diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for language-Modula2
+
+## 0.1 -- 2020-11-01
+
+* First version. Released on an unsuspecting world.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,15 @@
+language-Modula2 - Modula-2 parser, pretty-printer, and more
+------------------------------------------------------------
+
+This package provides a library and executable for parsing and processing the source code in programming language
+Modula-2. The following functionality is presently available:
+
+* Parsing with the grammars specified in the
+  [Grammar](http://hackage.haskell.org/package/language-modula-2/docs/Language-Modula-2-Grammar.html) module.
+* Constant folding with the
+  [ConstantFolder](http://hackage.haskell.org/package/language-modula-2/docs/Language-Modula-2-ConstantFolder.html) module.
+* Pretty-printing of a parsed AST with the
+  [Pretty](http://hackage.haskell.org/package/language-modula-2/docs/Language-Modula-2-Pretty.html) module.
+
+Much of this functionality is reused from the [`language-oberon`](http://hackage.haskell.org/package/language-oberon)
+package, and more should be coming in due course.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/app/Parse.hs b/app/Parse.hs
new file mode 100644
--- /dev/null
+++ b/app/Parse.hs
@@ -0,0 +1,180 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeFamilies #-}
+
+module Main where
+
+import Language.Modula2 (Placed, Version(Report, ISO), SomeVersion(SomeVersion), parseModule, parseAndSimplifyModule,
+                         resolvePosition, resolvePositions)
+import Language.Modula2.AST (Language, Module(..), StatementSequence, Statement, Expression)
+import Language.Modula2.ConstantFolder (ConstantFold)
+import qualified Language.Modula2.Abstract as Abstract
+import qualified Language.Modula2.AST as AST
+import qualified Language.Modula2.Grammar as Grammar
+import qualified Language.Modula2.ConstantFolder -- brings in HasField instances
+import qualified Language.Modula2.ISO.AST as ISO.AST
+import qualified Language.Modula2.ISO.Grammar as ISO.Grammar
+import qualified Language.Modula2.ISO.ConstantFolder -- brings in HasField instances
+
+import qualified Language.Oberon.Reserializer as Reserializer
+
+import qualified Rank2 as Rank2 (Product(Pair), snd)
+import qualified Transformation.Rank2 as Rank2
+import qualified Transformation.Deep as Deep
+import qualified Transformation.Full as Full
+import Transformation.AG.Generics (Auto)
+
+import Data.Text.Prettyprint.Doc (Pretty(pretty))
+import Data.Text.Prettyprint.Doc.Util (putDocW)
+
+import Control.Monad
+import Data.Data (Data)
+import Data.Either.Validation (Validation(..), validationToEither)
+import Data.Functor.Identity (Identity(Identity))
+import Data.Functor.Compose (Compose, getCompose)
+import Data.List.NonEmpty (NonEmpty((:|)))
+import qualified Data.Map.Lazy as Map
+import Data.Maybe (fromMaybe)
+import Data.Monoid ((<>))
+import Data.Text (Text, unpack)
+import Data.Text.IO (getLine, readFile, getContents)
+import qualified Data.Text.IO as Text
+import Data.Typeable (Typeable)
+import Options.Applicative
+import Text.Grampa (Ambiguous, Grammar, ParseResults, parseComplete, failureDescription)
+import qualified Text.Grampa.ContextFree.LeftRecursive as LeftRecursive
+import ReprTree
+import System.FilePath (FilePath, addExtension, combine, takeDirectory)
+
+import Prelude hiding (getLine, getContents, readFile)
+
+import Debug.Trace
+
+data GrammarMode = SimplifiedModuleMode | ModuleMode | StatementsMode | ExpressionMode
+    deriving Show
+
+data Output = Original | Plain | Pretty Int | Tree
+            deriving Show
+
+data Opts = Opts
+    { optsMode        :: GrammarMode
+    , optsVersion     :: SomeVersion
+    , optsIndex       :: Int
+    , optsOutput      :: Output
+    , optsInclude     :: Maybe FilePath
+    , optsFile        :: Maybe FilePath
+    } deriving Show
+
+main :: IO ()
+main = execParser opts >>= main'
+  where
+    opts = info (helper <*> p)
+        ( fullDesc
+       <> progDesc "Parse a Modula-2 file, or parse interactively"
+       <> header "Modula-2 parser")
+
+    p :: Parser Opts
+    p = Opts
+        <$> mode
+        <*> (SomeVersion Report <$ switch (long "report")
+             <|> SomeVersion ISO <$ switch (long "ISO" <> long "iso"))
+        <*> (option auto (long "index" <> help "Index of ambiguous parse" <> showDefault <> value 0 <> metavar "INT"))
+        <*> (Pretty <$> option auto (long "pretty" <> help "Pretty-print output" <> metavar "WIDTH")
+             <|> flag' Tree (long "tree" <> help "Print the output as an abstract syntax tree")
+             <|> flag' Original (long "original" <> help "Print the output with the original tokens and whitespace")
+             <|> pure Plain)
+        <*> optional (strOption (short 'i' <> long "include" <> metavar "DIRECTORY"
+                                 <> help "Where to look for imports"))
+        <*> optional (strArgument
+            ( metavar "FILE"
+              <> help "Modula-2 file to parse"))
+
+    mode :: Parser GrammarMode
+    mode = SimplifiedModuleMode   <$ switch (long "simplified-module")
+       <|> ModuleMode          <$ switch (long "module")
+       <|> StatementsMode      <$ switch (long "statements")
+       <|> ExpressionMode      <$ switch (long "expression")
+
+main' :: Opts -> IO ()
+main' Opts{..} =
+   case optsVersion
+   of SomeVersion Report -> process Report
+      SomeVersion ISO -> process ISO
+  where
+     process :: (Abstract.Modula2 l, Abstract.Nameable l,
+                 Full.Functor (Auto ConstantFold) (Abstract.Expression l l)) => Version l -> IO ()
+     process version =
+         case optsFile of
+             Just file -> (if file == "-" then getContents else readFile file)
+                          >>= case optsMode
+                              of SimplifiedModuleMode ->
+                                    \contents-> case version
+                                                of Report -> report contents (parseAndSimplifyModule Report contents)
+                                                   ISO -> report contents (parseAndSimplifyModule ISO contents)
+                                 ModuleMode
+                                    | Report <- version -> go Report Grammar.compilationUnit file
+                                    | ISO <- version -> go ISO Grammar.compilationUnit file
+                                 _ -> error "A file usually contains a whole module."
+
+             Nothing | Report <- version ->
+                 forever $
+                 getLine >>=
+                 case optsMode of
+                     ModuleMode     -> go Report Grammar.compilationUnit "<stdin>"
+                     StatementsMode -> go Report Grammar.statementSequence "<stdin>"
+                     ExpressionMode -> go Report Grammar.expression "<stdin>"
+             Nothing | ISO <- version ->
+                 forever $
+                 getLine >>=
+                 case optsMode of
+                     ModuleMode     -> go ISO Grammar.compilationUnit "<stdin>"
+                     StatementsMode -> go ISO Grammar.statementSequence "<stdin>"
+                     ExpressionMode -> go ISO Grammar.expression "<stdin>"
+     go :: (Show a, Pretty a, a ~ g l l Placed Placed,
+            Deep.Functor (Rank2.Map Grammar.NodeWrap Placed) (g l l),
+            Deep.Foldable Reserializer.Serialization (g l l)) =>
+           Version l
+        -> (forall p. Functor p => Grammar.Modula2Grammar l Grammar.NodeWrap p -> p (Grammar.NodeWrap (g l l Grammar.NodeWrap Grammar.NodeWrap)))
+        -> String -> Text -> IO ()
+     go Report production filename contents =
+        report contents (getCompose $ resolvePositions contents . snd
+                         <$> getCompose (production $ parseComplete Grammar.modula2grammar contents))
+     go ISO production filename contents =
+        report contents (getCompose $ resolvePositions contents . snd
+                         <$> getCompose (production $ Rank2.snd $ parseComplete (ISO.Grammar.modula2ISOgrammar) contents))
+     report :: (Pretty a, Show a, a ~ Placed (g l l Placed Placed),
+                Deep.Foldable Reserializer.Serialization (g l l)) => Text -> ParseResults Text [a] -> IO ()
+     report _ (Right [x]) = succeed optsOutput x
+     report _ (Right l) = putStrLn ("Ambiguous: " ++ show optsIndex ++ "/" ++ show (length l) ++ " parses")
+                          >> succeed optsOutput (l !! optsIndex)
+     report contents (Left err) = Text.putStrLn (failureDescription contents err 4)
+
+type NodeWrap = ((,) Int)
+
+
+succeed :: (Pretty a, Show a, a ~ Placed (g l l Placed Placed),
+            Deep.Foldable Reserializer.Serialization (g l l)) => Output -> a -> IO ()
+succeed out x = case out
+                of Original -> Text.putStr (Reserializer.reserialize x)
+                   Pretty width -> putDocW width (pretty x)
+                   --Tree -> putStrLn (reprTreeString x)
+                   Plain -> print x
+
+instance {-# overlaps #-} Pretty a => Pretty (Placed a) where
+   pretty = pretty . snd
+
+instance Pretty (Module Language Language Placed Placed) where
+   pretty m = pretty ((Identity . snd) Rank2.<$> m)
+instance Pretty (StatementSequence Language Language Placed Placed) where
+   pretty _ = error "Disambiguate before pretty-printing"
+instance Pretty (Statement Language Language Placed Placed) where
+   pretty _ = error "Disambiguate before pretty-printing"
+instance Pretty (Expression Language Language Placed Placed) where
+   pretty _ = error "Disambiguate before pretty-printing"
+
+instance Pretty (Module ISO.AST.Language ISO.AST.Language Placed Placed) where
+   pretty m = pretty ((Identity . snd) Rank2.<$> m)
+instance Pretty (StatementSequence ISO.AST.Language ISO.AST.Language Placed Placed) where
+   pretty _ = error "Disambiguate before pretty-printing"
+instance Pretty (ISO.AST.Statement ISO.AST.Language ISO.AST.Language Placed Placed) where
+   pretty _ = error "Disambiguate before pretty-printing"
+instance Pretty (ISO.AST.Expression ISO.AST.Language ISO.AST.Language Placed Placed) where
+   pretty _ = error "Disambiguate before pretty-printing"
diff --git a/examples/Dipl/BUFFERS.DEF b/examples/Dipl/BUFFERS.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/BUFFERS.DEF
@@ -0,0 +1,24 @@
+DEFINITION MODULE Buffers;
+
+FROM FIO IMPORT Separators, File;
+
+TYPE
+	CharSet=SET OF CHAR;
+	CharPtr=POINTER TO CHAR;
+
+VAR
+	input, output:File;
+	reachedLine:CARDINAL;
+	linePos, position, reached:LONGCARD;
+
+PROCEDURE ReadChar(VAR ch:CHAR);
+PROCEDURE Rewind(newPosition:LONGCARD);
+PROCEDURE FlushOut;
+PROCEDURE ReadWord(VAR wd:ARRAY OF CHAR; VAR firstChar, otherChars:CharSet);
+PROCEDURE WriteChars(a:ADDRESS);
+
+PROCEDURE OpenInput(filename:ARRAY OF CHAR):BOOLEAN;
+PROCEDURE CloseInput;
+PROCEDURE ReportError;
+
+END Buffers.
diff --git a/examples/Dipl/BUFFERS.MOD b/examples/Dipl/BUFFERS.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/BUFFERS.MOD
@@ -0,0 +1,184 @@
+IMPLEMENTATION MODULE Buffers;
+
+FROM Lib IMPORT IncAddr;
+FROM Str IMPORT Copy;
+FROM FIO IMPORT File, EOF, IOresult, ChopOff, IOcheck, Separators;
+FROM FIO IMPORT RdChar, WrChar, Seek, GetPos, Create, Open, Close;
+IMPORT IO;
+
+CONST
+	NULL=0C;
+	TAB=11C;
+	MaxHandles=10;
+VAR
+ 	inputOriginal,outOriginal:File;
+ 	lastChar:CHAR;
+ 	valid:BOOLEAN;
+ 	stack:ARRAY [1..MaxHandles] OF
+ 		RECORD
+ 			handle:File;
+ 			posReached:LONGCARD;
+ 			lineReached:CARDINAL;
+ 			linePosition:LONGCARD;
+ 		END;
+ 	top:[0..MaxHandles];
+
+PROCEDURE ReadChar(VAR ch:CHAR);
+BEGIN
+	INC(position);
+	IF NOT valid THEN
+		lastChar:=RdChar(input);
+		IF reached<position THEN
+			reached:=position;
+			IF lastChar=CHR(10) THEN
+				INC(reachedLine);
+				linePos:=position
+			END
+		END;
+		IF EOF THEN
+			lastChar:=IO.RdChar();
+			WrChar(input,lastChar)
+		END
+	ELSE
+		valid:=FALSE
+	END;
+	ch:=lastChar
+END ReadChar;
+
+PROCEDURE Rewind(newPos:LONGCARD);
+BEGIN
+	IF (position=newPos+1) AND (lastChar#0C) AND NOT valid THEN
+		valid:=TRUE
+	ELSE
+		valid:=FALSE;
+		lastChar:=0C;
+		Seek(input,newPos)
+	END;
+	position:=newPos
+END Rewind;
+
+PROCEDURE FlushOut;
+VAR
+	count,last:LONGCARD;
+BEGIN
+	IF output=outOriginal THEN
+		last:=GetPos(output);
+		Seek(output,0);
+		FOR count:=1 TO last DO
+			IO.WrChar(RdChar(output))
+		END
+	END
+END FlushOut;
+
+PROCEDURE ReadWord(VAR wd:ARRAY OF CHAR; VAR first,rest:CharSet);
+VAR
+	i:CARDINAL;
+	ch:CHAR;
+BEGIN
+	ReadChar(ch);
+	i:=0;
+	IF ch IN first THEN
+		wd[0]:=ch;
+		REPEAT
+			ReadChar(ch);
+			INC(i);
+			wd[i]:=ch
+		UNTIL NOT(ch IN rest) OR (i=HIGH(wd));
+		IF ch IN rest THEN
+			REPEAT
+				ReadChar(ch)
+			UNTIL NOT(ch IN rest)
+		END
+	END;
+	wd[i]:=NULL;
+	Rewind(position-1)
+END ReadWord;
+
+PROCEDURE WriteChars(a:ADDRESS);
+TYPE
+	CharPtr=POINTER TO CHAR;
+BEGIN
+	WHILE CharPtr(a)^#NULL DO
+		WrChar(output,CharPtr(a)^);
+		IncAddr(a,1)
+	END
+END WriteChars;
+
+PROCEDURE ReportError;
+VAR
+	ch:CHAR;
+	i:CARDINAL;
+BEGIN
+   IO.WrStr('Line ');
+   IO.WrCard(reachedLine,0);
+   IO.WrLn;
+   Seek(input,linePos);
+   REPEAT
+      ch:=RdChar(input);
+      IF ch=TAB THEN
+      	ch:=' '
+      END;
+      IO.WrChar(ch)
+   UNTIL (ch=CHR(13)) OR EOF;
+   IO.WrLn;
+   FOR i:=2 TO CARDINAL(reached-linePos) DO
+      IO.WrChar(' ')
+   END;
+   IO.WrChar('^');
+   Rewind(position)
+END ReportError;
+
+PROCEDURE OpenInput(filename:ARRAY OF CHAR):BOOLEAN;
+VAR
+	handle:CARDINAL;
+	unique:ARRAY [0..7] OF CHAR;
+BEGIN
+	IF filename[0]=0C THEN
+		Copy(unique,'input  .buf');
+      unique[5]:=CHR(ORD('0') + top DIV 10);
+      unique[6]:=CHR(ORD('0') + top MOD 10);
+		handle:=Create(unique);
+	ELSE
+		handle:=Open(filename)
+	END;
+	IF IOresult()=0 THEN
+		INC(top);
+		WITH stack[top] DO
+			handle:=input;
+			posReached:=reached;
+			lineReached:=reachedLine;
+			linePosition:=linePos
+		END;
+		Seek(input,position);
+		input:=handle;
+		position:=0;
+		linePos:=0;
+		reached:=0;
+		reachedLine:=1;
+		valid:=FALSE
+	END;
+	RETURN IOresult()=0
+END OpenInput;
+
+PROCEDURE CloseInput;
+BEGIN
+	Close(input);
+	WITH stack[top] DO
+		input:=handle;
+		reached:=posReached;
+		reachedLine:=lineReached;
+		linePos:=linePosition
+	END;
+	DEC(top);
+	position:=GetPos(input);
+	valid:=FALSE
+END CloseInput;
+
+BEGIN
+   ChopOff:=FALSE;
+   IOcheck:=FALSE;
+   top:=0;
+   output:=Create("output.buf");
+   outOriginal:=output
+END Buffers.
+
diff --git a/examples/Dipl/CILE.MOD b/examples/Dipl/CILE.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/CILE.MOD
@@ -0,0 +1,102 @@
+MODULE CILE;
+
+FROM IO IMPORT WrStr, WrLn, WrCard, EndOfRd, RdChar;
+IMPORT IO;
+FROM Machine IMPORT link, Root, result;
+FROM Machine IMPORT Reduce, StartLayer, PopLayer, SaveDefinition;
+FROM Machine IMPORT MakeDef, MakePacked, MakeString, ExtractPacked;
+FROM Library IMPORT wStruct, wFile, wAncestor;
+FROM Library IMPORT wString, wError, errorCodes, wUndefined;
+FROM Names IMPORT AddAtom, AddPrimWord, NewDictionary, OldDictionary;
+FROM Buffers IMPORT ReportError, OpenInput, CloseInput;
+FROM Parser IMPORT Parse;
+FROM Decoder IMPORT wWrite;
+FROM Grammars IMPORT wGrammar, wFail, wSentence, wDone;
+(* FROM Graph IMPORT SetVideoMode, InitGraph; *)
+IMPORT PMD;
+
+VAR
+	wInterpret,wQuit,wLoad:link;
+	level:CARDINAL;
+
+(*# data(stack_size => 0FF00H) *)
+	
+PROCEDURE pInterpret;
+VAR
+	ch,empty:CHAR;
+BEGIN
+	empty:=0C;
+	INC(level);
+	LOOP
+		MakeString(wFile^,wString,ADR(empty));
+		WrLn;
+		WrStr('Reduce[');
+		WrCard(level,0);
+		WrStr(']>');
+		Reduce(wLoad^);
+		WHILE NOT EndOfRd(FALSE) DO
+			ch:=RdChar()
+		END;
+		WrStr('  ');
+		IF Root(result)=wQuit THEN
+			MakeDef(result,wDone);
+			EXIT
+		ELSE
+			StartLayer;
+			SaveDefinition(wStruct);
+			wStruct^:=result;
+			Reduce(wWrite^);
+			IF Root(result)=wFail THEN
+				WrStr('Output error!')
+			END;
+			PopLayer
+		END
+	END;
+	DEC(level)
+END pInterpret;
+
+PROCEDURE pLoad;
+VAR
+	filename:ARRAY [0..30] OF CHAR;
+	newFile:BOOLEAN;
+	ch:CHAR;
+BEGIN
+	Reduce(wFile^);
+	newFile:=(Root(result)=wString);
+	IF newFile THEN
+		ExtractPacked(result,filename);
+		IF NOT OpenInput(filename) THEN
+			MakePacked(result,wError,IOError);
+			RETURN
+		END;
+      SaveDefinition(wFile);
+      MakeDef(wFile^,wUndefined)
+	END;
+	NewDictionary;
+	StartLayer;
+	SaveDefinition(wGrammar);
+	wGrammar^:=wSentence^;
+	Parse;
+	PopLayer;
+	SaveDefinition(wAncestor);
+	wAncestor^:=result;
+	Reduce(result);
+	OldDictionary;
+	IF newFile THEN
+		CloseInput
+	END
+END pLoad;
+
+BEGIN
+	level:=0;
+	AddAtom(wQuit,'Quit');
+	AddPrimWord(wInterpret, 'Interpret', pInterpret);
+	AddPrimWord(wLoad, 'Load', pLoad);
+(*	InitGraph;
+	IF NOT SetVideoMode(7) THEN
+		WrStr('Prebacivanje u tekst mod nije uspelo!')
+	END;
+*)
+	pInterpret
+END CILE.
+
diff --git a/examples/Dipl/DECODER.DEF b/examples/Dipl/DECODER.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/DECODER.DEF
@@ -0,0 +1,13 @@
+DEFINITION MODULE Decoder;
+
+FROM Machine IMPORT link, closure;
+
+VAR
+	wWrite, wWriteGrammar:link;
+
+PROCEDURE Write;
+PROCEDURE WriteGrammar;
+
+END Decoder.
+
+
diff --git a/examples/Dipl/DECODER.MOD b/examples/Dipl/DECODER.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/DECODER.MOD
@@ -0,0 +1,570 @@
+IMPLEMENTATION MODULE Decoder;
+
+FROM SYSTEM IMPORT TSIZE;
+FROM Lib IMPORT IncAddr;
+FROM Memory IMPORT ALLOCATE, AddMarker, MarkNeeded;
+FROM FIO IMPORT File, Create, Close, Seek, GetPos, WrChar, WrStr, WrLn, WrInt, WrLngHex, IOresult;
+FROM Buffers IMPORT output, FlushOut, WriteChars, CharPtr, CharSet;
+
+FROM Machine IMPORT EmptyClosure, link, HandlePackage, Reduce, Envelope, Root, result;
+FROM Machine IMPORT wPackage, tempDef, MakePrimitive, MakeDef, MakePacked, ExtractPacked;
+FROM Machine IMPORT SaveDefinition, NewLayer, StartLayer, PopLayer, Equal;
+FROM Machine IMPORT Copy, RemoveEnv, MarkLink, Join;
+
+FROM Library IMPORT wChar, wCharSet, wString, wNumber, wError, errorCodes;
+FROM Library IMPORT wStruct, wProperty, wValue, wFile, wDescription;
+FROM Library IMPORT wAddProp, wAddValProp;
+
+FROM Grammars IMPORT wSequence, wLexSequence, wValSequence, wLexValSequence;
+FROM Grammars IMPORT wEndSeq, wChoice, wOption;
+FROM Grammars IMPORT wDummy, wFail, wDone, wDiscard, wRaise, wGrammar, wNext;
+FROM Grammars IMPORT wSeparator, wFrameGrammar, wCustomGrammar;
+FROM Grammars IMPORT wFirst, wTail, wIdentGrammar, wIdentifier, wCharSetGrammar;
+FROM Grammars IMPORT wCharGrammar, wStrGrammar, wNumGrammar, wErrorGrammar, wPackageGrammar;
+FROM Grammars IMPORT Failure, Confirmation, HoldDummy;
+
+FROM Names IMPORT DefName, DefEntry, wName, wMeaning;
+FROM Names IMPORT AddPrimWord;
+
+TYPE
+	PassPtr=POINTER TO PassPoint;
+	PassPoint=RECORD
+		grammar,statement:closure;
+		next:PassPtr
+	END;
+
+VAR
+	wStatement:link;
+	oldChar, oldString, oldNumber, oldError, oldRoute:closure;
+	separated:BOOLEAN;
+	path:PassPtr;
+
+PROCEDURE PopPath;
+BEGIN
+	path:=path^.next
+END PopPath;
+
+PROCEDURE PathClosed():BOOLEAN;
+VAR
+	follow:PassPtr;
+BEGIN
+	follow:=path;
+	WHILE (follow#NIL) AND
+			((follow^.grammar#wGrammar^) OR (follow^.statement#wStatement^)) DO
+		follow:=follow^.next
+	END;
+	IF follow=NIL THEN
+		NEW(follow);
+		follow^.grammar:=wGrammar^;
+		follow^.statement:=wStatement^;
+		follow^.next:=path;
+		path:=follow;
+		RETURN FALSE
+	ELSE
+		RETURN TRUE
+	END
+END PathClosed;
+
+PROCEDURE PhraseTheLetter;
+VAR
+	chExpect,chIs:CHAR;
+BEGIN
+	ExtractPacked(wPackage^,chExpect);
+	IF wStatement^#EmptyClosure THEN
+		SaveDefinition(wChar);
+		wChar^:=HandlePackage;
+		Reduce(wStatement^);
+		ExtractPacked(result,chIs);
+		IF chExpect#chIs THEN
+			result:=Failure;
+			RETURN
+		END
+	END;
+	WrChar(output,chExpect);
+	result:=Confirmation
+END PhraseTheLetter;
+
+PROCEDURE PhraseTheString;
+VAR
+	str:CharPtr;
+BEGIN
+	IF wStatement^#EmptyClosure THEN
+		SaveDefinition(wString);
+		wString^:=HandlePackage;
+		Reduce(wStatement^);
+		IF NOT Equal(wPackage^,result) THEN
+			result:=Failure;
+			RETURN
+		END
+	END;
+	ExtractPacked(wPackage^,str);
+	WriteChars(str);
+	result:=Confirmation
+END PhraseTheString;
+
+PROCEDURE PhraseTheCharSet;
+VAR
+	s:POINTER TO CharSet;
+	ch:CHAR;
+BEGIN
+	SaveDefinition(wChar);
+	wChar^:=HandlePackage;
+	Reduce(wStatement^);
+	IF Root(result)=wChar THEN
+		ExtractPacked(result,ch);
+		ExtractPacked(wPackage^,s);
+		IF ch IN s^ THEN
+			WrChar(output,ch);
+			result:=Confirmation
+		ELSE
+			result:=Failure
+		END
+	ELSE
+		result:=Failure
+	END
+END PhraseTheCharSet;
+
+PROCEDURE PhraseChoice;
+BEGIN
+	Reduce(wGrammar^);
+	IF Root(result)=wFail THEN
+		Reduce(wNext^)
+	END
+END PhraseChoice;
+
+PROCEDURE PhraseOption;
+BEGIN
+	Reduce(wGrammar^);
+	IF Root(result)=wFail THEN
+		result:=HoldDummy
+	END
+END PhraseOption;
+
+PROCEDURE PhraseSeqPrimitive(separate:BOOLEAN);
+VAR
+	down:closure;
+	downPtr:link;
+	oldPos:LONGCARD;
+BEGIN
+	downPtr:=Root(wProperty^);
+	oldPos:=GetPos(output);
+	SaveDefinition(wStatement);
+	StartLayer;
+	SaveDefinition(wStatement);
+	IF downPtr#wDiscard THEN
+		IF (downPtr#wRaise) THEN
+			StartLayer;
+			SaveDefinition(downPtr);
+			downPtr^:=EmptyClosure;
+			NewLayer(wStatement^);
+			down:=downPtr^;
+			PopLayer;
+			IF down=EmptyClosure THEN
+				result:=Failure;
+				PopLayer;
+				RETURN
+			END;
+			wStatement^:=down
+		END
+	ELSE
+		wStatement^:=EmptyClosure
+	END;
+	IF PathClosed() THEN
+		result:=Failure;
+		RETURN
+	END;
+	separated:=FALSE;
+	Reduce(wGrammar^);
+	PopPath;
+	PopLayer;
+	IF Root(result)#wFail THEN
+(*
+		IF (Root(wProperty^)=wRaise) AND (Root(result)=wDone) THEN
+			MakeDef(tempDef,wDummy);
+			Join(tempDef,wStatement^);
+			wStatement^:=tempDef
+		END;
+*)
+		IF separate AND (GetPos(output)>oldPos) AND NOT separated THEN
+			StartLayer;
+			SaveDefinition(wChar);
+			SaveDefinition(wString);
+			SaveDefinition(wStatement);
+			MakePrimitive(wChar^,PhraseTheLetter);
+			MakePrimitive(wString^,PhraseTheString);
+			wStatement^:=EmptyClosure;
+			Reduce(wSeparator^);
+			PopLayer;
+			separated:=TRUE
+		END;
+		Reduce(wNext^);
+		IF Root(result)=wFail THEN
+			Seek(output,oldPos)
+		END
+	END	
+END PhraseSeqPrimitive;
+
+PROCEDURE PhraseSequence;
+BEGIN
+	PhraseSeqPrimitive(TRUE)
+END PhraseSequence;
+
+PROCEDURE PhraseLexSequence;
+BEGIN
+	PhraseSeqPrimitive(FALSE)
+END PhraseLexSequence;
+
+PROCEDURE PhraseEndSequence;
+BEGIN
+	IF (Root(wStruct^)=wDummy) OR (Root(wStatement^)=Root(wStruct^)) THEN
+		result:=Confirmation
+	ELSE
+		result:=Failure
+	END
+END PhraseEndSequence;
+
+PROCEDURE PhraseNumber;
+VAR
+	num:INTEGER;
+BEGIN
+	IF Root(wStatement^)#wNumber THEN
+		result:=Failure;
+		RETURN
+	END;
+	SaveDefinition(wNumber);
+	wNumber^:=HandlePackage;
+	Reduce(wStatement^);
+	ExtractPacked(result,num);
+	WrInt(output,num,0);
+	result:=Confirmation
+END PhraseNumber;
+
+PROCEDURE PhrasePackage;
+VAR
+	contents:LONGCARD;
+BEGIN
+	WrChar(output,'[');
+	ExtractPacked(wStatement^,contents);
+	WrLngHex(output,contents,0);
+	WrChar(output,']')
+END PhrasePackage;
+
+PROCEDURE PhraseChar;
+VAR
+	ch:CHAR;
+BEGIN
+	IF Root(wStatement^)#wChar THEN
+		result:=Failure;
+		RETURN
+	END;
+	SaveDefinition(wChar);
+	wChar^:=HandlePackage;
+	Reduce(wStatement^);
+	ExtractPacked(result,ch);
+	WrChar(output, "'");
+	WrChar(output,ch);
+	WrChar(output, "'");
+END PhraseChar;
+
+PROCEDURE PhraseCharSET;
+VAR
+	s:SET OF CHAR;
+	ch:CHAR;
+	first:BOOLEAN;
+BEGIN
+	IF Root(wStatement^)=wCharSet THEN
+		SaveDefinition(wCharSet);
+		wCharSet^:=HandlePackage;
+		Reduce(wStatement^);
+		ExtractPacked(result,s);
+		ch:=MIN(CHAR);
+		WrChar(output,'{');
+		first:=TRUE;
+		LOOP
+			IF ch IN s THEN
+				IF first THEN
+					first:=FALSE
+				ELSE
+					WrChar(output,',')
+				END;
+				IF (ch=' ') OR (ch='}') OR (ch='{') OR (ch='\') THEN
+					WrChar(output,'\')
+				END;
+				WrChar(output,ch);
+				INC(ch);
+				IF ch IN s THEN
+					REPEAT
+						INC(ch)
+					UNTIL NOT (ch IN s);
+					DEC(ch);
+					WrChar(output,'-');
+					IF (ch=' ') OR (ch='}') OR (ch='{') OR (ch='\') THEN
+						WrChar(output,'\')
+					END;
+					WrChar(output,ch);
+					INC(ch)
+				END
+			ELSIF ch<MAX(CHAR) THEN
+				INC(ch)
+			ELSE
+				EXIT
+			END
+		END;
+		WrChar(output,'}')
+	ELSE
+		result:=Failure
+	END
+END PhraseCharSET;
+
+PROCEDURE PhraseIdent;
+VAR
+	string:POINTER TO CHAR;
+	s:POINTER TO SET OF CHAR;
+BEGIN
+	IF Root(wStatement^)=wIdentifier THEN
+		NewLayer(wStatement^);
+		SaveDefinition(wString);
+		wString^:=HandlePackage;
+		Reduce(wDescription^);
+		ExtractPacked(result,string)
+	ELSE
+		string:=DefName(Root(wStatement^))
+	END;
+	SaveDefinition(wCharSet);
+	wCharSet^:=HandlePackage;
+	Reduce(wFirst^);
+	ExtractPacked(result,s);
+	IF string^ IN s^ THEN
+		Reduce(wTail^);
+		ExtractPacked(result,s);
+		REPEAT
+			WrChar(output,string^);
+			IncAddr(string,1)
+		UNTIL NOT (string^ IN s^) OR (string^=0C);
+		IF string^=0C THEN
+			result:=Confirmation;
+			RETURN
+		END
+	END;
+	result:=Failure
+END PhraseIdent;
+	
+PROCEDURE PhraseString;
+VAR
+	string:ADDRESS;
+BEGIN
+	IF Root(wStatement^)#wString THEN
+		result:=Failure;
+		RETURN
+	END;
+	SaveDefinition(wString);
+	wString^:=HandlePackage;
+	Reduce(wStatement^);
+	ExtractPacked(result,string);
+	WrChar(output,'"');
+	WriteChars(string);
+	WrChar(output,'"');
+	result:=Confirmation
+END PhraseString;
+	
+PROCEDURE PhraseError;
+VAR
+	err:errorCodes;
+BEGIN
+	IF Root(wStatement^)#wError THEN
+		result:=Failure;
+		RETURN
+	END;
+	SaveDefinition(wError);
+	wString^:=HandlePackage;
+	Reduce(wStatement^);
+	ExtractPacked(result,err);
+	CASE err OF
+		NotLogicalType:WrStr(output,'Not the logical type!')
+		|NotNumberType:WrStr(output,'Not the number type!')
+		|NotStringType:WrStr(output,'Not the string type!')
+		|IOError:WrStr(output,'(R) Tape loading error!')
+		|SyntaxError:WrStr(output,'Syntax error!')
+		|NotFound:WrStr(output,'Undefined word meaning!')
+	END;
+	WrLn(output);
+	result:=Confirmation
+END PhraseError;
+
+PROCEDURE PhraseCustom;
+FORWARD;
+
+PROCEDURE PhraseStd;
+VAR
+	oldPos:LONGCARD;
+BEGIN
+	oldPos:=GetPos(output);
+	SaveDefinition(wStatement);
+	WriteChars(DefName(Root(wStatement^)));
+(*
+	IF Root(wFrameGrammar^)#wFail THEN
+		StartLayer;
+		SaveDefinition(wGrammar);
+		wGrammar^:=wFrameGrammar^;
+		PhraseGrammar;
+		PopLayer;
+		IF Root(result)#wFail THEN
+			RETURN
+		END
+	END;
+*)
+	Envelope(result,wStatement^,wAddProp,wAddValProp,wDone,wProperty,wValue,wStruct);
+	WrChar(output,'(');
+	LOOP
+		IF Root(result)=wDone THEN
+			EXIT
+		END;
+		StartLayer;
+		NewLayer(result);
+		WriteChars(DefName(Root(wProperty^)));
+		IF Root(result)=wAddValProp THEN
+			WrChar(output,':')
+		END;
+		WrChar(output,'=');
+		wStatement^:=wValue^;
+		PhraseCustom;
+		IF Root(result)=wFail THEN
+			PopLayer;
+			EXIT
+		END;
+		result:=wStruct^;
+		PopLayer;
+		IF Root(result)#wDone THEN
+			WrChar(output,',')
+		END
+	END;
+	IF Root(result)=wFail THEN
+		Seek(output,oldPos)
+	ELSE
+		WrChar(output,')')
+	END
+END PhraseStd;
+
+PROCEDURE PhraseCustom;
+VAR
+	prop:closure;
+BEGIN
+	SaveDefinition(wCustomGrammar);
+	MakePrimitive(wCustomGrammar^,PhraseStd);
+	SaveDefinition(wFrameGrammar);
+	wFrameGrammar^:=Failure;
+	prop:=DefEntry(Root(wStatement^));
+	StartLayer;
+	NewLayer(prop);
+	result:=wCustomGrammar^;
+	PopLayer;
+	SaveDefinition(wGrammar);
+	wGrammar^:=result;
+	Reduce(result)
+END PhraseCustom;
+
+PROCEDURE PhraseGrammar;
+BEGIN
+	SaveDefinition(wSequence);
+	MakePrimitive(wSequence^,PhraseSequence);
+	SaveDefinition(wValSequence);
+	MakePrimitive(wValSequence^,PhraseSequence);
+	SaveDefinition(wLexSequence);
+	MakePrimitive(wLexSequence^,PhraseSequence);
+	SaveDefinition(wLexValSequence);
+	MakePrimitive(wLexValSequence^,PhraseSequence);
+	SaveDefinition(wEndSeq);
+	MakePrimitive(wEndSeq^,PhraseEndSequence);
+	SaveDefinition(wChoice);
+	MakePrimitive(wChoice^,PhraseChoice);
+	SaveDefinition(wOption);
+	MakePrimitive(wOption^,PhraseOption);
+	SaveDefinition(wChar);
+	MakePrimitive(wChar^,PhraseTheLetter);
+	SaveDefinition(wString);
+	MakePrimitive(wString^,PhraseTheString);
+	SaveDefinition(wCharSet);
+	MakePrimitive(wCharSet^,PhraseTheCharSet);
+	SaveDefinition(wPackageGrammar);
+	MakePrimitive(wPackageGrammar^,PhrasePackage);
+	SaveDefinition(wCharGrammar);
+	MakePrimitive(wCharGrammar^,PhraseChar);
+	SaveDefinition(wCharSetGrammar);
+	MakePrimitive(wCharSetGrammar^,PhraseCharSET);
+	SaveDefinition(wIdentGrammar);
+	MakePrimitive(wIdentGrammar^,PhraseIdent);
+	SaveDefinition(wStrGrammar);
+	MakePrimitive(wStrGrammar^,PhraseString);
+	SaveDefinition(wNumGrammar);
+	MakePrimitive(wNumGrammar^,PhraseNumber);
+	SaveDefinition(wErrorGrammar);
+	MakePrimitive(wErrorGrammar^,PhraseError);
+	SaveDefinition(wCustomGrammar);
+	MakePrimitive(wCustomGrammar^,PhraseCustom);
+	SaveDefinition(wStatement);
+	wStatement^:=wStruct^;
+	
+	Reduce(wGrammar^);
+	path:=NIL
+END PhraseGrammar;
+
+PROCEDURE WriteGrammar;
+CONST
+	FormalLength=1000;
+VAR
+	filename:POINTER TO ARRAY [0..FormalLength] OF CHAR;
+	oldHandle:File;
+BEGIN
+	Reduce(wFile^);
+	oldHandle:=output;
+	IF Root(result)=wString THEN
+		ExtractPacked(result,filename);
+		IF filename^[0]#0C THEN
+			output:=Create(filename^);
+			IF IOresult()#0 THEN
+				MakePacked(result,wError,IOError);
+				output:=oldHandle;
+				RETURN
+			END
+		END
+	END;
+	Seek(output,0);
+	PhraseGrammar;
+	IF Root(result)#wFail THEN
+		FlushOut
+	END;
+	IF output#oldHandle THEN
+		Close(output);
+		output:=oldHandle
+	END
+END WriteGrammar;
+
+PROCEDURE Write;
+BEGIN
+	SaveDefinition(wGrammar);
+	MakePrimitive(wGrammar^,PhraseCustom);
+	WriteGrammar
+END Write;
+
+PROCEDURE MarkPath;
+VAR
+	follow:PassPtr;
+	fresh:BOOLEAN;
+BEGIN
+	MarkLink(wStatement);
+	follow:=path;
+	WHILE follow#NIL DO
+		MarkNeeded(follow,TSIZE(PassPoint),fresh);
+		follow:=follow^.next
+	END
+END MarkPath;
+
+BEGIN
+	path:=NIL;
+	NEW(wStatement);
+	wStatement^:=EmptyClosure;
+	AddMarker(MarkPath);
+	AddPrimWord(wWrite,'Write',Write);
+	AddPrimWord(wWriteGrammar,'WriteGrammar',WriteGrammar)
+END Decoder.
+
diff --git a/examples/Dipl/GRAMMARS.DEF b/examples/Dipl/GRAMMARS.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/GRAMMARS.DEF
@@ -0,0 +1,20 @@
+DEFINITION MODULE Grammars;
+
+FROM Machine IMPORT link,closure;
+FROM Library IMPORT wDummy, wPacked;
+
+VAR
+	Failure, Confirmation, HoldDummy:closure;
+	wParse, wWrite, wWriteGrammar:link;
+	wGrammar, wRest, wNext, wRoot:link;
+	wFail, wDone, wRaise, wDiscard:link;
+	wSequence, wLexSequence, wValSequence, wLexValSequence:link;
+	wEndSeq, wChoice, wOption:link;
+	wSpaces, wComment, wSpaceChars, wSeparator:link;
+	wPackageGrammar, wNumGrammar, wCharGrammar, wCharSetGrammar, wStrGrammar, wErrorGrammar:link;
+	wFirst, wTail, wIdentGrammar, wIdentifier:link;
+	wStructGrammar, wEnvGrammar, wSentence:link;
+	wCustomGrammar, wFrameGrammar:link;
+END Grammars.
+
+
diff --git a/examples/Dipl/GRAMMARS.MOD b/examples/Dipl/GRAMMARS.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/GRAMMARS.MOD
@@ -0,0 +1,219 @@
+IMPLEMENTATION MODULE Grammars;
+
+(*# call(o_a_copy=>off, o_a_size=>off) *)
+
+FROM Memory IMPORT AddMarker;
+
+FROM Machine IMPORT EmptyClosure, link, HandlePackage, tempDef, AddEnv;
+FROM Machine IMPORT MakeDef, MakePrimitive, MakeString, MakePacked;
+FROM Machine IMPORT closure, handlerType, Build, MarkClosure;
+
+FROM Library IMPORT wChar, wCharSet, wString, wNumber, wError, wVain;
+FROM Library IMPORT wAddProp, wAddValProp, wJoin, wQuote, wCopy, wFind, wDummy;
+FROM Library IMPORT wType, wStruct, wProperty, wValue, wDescription;
+
+FROM Names IMPORT DefineWord, AddArgument, AddAtom, DefEntry, wName;
+
+TYPE CharSet=SET OF CHAR;
+
+PROCEDURE ChrDef(ch:CHAR):closure;
+VAR
+	result:closure;
+BEGIN
+	MakePacked(result,wChar,ch);
+	RETURN result
+END ChrDef;
+
+PROCEDURE StrDef(str:ARRAY OF CHAR):closure;
+VAR
+	result:closure;
+BEGIN
+	MakeString(result,wString,ADR(str));
+	RETURN result
+END StrDef;
+
+PROCEDURE Prim(h:handlerType):closure;
+VAR
+	result:closure;
+BEGIN
+	MakePrimitive(result,h);
+	RETURN result
+END Prim;
+
+PROCEDURE Def(root:link):closure;
+VAR
+	result:closure;
+BEGIN
+	MakeDef(result,root);
+	RETURN result
+END Def;
+
+PROCEDURE Obj(str:closure; prop:link; value:closure):closure;
+BEGIN
+	AddEnv(str,prop,value);
+	RETURN str
+END Obj;
+
+PROCEDURE Seq(pp:link; g,n:closure):closure;
+BEGIN
+	RETURN Obj(Obj(Obj(Def(wSequence),
+		wProperty,Def(pp)),
+		wGrammar,g),
+		wNext,n)
+END Seq;
+
+PROCEDURE ValSeq(pp:link; g,n:closure):closure;
+BEGIN
+	RETURN Obj(Obj(Obj(Def(wValSequence),
+		wProperty,Def(pp)),
+		wGrammar,g),
+		wNext,n)
+END ValSeq;
+
+PROCEDURE EndSeq(root:link):closure;
+BEGIN
+	RETURN Obj(Def(wEndSeq), wStruct, Def(root))
+END EndSeq;
+
+PROCEDURE Option(g:closure):closure;
+BEGIN
+	RETURN Obj(Def(wOption), wGrammar, g)
+END Option;
+
+PROCEDURE Choose(g,n:closure):closure;
+BEGIN
+	RETURN Obj(Obj(Def(wChoice),
+		wGrammar,g),
+		wNext,n)
+END Choose;
+
+PROCEDURE MarkFailure;
+BEGIN
+	MarkClosure(Failure);
+	MarkClosure(Confirmation);
+	MarkClosure(HoldDummy)
+END MarkFailure;
+
+VAR
+	entry:closure;	(* unmarked temporary, used only during initialisation *)
+
+BEGIN
+	AddAtom(wFail, 'Fail');
+	MakeDef(Failure,wFail);
+	AddAtom(wDone, 'Done');
+	MakeDef(Confirmation,wDone);
+	MakeDef(HoldDummy,wDummy);
+	AddMarker(MarkFailure);
+
+	AddAtom(wDiscard, 'Discard');
+	AddAtom(wRaise, 'Raise');
+	AddArgument(wGrammar, 'Grammar');
+	AddArgument(wNext, 'Next');
+	DefineWord(wSeparator, 'Separator', HandlePackage);
+	
+	MakePacked(tempDef,wCharSet,CharSet{'A'..'Z','a'..'z'});
+	DefineWord(wFirst, 'First', tempDef);
+	MakePacked(tempDef,wCharSet,CharSet{'0'..'9','A'..'Z','a'..'z'});
+	DefineWord(wTail, 'Tail', tempDef);
+
+	DefineWord(wFrameGrammar, 'FrameGrammar', Failure);
+	AddAtom(wCustomGrammar, 'CustomGrammar');
+	AddAtom(wPackageGrammar, 'PackageGrammar');
+	AddAtom(wNumGrammar, 'NumGrammar');
+	AddAtom(wCharSetGrammar, 'CharSetGrammar');
+	AddAtom(wCharGrammar, 'CharGrammar');
+	AddAtom(wErrorGrammar, 'ErrorGrammar');
+	AddAtom(wStrGrammar, 'StrGrammar');
+	AddAtom(wIdentGrammar, 'IdentGrammar');
+	DefineWord(wIdentifier, 'Identifier', HandlePackage);
+	DefineWord(wSpaceChars, 'SpaceChars', EmptyClosure);
+	MakePacked(wSpaceChars^,wCharSet,CharSet{' ',15C,12C,11C}); (* space,LF,CR,TAB *)
+	AddAtom(wSpaces, 'Spaces');
+	DefineWord(wComment, 'Comment', Failure);
+
+	MakeDef(tempDef,wVain);
+	DefineWord(wSequence, 'Seq', tempDef);
+	DefineWord(wLexSequence, 'LexSeq', tempDef);
+	DefineWord(wValSequence, 'ValSeq', tempDef);
+	DefineWord(wLexValSequence, 'LexValSeq', tempDef);
+	DefineWord(wEndSeq, 'EndSeq', tempDef);
+	DefineWord(wChoice, 'Choice', tempDef);
+	DefineWord(wOption, 'Option', tempDef);
+	
+	MakeDef(tempDef,wCharGrammar);
+	entry:=DefEntry(wChar);
+	AddEnv(entry,wCustomGrammar,tempDef);
+	
+	MakeDef(tempDef,wCharSetGrammar);
+	entry:=DefEntry(wCharSet);
+	AddEnv(entry,wCustomGrammar,tempDef);
+	
+	MakeDef(tempDef,wNumGrammar);
+	entry:=DefEntry(wNumber);
+	AddEnv(entry,wCustomGrammar,tempDef);
+	
+	MakeDef(tempDef,wStrGrammar);
+	entry:=DefEntry(wString);
+	AddEnv(entry,wCustomGrammar,tempDef);
+	
+	MakeDef(tempDef,wErrorGrammar);
+	entry:=DefEntry(wError);
+	AddEnv(entry,wCustomGrammar,tempDef);
+	
+	MakeDef(tempDef,wIdentGrammar);
+	entry:=DefEntry(wIdentifier);
+	AddEnv(entry,wCustomGrammar,tempDef);
+	
+	entry:=DefEntry(wPacked);
+	MakeDef(tempDef,wPackageGrammar);
+	AddEnv(entry,wCustomGrammar,tempDef);
+	
+	DefineWord(wSentence, 'Sentence', EmptyClosure);
+	DefineWord(wEnvGrammar, 'EnvGrammar', EmptyClosure);
+
+	wEnvGrammar^:=
+		Seq(wProperty,Def(wIdentGrammar),
+		Seq(wRaise, Choose(
+			Seq(wDiscard, ChrDef('='),
+			EndSeq(wAddProp)),
+
+			Seq(wDiscard, StrDef(':='),
+			EndSeq(wAddValProp))),
+		ValSeq(wValue, Def(wSentence),
+		ValSeq(wStruct,
+			Option(
+				Seq(wDiscard, ChrDef(','),
+				Seq(wRaise, Def(wEnvGrammar),
+				EndSeq(wDummy)))),
+		EndSeq(wDummy)))));
+
+(* StructGrammar::= Join(Struct=IdentGrammar '(' Description:=[EnvGrammar] ')'). *)
+	DefineWord(wStructGrammar, 'StructGrammar',
+		Seq(wStruct,Obj(Def(wCopy),wProperty,Def(wType)),
+		Seq(wDiscard, ChrDef('('),
+		Seq(wRaise,
+			Option(
+				ValSeq(wDescription, Def(wEnvGrammar),
+				EndSeq(wJoin))),
+		Seq(wDiscard, ChrDef(')'),
+		EndSeq(wQuote))))));
+
+(* Sentence::= Custom|Char|CharSet|String|Number. *)
+	wSentence^:=
+		Choose(Def(wCustomGrammar),
+		Choose(Def(wCharGrammar),
+		Choose(Def(wStrGrammar),
+		Choose(Def(wCharSetGrammar),
+		Def(wNumGrammar)))));
+	
+	tempDef:=EmptyClosure
+END Grammars.
+
+(*
+EnvGrammar::= Property:=IdentGrammar() Raise=('=' :AddProperty() | ":=" :AddValuedProperty())
+		Value:=Sentence(), Struct:=[',' Raise=EnvGrammar() :Dummy()]: Dummy().
+StructGrammar::= Property:=IdentGrammar() '(' Raise=[Description:=EnvGrammar() :Join()] ')' :Quote().
+Sentence::= Number()|Char()|String()|CharSET()|StructGrammar()|CommonGrammar().
+InputGrammar::= Struct:=Sentence() :Struct().
+*)
+
diff --git a/examples/Dipl/LIBRARY.DEF b/examples/Dipl/LIBRARY.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/LIBRARY.DEF
@@ -0,0 +1,22 @@
+DEFINITION MODULE Library;
+FROM Machine IMPORT link, closure, wPackage, wPacked, wType;
+FROM Names IMPORT wString, wUndefined, wParent;
+
+TYPE
+	errorCodes=(NotLogicalType,NotNumberType,NotStringType,IOError,SyntaxError,NotFound);
+VAR
+	wFile:link;
+	wChar, wNumber, wCharSet, wError:link;
+	wStruct, wDescription, wProperty, wValue, wAncestor:link;
+	wJoin, wGetType, wGetProp, wAddProp, wAddValProp, wRemProp:link;
+	wBuild, wBuildReduced, wVain:link;
+	wCopy, wQuote, wIsOfClass, wEqual:link;
+	wDummy, wArg1, wArg2, wTest, wYes, wNo:link;
+	wTrue, wFalse, wIf, wAnd, wOr, wNot:link;
+	wAdd, wSub, wMul, wDiv:link;
+	wCons, wCar, wCdr, wNil :link;
+	wFind, wRemember, wWordEntry, wAssociate:link;
+	wDebug, wCollect, wAbort, wVList:link;
+END Library.
+
+
diff --git a/examples/Dipl/LIBRARY.MOD b/examples/Dipl/LIBRARY.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/LIBRARY.MOD
@@ -0,0 +1,354 @@
+IMPLEMENTATION MODULE Library;
+FROM Machine IMPORT closure, link, EmptyClosure, result;
+FROM Machine IMPORT Reduce, NewLayer, SaveDefinition, StartLayer, PopLayer, debug;
+FROM Machine IMPORT AddEnv, AddValuedEnv, RemoveEnv, Copy, Join, Equal, Root;
+FROM Machine IMPORT MakeDef, MakePrimitive, MakePacked, ExtractPacked;
+FROM Machine IMPORT tempDef, HandlePackage, Build, wPackage;
+FROM Machine IMPORT Build, BuildReduced;
+FROM Names IMPORT DefineWord, AddArgument, AddPrimWord, AddAtom;
+FROM Names IMPORT wName, wMeaning;
+FROM Names IMPORT DefEntry, SetDefEntry, FindWord, vList;
+FROM Memory IMPORT Collect;
+
+CONST
+	FormalLength=1000;
+
+PROCEDURE pGetProp;
+VAR
+	r:link;
+BEGIN
+	r:=Root(wProperty^);
+	NewLayer(wStruct^);
+	result:=r^
+END pGetProp;
+
+PROCEDURE pAddProp;
+BEGIN
+	IF Root(wStruct^)=wError THEN
+		result:=wStruct^
+	ELSIF Root(wProperty^)=wError THEN
+		result:=wProperty^
+	ELSIF Root(wValue^)=wError THEN
+		result:=wValue^
+	ELSE
+		Copy(wStruct^,result);
+		AddEnv(result,Root(wProperty^),wValue^)
+	END
+END pAddProp;
+
+PROCEDURE pAddValProp;
+BEGIN
+	IF Root(wStruct^)=wError THEN
+		result:=wStruct^
+	ELSIF Root(wProperty^)=wError THEN
+		result:=wProperty^
+	ELSIF Root(wValue^)=wError THEN
+		result:=wValue^
+	ELSE
+		Copy(wStruct^,result);
+		AddValuedEnv(result,Root(wProperty^),wValue^)
+	END
+END pAddValProp;
+
+PROCEDURE pRemProp;
+BEGIN
+	Copy(wStruct^,result);
+	RemoveEnv(result,Root(wProperty^))
+END pRemProp;
+
+PROCEDURE pJoin;
+BEGIN
+	IF Root(wStruct^)=wError THEN
+		result:=wStruct^
+	ELSIF Root(wDescription^)=wError THEN
+		result:=wDescription^
+	ELSE
+		Copy(wStruct^,result);
+		Join(result,wDescription^)
+	END
+END pJoin;
+
+PROCEDURE pCopy;
+BEGIN
+	result:=Root(wProperty^)^
+END pCopy;
+
+PROCEDURE pQuote;
+BEGIN
+	result:=wStruct^
+END pQuote;
+
+PROCEDURE pVain;
+BEGIN
+	result:=wAncestor^
+END pVain;
+
+PROCEDURE pGetType;
+BEGIN
+	MakeDef(result,Root(wStruct^))
+END pGetType;
+
+PROCEDURE pIsOfClass;
+BEGIN
+	IF Root(wStruct^)=Root(wType^) THEN
+		MakeDef(result,wTrue)
+	ELSE
+		MakeDef(result,wFalse)
+	END
+END pIsOfClass;
+
+PROCEDURE pEqual;
+BEGIN
+	IF Equal(wArg1^,wArg2^) THEN
+		MakeDef(result,wTrue)
+	ELSE
+		MakeDef(result,wFalse)
+	END
+END pEqual;
+
+PROCEDURE pNot;
+VAR
+	l:BOOLEAN;
+BEGIN
+	IF Root(wArg1^)=wTrue THEN
+		MakeDef(result,wFalse)
+	ELSIF Root(wTest^)=wFalse THEN
+		MakeDef(result,wTrue)
+	ELSE
+		MakePacked(result,wError,NotLogicalType)
+	END
+END pNot;
+
+PROCEDURE pAnd;
+VAR
+	l:BOOLEAN;
+BEGIN
+	IF Root(wArg1^)=wTrue THEN
+		Reduce(wArg2^)
+	ELSIF Root(wTest^)=wFalse THEN
+		MakeDef(result,wFalse)
+	ELSE
+		MakePacked(result,wError,NotLogicalType)
+	END
+END pAnd;
+
+PROCEDURE pOr;
+VAR
+	l:BOOLEAN;
+BEGIN
+	IF Root(wArg1^)=wFalse THEN
+		Reduce(wArg2^)
+	ELSIF Root(wTest^)=wTrue THEN
+		MakeDef(result,wTrue)
+	ELSE
+		MakePacked(result,wError,NotLogicalType)
+	END
+END pOr;
+
+PROCEDURE pIf;
+VAR
+	l:BOOLEAN;
+BEGIN
+	Reduce(wTest^);
+	IF Root(result)=wTrue THEN
+		Reduce(wYes^)
+	ELSIF Root(wTest^)=wFalse THEN
+		Reduce(wNo^)
+	ELSE
+		MakePacked(result,wError,NotLogicalType)
+	END
+END pIf;
+
+PROCEDURE ExtractNumbers(VAR x,y:INTEGER):BOOLEAN;
+BEGIN
+	Reduce(wArg1^);
+	IF Root(result)#wNumber THEN
+		IF Root(result)#wError THEN
+			MakePacked(result,wError,NotNumberType)
+		END;
+		RETURN FALSE
+	END;
+	ExtractPacked(result,x);
+	
+	Reduce(wArg2^);
+	IF Root(result)#wNumber THEN
+		IF Root(result)#wError THEN
+			MakePacked(result,wError,NotNumberType)
+		END;
+		RETURN FALSE
+	END;
+	ExtractPacked(result,y);
+	RETURN TRUE
+END ExtractNumbers;
+
+PROCEDURE pAdd;
+VAR
+	x,y:INTEGER;
+BEGIN
+	IF ExtractNumbers(x,y) THEN
+		MakePacked(result,wNumber,x+y)
+	END
+END pAdd;
+
+PROCEDURE pSub;
+VAR
+	x,y:INTEGER;
+BEGIN
+	IF ExtractNumbers(x,y) THEN
+		MakePacked(result,wNumber,x-y)
+	END
+END pSub;
+
+PROCEDURE pMul;
+VAR
+	x,y:INTEGER;
+BEGIN
+	IF ExtractNumbers(x,y) THEN
+		MakePacked(result,wNumber,x*y)
+	END
+END pMul;
+
+PROCEDURE pDiv;
+VAR
+	x,y:INTEGER;
+BEGIN
+	IF ExtractNumbers(x,y) THEN
+		MakePacked(result,wNumber,x DIV y)
+	END
+END pDiv;
+
+PROCEDURE pFind;
+VAR
+	s:POINTER TO ARRAY [0..FormalLength] OF CHAR;
+	l:link;
+BEGIN
+	Reduce(wName^);
+	IF Root(result)#wString THEN
+		IF Root(result)#wError THEN
+			MakePacked(result,wError,NotStringType)
+		END;
+		RETURN
+	END;
+	ExtractPacked(result,s);
+	l:=FindWord(s^);
+	IF l=NIL THEN
+		MakePacked(result,wError,NotFound)
+	ELSE
+		NewLayer(DefEntry(l));
+		result:=wMeaning^
+	END
+END pFind;
+
+PROCEDURE pAssociate;
+VAR
+	entry:closure;
+BEGIN
+	Copy(DefEntry(Root(wName^)),tempDef);
+	AddEnv(tempDef,Root(wProperty^),wValue^);
+	SetDefEntry(Root(wName^),tempDef);
+	tempDef:=EmptyClosure;
+	Reduce(wStruct^)
+END pAssociate;
+
+PROCEDURE pWordEntry;
+BEGIN
+	result:=DefEntry(Root(wStruct^))
+END pWordEntry;
+
+PROCEDURE pDebug;
+BEGIN
+	debug:=TRUE;
+	Reduce(wStruct^);
+	debug:=FALSE
+END pDebug;
+
+PROCEDURE pCollect;
+BEGIN
+	Collect;
+	Reduce(wStruct^)
+END pCollect;
+
+PROCEDURE pAbort;
+BEGIN
+	HALT
+END pAbort;
+
+PROCEDURE pVList;
+BEGIN
+	vList;
+	MakeDef(result,wTrue)
+END pVList;
+
+BEGIN
+	DefineWord(wChar, 'CHAR', HandlePackage);
+	DefineWord(wError, 'ERROR', HandlePackage);
+	DefineWord(wNumber, 'NUMBER', HandlePackage);
+	DefineWord(wCharSet, 'CharSET', HandlePackage);
+
+	AddArgument(wPackage, 'Package');
+	DefineWord(wPacked, 'Packed', HandlePackage);
+
+	AddArgument(wCar, 'Car');
+	AddArgument(wCdr, 'Cdr');
+	AddAtom(wNil, 'Nil');
+
+	AddPrimWord(wCons, 'Cons', Build);
+	MakeDef(tempDef,wCons);
+	AddEnv(wCons^,wType,tempDef);
+	MakeDef(tempDef,wCar);
+	AddValuedEnv(wCons^,wCar,tempDef);
+	MakeDef(tempDef,wCdr);
+	AddValuedEnv(wCons^,wCdr,tempDef);
+	tempDef:=EmptyClosure;
+
+	AddPrimWord(wJoin, 'Join', pJoin);
+	AddPrimWord(wGetType, 'GetType', pGetType);
+	AddPrimWord(wGetProp, 'PropertyValue', pGetProp);
+	AddPrimWord(wAddValProp, 'AddValuedProperty', pAddValProp);
+	AddPrimWord(wAddProp, 'AddProperty', pAddProp);
+	AddPrimWord(wRemProp, 'RemoveProperty', pRemProp);
+	AddPrimWord(wCopy, 'Copy', pCopy);
+	AddPrimWord(wIsOfClass, 'IsOfClass', pIsOfClass);
+	AddPrimWord(wEqual, 'Equal', pEqual);
+	AddPrimWord(wQuote, 'Quote', pQuote);
+	AddPrimWord(wBuild, 'Build', Build);
+	AddPrimWord(wBuild, 'BuildReduced', BuildReduced);
+	AddPrimWord(wVain, 'Vain', pVain);
+
+	AddArgument(wDescription, 'Description');
+	AddArgument(wStruct, 'Struct');
+	AddArgument(wProperty, 'Property');
+	AddArgument(wValue, 'Value');
+	AddArgument(wType, 'Type');
+	AddArgument(wAncestor, 'Ancestor');
+	
+	AddAtom(wDummy, 'Dummy');
+	AddAtom(wTrue, 'True');
+	AddAtom(wFalse, 'False');
+	AddPrimWord(wAnd, 'And', pAnd);
+	AddPrimWord(wOr, 'Or', pOr);
+	AddPrimWord(wNot, 'Not', pNot);
+	AddPrimWord(wIf, 'If', pIf);
+	AddArgument(wTest, 'Test');
+	AddArgument(wYes, 'Yes');
+	AddArgument(wNo, 'No');
+	AddArgument(wArg1, 'Arg1');
+	AddArgument(wArg2, 'Arg2');
+	AddArgument(wFile, 'File');
+
+	AddPrimWord(wAdd, 'Add', pAdd);
+	AddPrimWord(wSub, 'Sub', pSub);
+	AddPrimWord(wMul, 'Mul', pMul);
+	AddPrimWord(wDiv, 'Div', pDiv);
+	
+	AddPrimWord(wFind, 'Find', pFind);
+	AddPrimWord(wWordEntry, 'WordEntry', pWordEntry);
+	AddPrimWord(wAssociate, 'Associate', pAssociate);
+	
+	AddPrimWord(wDebug, 'Debug', pDebug);
+	AddPrimWord(wCollect, 'Collect', pCollect);
+	AddPrimWord(wAbort, 'Abort', pAbort);
+	AddPrimWord(wVList, 'VList', pVList)
+END Library.
+
+
diff --git a/examples/Dipl/M2/BUFFERS.DEF b/examples/Dipl/M2/BUFFERS.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/BUFFERS.DEF
@@ -0,0 +1,24 @@
+DEFINITION MODULE Buffers;
+
+FROM FIO IMPORT Separators, File;
+
+TYPE
+	CharSet=SET OF CHAR;
+	CharPtr=POINTER TO CHAR;
+
+VAR
+	input, output:File;
+	reachedLine:CARDINAL;
+	linePos, position, reached:LONGCARD;
+
+PROCEDURE ReadChar(VAR ch:CHAR);
+PROCEDURE Rewind(newPosition:LONGCARD);
+PROCEDURE FlushOut;
+PROCEDURE ReadWord(VAR wd:ARRAY OF CHAR; VAR firstChar, otherChars:CharSet);
+PROCEDURE WriteChars(a:ADDRESS);
+
+PROCEDURE OpenInput(filename:ARRAY OF CHAR):BOOLEAN;
+PROCEDURE CloseInput;
+PROCEDURE ReportError;
+
+END Buffers.
diff --git a/examples/Dipl/M2/BUFFERS.MOD b/examples/Dipl/M2/BUFFERS.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/BUFFERS.MOD
@@ -0,0 +1,184 @@
+IMPLEMENTATION MODULE Buffers;
+
+FROM Lib IMPORT IncAddr;
+FROM Str IMPORT Copy;
+FROM FIO IMPORT File, EOF, IOresult, ChopOff, IOcheck, Separators;
+FROM FIO IMPORT RdChar, WrChar, Seek, GetPos, Create, Open, Close;
+IMPORT IO;
+
+CONST
+	NULL=0C;
+	TAB=11C;
+	MaxHandles=10;
+VAR
+ 	inputOriginal,outOriginal:File;
+ 	lastChar:CHAR;
+ 	valid:BOOLEAN;
+ 	stack:ARRAY [1..MaxHandles] OF
+ 		RECORD
+ 			handle:File;
+ 			posReached:LONGCARD;
+ 			lineReached:CARDINAL;
+ 			linePosition:LONGCARD;
+ 		END;
+ 	top:[0..MaxHandles];
+
+PROCEDURE ReadChar(VAR ch:CHAR);
+BEGIN
+	INC(position);
+	IF NOT valid THEN
+		lastChar:=RdChar(input);
+		IF reached<position THEN
+			reached:=position;
+			IF lastChar=CHR(10) THEN
+				INC(reachedLine);
+				linePos:=position
+			END
+		END;
+		IF EOF THEN
+			lastChar:=IO.RdChar();
+			WrChar(input,lastChar)
+		END
+	ELSE
+		valid:=FALSE
+	END;
+	ch:=lastChar
+END ReadChar;
+
+PROCEDURE Rewind(newPos:LONGCARD);
+BEGIN
+	IF (position=newPos+1) AND (lastChar#0C) AND NOT valid THEN
+		valid:=TRUE
+	ELSE
+		valid:=FALSE;
+		lastChar:=0C;
+		Seek(input,newPos)
+	END;
+	position:=newPos
+END Rewind;
+
+PROCEDURE FlushOut;
+VAR
+	count,last:LONGCARD;
+BEGIN
+	IF output=outOriginal THEN
+		last:=GetPos(output);
+		Seek(output,0);
+		FOR count:=1 TO last DO
+			IO.WrChar(RdChar(output))
+		END
+	END
+END FlushOut;
+
+PROCEDURE ReadWord(VAR wd:ARRAY OF CHAR; VAR first,rest:CharSet);
+VAR
+	i:CARDINAL;
+	ch:CHAR;
+BEGIN
+	ReadChar(ch);
+	i:=0;
+	IF ch IN first THEN
+		wd[0]:=ch;
+		REPEAT
+			ReadChar(ch);
+			INC(i);
+			wd[i]:=ch
+		UNTIL NOT(ch IN rest) OR (i=HIGH(wd));
+		IF ch IN rest THEN
+			REPEAT
+				ReadChar(ch)
+			UNTIL NOT(ch IN rest)
+		END
+	END;
+	wd[i]:=NULL;
+	Rewind(position-1)
+END ReadWord;
+
+PROCEDURE WriteChars(a:ADDRESS);
+TYPE
+	CharPtr=POINTER TO CHAR;
+BEGIN
+	WHILE CharPtr(a)^#NULL DO
+		WrChar(output,CharPtr(a)^);
+		IncAddr(a,1)
+	END
+END WriteChars;
+
+PROCEDURE ReportError;
+VAR
+	ch:CHAR;
+	i:CARDINAL;
+BEGIN
+   IO.WrStr('Line ');
+   IO.WrCard(reachedLine,0);
+   IO.WrLn;
+   Seek(input,linePos);
+   REPEAT
+      ch:=RdChar(input);
+      IF ch=TAB THEN
+      	ch:=' '
+      END;
+      IO.WrChar(ch)
+   UNTIL (ch=CHR(13)) OR EOF;
+   IO.WrLn;
+   FOR i:=2 TO CARDINAL(reached-linePos) DO
+      IO.WrChar(' ')
+   END;
+   IO.WrChar('^');
+   Rewind(position)
+END ReportError;
+
+PROCEDURE OpenInput(filename:ARRAY OF CHAR):BOOLEAN;
+VAR
+	handle:CARDINAL;
+	unique:ARRAY [0..7] OF CHAR;
+BEGIN
+	IF filename[0]=0C THEN
+		Copy(unique,'input  .buf');
+      unique[5]:=CHR(ORD('0') + top DIV 10);
+      unique[6]:=CHR(ORD('0') + top MOD 10);
+		handle:=Create(unique);
+	ELSE
+		handle:=Open(filename)
+	END;
+	IF IOresult()=0 THEN
+		INC(top);
+		WITH stack[top] DO
+			handle:=input;
+			posReached:=reached;
+			lineReached:=reachedLine;
+			linePosition:=linePos
+		END;
+		Seek(input,position);
+		input:=handle;
+		position:=0;
+		linePos:=0;
+		reached:=0;
+		reachedLine:=1;
+		valid:=FALSE
+	END;
+	RETURN IOresult()=0
+END OpenInput;
+
+PROCEDURE CloseInput;
+BEGIN
+	Close(input);
+	WITH stack[top] DO
+		input:=handle;
+		reached:=posReached;
+		reachedLine:=lineReached;
+		linePos:=linePosition
+	END;
+	DEC(top);
+	position:=GetPos(input);
+	valid:=FALSE
+END CloseInput;
+
+BEGIN
+   ChopOff:=FALSE;
+   IOcheck:=FALSE;
+   top:=0;
+   output:=Create("output.buf");
+   outOriginal:=output
+END Buffers.
+
diff --git a/examples/Dipl/M2/CILE.MOD b/examples/Dipl/M2/CILE.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/CILE.MOD
@@ -0,0 +1,97 @@
+MODULE CILE;
+
+FROM IO IMPORT WrStr, WrLn, WrCard, EndOfRd, RdChar;
+IMPORT IO;
+FROM Machine IMPORT link, Root, result;
+FROM Machine IMPORT Reduce, StartLayer, PopLayer, ChangeDefinition;
+FROM Machine IMPORT MakeDef, MakePacked, MakeString, ExtractPacked;
+FROM Library IMPORT wStruct, wFile, wAncestor;
+FROM Library IMPORT wString, wError, errorCodes, wUndefined;
+FROM Names IMPORT AddAtom, AddPrimWord, NewDictionary, OldDictionary;
+FROM Buffers IMPORT ReportError, OpenInput, CloseInput;
+FROM Parser IMPORT Parse;
+FROM Decoder IMPORT wWrite;
+FROM Grammars IMPORT wGrammar, wFail, wSentence, wDone;
+(* FROM Graph IMPORT SetVideoMode, InitGraph; *)
+IMPORT PMD;
+
+VAR
+	wInterpret,wQuit,wLoad:link;
+	level:CARDINAL;
+
+(*# data(stack_size => 0FF00H) *)
+	
+PROCEDURE pInterpret;
+VAR
+	ch,empty:CHAR;
+BEGIN
+	empty:=0C;
+	INC(level);
+	LOOP
+		LinkString(wFile,wString,ADR(empty));
+		WrLn;
+		WrStr('Reduce[');
+		WrCard(level,0);
+		WrStr(']>');
+		Reduce(wLoad^);
+		WHILE NOT EndOfRd(FALSE) DO
+			ch:=RdChar()
+		END;
+		WrStr('  ');
+		IF Root(result)=wQuit THEN
+			MakeDef(result,wDone);
+			EXIT
+		ELSE
+			StartLayer;
+			ChangeDefinition(wStruct,result);
+			Reduce(wWrite^);
+			IF Root(result)=wFail THEN
+				WrStr('Output error!')
+			END;
+			PopLayer
+		END
+	END;
+	DEC(level)
+END pInterpret;
+
+PROCEDURE pLoad;
+VAR
+	filename:ARRAY [0..30] OF CHAR;
+	newFile:BOOLEAN;
+	ch:CHAR;
+BEGIN
+	Reduce(wFile^);
+	newFile:=(Root(result)=wString);
+	IF newFile THEN
+		ExtractPacked(result,filename);
+		IF NOT OpenInput(filename) THEN
+			MakePacked(result,wError,IOError);
+			RETURN
+		END;
+      LinkDef(wFile,wUndefined)
+	END;
+	NewDictionary;
+	StartLayer;
+	ChangeDefinition(wGrammar,wSentence);
+	Parse;
+	PopLayer;
+	ChangeDefinition(wAncestor,result);
+	Reduce(result);
+	OldDictionary;
+	IF newFile THEN
+		CloseInput
+	END
+END pLoad;
+
+BEGIN
+	level:=0;
+	AddAtom(wQuit,'Quit');
+	AddPrimWord(wInterpret, 'Interpret', pInterpret);
+	AddPrimWord(wLoad, 'Load', pLoad);
+(*	InitGraph;
+	IF NOT SetVideoMode(7) THEN
+		WrStr('Prebacivanje u tekst mod nije uspelo!')
+	END;
+*)
+	pInterpret
+END CILE.
diff --git a/examples/Dipl/M2/DECODER.DEF b/examples/Dipl/M2/DECODER.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/DECODER.DEF
@@ -0,0 +1,13 @@
+DEFINITION MODULE Decoder;
+
+FROM Machine IMPORT link, closure;
+
+VAR
+	wWrite, wWriteGrammar:link;
+
+PROCEDURE Write;
+PROCEDURE WriteGrammar;
+
+END Decoder.
+
+
diff --git a/examples/Dipl/M2/DECODER.MOD b/examples/Dipl/M2/DECODER.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/DECODER.MOD
@@ -0,0 +1,542 @@
+IMPLEMENTATION MODULE Decoder;
+
+FROM SYSTEM IMPORT TSIZE;
+FROM Lib IMPORT IncAddr;
+FROM Memory IMPORT ALLOCATE, AddMarker, MarkNeeded;
+FROM FIO IMPORT File, Create, Close, Seek, GetPos, WrChar, WrStr, WrLn, WrInt, WrLngHex, IOresult;
+FROM Buffers IMPORT output, FlushOut, WriteChars, CharPtr, CharSet;
+
+FROM Machine IMPORT EmptyClosure, link, HandlePackage, Reduce, Envelope, Root, result;
+FROM Machine IMPORT wPackage, tempDef, MakePrimitive, MakeDef, MakePacked, ExtractPacked;
+FROM Machine IMPORT ChangeDefinition, NewLayer, StartLayer, PopLayer, Equal;
+FROM Machine IMPORT Copy, RemoveEnv, MarkLink, Join;
+
+FROM Library IMPORT wChar, wCharSet, wString, wNumber, wError, errorCodes;
+FROM Library IMPORT wStruct, wProperty, wValue, wFile, wDescription;
+FROM Library IMPORT wAddProp, wAddValProp;
+
+FROM Grammars IMPORT wSequence, wLexSequence, wValSequence, wLexValSequence;
+FROM Grammars IMPORT wEndSeq, wChoice, wOption;
+FROM Grammars IMPORT wDummy, wFail, wDone, wDiscard, wRaise, wGrammar, wNext;
+FROM Grammars IMPORT wSeparator, wFrameGrammar, wCustomGrammar;
+FROM Grammars IMPORT wFirst, wTail, wIdentGrammar, wIdentifier, wCharSetGrammar;
+FROM Grammars IMPORT wCharGrammar, wStrGrammar, wNumGrammar, wErrorGrammar, wPackageGrammar;
+FROM Grammars IMPORT Failure, Confirmation, HoldDummy;
+
+FROM Names IMPORT DefName, DefEntry, wName, wMeaning;
+FROM Names IMPORT AddPrimWord;
+
+TYPE
+	PassPtr=POINTER TO PassPoint;
+	PassPoint=RECORD
+		grammar,statement:closure;
+		next:PassPtr
+	END;
+
+VAR
+	wStatement:link;
+	oldChar, oldString, oldNumber, oldError, oldRoute:closure;
+	separated:BOOLEAN;
+	path:PassPtr;
+
+PROCEDURE PopPath;
+BEGIN
+   Discard(path);
+	path:=path^.next
+END PopPath;
+
+PROCEDURE PathClosed():BOOLEAN;
+VAR
+	follow:PassPtr;
+BEGIN
+	follow:=path;
+	WHILE (follow#NIL) AND
+			((follow^.grammar#wGrammar^) OR (follow^.statement#wStatement^)) DO
+		follow:=follow^.next
+	END;
+	IF follow=NIL THEN
+		NEW(follow);
+      Use(wGrammar^);
+      Use(wStatement^);
+		follow^.grammar:=wGrammar^;
+		follow^.statement:=wStatement^;
+		follow^.next:=path;
+		path:=follow;
+		RETURN FALSE
+	ELSE
+		RETURN TRUE
+	END
+END PathClosed;
+
+PROCEDURE PhraseTheLetter;
+VAR
+	chExpect,chIs:CHAR;
+BEGIN
+	ExtractPacked(wPackage^,chExpect);
+	IF wStatement^#EmptyClosure THEN
+		ChangeDefinition(wChar,HandlePackage);
+		Reduce(wStatement^);
+		ExtractPacked(result,chIs);
+		IF chExpect#chIs THEN
+         Discard(result^);
+			result:=Failure;
+			RETURN
+		END
+	END;
+	WrChar(output,chExpect);
+   Discard(result^);
+	result:=Confirmation
+END PhraseTheLetter;
+
+PROCEDURE PhraseTheString;
+VAR
+	str:CharPtr;
+BEGIN
+	IF wStatement^#EmptyClosure THEN
+		ChangeDefinition(wString,HandlePackage);
+		Reduce(wStatement^);
+		IF NOT Equal(wPackage^,result) THEN
+         Discard(result^);
+			result:=Failure;
+			RETURN
+		END
+	END;
+	ExtractPacked(wPackage^,str);
+	WriteChars(str);
+   Discard(result^);
+	result:=Confirmation
+END PhraseTheString;
+
+PROCEDURE PhraseTheCharSet;
+VAR
+	s:POINTER TO CharSet;
+	ch:CHAR;
+BEGIN
+	ChangeDefinition(wChar,HandlePackage);
+	Reduce(wStatement^);
+   Discard(result^);
+	IF Root(result)=wChar THEN
+		ExtractPacked(result,ch);
+		ExtractPacked(wPackage^,s);
+		IF ch IN s^ THEN
+			WrChar(output,ch);
+			result:=Confirmation
+		ELSE
+			result:=Failure
+		END
+	ELSE
+		result:=Failure
+	END
+END PhraseTheCharSet;
+
+PROCEDURE PhraseChoice;
+BEGIN
+	Reduce(wGrammar^);
+	IF Root(result)=wFail THEN
+		Reduce(wNext^)
+	END
+END PhraseChoice;
+
+PROCEDURE PhraseOption;
+BEGIN
+	Reduce(wGrammar^);
+	IF Root(result)=wFail THEN
+      Discard(result^);
+		result:=HoldDummy
+	END
+END PhraseOption;
+
+PROCEDURE PhraseSeqPrimitive(separate:BOOLEAN);
+VAR
+	down:closure;
+	downPtr:link;
+	oldPos:LONGCARD;
+BEGIN
+	downPtr:=Root(wProperty^);
+   Use(downPtr);
+	oldPos:=GetPos(output);
+	StartLayer;
+	IF downPtr#wDiscard THEN
+		IF (downPtr#wRaise) THEN
+			StartLayer;
+			ChangeDefinition(downPtr,EmptyClosure);
+			NewLayer(wStatement^);
+			down:=downPtr^;
+         Use(down);
+			PopLayer;
+			IF down=EmptyClosure THEN
+            Discard(result);
+				result:=Failure;
+				PopLayer;
+				RETURN
+			END;
+      	ChangeDefinition(wStatement,down)
+		END
+	ELSE
+     	ChangeDefinition(wStatement,EmptyClosure);
+	END;
+	IF PathClosed() THEN
+      Discard(result);
+		result:=Failure;
+		RETURN
+	END;
+	separated:=FALSE;
+	Reduce(wGrammar^);
+	PopPath;
+	PopLayer;
+	IF Root(result)#wFail THEN
+		IF separate AND (GetPos(output)>oldPos) AND NOT separated THEN
+			StartLayer;
+			LinkPrimitive(wChar,PhraseTheLetter);
+			LinkPrimitive(wString,PhraseTheString);
+
+			ChangeDefinition(wStatement,EmptyClosure);
+			Reduce(wSeparator^);
+			PopLayer;
+			separated:=TRUE
+		END;
+		Reduce(wNext^);
+		IF Root(result)=wFail THEN
+			Seek(output,oldPos)
+		END
+	END	
+END PhraseSeqPrimitive;
+
+PROCEDURE PhraseSequence;
+BEGIN
+	PhraseSeqPrimitive(TRUE)
+END PhraseSequence;
+
+PROCEDURE PhraseLexSequence;
+BEGIN
+	PhraseSeqPrimitive(FALSE)
+END PhraseLexSequence;
+
+PROCEDURE PhraseEndSequence;
+BEGIN
+   Discard(result);
+	IF (Root(wStruct^)=wDummy) OR (Root(wStatement^)=Root(wStruct^)) THEN
+		result:=Confirmation
+	ELSE
+		result:=Failure
+	END
+END PhraseEndSequence;
+
+PROCEDURE PhraseNumber;
+VAR
+	num:INTEGER;
+BEGIN
+	IF Root(wStatement^)#wNumber THEN
+      Discard(result);
+		result:=Failure;
+		RETURN
+	END;
+	ChangeDefinition(wNumber,HandlePackage);
+	Reduce(wStatement^);
+	ExtractPacked(result,num);
+	WrInt(output,num,0);
+   Discard(result);
+	result:=Confirmation
+END PhraseNumber;
+
+PROCEDURE PhrasePackage;
+VAR
+	contents:LONGCARD;
+BEGIN
+	WrChar(output,'[');
+	ExtractPacked(wStatement^,contents);
+	WrLngHex(output,contents,0);
+	WrChar(output,']')
+END PhrasePackage;
+
+PROCEDURE PhraseChar;
+VAR
+	ch:CHAR;
+BEGIN
+	IF Root(wStatement^)#wChar THEN
+      Discard(result);
+		result:=Failure;
+		RETURN
+	END;
+	ChangeDefinition(wChar,HandlePackage);
+	Reduce(wStatement^);
+	ExtractPacked(result,ch);
+	WrChar(output, "'");
+	WrChar(output,ch);
+	WrChar(output, "'");
+END PhraseChar;
+
+PROCEDURE PhraseCharSET;
+VAR
+	s:SET OF CHAR;
+	ch:CHAR;
+	first:BOOLEAN;
+BEGIN
+	IF Root(wStatement^)=wCharSet THEN
+		ChangeDefinition(wCharSet,HandlePackage);
+		Reduce(wStatement^);
+		ExtractPacked(result,s);
+		ch:=MIN(CHAR);
+		WrChar(output,'{');
+		first:=TRUE;
+		LOOP
+			IF ch IN s THEN
+				IF first THEN
+					first:=FALSE
+				ELSE
+					WrChar(output,',')
+				END;
+				IF (ch=' ') OR (ch='}') OR (ch='{') OR (ch='\') THEN
+					WrChar(output,'\')
+				END;
+				WrChar(output,ch);
+				INC(ch);
+				IF ch IN s THEN
+					REPEAT
+						INC(ch)
+					UNTIL NOT (ch IN s);
+					DEC(ch);
+					WrChar(output,'-');
+					IF (ch=' ') OR (ch='}') OR (ch='{') OR (ch='\') THEN
+						WrChar(output,'\')
+					END;
+					WrChar(output,ch);
+					INC(ch)
+				END
+			ELSIF ch<MAX(CHAR) THEN
+				INC(ch)
+			ELSE
+				EXIT
+			END
+		END;
+		WrChar(output,'}')
+	ELSE
+      Discard(result);
+		result:=Failure
+	END
+END PhraseCharSET;
+
+PROCEDURE PhraseIdent;
+VAR
+	string:POINTER TO CHAR;
+	s:POINTER TO SET OF CHAR;
+BEGIN
+	IF Root(wStatement^)=wIdentifier THEN
+		NewLayer(wStatement^);
+		ChangeDefinition(wString,HandlePackage);
+		Reduce(wDescription^);
+		ExtractPacked(result,string)
+	ELSE
+		string:=DefName(Root(wStatement^));
+      Use(string)
+	END;
+	ChangeDefinition(wCharSet,HandlePackage);
+	Reduce(wFirst^);
+	ExtractPacked(result,s);
+	IF string^ IN s^ THEN
+		Reduce(wTail^);
+		ExtractPacked(result,s);
+		REPEAT
+			WrChar(output,string^);
+			IncAddr(string,1)
+		UNTIL NOT (string^ IN s^) OR (string^=0C);
+		IF string^=0C THEN
+         Discard(result);
+			result:=Confirmation;
+			RETURN
+		END
+	END;
+   Discard(result);
+	result:=Failure
+END PhraseIdent;
+	
+PROCEDURE PhraseString;
+VAR
+	string:ADDRESS;
+BEGIN
+	IF Root(wStatement^)#wString THEN
+      Discard(result);
+		result:=Failure;
+		RETURN
+	END;
+	ChangeDefinition(wString,HandlePackage);
+	Reduce(wStatement^);
+	ExtractPacked(result,string);
+	WrChar(output,'"');
+	WriteChars(string);
+	WrChar(output,'"');
+   Discard(result);
+	result:=Confirmation
+END PhraseString;
+	
+PROCEDURE PhraseError;
+VAR
+	err:errorCodes;
+BEGIN
+	IF Root(wStatement^)#wError THEN
+      Discard(result);
+		result:=Failure;
+		RETURN
+	END;
+	ChangeDefinition(wError,HandlePackage);
+	Reduce(wStatement^);
+	ExtractPacked(result,err);
+	CASE err OF
+		NotLogicalType:WrStr(output,'Not the logical type!')
+		|NotNumberType:WrStr(output,'Not the number type!')
+		|NotStringType:WrStr(output,'Not the string type!')
+		|IOError:WrStr(output,'(R) Tape loading error!')
+		|SyntaxError:WrStr(output,'Syntax error!')
+		|NotFound:WrStr(output,'Undefined word meaning!')
+	END;
+	WrLn(output);
+   Discard(result);
+	result:=Confirmation
+END PhraseError;
+
+PROCEDURE PhraseCustom;
+FORWARD;
+
+PROCEDURE PhraseStd;
+VAR
+	oldPos:LONGCARD;
+BEGIN
+	oldPos:=GetPos(output);
+	WriteChars(DefName(Root(wStatement^)));
+	Envelope(result,wStatement^,wAddProp,wAddValProp,wDone,wProperty,wValue,wStruct);
+	WrChar(output,'(');
+	LOOP
+		IF Root(result)=wDone THEN
+			EXIT
+		END;
+		StartLayer;
+		NewLayer(result);
+		WriteChars(DefName(Root(wProperty^)));
+		IF Root(result)=wAddValProp THEN
+			WrChar(output,':')
+		END;
+		WrChar(output,'=');
+   	ChangeDefinition(wStatement,wValue^);
+		PhraseCustom;
+		IF Root(result)=wFail THEN
+			PopLayer;
+			EXIT
+		END;
+      Discard(result);
+		result:=wStruct^;
+      Use(result);
+		PopLayer;
+		IF Root(result)#wDone THEN
+			WrChar(output,',')
+		END
+	END;
+	IF Root(result)=wFail THEN
+		Seek(output,oldPos)
+	ELSE
+		WrChar(output,')')
+	END
+END PhraseStd;
+
+PROCEDURE PhraseCustom;
+VAR
+	prop:closure;
+BEGIN
+	LinkPrimitive(wCustomGrammar,PhraseStd);
+	ChangeDefinition(wFrameGrammar,Failure);
+	prop:=DefEntry(Root(wStatement^));
+   Use(prop);
+	StartLayer;
+	NewLayer(prop);
+   Discard(result);
+	result:=wCustomGrammar^;
+   Use(result);
+	PopLayer;
+	ChangeDefinition(wGrammar,result);
+	Reduce(result)
+END PhraseCustom;
+
+PROCEDURE PhraseGrammar;
+BEGIN
+	LinkPrimitive(wSequence,PhraseSequence);
+	LinkPrimitive(wValSequence,PhraseSequence);
+	LinkPrimitive(wLexSequence,PhraseSequence);
+	LinkPrimitive(wLexValSequence,PhraseSequence);
+	LinkPrimitive(wEndSeq,PhraseEndSequence);
+	LinkPrimitive(wChoice,PhraseChoice);
+	LinkPrimitive(wOption,PhraseOption);
+	LinkPrimitive(wChar,PhraseTheLetter);
+	LinkPrimitive(wString,PhraseTheString);
+	LinkPrimitive(wCharSet,PhraseTheCharSet);
+	LinkPrimitive(wPackageGrammar,PhrasePackage);
+	LinkPrimitive(wCharGrammar,PhraseChar);
+	LinkPrimitive(wCharSetGrammar,PhraseCharSET);
+	LinkPrimitive(wIdentGrammar,PhraseIdent);
+	LinkPrimitive(wStrGrammar,PhraseString);
+	LinkPrimitive(wNumGrammar,PhraseNumber);
+	LinkPrimitive(wErrorGrammar,PhraseError);
+	LinkPrimitive(wCustomGrammar,PhraseCustom);
+	ChangeDefinition(wStatement,wStruct^);
+	
+	Reduce(wGrammar^);
+	path:=NIL
+END PhraseGrammar;
+
+PROCEDURE WriteGrammar;
+CONST
+	FormalLength=1000;
+VAR
+	filename:POINTER TO ARRAY [0..FormalLength] OF CHAR;
+	oldHandle:File;
+BEGIN
+	Reduce(wFile^);
+	oldHandle:=output;
+	IF Root(result)=wString THEN
+		ExtractPacked(result,filename);
+		IF filename^[0]#0C THEN
+			output:=Create(filename^);
+			IF IOresult()#0 THEN
+				MakePacked(result,wError,IOError);
+				output:=oldHandle;
+				RETURN
+			END
+		END
+	END;
+	Seek(output,0);
+	PhraseGrammar;
+	IF Root(result)#wFail THEN
+		FlushOut
+	END;
+	IF output#oldHandle THEN
+		Close(output);
+		output:=oldHandle
+	END
+END WriteGrammar;
+
+PROCEDURE Write;
+BEGIN
+	LinkPrimitive(wGrammar,PhraseCustom);
+	WriteGrammar
+END Write;
+
+PROCEDURE MarkPath;
+VAR
+	follow:PassPtr;
+	fresh:BOOLEAN;
+BEGIN
+	MarkLink(wStatement);
+	follow:=path;
+	WHILE follow#NIL DO
+		MarkNeeded(follow,TSIZE(PassPoint),fresh);
+		follow:=follow^.next
+	END
+END MarkPath;
+
+BEGIN
+	path:=NIL;
+	NEW(wStatement);
+	wStatement^:=EmptyClosure;
+	AddMarker(MarkPath);
+	AddPrimWord(wWrite,'Write',Write);
+	AddPrimWord(wWriteGrammar,'WriteGrammar',WriteGrammar)
+END Decoder.
+
diff --git a/examples/Dipl/M2/GRAMMARS.DEF b/examples/Dipl/M2/GRAMMARS.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/GRAMMARS.DEF
@@ -0,0 +1,20 @@
+DEFINITION MODULE Grammars;
+
+FROM Machine IMPORT link,closure;
+FROM Library IMPORT wDummy, wPacked;
+
+VAR
+	Failure, Confirmation, HoldDummy:closure;
+	wParse, wWrite, wWriteGrammar:link;
+	wGrammar, wRest, wNext, wRoot:link;
+	wFail, wDone, wRaise, wDiscard:link;
+	wSequence, wLexSequence, wValSequence, wLexValSequence:link;
+	wEndSeq, wChoice, wOption:link;
+	wSpaces, wComment, wSpaceChars, wSeparator:link;
+	wPackageGrammar, wNumGrammar, wCharGrammar, wCharSetGrammar, wStrGrammar, wErrorGrammar:link;
+	wFirst, wTail, wIdentGrammar, wIdentifier:link;
+	wStructGrammar, wEnvGrammar, wSentence:link;
+	wCustomGrammar, wFrameGrammar:link;
+END Grammars.
+
+
diff --git a/examples/Dipl/M2/GRAMMARS.MOD b/examples/Dipl/M2/GRAMMARS.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/GRAMMARS.MOD
@@ -0,0 +1,219 @@
+IMPLEMENTATION MODULE Grammars;
+
+(*# call(o_a_copy=>off, o_a_size=>off) *)
+
+FROM Memory IMPORT AddMarker;
+
+FROM Machine IMPORT EmptyClosure, link, HandlePackage, tempDef, AddEnv;
+FROM Machine IMPORT MakeDef, MakePrimitive, MakeString, MakePacked;
+FROM Machine IMPORT closure, handlerType, Build, MarkClosure;
+
+FROM Library IMPORT wChar, wCharSet, wString, wNumber, wError, wVain;
+FROM Library IMPORT wAddProp, wAddValProp, wJoin, wQuote, wCopy, wFind, wDummy;
+FROM Library IMPORT wType, wStruct, wProperty, wValue, wDescription;
+
+FROM Names IMPORT DefineWord, AddArgument, AddAtom, DefEntry, wName;
+
+TYPE CharSet=SET OF CHAR;
+
+PROCEDURE ChrDef(ch:CHAR):closure;
+VAR
+	result:closure;
+BEGIN
+	MakePacked(result,wChar,ch);
+	RETURN result
+END ChrDef;
+
+PROCEDURE StrDef(str:ARRAY OF CHAR):closure;
+VAR
+	result:closure;
+BEGIN
+	MakeString(result,wString,ADR(str));
+	RETURN result
+END StrDef;
+
+PROCEDURE Prim(h:handlerType):closure;
+VAR
+	result:closure;
+BEGIN
+	MakePrimitive(result,h);
+	RETURN result
+END Prim;
+
+PROCEDURE Def(root:link):closure;
+VAR
+	result:closure;
+BEGIN
+	MakeDef(result,root);
+	RETURN result
+END Def;
+
+PROCEDURE Obj(str:closure; prop:link; value:closure):closure;
+BEGIN
+	AddEnv(str,prop,value);
+	RETURN str
+END Obj;
+
+PROCEDURE Seq(pp:link; g,n:closure):closure;
+BEGIN
+	RETURN Obj(Obj(Obj(Def(wSequence),
+		wProperty,Def(pp)),
+		wGrammar,g),
+		wNext,n)
+END Seq;
+
+PROCEDURE ValSeq(pp:link; g,n:closure):closure;
+BEGIN
+	RETURN Obj(Obj(Obj(Def(wValSequence),
+		wProperty,Def(pp)),
+		wGrammar,g),
+		wNext,n)
+END ValSeq;
+
+PROCEDURE EndSeq(root:link):closure;
+BEGIN
+	RETURN Obj(Def(wEndSeq), wStruct, Def(root))
+END EndSeq;
+
+PROCEDURE Option(g:closure):closure;
+BEGIN
+	RETURN Obj(Def(wOption), wGrammar, g)
+END Option;
+
+PROCEDURE Choose(g,n:closure):closure;
+BEGIN
+	RETURN Obj(Obj(Def(wChoice),
+		wGrammar,g),
+		wNext,n)
+END Choose;
+
+PROCEDURE MarkFailure;
+BEGIN
+	MarkClosure(Failure);
+	MarkClosure(Confirmation);
+	MarkClosure(HoldDummy)
+END MarkFailure;
+
+VAR
+	entry:closure;	(* unmarked temporary, used only during initialisation *)
+
+BEGIN
+	AddAtom(wFail, 'Fail');
+	MakeDef(Failure,wFail);
+	AddAtom(wDone, 'Done');
+	MakeDef(Confirmation,wDone);
+	MakeDef(HoldDummy,wDummy);
+	AddMarker(MarkFailure);
+
+	AddAtom(wDiscard, 'Discard');
+	AddAtom(wRaise, 'Raise');
+	AddArgument(wGrammar, 'Grammar');
+	AddArgument(wNext, 'Next');
+	DefineWord(wSeparator, 'Separator', HandlePackage);
+	
+	MakePacked(tempDef,wCharSet,CharSet{'A'..'Z','a'..'z'});
+	DefineWord(wFirst, 'First', tempDef);
+	MakePacked(tempDef,wCharSet,CharSet{'0'..'9','A'..'Z','a'..'z'});
+	DefineWord(wTail, 'Tail', tempDef);
+
+	DefineWord(wFrameGrammar, 'FrameGrammar', Failure);
+	AddAtom(wCustomGrammar, 'CustomGrammar');
+	AddAtom(wPackageGrammar, 'PackageGrammar');
+	AddAtom(wNumGrammar, 'NumGrammar');
+	AddAtom(wCharSetGrammar, 'CharSetGrammar');
+	AddAtom(wCharGrammar, 'CharGrammar');
+	AddAtom(wErrorGrammar, 'ErrorGrammar');
+	AddAtom(wStrGrammar, 'StrGrammar');
+	AddAtom(wIdentGrammar, 'IdentGrammar');
+	DefineWord(wIdentifier, 'Identifier', HandlePackage);
+	DefineWord(wSpaceChars, 'SpaceChars', EmptyClosure);
+	LinkPacked(wSpaceChars,wCharSet,CharSet{' ',15C,12C,11C}); (* space,LF,CR,TAB *)
+	AddAtom(wSpaces, 'Spaces');
+	DefineWord(wComment, 'Comment', Failure);
+
+	MakeDef(tempDef,wVain);
+	DefineWord(wSequence, 'Seq', tempDef);
+	DefineWord(wLexSequence, 'LexSeq', tempDef);
+	DefineWord(wValSequence, 'ValSeq', tempDef);
+	DefineWord(wLexValSequence, 'LexValSeq', tempDef);
+	DefineWord(wEndSeq, 'EndSeq', tempDef);
+	DefineWord(wChoice, 'Choice', tempDef);
+	DefineWord(wOption, 'Option', tempDef);
+	
+	MakeDef(tempDef,wCharGrammar);
+	entry:=DefEntry(wChar);
+	AddEnv(entry,wCustomGrammar,tempDef);
+	
+	MakeDef(tempDef,wCharSetGrammar);
+	entry:=DefEntry(wCharSet);
+	AddEnv(entry,wCustomGrammar,tempDef);
+	
+	MakeDef(tempDef,wNumGrammar);
+	entry:=DefEntry(wNumber);
+	AddEnv(entry,wCustomGrammar,tempDef);
+	
+	MakeDef(tempDef,wStrGrammar);
+	entry:=DefEntry(wString);
+	AddEnv(entry,wCustomGrammar,tempDef);
+	
+	MakeDef(tempDef,wErrorGrammar);
+	entry:=DefEntry(wError);
+	AddEnv(entry,wCustomGrammar,tempDef);
+	
+	MakeDef(tempDef,wIdentGrammar);
+	entry:=DefEntry(wIdentifier);
+	AddEnv(entry,wCustomGrammar,tempDef);
+	
+	entry:=DefEntry(wPacked);
+	MakeDef(tempDef,wPackageGrammar);
+	AddEnv(entry,wCustomGrammar,tempDef);
+	
+	DefineWord(wSentence, 'Sentence', EmptyClosure);
+	DefineWord(wEnvGrammar, 'EnvGrammar', EmptyClosure);
+
+	wEnvGrammar^:=
+		Seq(wProperty,Def(wIdentGrammar),
+		Seq(wRaise, Choose(
+			Seq(wDiscard, ChrDef('='),
+			EndSeq(wAddProp)),
+
+			Seq(wDiscard, StrDef(':='),
+			EndSeq(wAddValProp))),
+		ValSeq(wValue, Def(wSentence),
+		ValSeq(wStruct,
+			Option(
+				Seq(wDiscard, ChrDef(','),
+				Seq(wRaise, Def(wEnvGrammar),
+				EndSeq(wDummy)))),
+		EndSeq(wDummy)))));
+
+(* StructGrammar::= Join(Struct=IdentGrammar '(' Description:=[EnvGrammar] ')'). *)
+	DefineWord(wStructGrammar, 'StructGrammar',
+		Seq(wStruct,Obj(Def(wCopy),wProperty,Def(wType)),
+		Seq(wDiscard, ChrDef('('),
+		Seq(wRaise,
+			Option(
+				ValSeq(wDescription, Def(wEnvGrammar),
+				EndSeq(wJoin))),
+		Seq(wDiscard, ChrDef(')'),
+		EndSeq(wQuote))))));
+
+(* Sentence::= Custom|Char|CharSet|String|Number. *)
+	wSentence^:=
+		Choose(Def(wCustomGrammar),
+		Choose(Def(wCharGrammar),
+		Choose(Def(wStrGrammar),
+		Choose(Def(wCharSetGrammar),
+		Def(wNumGrammar)))));
+	
+	tempDef:=EmptyClosure
+END Grammars.
+
+(*
+EnvGrammar::= Property:=IdentGrammar() Raise=('=' :AddProperty() | ":=" :AddValuedProperty())
+		Value:=Sentence(), Struct:=[',' Raise=EnvGrammar() :Dummy()]: Dummy().
+StructGrammar::= Property:=IdentGrammar() '(' Raise=[Description:=EnvGrammar() :Join()] ')' :Quote().
+Sentence::= Number()|Char()|String()|CharSET()|StructGrammar()|CommonGrammar().
+InputGrammar::= Struct:=Sentence() :Struct().
+*)
+
diff --git a/examples/Dipl/M2/LIBRARY.DEF b/examples/Dipl/M2/LIBRARY.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/LIBRARY.DEF
@@ -0,0 +1,22 @@
+DEFINITION MODULE Library;
+FROM Machine IMPORT link, closure, wPackage, wPacked, wType;
+FROM Names IMPORT wString, wUndefined, wParent;
+
+TYPE
+	errorCodes=(NotLogicalType,NotNumberType,NotStringType,IOError,SyntaxError,NotFound);
+VAR
+	wFile:link;
+	wChar, wNumber, wCharSet, wError:link;
+	wStruct, wDescription, wProperty, wValue, wAncestor:link;
+	wJoin, wGetType, wGetProp, wAddProp, wAddValProp, wRemProp:link;
+	wBuild, wBuildReduced, wVain:link;
+	wCopy, wQuote, wIsOfClass, wEqual:link;
+	wDummy, wArg1, wArg2, wTest, wYes, wNo:link;
+	wTrue, wFalse, wIf, wAnd, wOr, wNot:link;
+	wAdd, wSub, wMul, wDiv:link;
+	wCons, wCar, wCdr, wNil :link;
+	wFind, wRemember, wWordEntry, wAssociate:link;
+	wDebug, wCollect, wAbort, wVList:link;
+END Library.
+
+
diff --git a/examples/Dipl/M2/LIBRARY.MOD b/examples/Dipl/M2/LIBRARY.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/LIBRARY.MOD
@@ -0,0 +1,354 @@
+IMPLEMENTATION MODULE Library;
+FROM Machine IMPORT closure, link, EmptyClosure, result;
+FROM Machine IMPORT Reduce, NewLayer, ChangeDefinition, StartLayer, PopLayer, debug;
+FROM Machine IMPORT AddEnv, AddValuedEnv, RemoveEnv, Copy, Join, Equal, Root;
+FROM Machine IMPORT MakeDef, MakePrimitive, MakePacked, ExtractPacked;
+FROM Machine IMPORT tempDef, HandlePackage, Build, wPackage;
+FROM Machine IMPORT Build, BuildReduced;
+FROM Names IMPORT DefineWord, AddArgument, AddPrimWord, AddAtom;
+FROM Names IMPORT wName, wMeaning;
+FROM Names IMPORT DefEntry, SetDefEntry, FindWord, vList;
+FROM Memory IMPORT Collect;
+
+CONST
+	FormalLength=1000;
+
+PROCEDURE pGetProp;
+VAR
+	r:link;
+BEGIN
+	r:=Root(wProperty^);
+	NewLayer(wStruct^);
+	result:=r^
+END pGetProp;
+
+PROCEDURE pAddProp;
+BEGIN
+	IF Root(wStruct^)=wError THEN
+		result:=wStruct^
+	ELSIF Root(wProperty^)=wError THEN
+		result:=wProperty^
+	ELSIF Root(wValue^)=wError THEN
+		result:=wValue^
+	ELSE
+		Copy(wStruct^,result);
+		AddEnv(result,Root(wProperty^),wValue^)
+	END
+END pAddProp;
+
+PROCEDURE pAddValProp;
+BEGIN
+	IF Root(wStruct^)=wError THEN
+		result:=wStruct^
+	ELSIF Root(wProperty^)=wError THEN
+		result:=wProperty^
+	ELSIF Root(wValue^)=wError THEN
+		result:=wValue^
+	ELSE
+		Copy(wStruct^,result);
+		AddValuedEnv(result,Root(wProperty^),wValue^)
+	END
+END pAddValProp;
+
+PROCEDURE pRemProp;
+BEGIN
+	Copy(wStruct^,result);
+	RemoveEnv(result,Root(wProperty^))
+END pRemProp;
+
+PROCEDURE pJoin;
+BEGIN
+	IF Root(wStruct^)=wError THEN
+		result:=wStruct^
+	ELSIF Root(wDescription^)=wError THEN
+		result:=wDescription^
+	ELSE
+		Copy(wStruct^,result);
+		Join(result,wDescription^)
+	END
+END pJoin;
+
+PROCEDURE pCopy;
+BEGIN
+	result:=Root(wProperty^)^
+END pCopy;
+
+PROCEDURE pQuote;
+BEGIN
+	result:=wStruct^
+END pQuote;
+
+PROCEDURE pVain;
+BEGIN
+	result:=wAncestor^
+END pVain;
+
+PROCEDURE pGetType;
+BEGIN
+	MakeDef(result,Root(wStruct^))
+END pGetType;
+
+PROCEDURE pIsOfClass;
+BEGIN
+	IF Root(wStruct^)=Root(wType^) THEN
+		MakeDef(result,wTrue)
+	ELSE
+		MakeDef(result,wFalse)
+	END
+END pIsOfClass;
+
+PROCEDURE pEqual;
+BEGIN
+	IF Equal(wArg1^,wArg2^) THEN
+		MakeDef(result,wTrue)
+	ELSE
+		MakeDef(result,wFalse)
+	END
+END pEqual;
+
+PROCEDURE pNot;
+VAR
+	l:BOOLEAN;
+BEGIN
+	IF Root(wArg1^)=wTrue THEN
+		MakeDef(result,wFalse)
+	ELSIF Root(wTest^)=wFalse THEN
+		MakeDef(result,wTrue)
+	ELSE
+		MakePacked(result,wError,NotLogicalType)
+	END
+END pNot;
+
+PROCEDURE pAnd;
+VAR
+	l:BOOLEAN;
+BEGIN
+	IF Root(wArg1^)=wTrue THEN
+		Reduce(wArg2^)
+	ELSIF Root(wTest^)=wFalse THEN
+		MakeDef(result,wFalse)
+	ELSE
+		MakePacked(result,wError,NotLogicalType)
+	END
+END pAnd;
+
+PROCEDURE pOr;
+VAR
+	l:BOOLEAN;
+BEGIN
+	IF Root(wArg1^)=wFalse THEN
+		Reduce(wArg2^)
+	ELSIF Root(wTest^)=wTrue THEN
+		MakeDef(result,wTrue)
+	ELSE
+		MakePacked(result,wError,NotLogicalType)
+	END
+END pOr;
+
+PROCEDURE pIf;
+VAR
+	l:BOOLEAN;
+BEGIN
+	Reduce(wTest^);
+	IF Root(result)=wTrue THEN
+		Reduce(wYes^)
+	ELSIF Root(wTest^)=wFalse THEN
+		Reduce(wNo^)
+	ELSE
+		MakePacked(result,wError,NotLogicalType)
+	END
+END pIf;
+
+PROCEDURE ExtractNumbers(VAR x,y:INTEGER):BOOLEAN;
+BEGIN
+	Reduce(wArg1^);
+	IF Root(result)#wNumber THEN
+		IF Root(result)#wError THEN
+			MakePacked(result,wError,NotNumberType)
+		END;
+		RETURN FALSE
+	END;
+	ExtractPacked(result,x);
+	
+	Reduce(wArg2^);
+	IF Root(result)#wNumber THEN
+		IF Root(result)#wError THEN
+			MakePacked(result,wError,NotNumberType)
+		END;
+		RETURN FALSE
+	END;
+	ExtractPacked(result,y);
+	RETURN TRUE
+END ExtractNumbers;
+
+PROCEDURE pAdd;
+VAR
+	x,y:INTEGER;
+BEGIN
+	IF ExtractNumbers(x,y) THEN
+		MakePacked(result,wNumber,x+y)
+	END
+END pAdd;
+
+PROCEDURE pSub;
+VAR
+	x,y:INTEGER;
+BEGIN
+	IF ExtractNumbers(x,y) THEN
+		MakePacked(result,wNumber,x-y)
+	END
+END pSub;
+
+PROCEDURE pMul;
+VAR
+	x,y:INTEGER;
+BEGIN
+	IF ExtractNumbers(x,y) THEN
+		MakePacked(result,wNumber,x*y)
+	END
+END pMul;
+
+PROCEDURE pDiv;
+VAR
+	x,y:INTEGER;
+BEGIN
+	IF ExtractNumbers(x,y) THEN
+		MakePacked(result,wNumber,x DIV y)
+	END
+END pDiv;
+
+PROCEDURE pFind;
+VAR
+	s:POINTER TO ARRAY [0..FormalLength] OF CHAR;
+	l:link;
+BEGIN
+	Reduce(wName^);
+	IF Root(result)#wString THEN
+		IF Root(result)#wError THEN
+			MakePacked(result,wError,NotStringType)
+		END;
+		RETURN
+	END;
+	ExtractPacked(result,s);
+	l:=FindWord(s^);
+	IF l=NIL THEN
+		MakePacked(result,wError,NotFound)
+	ELSE
+		NewLayer(DefEntry(l));
+		result:=wMeaning^
+	END
+END pFind;
+
+PROCEDURE pAssociate;
+VAR
+	entry:closure;
+BEGIN
+	Copy(DefEntry(Root(wName^)),tempDef);
+	AddEnv(tempDef,Root(wProperty^),wValue^);
+	SetDefEntry(Root(wName^),tempDef);
+	tempDef:=EmptyClosure;
+	Reduce(wStruct^)
+END pAssociate;
+
+PROCEDURE pWordEntry;
+BEGIN
+	result:=DefEntry(Root(wStruct^))
+END pWordEntry;
+
+PROCEDURE pDebug;
+BEGIN
+	debug:=TRUE;
+	Reduce(wStruct^);
+	debug:=FALSE
+END pDebug;
+
+PROCEDURE pCollect;
+BEGIN
+	Collect;
+	Reduce(wStruct^)
+END pCollect;
+
+PROCEDURE pAbort;
+BEGIN
+	HALT
+END pAbort;
+
+PROCEDURE pVList;
+BEGIN
+	vList;
+	MakeDef(result,wTrue)
+END pVList;
+
+BEGIN
+	DefineWord(wChar, 'CHAR', HandlePackage);
+	DefineWord(wError, 'ERROR', HandlePackage);
+	DefineWord(wNumber, 'NUMBER', HandlePackage);
+	DefineWord(wCharSet, 'CharSET', HandlePackage);
+
+	AddArgument(wPackage, 'Package');
+	DefineWord(wPacked, 'Packed', HandlePackage);
+
+	AddArgument(wCar, 'Car');
+	AddArgument(wCdr, 'Cdr');
+	AddAtom(wNil, 'Nil');
+
+	AddPrimWord(wCons, 'Cons', Build);
+	MakeDef(tempDef,wCons);
+	AddEnv(wCons^,wType,tempDef);
+	MakeDef(tempDef,wCar);
+	AddValuedEnv(wCons^,wCar,tempDef);
+	MakeDef(tempDef,wCdr);
+	AddValuedEnv(wCons^,wCdr,tempDef);
+	tempDef:=EmptyClosure;
+
+	AddPrimWord(wJoin, 'Join', pJoin);
+	AddPrimWord(wGetType, 'GetType', pGetType);
+	AddPrimWord(wGetProp, 'PropertyValue', pGetProp);
+	AddPrimWord(wAddValProp, 'AddValuedProperty', pAddValProp);
+	AddPrimWord(wAddProp, 'AddProperty', pAddProp);
+	AddPrimWord(wRemProp, 'RemoveProperty', pRemProp);
+	AddPrimWord(wCopy, 'Copy', pCopy);
+	AddPrimWord(wIsOfClass, 'IsOfClass', pIsOfClass);
+	AddPrimWord(wEqual, 'Equal', pEqual);
+	AddPrimWord(wQuote, 'Quote', pQuote);
+	AddPrimWord(wBuild, 'Build', Build);
+	AddPrimWord(wBuild, 'BuildReduced', BuildReduced);
+	AddPrimWord(wVain, 'Vain', pVain);
+
+	AddArgument(wDescription, 'Description');
+	AddArgument(wStruct, 'Struct');
+	AddArgument(wProperty, 'Property');
+	AddArgument(wValue, 'Value');
+	AddArgument(wType, 'Type');
+	AddArgument(wAncestor, 'Ancestor');
+	
+	AddAtom(wDummy, 'Dummy');
+	AddAtom(wTrue, 'True');
+	AddAtom(wFalse, 'False');
+	AddPrimWord(wAnd, 'And', pAnd);
+	AddPrimWord(wOr, 'Or', pOr);
+	AddPrimWord(wNot, 'Not', pNot);
+	AddPrimWord(wIf, 'If', pIf);
+	AddArgument(wTest, 'Test');
+	AddArgument(wYes, 'Yes');
+	AddArgument(wNo, 'No');
+	AddArgument(wArg1, 'Arg1');
+	AddArgument(wArg2, 'Arg2');
+	AddArgument(wFile, 'File');
+
+	AddPrimWord(wAdd, 'Add', pAdd);
+	AddPrimWord(wSub, 'Sub', pSub);
+	AddPrimWord(wMul, 'Mul', pMul);
+	AddPrimWord(wDiv, 'Div', pDiv);
+	
+	AddPrimWord(wFind, 'Find', pFind);
+	AddPrimWord(wWordEntry, 'WordEntry', pWordEntry);
+	AddPrimWord(wAssociate, 'Associate', pAssociate);
+	
+	AddPrimWord(wDebug, 'Debug', pDebug);
+	AddPrimWord(wCollect, 'Collect', pCollect);
+	AddPrimWord(wAbort, 'Abort', pAbort);
+	AddPrimWord(wVList, 'VList', pVList)
+END Library.
+
+
diff --git a/examples/Dipl/M2/MACHINE.DEF b/examples/Dipl/M2/MACHINE.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/MACHINE.DEF
@@ -0,0 +1,64 @@
+DEFINITION MODULE Machine;
+
+CONST
+   maxLength=24;
+TYPE
+   link= POINTER TO closure;
+   handlerType= PROC;
+   envList=POINTER TO environment;
+   wdPtr=POINTER TO wd;
+   wd=RECORD
+         def:closure;
+         name:POINTER TO ARRAY [0..maxLength] OF CHAR
+      END;
+   flag=(defined, primitive, packed, string, length);
+   closure= RECORD
+            CASE kind:flag OF
+               defined:
+                  root:wdPtr;
+               ELSE
+                  handler:handlerType
+            END;
+            env,valEnv:envList
+         END;
+   environment=RECORD
+                  name:wdPtr;
+                  newDef:closure;
+                  next:envList
+               END;
+VAR
+   result,EmptyClosure,HandlePackage,HandleParent,parent,tempDef:closure;
+   wPackage,wPacked,wType:link;
+   debug:BOOLEAN;
+
+PROCEDURE StartLayer;
+PROCEDURE SaveDefinition(dp:link);
+PROCEDURE ChangeDefinition(dp:link; value:closure);
+PROCEDURE NewLayer(d:closure);
+PROCEDURE PopLayer;
+PROCEDURE Keep(dp:link);
+
+PROCEDURE Reduce(from:closure);
+
+PROCEDURE Build;
+PROCEDURE BuildReduced;
+
+PROCEDURE Copy(from:closure; VAR to:closure);
+PROCEDURE Root(def:closure):link;
+PROCEDURE Join(VAR def:closure; description:closure);
+PROCEDURE MakeDef(VAR new:closure; root:link);
+PROCEDURE MakePrimitive(VAR new:closure; root:handlerType);
+PROCEDURE MakePacked(VAR d:closure; root:link; contents:ARRAY OF BYTE);
+PROCEDURE MakeString(VAR d:closure; root:link; start:ADDRESS);
+PROCEDURE AddEnv(VAR d:closure; prop:link; value:closure);
+PROCEDURE AddValuedEnv(VAR d:closure; prop:link; value:closure);
+PROCEDURE RemoveEnv(VAR d:closure; prop:link);
+PROCEDURE Equal(d1,d2:closure):BOOLEAN;
+PROCEDURE ExtractPacked(package:closure; VAR contents:ARRAY OF BYTE);
+PROCEDURE Envelope(VAR def:closure; struct:closure; cons,valCons,listEnd,prop,value,next:link);
+
+PROCEDURE MarkString(VAR str:ADDRESS);
+PROCEDURE MarkClosure(VAR d:closure);
+PROCEDURE MarkLink(VAR dp:link);
+
+END Machine.
diff --git a/examples/Dipl/M2/MACHINE.MOD b/examples/Dipl/M2/MACHINE.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/MACHINE.MOD
@@ -0,0 +1,828 @@
+IMPLEMENTATION MODULE Machine;
+FROM SYSTEM IMPORT ADDRESS, WORD, BYTE, ADR, TSIZE, Registers;
+FROM Lib IMPORT IncAddr, Move, WordMove, WordFill, Compare, Intr;
+FROM Memory IMPORT ALLOCATE, MarkNeeded, AddMarker, DropMarker;
+FROM IO IMPORT WrStr, WrChar, WrCharRep, WrInt, WrHex, WrLn, RdKey;
+CONST
+   MaxStack=8000;
+   MaxLayers=8000;
+   indention=3;
+   FillValue=700H;
+   TextScreen=0B000H;
+TYPE
+(*
+   envList=POINTER TO environment;
+   closure=POINTER TO clRec;
+   flag=(defined, primitive, packed, string, length);
+   clRec=RECORD
+            CASE kind:flag OF
+               defined:
+                  root:link
+               ELSE
+                  handler:handlerType
+            END;
+            env,valEnv:envList
+         END;
+   environment=RECORD
+                  name:link;
+                  newDef:closure;
+                  next:envList
+               END;
+*)
+   stackItem=   RECORD
+                  name:wdPtr;
+                  oldDef:closure
+               END;
+VAR
+   stack:ARRAY[1..MaxStack] OF stackItem;
+   layers:ARRAY[1..MaxLayers] OF [0..MaxStack];
+   sp:[0..MaxStack];
+   topLayer,breakLayer:[0..MaxLayers];
+   runScreen:ARRAY [0..25*80-1] OF WORD;
+   runCurPos:CARDINAL;
+
+PROCEDURE StartLayer;
+BEGIN
+   INC(topLayer);
+   layers[topLayer]:=sp
+END StartLayer;
+
+PROCEDURE SaveDefinition(name:link);
+BEGIN
+   INC(sp);
+   stack[sp].name:=wdPtr(name);
+   stack[sp].oldDef:=name^
+END SaveDefinition;
+
+PROCEDURE ChangeDefinition(name:link; value:closure);
+BEGIN
+   SaveDefinition(name);
+   name^:=value
+END ChangeDefinition;
+
+PROCEDURE NewLayer(d:closure);
+VAR
+   swap:closure;
+   i:CARDINAL;
+   layer:envList;
+BEGIN
+   IF (d^.kind<packed) & (d^.env=NIL) & (d^.valEnv=NIL) THEN
+      RETURN
+   END;
+   IF d^.kind>primitive THEN
+      INC(sp);
+      stack[sp].name:=wdPtr(ADR(parent));
+      stack[sp].oldDef:=parent;
+      parent:=d;
+      INC(sp);
+      stack[sp].name:=wdPtr(wPackage);
+      stack[sp].oldDef:=wPackage^;
+      wPackage^:=d
+   ELSE
+      IF d^.valEnv=NIL THEN
+         layer:=d^.env
+      ELSE
+         i:=sp;
+         layer:=d^.valEnv;
+         WHILE layer#NIL DO
+            INC(sp);
+            WITH stack[sp] DO
+               name:=layer^.name;
+               oldDef:=layer^.newDef;
+               Reduce(oldDef);
+               oldDef:=result
+            END;
+            layer:=layer^.next
+         END;
+         layer:=d^.env;
+         WHILE i<sp DO
+            INC(i);
+             WITH stack[i] DO
+               swap:=oldDef;
+               oldDef:=link(name)^;
+               link(name)^:=swap
+            END
+         END
+      END;
+      INC(sp);
+      stack[sp].name:=wdPtr(ADR(parent));
+      stack[sp].oldDef:=parent;
+      parent:=d;
+      WHILE layer#NIL DO
+         INC(sp);
+         WITH stack[sp] DO
+            name:=layer^.name;
+            oldDef:=link(name)^;
+            link(name)^:=layer^.newDef
+         END;
+         layer:=layer^.next
+      END
+   END
+END NewLayer;
+      
+PROCEDURE PopLayer;
+BEGIN
+(*   limit:=layers[topLayer]; *)
+   WHILE sp>layers[topLayer] DO
+      link(stack[sp].name)^:=stack[sp].oldDef;
+      DEC(sp)
+   END;
+   DEC(topLayer)
+END PopLayer;
+
+PROCEDURE Keep(name:link);
+VAR
+   s:CARDINAL;
+BEGIN
+   s:=sp;
+   WHILE (s>layers[topLayer]) AND (link(stack[s].name)#name) DO
+      DEC(s)
+   END;
+   IF s>layers[topLayer] THEN
+      stack[s]:=stack[sp];
+      DEC(sp)
+   END
+END Keep;
+
+PROCEDURE ShowDef(d:closure);
+FORWARD;
+
+PROCEDURE Reduce(def:closure);
+BEGIN
+   StartLayer;
+   WHILE def^.kind#primitive DO
+      IF debug OR (topLayer<=breakLayer) THEN
+         ShowDef(def)
+      END;
+      NewLayer(def);
+      def:=link(def^.root)^
+   END;
+   IF (def^.env#NIL) OR (def^.valEnv#NIL) THEN
+      NewLayer(def)
+   END;
+   def^.handler;
+   PopLayer
+END Reduce;
+
+PROCEDURE DummyHandler;
+BEGIN
+   result:=wPackage^
+END DummyHandler;
+
+PROCEDURE EmptyHandler;
+END EmptyHandler;
+
+PROCEDURE ParentHandler;
+BEGIN
+   result:=parent
+END ParentHandler;
+
+PROCEDURE Root(def:closure):link;
+BEGIN
+   RETURN link(def^.root)
+END Root;
+
+PROCEDURE EnvCopy(source:envList; VAR dest:envList);
+VAR
+   current:POINTER TO envList;
+BEGIN
+   dest:=NIL;
+   current:=ADR(dest);
+   WHILE source#NIL DO
+      NEW(current^);
+      current^^:=source^;
+      current:=ADR(current^^.next);
+      source:=source^.next
+   END
+END EnvCopy;
+
+PROCEDURE Copy(source:closure; VAR dest:closure);
+BEGIN
+   NEW(dest);
+   IF source^.kind>primitive THEN
+      dest^:=source^
+   ELSE
+      dest^.root:=source^.root;
+      dest^.kind:=source^.kind;
+      dest^.valEnv:=NIL;
+      EnvCopy(source^.env,dest^.env);
+      EnvCopy(source^.valEnv,dest^.valEnv)
+   END
+END Copy;
+
+PROCEDURE JoinEnv(VAR union:envList; add:envList);
+VAR
+   newEnv:envList;
+   current:POINTER TO envList;
+BEGIN
+   current:=ADR(union);
+   WHILE add#NIL DO
+      WHILE (current^#NIL) AND (Seg(add^.name^) > Seg(current^^.name^)) DO
+         current:=ADR(current^^.next)
+      END;
+      IF (current^#NIL) AND (add^.name=current^^.name) THEN
+         current^^.newDef:=add^.newDef
+      ELSE
+         NEW(newEnv);
+         newEnv^:=add^;
+         newEnv^.next:=current^;
+         current^:=newEnv
+      END;
+      add:=add^.next
+   END
+END JoinEnv;
+   
+PROCEDURE Join(VAR def:closure; description:closure);
+BEGIN
+   IF (def^.kind<=primitive) AND (description^.kind<=primitive) THEN
+      JoinEnv(def^.env,description^.env);
+      JoinEnv(def^.valEnv,description^.valEnv)
+   ELSIF (def^.kind=defined) AND (def^.env=NIL) AND (def^.valEnv=NIL) THEN
+      def^.kind:=description^.kind;
+      EnvCopy(description^.env,def^.env);
+      EnvCopy(description^.valEnv,def^.valEnv)
+   END
+END Join;
+
+PROCEDURE Build;
+VAR
+   follow,valFollow:envList;
+   current:POINTER TO envList;
+BEGIN
+   IF (parent^.kind<packed) & (parent^.valEnv#NIL) THEN
+      NEW(result);
+      result^:=wType^^;
+      follow:=result^.env;
+      valFollow:=parent^.valEnv;
+      IF link(valFollow^.name)=wType THEN
+         valFollow:=valFollow^.next
+      END;
+      current:=ADR(result^.env);
+      WHILE valFollow#NIL DO
+         WHILE (follow#NIL) & (Seg(follow^.name^) < Seg(valFollow^.name^)) DO
+            current^:=NIL;
+            NEW(current^);
+            current^^.name:=follow^.name;
+            current^^.newDef:=follow^.newDef;
+            current:=ADR(current^^.next);
+            follow:=follow^.next
+         END;
+         IF (follow#NIL) & (follow^.name = valFollow^.name) THEN
+            follow:=follow^.next
+         END;
+         current^:=NIL;
+         NEW(current^);
+         current^^.name:=valFollow^.name;
+         current^^.newDef:=link(valFollow^.name)^;
+         current:=ADR(current^^.next);
+         valFollow:=valFollow^.next
+      END;
+      WHILE follow#NIL DO
+         current^:=NIL;
+         NEW(current^);
+         current^^.name:=follow^.name;
+         current^^.newDef:=follow^.newDef;
+         current:=ADR(current^^.next);
+         follow:=follow^.next
+      END;
+      current^:=NIL
+   ELSE
+      result:=wType^
+   END
+END Build;
+
+PROCEDURE BuildMixed;
+VAR
+   e:envList;
+   dest:POINTER TO envList;
+BEGIN
+   result:=parent;
+   IF (result^.kind<packed) & (result^.valEnv#NIL) THEN
+      NEW(result);
+      result^:=parent^;
+      WITH result^ DO
+         dest:=ADR(env);
+         REPEAT
+            NEW(e);
+            e^.name:=valEnv^.name;
+            e^.newDef:=link(e^.name)^;
+            WHILE (dest^#NIL) & (Seg(e^.name^) > Seg(dest^^.name^)) DO
+               dest:=ADR(dest^^.next)
+            END;
+            e^.next:=dest^;
+            dest^:=e;
+            valEnv:=valEnv^.next
+         UNTIL valEnv=NIL
+      END
+   END
+END BuildMixed;
+
+PROCEDURE BuildReduced;
+VAR
+   follow:envList;
+   i:CARDINAL;
+BEGIN
+   follow:=parent^.env;
+   WHILE follow#NIL DO
+      link(stack[sp].name)^:=stack[sp].oldDef;
+      DEC(sp);
+      follow:=follow^.next
+   END;
+   SaveDefinition(ADR(parent));
+   Copy(parent,parent);
+   follow:=parent^.env;
+   WHILE follow#NIL DO
+      Reduce(follow^.newDef);
+      follow^.newDef:=result;
+      follow:=follow^.next
+   END;
+   follow:=parent^.valEnv;
+   WHILE follow#NIL DO
+      Reduce(link(follow^.name)^);
+      follow^.newDef:=result;
+      follow:=follow^.next
+   END;
+   result:=parent;
+   JoinEnv(result^.env,result^.valEnv);
+   result^.valEnv:=NIL
+END BuildReduced;
+
+PROCEDURE MakeDef(VAR def:closure; defRoot:link);
+BEGIN
+   NEW(def);
+   WITH def^ DO
+      kind:=defined;
+      env:=NIL;
+      valEnv:=NIL;
+      root:=wdPtr(defRoot)
+   END
+END MakeDef;
+
+PROCEDURE LinkDef(l:link; defRoot:link);
+BEGIN
+   SaveDefinition(l);
+   MakeDef(l^,defRoot)
+END LinkDef;
+
+PROCEDURE MakePrimitive(VAR def:closure; defHandler:handlerType);
+BEGIN
+   NEW(def);
+   WITH def^ DO
+      kind:=primitive;
+      env:=NIL;
+      valEnv:=NIL;
+      handler:=defHandler
+   END
+END MakePrimitive;
+
+PROCEDURE LinkPrimitive(l:link; defHandler:handlerType);
+BEGIN
+   SaveDefinition(l);
+   MakePrimitive(l^,defHandler)
+END LinkPrimitive;
+
+PROCEDURE MakePacked(VAR d:closure; root:link; x:ARRAY OF BYTE);
+BEGIN
+   NEW(d);
+   d^.root:=wdPtr(root);
+   d^.kind:=packed;
+   IF HIGH(x)>3 THEN
+      ALLOCATE(d^.env,HIGH(x)+1);
+      d^.kind:=length;
+      Move(ADR(x),d^.env,HIGH(x)+1);
+      d^.valEnv:=envList(HIGH(x)+1)
+   ELSE
+      d^.valEnv:=NIL;
+      d^.env:=NIL;
+      Move(ADR(x),ADR(d^.env),HIGH(x)+1)
+   END
+END MakePacked;
+
+PROCEDURE LinkPacked(l:link; root:link; x:ARRAY OF BYTE);
+BEGIN
+   SaveDefinition(l);
+   MakePacked(l^,root,x)
+END LinkPacked;
+
+PROCEDURE MakeString(VAR d:closure; root:link; a:ADDRESS);
+BEGIN
+   NEW(d);
+   d^.kind:=string;
+   d^.root:=wdPtr(root);
+   d^.env:=envList(a);
+   d^.valEnv:=NIL
+END MakeString;
+
+PROCEDURE LinkString(l:link; root:link; a:ADDRESS);
+BEGIN
+   SaveDefinition(l);
+   MakeString(l^,defRoot)
+END LinkString;
+
+PROCEDURE AddEnv(VAR d:closure; prop:link; newValue:closure);
+VAR
+   newProp:envList;
+   current:POINTER TO envList;
+BEGIN
+   IF (prop=NIL) OR (d^.kind>primitive) THEN
+      RETURN
+   END;
+   current:=ADR(d^.env);
+   WHILE (current^#NIL) AND (Seg(current^^.name^) < Seg(prop^)) DO
+      current:=ADR(current^^.next)
+   END;
+   IF (current^#NIL) AND (link(current^^.name)=prop) THEN
+      current^^.newDef:=newValue
+   ELSE
+      NEW(newProp);
+      WITH newProp^ DO
+         name:=wdPtr(prop);
+         newDef:=newValue;
+         next:=current^
+      END;
+      current^:=newProp
+   END
+END AddEnv;
+
+PROCEDURE AddValuedEnv(VAR d:closure; prop:link; newValue:closure);
+VAR
+   newProp:envList;
+   current:POINTER TO envList;
+BEGIN
+   IF (prop=NIL) OR (d^.kind>primitive) THEN
+      RETURN
+   END;
+   current:=ADR(d^.valEnv);
+   WHILE (current^#NIL) AND (Seg(current^^.name^) < Seg(prop^)) DO
+      current:=ADR(current^^.next)
+   END;
+   IF (current^#NIL) AND (link(current^^.name)=prop) THEN
+      current^^.newDef:=newValue
+   ELSE
+      NEW(newProp);
+      WITH newProp^ DO
+         name:=wdPtr(prop);
+         newDef:=newValue;
+         next:=current^
+      END;
+      current^:=newProp
+   END
+END AddValuedEnv;
+
+PROCEDURE RemoveEnv(VAR d:closure; prop:link);
+VAR
+   current:POINTER TO envList;
+BEGIN
+   IF (prop=NIL) OR (d^.kind>primitive) THEN
+      RETURN
+   END;
+   current:=ADR(d^.env);
+   WHILE (current^#NIL) AND (link(current^^.name)#prop) DO
+      current:=ADR(current^^.next)
+   END;
+   IF current^#NIL THEN
+      current^:=current^^.next
+   END;
+   current:=ADR(d^.valEnv);
+   WHILE (current^#NIL) AND (link(current^^.name)#prop) DO
+      current:=ADR(current^^.next)
+   END;
+   IF current^#NIL THEN
+      current^:=current^^.next
+   END
+END RemoveEnv;
+
+PROCEDURE EnvEqual(e1,e2:envList):BOOLEAN;
+BEGIN
+   WHILE e1#NIL DO
+      IF (e2#NIL) AND (e1^.name=e2^.name) AND (e1^.newDef=e2^.newDef) THEN
+         e1:=e1^.next;
+         e2:=e2^.next
+      ELSE
+         RETURN FALSE
+      END
+   END;
+   RETURN e2=NIL
+END EnvEqual;
+   
+TYPE
+   CharPtr=POINTER TO CHAR;
+
+PROCEDURE SameStrings(s1,s2:ADDRESS):BOOLEAN;
+BEGIN
+   WHILE (s1^=s2^) AND (CharPtr(s1)^#0C) DO
+      IncAddr(s1,1);
+      IncAddr(s2,1)
+   END;
+   RETURN s1^=s2^
+END SameStrings;
+
+PROCEDURE Equal(d1,d2:closure):BOOLEAN;
+BEGIN
+   IF (d1=d2) OR (d1^=d2^) THEN
+      RETURN TRUE
+   END;
+   IF (d1^.root#d2^.root) OR (d1^.kind#d2^.kind) THEN
+      RETURN FALSE
+   END;
+   CASE d1^.kind OF
+      |packed:RETURN FALSE
+      |string:RETURN SameStrings(d1^.env,d2^.env)
+      |length:RETURN (d1^.valEnv=d2^.valEnv) AND
+            (CARDINAL(d1^.valEnv)=Compare(d1^.env,d2^.env,CARDINAL(d1^.valEnv)))
+   ELSE
+      RETURN EnvEqual(d1^.env,d2^.env) AND EnvEqual(d1^.valEnv,d2^.valEnv)
+   END
+END Equal;
+      
+PROCEDURE ExtractPacked(package:closure; VAR x:ARRAY OF BYTE);
+BEGIN
+   IF HIGH(x)<4 THEN
+      Move(ADR(package^.env),ADR(x),HIGH(x)+1)
+   ELSE
+      Move(package^.env,ADR(x),HIGH(x)+1)
+   END
+END ExtractPacked;
+
+PROCEDURE Envelope(VAR def:closure; struct:closure;
+                  cons,valCons,listEnd,prop,value,next:link);
+   PROCEDURE EnvToList(env:envList;cons:link);
+   BEGIN
+      IF env#NIL THEN
+         EnvToList(env^.next,cons);
+         tempDef:=def;
+         MakeDef(def,cons);
+         AddEnv(def,next,tempDef);
+         MakeDef(tempDef,link(env^.name));
+         AddEnv(def,prop,tempDef);
+         AddEnv(def,value,env^.newDef)
+      END
+   END EnvToList;
+BEGIN
+   MakeDef(def,listEnd);
+   IF struct^.kind>primitive THEN
+      tempDef:=def;
+      MakeDef(def,cons);
+      AddEnv(def,next,tempDef);
+      MakeDef(tempDef,wPackage);
+      AddEnv(def,prop,tempDef);
+      NEW(tempDef);
+      tempDef^:=struct^;
+      tempDef^.root:=wdPtr(wPacked);
+      AddEnv(def,value,tempDef)
+   ELSE
+      EnvToList(struct^.env,cons);
+      EnvToList(struct^.valEnv,valCons)
+   END;
+   tempDef:=EmptyClosure
+END Envelope;
+
+   
+PROCEDURE MarkEnvironment(VAR env:envList);
+VAR
+   fresh:BOOLEAN;
+   ep:POINTER TO envList;
+BEGIN
+   fresh:=TRUE;
+   ep:=ADR(env);
+   WHILE (ep^#NIL) AND fresh DO
+      MarkNeeded(ep^, TSIZE(environment), fresh);
+      MarkClosure(ep^^.newDef);
+      ep:=ADR(ep^^.next)
+   END
+END MarkEnvironment;
+
+PROCEDURE MarkString(VAR str:ADDRESS);
+VAR
+   length:CARDINAL;
+   fresh:BOOLEAN;
+   follow:CharPtr;
+BEGIN
+   IF str#NIL THEN
+      length:=1;
+      follow:=CharPtr(str);
+      WHILE follow^#0C DO
+         INC(length);
+         IncAddr(follow,1)
+      END;
+      MarkNeeded(str,length,fresh)
+   END
+END MarkString;
+
+PROCEDURE MarkClosure(VAR def:closure);
+VAR
+   fresh:BOOLEAN;
+BEGIN
+   IF def=NIL THEN
+      RETURN
+   END;
+   MarkNeeded(def,TSIZE(clRec),fresh);
+   IF fresh THEN
+      CASE def^.kind OF
+         defined:
+            MarkLink(link(def^.root));
+            MarkEnvironment(def^.env);
+            MarkEnvironment(def^.valEnv)
+         |primitive:
+            MarkEnvironment(def^.env);
+            MarkEnvironment(def^.valEnv)
+         |string:
+            MarkLink(link(def^.root));
+            MarkString(def^.env)
+         |length:
+            MarkLink(link(def^.root));
+            MarkNeeded(def^.env,CARDINAL(def^.valEnv),fresh)
+      END
+   END
+END MarkClosure;
+
+PROCEDURE MarkLink(VAR l:link);
+VAR
+   fresh:BOOLEAN;
+BEGIN
+   MarkNeeded(l,TSIZE(closure),fresh);
+   IF fresh THEN
+      MarkClosure(l^)
+   END
+END MarkLink;
+
+PROCEDURE MarkStack;
+VAR
+   i:CARDINAL;
+BEGIN
+   FOR i:=sp TO 1 BY -1 DO
+      MarkLink(link(stack[i].name));
+      MarkClosure(stack[i].oldDef)
+   END
+END MarkStack;
+
+PROCEDURE MarkTemporaries;
+BEGIN
+   MarkClosure(tempDef);
+   MarkClosure(result);
+   MarkClosure(EmptyClosure);
+   MarkClosure(HandlePackage);
+   MarkClosure(HandleParent);
+   MarkLink(wPackage);
+   MarkClosure(parent)
+END MarkTemporaries;
+
+PROCEDURE CursorPos():CARDINAL;
+VAR
+   r:Registers;
+BEGIN
+   r.AH:=3;
+   r.BH:=0;
+   Intr(r,10H);
+   RETURN r.DX
+END CursorPos;
+
+PROCEDURE PlaceCursor(pos:CARDINAL);
+VAR
+   r:Registers;
+BEGIN
+   r.AH:=2;
+   r.BH:=0;
+   r.DX:=pos;
+   Intr(r,10H)
+END PlaceCursor;
+
+PROCEDURE SaveScreen(VAR scr:ARRAY OF WORD);
+BEGIN
+   WordMove([TextScreen:0], ADR(scr), 25*80)
+END SaveScreen;
+
+PROCEDURE RestoreScreen(VAR scr:ARRAY OF WORD);
+BEGIN
+   WordMove(ADR(scr), [TextScreen:0], 25*80)
+END RestoreScreen;
+
+PROCEDURE ClearScreen;
+BEGIN
+   WordFill([TextScreen:0], 50*80, FillValue);
+   PlaceCursor(0)
+END ClearScreen;
+
+PROCEDURE WriteDef(d:closure; indent:CARDINAL);
+VAR
+   follow:CharPtr;
+   
+   PROCEDURE WriteEnv(e:envList; indent:CARDINAL; colon:BOOLEAN);
+   BEGIN
+      WHILE e#NIL DO
+         WrLn;
+         WrCharRep(' ',indent);
+         WrStr(e^.name^.name^);
+         IF colon THEN
+            WrChar(':')
+         END;
+         WrChar('=');
+         WriteDef(e^.newDef, indent);
+         e:=e^.next
+      END
+   END WriteEnv;
+BEGIN
+   CASE d^.kind OF
+      |defined:
+         WrStr(d^.root^.name^);
+         WrChar('(');
+         IF d^.valEnv#NIL THEN
+            WriteEnv(d^.valEnv, indent+indention, TRUE);
+            WrLn
+         END;
+         WriteEnv(d^.env, indent+indention, FALSE);
+         WrChar(')')
+      |string:
+         WrChar('[');
+         WrStr(d^.root^.name^);
+         WrChar(']');
+         WrChar('"');
+         follow:=CharPtr(d^.env);
+         WHILE follow^#0C DO
+            WrChar(follow^);
+            IncAddr(follow,1)
+         END;
+         WrChar('"')
+      |primitive:
+         WrStr('PRIMITIVE[');
+         WrHex(Seg(d^.env),0);
+         WrChar(':');
+         WrHex(Ofs(d^.env),0);
+         WrChar(']')
+      |packed:
+         WrChar('[');
+         WrStr(d^.root^.name^);
+         WrChar(']');
+         WrInt(INTEGER(d^.env),0);
+         IF CHAR(d^.env) >= ' ' THEN
+            WrStr(" - '");
+            WrChar(CHAR(d^.env));
+            WrChar("'")
+         END
+      |length:
+         WrChar('[');
+         WrStr(d^.root^.name^);
+         WrChar(']');
+         WrHex(Seg(d^.valEnv),5)
+   END
+END WriteDef;
+
+PROCEDURE ShowDef(d:closure);
+VAR
+   ch:CHAR;
+BEGIN
+   debug:=TRUE;
+   breakLayer:=0;
+   runCurPos:=CursorPos();
+   SaveScreen(runScreen);
+   ClearScreen;
+   WriteDef(d,0);
+   LOOP
+      ch:=RdKey();
+      CASE ch OF
+(*         |'w','W':
+            Info(debugWin,winfo);
+            SetWrap(NOT winfo.WrapOn);
+            Clear;
+            WriteDef(d,0)
+*)
+         |' ':
+            EXIT
+         |'p','P':
+            debug:=FALSE;
+            breakLayer:=topLayer;
+            RestoreScreen(runScreen);
+            EXIT
+         |'/':
+            RestoreScreen(runScreen);
+            ch:=RdKey();
+            ClearScreen;
+            WriteDef(d,0)
+         |'g','G':
+            debug:=FALSE;
+            EXIT
+         |'q','Q':
+            ch:=RdKey();
+            IF ch='!' THEN
+               HALT
+            END
+      END
+   END;
+   RestoreScreen(runScreen);
+   PlaceCursor(runCurPos)
+END ShowDef;
+
+BEGIN
+   sp:=0;
+   topLayer:=1;
+   breakLayer:=0;
+   MakePrimitive(EmptyClosure,EmptyHandler);
+   MakePrimitive(HandlePackage,DummyHandler);
+   MakePrimitive(HandleParent,ParentHandler);
+   tempDef:=EmptyClosure;
+   result:=EmptyClosure;
+   parent:=NIL;
+   AddMarker(MarkStack);
+   AddMarker(MarkTemporaries);
+   debug:=FALSE
+END Machine.
diff --git a/examples/Dipl/M2/MEMORY.DEF b/examples/Dipl/M2/MEMORY.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/MEMORY.DEF
@@ -0,0 +1,12 @@
+DEFINITION MODULE Memory;
+
+PROCEDURE MarkNeeded(VAR ptr:ADDRESS; length:CARDINAL; VAR newDiscovery:BOOLEAN);
+PROCEDURE Collect;
+PROCEDURE AddMarker(marker:PROC);
+PROCEDURE DropMarker;
+PROCEDURE ALLOCATE(VAR ptr:ADDRESS; length:CARDINAL);
+
+END Memory.
+
+
+
diff --git a/examples/Dipl/M2/MEMORY.MOD b/examples/Dipl/M2/MEMORY.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/MEMORY.MOD
@@ -0,0 +1,227 @@
+IMPLEMENTATION MODULE Memory;
+FROM Lib IMPORT AddAddr, DecAddr, IncAddr, SubAddr, Dos;
+FROM SYSTEM IMPORT ADDRESS, BYTE, TSIZE, Registers;
+FROM IO IMPORT WrStr, WrLn;
+CONST
+	MaxMarkers=200;
+	MinParagraph=400H;
+	MaxParagraph=0A000H;
+	MinBitMap=MinParagraph DIV 16;
+	MaxBitMap=MaxParagraph DIV 16;
+	MaxBlockSize=1025;
+VAR
+	markers:ARRAY [1..MaxMarkers] OF PROC;
+	lastMarker:[0..MaxMarkers];
+	bitMap:ARRAY [MinBitMap..MaxBitMap] OF BITSET;
+	HeapTop,HeapBottom:CARDINAL;
+	sizes:ARRAY [0..MaxBlockSize+1] OF
+		RECORD
+			paragraph:CARDINAL;
+			previous,next:[0..MaxBlockSize+1]
+		END;
+	largestBlock:[0..MaxBlockSize];
+	block1,length1:CARDINAL;
+
+PROCEDURE FatalError(text:ARRAY OF CHAR);
+BEGIN
+	WrLn;
+	WrStr('Greska u garbage collector modulu!');
+	WrLn;
+	WrStr(text);
+	HALT
+END FatalError;
+
+PROCEDURE AddMarker(m:PROC);
+BEGIN
+	IF lastMarker<MaxMarkers THEN
+		INC(lastMarker);
+		markers[lastMarker]:=m
+	ELSE
+		FatalError('Prekoracen maximalan broj markera potrebnih celija u HEAPu!')
+	END
+END AddMarker;
+
+PROCEDURE DropMarker;
+BEGIN
+	IF lastMarker>0 THEN
+		DEC(lastMarker)
+	ELSE
+		FatalError('Malo previse brisanja markera potrebnih celija u HEAPu.')
+	END
+END DropMarker;
+
+PROCEDURE MarkNeeded(VAR addr:ADDRESS; length:CARDINAL; VAR discovery:BOOLEAN);
+VAR
+	paragraph:CARDINAL;
+BEGIN
+	paragraph:=Seg(addr^);
+	IF Ofs(addr^)#0 THEN
+		paragraph:=paragraph + Ofs(addr^) DIV 16;
+		length:=length + Ofs(addr^) MOD 16
+	END;
+	length:=(length+15) DIV 16;
+	IF paragraph>=HeapBottom THEN
+		discovery:=FALSE;
+		IF paragraph>HeapTop THEN
+			RETURN
+		END;
+		REPEAT
+			IF NOT (paragraph MOD 16 IN bitMap[paragraph DIV 16]) THEN
+				discovery:=TRUE;
+				INCL(bitMap[paragraph DIV 16],paragraph MOD 16)
+			END;
+			INC(paragraph);
+			DEC(length)
+		UNTIL length=0
+	ELSE
+		discovery:=TRUE
+	END
+END MarkNeeded;
+
+(*#check(index => off) *)
+(*#check(range => off) *)
+(*#check(overflow => off) *)
+(*#check(stack => off) *)
+(*#check(guard => off) *)
+(*#check(nil_ptr => off) *)
+
+PROCEDURE Collect;
+VAR
+	i,blockSize,previous:CARDINAL;
+BEGIN
+	FOR i:=HeapBottom DIV 16 TO HeapTop DIV 16 DO
+		bitMap[i]:=BITSET(0)
+	END;
+	FOR i:=1 TO lastMarker DO
+		markers[i]
+	END;
+	largestBlock:=0;
+	FOR i:=1 TO MaxBlockSize DO
+		sizes[i].paragraph:=0
+	END;
+	EXCL(bitMap[HeapBottom DIV 16],HeapBottom MOD 16);
+	INCL(bitMap[(HeapBottom+1) DIV 16],(HeapBottom+1) MOD 16);
+	i:=HeapTop-1;
+	LOOP
+		WHILE i MOD 16 IN bitMap[i DIV 16] DO
+			DEC(i)
+		END;
+		IF i=HeapBottom THEN
+			EXIT
+		END;
+		blockSize:=0;
+		REPEAT
+			INC(blockSize);
+			DEC(i);
+		UNTIL i MOD 16 IN bitMap[i DIV 16];
+		IF blockSize>largestBlock THEN
+			IF blockSize>MaxBlockSize THEN
+				INC(i,blockSize-MaxBlockSize);
+				blockSize:=MaxBlockSize
+			END;
+			largestBlock:=blockSize
+		END;
+		[i+1:0]^:=sizes[blockSize].paragraph;
+		sizes[blockSize].paragraph:=i+1
+	END;
+	IF largestBlock=0 THEN
+		FatalError( 'Heap je definitivno prepunjen. Zaboravi na taj algoritam!' )
+	END;
+	previous:=0;
+	FOR blockSize:=1 TO largestBlock DO
+		IF sizes[blockSize].paragraph#0 THEN
+			sizes[blockSize].previous:=previous;
+			sizes[previous].next:=blockSize;
+			previous:=blockSize
+		END
+	END;
+	sizes[largestBlock].next:=MaxBlockSize+1;
+	length1:=0
+END Collect;
+
+PROCEDURE ALLOCATE(VAR ptr:ADDRESS; length:CARDINAL);
+VAR
+	original:CARDINAL;
+BEGIN
+	IF length<=16 THEN
+		IF sizes[1].paragraph#0 THEN
+			ptr:=[sizes[1].paragraph:0];
+			sizes[1].paragraph:=ptr^;
+			IF sizes[1].paragraph=0 THEN
+				sizes[0].next:=sizes[1].next;
+				sizes[sizes[1].next].previous:=0
+			END
+		ELSE
+			IF length1=0 THEN
+				length1:=sizes[0].next;
+				IF length1>MaxBlockSize THEN
+					Collect;
+					ALLOCATE(ptr,length);
+					RETURN
+				END;
+				block1:=sizes[length1].paragraph;
+				sizes[length1].paragraph:=[block1:0]^;
+				IF sizes[length1].paragraph=0 THEN
+					sizes[0].next:=sizes[length1].next;
+					sizes[sizes[length1].next].previous:=0
+				END
+			END;
+			ptr:=[block1:0];
+			INC(block1);
+			DEC(length1)
+		END
+	ELSE
+		length:=(length+15) DIV 16;
+		original:=length;
+		IF sizes[length].paragraph=0 THEN
+			length:=0;
+			REPEAT
+				length:=sizes[length].next
+			UNTIL length>=original;
+			IF length>MaxBlockSize THEN
+				Collect;
+				IF original>largestBlock THEN
+					FatalError( 'Heap je definitivno prepunjen. Zaboravi na taj algoritam!' )
+				END;
+				ALLOCATE(ptr,original*16);
+				RETURN
+			END
+		END;
+		WITH sizes[length] DO
+			IF length#original THEN
+				[paragraph+original:0]^:=sizes[length-original].paragraph;
+				sizes[length-original].paragraph:=paragraph+original;
+				IF [paragraph+original:0]^=WORD(0) THEN
+					sizes[previous].next:=length-original;
+					sizes[length-original].previous:=previous;
+					previous:=length-original;
+					sizes[length-original].next:=length
+				END
+			END;
+			ptr:=[paragraph:0];
+			paragraph:=ptr^;
+			IF paragraph=0 THEN
+				sizes[previous].next:=next;
+				sizes[next].previous:=previous
+			END
+		END
+	END
+END ALLOCATE;
+
+VAR
+	r:Registers;
+	
+BEGIN
+	r.AH:=48H;
+	r.BX:=0FFFFH;
+	Dos(r);
+	r.AH:=48H;
+	Dos(r);
+	HeapBottom:=r.AX;
+	HeapTop:=r.AX+r.BX-1;
+	lastMarker:=0;
+	Collect
+END Memory.
+
+
+
diff --git a/examples/Dipl/M2/NAMES.DEF b/examples/Dipl/M2/NAMES.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/NAMES.DEF
@@ -0,0 +1,24 @@
+DEFINITION MODULE Names;
+
+FROM Machine IMPORT link, closure, handlerType;
+
+PROCEDURE DefName(dp:link):ADDRESS;
+PROCEDURE DefEntry(dp:link):closure;
+PROCEDURE SetDefEntry(dp:link; newEntry:closure);
+PROCEDURE FindWord(wd:ARRAY OF CHAR):link;
+
+PROCEDURE NewDictionary;
+PROCEDURE OldDictionary;
+
+PROCEDURE DefineWord(VAR newDef:link; name:ARRAY OF CHAR; wordMeaning:closure);
+PROCEDURE AddPrimWord(VAR newDef:link; name:ARRAY OF CHAR;
+								handler:handlerType);
+PROCEDURE AddArgument(VAR worDef:link; wordName:ARRAY OF CHAR);
+PROCEDURE AddAtom(VAR worDef:link; wordName:ARRAY OF CHAR);
+PROCEDURE vList;
+
+VAR
+	wParent, wString, wMeaning, wName, wEntry, wUndefined:link;
+END Names.
+
+
diff --git a/examples/Dipl/M2/NAMES.MOD b/examples/Dipl/M2/NAMES.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/NAMES.MOD
@@ -0,0 +1,334 @@
+IMPLEMENTATION MODULE Names;
+
+FROM SYSTEM IMPORT TSIZE;
+FROM Lib IMPORT AddAddr, SubAddr, HashString;
+FROM IO IMPORT WrStrAdj, WrLn;
+FROM Str IMPORT Caps;
+FROM Memory IMPORT ALLOCATE, MarkNeeded, AddMarker, DropMarker;
+FROM Machine IMPORT link, closure, parent, tempDef;
+FROM Machine IMPORT EmptyClosure, MarkClosure, MarkString;
+FROM Machine IMPORT wType, Build, HandlePackage, HandleParent, ChangeDefinition;
+FROM Machine IMPORT AddEnv, RemoveEnv, MakeDef, MakePrimitive, MakeString;
+CONST
+	FormalMaximum=10000;
+	MaxEntries=64;
+	LastEntry=MaxEntries-1;
+TYPE
+	wordPtr=POINTER TO wordType;
+	wordType=RECORD
+					next:wordPtr;
+					def:closure;
+					name:POINTER TO ARRAY [0..FormalMaximum] OF CHAR;
+					entry:closure;
+				END;
+	dictionary=POINTER TO dictRec;
+	dictRec= RECORD
+					info:ARRAY [0..LastEntry] OF wordPtr;
+					next:dictionary
+				 END;
+VAR
+	i:CARDINAL;
+	top:dictionary;
+	UndefinedMeaning:closure;
+	
+PROCEDURE DefWord(l:link):wordPtr;
+BEGIN
+	RETURN wordPtr(SubAddr(l,TSIZE(wordPtr)))
+END DefWord;
+
+PROCEDURE vList;
+CONST
+	WordsInRow=3;
+	MaxLength=25;
+VAR
+	follow:wordPtr;
+	i,counter:CARDINAL;
+BEGIN
+	counter:=1;
+	FOR i:=0 TO LastEntry DO
+		follow:=top^.info[i];
+		WHILE follow#NIL DO
+			DEC(counter);
+			IF counter=0 THEN
+				counter:=WordsInRow;
+				WrLn
+			END;
+			WrStrAdj(follow^.name^,-MaxLength);
+			follow:=follow^.next
+		END
+	END;
+	WrLn
+END vList;
+
+PROCEDURE NewDictionary;
+VAR
+	d:dictionary;
+	i:CARDINAL;
+BEGIN
+	NEW(d);
+	FOR i:=0 TO LastEntry DO
+		d^.info[i]:=top^.info[i]
+	END;
+	d^.next:=top;
+	top:=d
+END NewDictionary;
+
+PROCEDURE OldDictionary;
+BEGIN
+	top:=top^.next
+END OldDictionary;
+
+PROCEDURE DefineWord(VAR worDef:link; wordName:ARRAY OF CHAR;
+								wordMeaning:closure);
+VAR
+	newWord:wordPtr;
+	hash:CARDINAL;
+BEGIN
+	hash:=HashString(wordName,MaxEntries);
+	NEW(newWord);
+	WITH newWord^ DO
+		next:=top^.info[hash];
+		top^.info[hash]:=newWord;
+		name:=ADR(wordName);
+		def:=EmptyClosure;
+		entry:=EmptyClosure;
+		worDef:=ADR(def);
+		MakeDef(entry,wEntry);
+		MakeDef(def,worDef);
+		AddEnv(entry,wMeaning,def);
+		MakeString(def,wString,name);
+		AddEnv(entry,wName,def);
+		def:=wordMeaning
+	END
+END DefineWord;
+
+(*
+PROCEDURE UndefineWord(l:link);
+VAR
+	hash:CARDINAL;
+BEGIN
+	hash:=HashString(DefWord(l)^.name^,MaxEntries);
+	top^.info[hash]:=top^.info[hash]^.next
+END UndefineWord;
+
+PROCEDURE MoveWord(l:link; fromVoc, toVoc:dictionary);
+VAR
+	hash:CARDINAL;
+	follow:POINTER TO wordPtr;
+	wd:wordPtr;
+BEGIN
+	wd:=DefWord(l);
+	hash:=HashString(wd^.name^,MaxEntries);
+	IF fromVoc#EmptyDict THEN
+		follow:=ADR(fromVoc^.info[hash]);
+		WHILE (follow^#wd) AND (follow^#NIL) DO
+			follow:=ADR(follow^^.next)
+		END;
+		IF follow^=wd THEN
+			follow^:=follow^^.next
+		END
+	END;
+	wd^.next:=toVoc^.info[hash];
+	toVoc^.info[hash]:=wd
+END MoveWord;
+
+PROCEDURE Forget(dp:link):BOOLEAN;
+VAR
+	follow,target:wordPtr;
+BEGIN
+	target:=wordPtr(dp);
+	follow:=lastWord;
+	WHILE (follow#NIL) AND (follow#target) DO
+		follow:=follow^.next
+	END;
+	IF follow=NIL THEN
+		RETURN FALSE
+	ELSE
+		lastWord:=follow^.next;
+		RETURN TRUE
+	END
+END Forget;
+*)
+
+PROCEDURE AddPrimWord(VAR worDef:link; wordName:ARRAY OF CHAR;
+								handler:handlerType);
+BEGIN
+	MakePrimitive(tempDef,handler);
+	DefineWord(worDef,wordName,tempDef);
+	tempDef:=EmptyClosure
+END AddPrimWord;
+
+PROCEDURE AddArgument(VAR worDef:link; wordName:ARRAY OF CHAR);
+BEGIN
+	DefineWord(worDef,wordName,UndefinedMeaning)
+END AddArgument;
+
+PROCEDURE AddAtom(VAR worDef:link; wordName:ARRAY OF CHAR);
+BEGIN
+	AddPrimWord(worDef,wordName,Build);
+	MakeDef(tempDef,worDef);
+	AddEnv(worDef^,wType,tempDef);
+	tempDef:=EmptyClosure
+END AddAtom;
+	
+PROCEDURE MarkWords;
+VAR
+	i:[0..LastEntry];
+	wdCurrent:wordPtr;
+	dictFollow:dictionary;
+	fresh:BOOLEAN;
+BEGIN
+	MarkClosure(UndefinedMeaning);
+	dictFollow:=top;
+	WHILE dictFollow#NIL DO
+		MarkNeeded(dictFollow,TSIZE(dictRec),fresh);
+		dictFollow:=dictFollow^.next
+	END;
+	FOR i:=0 TO LastEntry DO
+		wdCurrent:=top^.info[i];
+		WHILE wdCurrent#NIL DO
+			MarkNeeded(wdCurrent,TSIZE(wordType),fresh);
+			WITH wdCurrent^ DO
+				MarkString(name);
+				MarkClosure(def);
+				MarkClosure(entry);
+				wdCurrent:=next
+			END
+		END
+	END
+END MarkWords;
+
+PROCEDURE FindWord(wd:ARRAY OF CHAR):link;
+VAR
+	follow:wordPtr;
+	letter:CARDINAL;
+BEGIN
+	follow:=top^.info[HashString(wd,MaxEntries)];
+	WHILE follow#NIL DO
+		IF follow^.name^[0]=wd[0] THEN
+			letter:=1;
+			WITH follow^ DO
+				WHILE (wd[letter]=name^[letter]) AND (name^[letter]#0C) DO
+					INC(letter)
+				END;
+				IF wd[letter]=name^[letter] THEN
+					RETURN ADR(def)
+				END;
+			END
+		END;
+		follow:=follow^.next
+	END;
+	RETURN NIL
+END FindWord;
+
+(*# call( o_a_copy => on ) *)
+
+PROCEDURE FindWordNoCase(wd:ARRAY OF CHAR):link;
+VAR
+	follow:wordPtr;
+	letter:CARDINAL;
+BEGIN
+	Caps(wd);
+	follow:=top^.info[HashString(wd,MaxEntries)];
+	WHILE follow#NIL DO
+		IF CAP(follow^.name^[0])=wd[0] THEN
+			letter:=1;
+			WITH follow^ DO
+				WHILE (wd[letter]=CAP(name^[letter])) AND (name^[letter]#0C) DO
+					INC(letter)
+				END;
+				IF wd[letter]=name^[letter] THEN
+					RETURN ADR(def)
+				END;
+			END
+		END;
+		follow:=follow^.next
+	END;
+	RETURN NIL
+END FindWordNoCase;
+
+PROCEDURE DefName(dp:link):ADDRESS;
+TYPE
+	AddrPtr=POINTER TO ADDRESS;
+BEGIN
+	RETURN AddrPtr(AddAddr(dp,TSIZE(closure)))^
+END DefName;
+
+PROCEDURE DefEntry(dp:link):closure;
+BEGIN
+	RETURN link(AddAddr(dp, TSIZE(closure) + TSIZE(ADDRESS)))^
+END DefEntry;
+
+PROCEDURE SetDefEntry(dp:link;newEntry:closure);
+VAR
+	entry:link;
+BEGIN
+	entry:=link(AddAddr(dp, TSIZE(closure) + TSIZE(ADDRESS)));
+	ChangeDefinition(entry,newEntry)
+END SetDefEntry;
+
+VAR
+	name:closure;		(* unmarked temporary, used only during initialisation *)
+
+BEGIN
+	AddMarker( MarkWords );
+	NEW(top);
+	top^.next:=NIL;
+	FOR i:=0 TO LastEntry DO
+		top^.info[i]:=NIL
+	END;
+
+	AddArgument(wEntry, 'Entry');
+	tempDef:=DefEntry(wEntry);
+	RemoveEnv(tempDef,wMeaning);
+	RemoveEnv(tempDef,wName);
+
+	DefineWord(wParent, 'Parent', HandleParent);
+	tempDef:=DefEntry(wParent);
+	RemoveEnv(tempDef,wMeaning);
+	RemoveEnv(tempDef,wName);
+
+	AddAtom(wUndefined, 'Undefined');
+	tempDef:=DefEntry(wUndefined);
+	RemoveEnv(tempDef,wMeaning);
+	RemoveEnv(tempDef,wName);
+	MakeDef(UndefinedMeaning,wUndefined);
+	parent:= UndefinedMeaning;
+
+	AddArgument(wMeaning,'Meaning');
+	tempDef:=DefEntry(wMeaning);
+	RemoveEnv(tempDef,wName);
+
+	AddArgument(wName,'Name');
+
+	DefineWord(wString,'STRING',HandlePackage);
+
+	MakeString(name,wString,DefName(wName));
+	tempDef:=DefEntry(wName);
+	AddEnv(tempDef,wName,name);
+
+	MakeString(name,wString,DefName(wMeaning));
+	tempDef:=DefEntry(wMeaning);
+	AddEnv(tempDef,wName,name);
+
+	MakeString(name,wString,DefName(wUndefined));
+	tempDef:=DefEntry(wUndefined);
+	AddEnv(tempDef,wName,name);
+	MakeDef(name,wUndefined);
+	AddEnv(tempDef,wMeaning,name);
+
+	MakeString(name,wString,DefName(wParent));
+	tempDef:=DefEntry(wParent);
+	AddEnv(tempDef,wName,name);
+	MakeDef(name,wParent);
+	AddEnv(tempDef,wMeaning,name);
+
+	MakeString(name,wString,DefName(wEntry));
+	tempDef:=DefEntry(wEntry);
+	AddEnv(tempDef,wName,name);
+	MakeDef(name,wEntry);
+	AddEnv(tempDef,wMeaning,name);
+	wEntry^:=UndefinedMeaning;
+
+	tempDef:=EmptyClosure
+END Names.
diff --git a/examples/Dipl/M2/PARSELOW.DEF b/examples/Dipl/M2/PARSELOW.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/PARSELOW.DEF
@@ -0,0 +1,13 @@
+DEFINITION MODULE ParseLow;
+
+VAR
+	buildTree:BOOLEAN;
+
+PROCEDURE ParsePrimitive;
+PROCEDURE ParseTerminalPrimitive;
+PROCEDURE ParseAttributePrimitive(valuedProperty:BOOLEAN);
+PROCEDURE ParseNonTerminal;
+PROCEDURE ParseChoice;
+PROCEDURE ParseOption;
+
+END ParseLow.
diff --git a/examples/Dipl/M2/PARSELOW.MOD b/examples/Dipl/M2/PARSELOW.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/PARSELOW.MOD
@@ -0,0 +1,290 @@
+IMPLEMENTATION MODULE ParseLow;
+
+FROM SYSTEM IMPORT TSIZE;
+FROM Buffers IMPORT Rewind, position;
+FROM Memory IMPORT ALLOCATE, AddMarker, DropMarker, MarkNeeded;
+FROM Machine IMPORT MarkLink, MarkClosure, tempDef, EmptyClosure;
+FROM Machine IMPORT closure, result, MakeDef, Reduce;
+FROM Machine IMPORT Root, AddEnv, AddValuedEnv, Join, Copy;
+FROM Library IMPORT wProperty, wStruct;
+FROM Grammars IMPORT wDummy, wFail, wRaise, wDiscard, wGrammar, wNext;
+FROM Grammars IMPORT Failure, HoldDummy;
+
+TYPE
+	RestPtr=POINTER TO RestRec;
+	RestRec=RECORD
+				grammar:closure;
+				next:RestPtr
+			  END;
+	ParsedPtr=POINTER TO ParsedRec;
+	ParsedRec=RECORD
+					CASE leaf:BOOLEAN OF
+						FALSE:
+							property:closure;
+							valued:BOOLEAN
+						|TRUE:
+							result:closure
+					END;
+					next:ParsedPtr
+				 END;
+	StackPtr=POINTER TO StackRec;
+	StackRec=RECORD
+					restRec:RestRec;
+					prevLink:ParsedPtr;
+					pos:LONGCARD;
+(*					layer:CARDINAL; *)
+					next:StackPtr
+				END;
+VAR
+	current:closure;
+	parsed,parsedNew,linked:ParsedPtr;
+	rest,restNew:RestPtr;
+	stack,stackNew:StackPtr;
+(*	layers:CARDINAL; *)
+
+PROCEDURE MarkRest(list:RestPtr);
+VAR
+	fresh:BOOLEAN;
+BEGIN
+	WHILE list#NIL DO
+		MarkNeeded(list,TSIZE(RestRec),fresh);
+		IF NOT fresh THEN
+			RETURN
+		END;
+		MarkClosure(list^.grammar);
+		list:=list^.next
+	END
+END MarkRest;
+
+PROCEDURE MarkParsed(list:ParsedPtr);
+VAR
+	fresh:BOOLEAN;
+BEGIN
+	WHILE list#NIL DO
+		MarkNeeded(list,TSIZE(ParsedRec),fresh);
+		IF NOT fresh THEN
+			RETURN
+		END;
+		IF list^.leaf THEN
+			MarkClosure(list^.result)
+		ELSE
+			MarkClosure(list^.property)
+		END;
+		list:=list^.next
+	END
+END MarkParsed;
+
+PROCEDURE MarkAll;
+VAR
+	s:StackPtr;
+	fresh:BOOLEAN;
+BEGIN
+	s:=stack;
+	fresh:=TRUE;
+	WHILE fresh AND (s#NIL) DO
+		MarkNeeded(s,TSIZE(StackRec),fresh);
+		MarkRest(s^.restRec.next);
+		MarkParsed(s^.prevLink);
+		s:=s^.next
+	END;
+	MarkClosure(current);
+	MarkRest(rest);
+	MarkParsed(parsed)
+END MarkAll;
+
+PROCEDURE MarkLinked;
+BEGIN
+	MarkParsed(linked)
+END MarkLinked;
+
+PROCEDURE LinkParsed;
+VAR
+	swap:ParsedPtr;
+BEGIN
+	linked:=NIL;
+	AddMarker(MarkLinked);
+	WHILE parsed#NIL DO
+		IF parsed^.leaf THEN
+			swap:=parsed^.next;
+			parsed^.next:=linked;
+			linked:=parsed;
+			parsed:=swap;
+		ELSE
+         IF Root(parsed^.property)#wDiscard THEN
+         	IF Root(parsed^.property)=wRaise THEN
+         		IF Root(linked^.result)#wDummy THEN
+						IF linked^.leaf THEN
+							Copy(linked^.result,tempDef);
+							linked^.next^.leaf:=FALSE
+						ELSE
+							tempDef:=linked^.result
+						END;
+						Join(tempDef,linked^.next^.result);
+						linked^.next^.result:=tempDef
+					END
+				ELSE
+					IF linked^.next^.leaf THEN
+						tempDef:=linked^.next^.result;
+						Copy(tempDef,linked^.next^.result);
+						linked^.next^.leaf:=FALSE
+					END;
+					IF parsed^.valued THEN
+						AddValuedEnv(linked^.next^.result,Root(parsed^.property),linked^.result)
+					ELSE
+						AddEnv(linked^.next^.result,Root(parsed^.property),linked^.result)
+					END
+				END
+			END;
+			linked:=linked^.next;
+			parsed:=parsed^.next
+		END
+	END;
+	tempDef:=EmptyClosure;
+	IF linked^.next=NIL THEN
+		result:=linked^.result
+	ELSE
+		result:=Failure
+	END;
+	DropMarker
+END LinkParsed;
+				
+PROCEDURE ParsePrimitive;
+VAR
+	prevPos:LONGCARD;
+BEGIN
+	NEW(stackNew);
+	WITH stackNew^ DO
+(*		layer:=layers; *)
+		restRec.next:=rest;
+		restRec.grammar:=NIL;
+		prevLink:=parsed;
+		pos:=MAX(LONGCARD);
+		next:=stack
+	END;
+	stack:=stackNew;
+(*	layers:=0; *)
+	NEW(rest);
+	WITH rest^ DO
+		grammar:=wGrammar^;
+		next:=NIL
+	END;
+	parsed:=NIL;
+	REPEAT
+		REPEAT
+			buildTree:=TRUE;
+			current:=rest^.grammar;
+			rest:=rest^.next;
+			Reduce(current);
+			IF Root(result)=wFail THEN
+				rest:=NIL
+			ELSIF (parsed#NIL) AND NOT parsed^.leaf AND
+					((Root(parsed^.property)=wDiscard) OR
+					(Root(parsed^.property)=wRaise) AND (Root(result)=wDummy)) THEN
+				parsed:=parsed^.next
+			ELSE
+				NEW(parsedNew);
+				parsedNew^.leaf:=TRUE;
+				parsedNew^.result:=result;
+				parsedNew^.next:=parsed;
+				parsed:=parsedNew
+			END
+		UNTIL rest=NIL;
+		IF Root(result)#wFail THEN
+			WHILE stack^.pos#MAX(LONGCARD) DO
+				stack:=stack^.next
+			END;
+			LinkParsed;
+(*			WHILE layers>0 DO
+				PopLayer;
+				DEC(layers)
+			END *)
+		END;
+		prevPos:=stack^.pos;
+		IF prevPos#MAX(LONGCARD) THEN
+			Rewind(prevPos)
+		END;
+		rest:=ADR(stack^.restRec);
+		parsed:=stack^.prevLink;
+(*		WHILE layers>stack^.layer DO
+			PopLayer;
+			DEC(layers)
+		END;
+		layers:=stack^.layer; *)
+		stack:=stack^.next;
+	UNTIL prevPos=MAX(LONGCARD);
+	rest:=rest^.next;
+	current:=NIL
+END ParsePrimitive;
+
+PROCEDURE ParseSequencePrimitive(valuedProperty:BOOLEAN);
+VAR
+	buildOld:BOOLEAN;
+BEGIN
+	NEW(restNew);
+	restNew^.grammar:=wNext^;
+	restNew^.next:=rest;
+	rest:=restNew;
+	buildOld:=buildTree;
+	IF Root(wProperty^)=wDiscard THEN
+		buildTree:=FALSE
+	END;
+	NEW(parsedNew);
+	WITH parsedNew^ DO
+		leaf:=FALSE;
+		property:=wProperty^;
+		valued:=valuedProperty;
+		next:=parsed;
+	END;
+	parsed:=parsedNew;
+	Reduce(wGrammar^);
+	buildTree:=buildOld
+END ParseSequencePrimitive;
+
+PROCEDURE ParseEndSequence;
+BEGIN
+	result:=wStruct^
+END ParseEndSequence;
+
+PROCEDURE ParseChoice;
+BEGIN
+	NEW(stackNew);
+	WITH stackNew^ DO
+(*		StartLayer;
+		INC(layers);
+		layer:=layers; *)
+		pos:=position;
+		prevLink:=parsed;
+		next:=stack;
+		stack:=stackNew;
+		restRec.grammar:=wNext^;
+		restRec.next:=rest
+	END;
+	Reduce(wGrammar^)
+END ParseChoice;
+
+PROCEDURE ParseOption;
+BEGIN
+	NEW(stackNew);
+	WITH stackNew^ DO
+(*		StartLayer;
+		INC(layers);
+		layer:=layers; *)
+		pos:=position;
+		prevLink:=parsed;
+		next:=stack;
+		stack:=stackNew;
+		restRec.grammar:=wGrammar^;
+		restRec.next:=rest
+	END;
+	result:=HoldDummy
+END ParseOption;
+
+BEGIN
+	rest:=NIL;
+	stack:=NIL;
+	parsed:=NIL;
+	current:=NIL;
+	AddMarker(MarkAll)
+END ParseLow.
+
+
diff --git a/examples/Dipl/M2/PARSER.DEF b/examples/Dipl/M2/PARSER.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/PARSER.DEF
@@ -0,0 +1,11 @@
+DEFINITION MODULE Parser;
+
+FROM Machine IMPORT link, closure;
+
+VAR
+	wParse:link;
+
+PROCEDURE Parse;
+
+END Parser.
+
diff --git a/examples/Dipl/M2/PARSER.MOD b/examples/Dipl/M2/PARSER.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/PARSER.MOD
@@ -0,0 +1,442 @@
+IMPLEMENTATION MODULE Parser;
+
+FROM Memory IMPORT ALLOCATE, AddMarker;
+FROM Lib IMPORT IncAddr;
+IMPORT Str;
+FROM FIO IMPORT File, Open, IOresult, Close;
+FROM Buffers IMPORT ReadChar, ReadWord, Rewind, CharSet;
+FROM Buffers IMPORT position, OpenInput, CloseInput, ReportError;
+
+FROM Machine IMPORT EmptyClosure, tempDef, wPackage, link, HandlePackage, Reduce;
+FROM Machine IMPORT Join, AddEnv, AddValuedEnv, Root, Copy, result;
+FROM Machine IMPORT ChangeDefinition, NewLayer, StartLayer, PopLayer;
+FROM Machine IMPORT MakeDef, MakePrimitive, MakeString, MakePacked, ExtractPacked;
+FROM Machine IMPORT MarkString, MarkClosure;
+
+FROM Library IMPORT wChar, wString,	wCharSet, wNumber, wError, errorCodes;
+FROM Library IMPORT wType, wStruct, wFile, wUndefined, wDescription;
+
+FROM Names IMPORT FindWord, DefEntry, AddPrimWord, DefineWord, wMeaning;
+FROM Names IMPORT NewDictionary, OldDictionary;
+
+FROM Grammars IMPORT wSequence, wLexSequence, wValSequence, wLexValSequence;
+FROM Grammars IMPORT wEndSeq, wChoice, wOption;
+FROM Grammars IMPORT wDummy, wFail, wDone, wRaise, wDiscard, wGrammar, wNext;
+FROM Grammars IMPORT wSpaceChars, wSpaces, wComment, wFrameGrammar, wCustomGrammar;
+FROM Grammars IMPORT wCharGrammar, wCharSetGrammar, wStrGrammar, wNumGrammar;
+FROM Grammars IMPORT wIdentifier, wIdentGrammar, wFirst, wTail;
+FROM Grammars IMPORT wStructGrammar;
+FROM Grammars IMPORT Failure, Confirmation;
+
+FROM ParseLow IMPORT ParsePrimitive, buildTree;
+FROM ParseLow IMPORT ParseSequencePrimitive, ParseEndSequence, ParseChoice, ParseOption;
+
+CONST
+	MaxStrLength=200;
+	all=CharSet{0C..377C};
+
+TYPE
+	CharPtr=POINTER TO CHAR;
+	string=ARRAY [0..MaxStrLength] OF CHAR;
+
+VAR
+	firstSet,tailSet:CharSet;
+	originalFirst,originalTail:closure;
+	strPtr:POINTER TO string;
+
+PROCEDURE pSpaces;
+VAR
+	prevPos:LONGCARD;
+	spaces:POINTER TO CharSet;
+	str:ARRAY [0..1] OF CHAR;
+BEGIN
+	StartLayer;
+	ChangeDefinition(wCharSet,HandlePackage);
+	Reduce(wSpaceChars^);
+	PopLayer;
+	ExtractPacked(result,spaces);
+	IF Root(wComment^)=wFail THEN
+		ReadWord(str,spaces^,spaces^)
+	ELSE
+		REPEAT
+			ReadWord(str,spaces^,spaces^);
+			prevPos:=position;
+			StartLayer;
+			ChangeDefinition(wGrammar,wComment^);
+			ParsePrimitive;
+			PopLayer;
+		UNTIL Root(result)=wFail;
+		Rewind(prevPos)
+	END;
+	result:=Confirmation
+END pSpaces;
+
+PROCEDURE ParseLexValSequence;
+BEGIN
+	ParseSequencePrimitive(TRUE)
+END ParseLexValSequence;
+
+PROCEDURE ParseLexSequence;
+BEGIN
+	ParseSequencePrimitive(FALSE)
+END ParseLexSequence;
+
+PROCEDURE ParseValSequence;
+BEGIN
+	Reduce(wSpaces^);
+	ParseSequencePrimitive(TRUE)
+END ParseValSequence;
+
+PROCEDURE ParseSequence;
+BEGIN
+	Reduce(wSpaces^);
+	ParseSequencePrimitive(FALSE)
+END ParseSequence;
+
+PROCEDURE ParseTheLetter;
+VAR
+	chExpect,chRead:CHAR;
+BEGIN
+	ExtractPacked(wPackage^,chExpect);
+	ReadChar(chRead);
+	IF chRead=chExpect THEN
+		IF buildTree THEN
+			MakePacked(result,wChar,chRead)
+		ELSE
+			result:=Confirmation
+		END
+	ELSE
+		result:=Failure
+	END
+END ParseTheLetter;
+
+VAR
+	strRest:CharPtr;
+
+PROCEDURE ParseTheString;
+VAR
+	ch:CHAR;
+	strExpect:CharPtr;
+BEGIN
+	ExtractPacked(wPackage^,strExpect);
+	strRest:=strExpect;
+	LOOP
+		IF strRest^=0C THEN
+			EXIT
+		END;
+		ReadChar(ch);
+		IF strRest^#ch THEN
+			EXIT
+		END;
+		IncAddr(strRest,1)
+	END;
+	IF strRest^=0C THEN
+		IF buildTree THEN
+			MakeString(result,wString,strExpect)
+		ELSE
+			result:=Confirmation
+		END
+	ELSE
+		result:=Failure
+	END
+END ParseTheString;
+
+PROCEDURE ParseTheCharSet;
+VAR
+	ch:CHAR;
+	s:POINTER TO CharSet;
+BEGIN
+	ExtractPacked(wPackage^,s);
+	ReadChar(ch);
+	IF ch IN s^ THEN
+		IF buildTree THEN
+			MakePacked(result,wChar,ch)
+		ELSE
+			result:=Confirmation
+		END
+	ELSE
+		result:=Failure
+	END
+END ParseTheCharSet;
+
+PROCEDURE ParseNumber;
+VAR
+	ch:CHAR;
+	minus:BOOLEAN;
+	x:CARDINAL;
+BEGIN
+	ReadChar(ch);
+	IF ch='-' THEN
+		minus:=TRUE;
+		ReadChar(ch)
+	ELSE
+		minus:=FALSE;
+		IF ch='+' THEN
+			ReadChar(ch)
+		END
+	END;
+	x:=0;
+	IF ch IN CharSet{'0'..'9'} THEN
+		REPEAT
+			IF x <= (MAX(INTEGER)-ORD(ch)+ORD('0')) DIV 10 THEN
+				x:=10*x+ORD(ch)-ORD('0')
+			END;
+			ReadChar(ch)
+		UNTIL NOT (ch IN CharSet{'0'..'9'});
+		Rewind(position-1);
+ 		IF minus THEN
+  			MakePacked(result,wNumber,-INTEGER(x))
+  		ELSE
+			MakePacked(result,wNumber,x)
+		END
+  	ELSE
+		result:=Failure
+  	END
+END ParseNumber;
+
+PROCEDURE ParseChar;
+VAR
+	delimiter,chRead:CHAR;
+BEGIN
+	ReadChar(delimiter);
+	IF delimiter="'" THEN
+		ReadChar(chRead);
+		ReadChar(delimiter);
+		IF delimiter="'" THEN
+			MakePacked(result,wChar,chRead)
+		ELSE
+			result:=Failure
+		END
+	ELSE
+		result:=Failure
+	END
+END ParseChar;
+
+PROCEDURE ParseCharSET;
+VAR
+	ch,second,i:CHAR;
+	s:CharSet;
+	complement:BOOLEAN;
+BEGIN
+	ReadChar(ch);
+	IF ch='{' THEN
+		s:=CharSet{};
+		ReadChar(ch);
+		IF ch='~' THEN
+			complement:=TRUE;
+		ELSE
+			complement:=FALSE;
+			Rewind(position-1)
+		END;
+		LOOP
+			pSpaces;
+			ReadChar(ch);
+			IF ch='}' THEN
+				EXIT
+			ELSIF ch='\' THEN
+				ReadChar(ch);
+			END;
+			pSpaces;
+			ReadChar(second);
+			IF second='-' THEN
+				pSpaces;
+				ReadChar(second);
+				IF second<ch THEN
+					ch:=0C;
+					EXIT
+				END;
+				FOR i:=ch TO second DO
+					INCL(s,i)
+				END;
+				ReadChar(second)
+			ELSE
+				INCL(s,ch)
+			END;
+			IF second#',' THEN
+				IF second#'}' THEN
+					ch:=0C
+				END;
+				EXIT
+			END
+		END;
+		IF ch#0C THEN
+			IF buildTree THEN
+				IF complement THEN
+					s:=all-s;
+				END;
+				MakePacked(result,wCharSet,s)
+			ELSE
+				result:=Confirmation
+			END;
+			RETURN
+		END
+	END;
+	result:=Failure
+END ParseCharSET;
+
+PROCEDURE ParseIdentifier;
+VAR
+	first,tail:POINTER TO CharSet;
+	wd:link;
+	str:string;
+BEGIN
+	IF (wFirst^=originalFirst) AND (wTail^=originalTail) THEN
+		ReadWord(str,firstSet,tailSet)
+	ELSE
+		ChangeDefinition(wCharSet,HandlePackage);
+		Reduce(wFirst^);
+		ExtractPacked(result,first);
+		Reduce(wTail^);
+		ExtractPacked(result,tail);
+		ReadWord(str,first^,tail^)
+	END;
+	IF str[0]=0C THEN
+		result:=Failure
+	ELSE
+		wd:=FindWord(str);
+		IF wd=NIL THEN
+			ALLOCATE(strPtr,Str.Length(str)+1);
+			Str.Copy(strPtr^,str);
+			MakeDef(result,wIdentifier);
+			DefineWord(wd,strPtr^,result);
+			AddEnv(wd^,wDescription,DefEntry(wd));
+			strPtr:=NIL
+		END;
+		NewLayer(DefEntry(wd));
+		result:=wMeaning^
+	END
+END ParseIdentifier;
+	
+PROCEDURE ParseString;
+VAR
+	ch,between:CHAR;
+	str:string;
+	length:CARDINAL;
+BEGIN
+	ReadChar(between);
+	IF (between="'") OR (between='"') THEN
+		length:=0;
+		ReadChar(ch);
+		WHILE (ch#between) AND (ch#CHR(13)) AND (length<MaxStrLength) DO
+			str[length]:=ch;
+			INC(length);
+			ReadChar(ch)
+		END;
+		IF ch=between THEN
+			str[length]:=0C;
+			ALLOCATE(strPtr,length+1);
+			Str.Copy(strPtr^,str);
+			MakeString(result,wString,strPtr);
+			strPtr:=NIL;
+			RETURN
+	  	END
+  	END;
+	result:=Failure
+END ParseString;
+
+PROCEDURE ParseCustom;
+VAR
+	wprop:closure;
+BEGIN
+	ParseIdentifier;
+	IF Root(result)#wFail THEN
+		wprop:=DefEntry(Root(result));
+		ChangeDefinition(wFrameGrammar,wStructGrammar^);
+		NewLayer(wprop);
+		ChangeDefinition(wType,result);
+		Reduce(wFrameGrammar^)
+	END
+END ParseCustom;
+
+PROCEDURE Parse;
+VAR
+	saveFirstSet,saveTailSet:CharSet;
+BEGIN
+	StartLayer;
+	LinkPrimitive(wSpaces,pSpaces);
+	LinkPrimitive(wSequence,ParseSequence);
+	LinkPrimitive(wLexSequence,ParseLexSequence);
+	LinkPrimitive(wValSequence,ParseValSequence);
+	LinkPrimitive(wLexValSequence,ParseLexValSequence);
+	LinkPrimitive(wEndSeq,ParseEndSequence);
+	LinkPrimitive(wChoice,ParseChoice);
+	LinkPrimitive(wOption,ParseOption);
+	LinkPrimitive(wChar,ParseTheLetter);
+	LinkPrimitive(wString,ParseTheString);
+
+	originalFirst:=wFirst^;
+	originalTail:=wTail^;
+	Reduce(wFirst^);
+	saveFirstSet:=firstSet;
+	ExtractPacked(result,firstSet);
+	IF Root(result)#wCharSet THEN
+		originalFirst:=NIL
+	END;
+	Reduce(wTail^);
+	saveTailSet:=tailSet;
+	ExtractPacked(result,tailSet);
+	IF Root(result)#wCharSet THEN
+		originalTail:=NIL
+	END;
+	LinkPrimitive(wCharSet,ParseTheCharSet);
+
+	LinkPrimitive(wNumGrammar,ParseNumber);
+	LinkPrimitive(wCharGrammar,ParseChar);
+	LinkPrimitive(wStrGrammar,ParseString);
+	LinkPrimitive(wCharSetGrammar,ParseCharSET);
+	LinkPrimitive(wIdentGrammar,ParseIdentifier);
+	LinkPrimitive(wCustomGrammar,ParseCustom);
+	ChangeDefinition(wFrameGrammar,Failure);
+	pSpaces;
+	ParsePrimitive;
+	PopLayer;
+	originalFirst:=EmptyClosure;
+	originalTail:=EmptyClosure;
+	IF Root(result)=wFail THEN
+		ReportError;
+		MakePacked(result,wError,SyntaxError)
+	ELSE
+		ChangeDefinition(wStruct,result);
+		Reduce(result)
+	END;
+END Parse;
+
+PROCEDURE pParse;
+VAR
+	filename:POINTER TO string;
+	newFile:BOOLEAN;
+BEGIN
+	Reduce(wFile^);
+	newFile:=(Root(result)=wString);
+	IF newFile THEN
+		ExtractPacked(result,filename);
+		IF NOT OpenInput(filename^) THEN
+			MakePacked(result,wError,IOError);
+			RETURN
+		END;
+		LinkDef(wFile,wUndefined)
+	END;
+	NewDictionary;
+	Parse;
+	OldDictionary;
+	IF newFile THEN
+		CloseInput
+	END
+END pParse;
+
+PROCEDURE MarkInternals;
+BEGIN
+	MarkString(strPtr);
+	MarkClosure(originalFirst);
+	MarkClosure(originalTail)
+END MarkInternals;
+
+BEGIN
+	strPtr:=NIL;
+	originalFirst:=EmptyClosure;
+	originalTail:=EmptyClosure;
+	AddMarker(MarkInternals);
+	AddPrimWord(wParse,'Parse',pParse)
+END Parser.
+
+
diff --git a/examples/Dipl/M2/W.MOD b/examples/Dipl/M2/W.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/M2/W.MOD
@@ -0,0 +1,97 @@
+MODULE W;
+
+FROM IO IMPORT WrStr, WrLn, WrCard, EndOfRd, RdChar;
+IMPORT IO;
+FROM Machine IMPORT link, Root, result;
+FROM Machine IMPORT Reduce, StartLayer, PopLayer, ChangeDefinition;
+FROM Machine IMPORT MakeDef, MakePacked, MakeString, ExtractPacked;
+FROM Library IMPORT wStruct, wFile, wAncestor;
+FROM Library IMPORT wString, wError, errorCodes, wTrue, wUndefined;
+FROM Names IMPORT AddAtom, AddPrimWord, NewDictionary, OldDictionary;
+FROM Buffers IMPORT ReportError, OpenInput, CloseInput;
+FROM Parser IMPORT Parse;
+FROM Decoder IMPORT wWrite;
+FROM Grammars IMPORT wGrammar, wFail, wSentence;
+(* FROM Graph IMPORT SetVideoMode, InitGraph; *)
+IMPORT PMD;
+
+VAR
+	wInterpret,wQuit,wLoad:link;
+	level:CARDINAL;
+
+(*# data(stack_size => 0FF00H) *)
+	
+PROCEDURE pInterpret;
+VAR
+	ch,empty:CHAR;
+BEGIN
+	empty:=0C;
+	INC(level);
+	LOOP
+		LinkString(wFile,wString,ADR(empty));
+		WrLn;
+		WrStr('Reduce[');
+		WrCard(level,0);
+		WrStr(']>');
+		Reduce(wLoad^);
+		WHILE NOT EndOfRd(FALSE) DO
+			ch:=RdChar()
+		END;
+		IF Root(result)=wQuit THEN
+			MakeDef(result,wTrue);
+			EXIT
+		ELSE
+			StartLayer;
+			ChangeDefinition(wStruct,result);
+			Reduce(wWrite^);
+			IF Root(result)=wFail THEN
+				WrStr('Output error!')
+			END;
+			PopLayer
+		END
+	END;
+	DEC(level)
+END pInterpret;
+
+PROCEDURE pLoad;
+VAR
+	filename:ARRAY [0..30] OF CHAR;
+	newFile:BOOLEAN;
+	ch:CHAR;
+BEGIN
+	Reduce(wFile^);
+	newFile:=(Root(result)=wString);
+	IF newFile THEN
+		ExtractPacked(result,filename);
+		IF NOT OpenInput(filename) THEN
+			MakePacked(result,wError,IOError);
+			RETURN
+		END;
+      LinkDef(wFile,wUndefined)
+	END;
+	NewDictionary;
+	StartLayer;
+	ChangeDefinition(wGrammar,wSentence^);
+	Parse;
+	PopLayer;
+	ChangeDefinition(wAncestor,result);
+	Reduce(result);
+	OldDictionary;
+	IF newFile THEN
+		CloseInput
+	END
+END pLoad;
+
+BEGIN
+	level:=0;
+	AddAtom(wQuit,'Quit');
+	AddPrimWord(wInterpret, 'Interpret', pInterpret);
+	AddPrimWord(wLoad, 'Load', pLoad);
+(*	InitGraph;
+	IF NOT SetVideoMode(7) THEN
+		WrStr('Prebacivanje u tekst mod nije uspelo!')
+	END;
+*)
+	pInterpret
+END W.
+
diff --git a/examples/Dipl/MACHINE.DEF b/examples/Dipl/MACHINE.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/MACHINE.DEF
@@ -0,0 +1,68 @@
+DEFINITION MODULE Machine;
+
+CONST
+	maxLength=24;
+TYPE
+   link=POINTER TO closure;
+	handlerType=PROC;
+   closure=POINTER TO clRec;
+   envList=POINTER TO environment;
+   wdPtr=POINTER TO wd;
+   wd=RECORD
+   		def:closure;
+   		name:POINTER TO ARRAY [0..maxLength] OF CHAR
+   	END;
+   flag=(defined, primitive, packed, string, length);
+   clRec=RECORD
+            CASE kind:flag OF
+               defined:
+                  root:wdPtr;
+               ELSE
+                  handler:handlerType
+            END;
+            env,valEnv:envList
+         END;
+   environment=RECORD
+                  name:wdPtr;
+                  newDef:closure;
+                  next:envList
+               END;
+VAR
+	result,EmptyClosure,HandlePackage,HandleParent,parent,tempDef:closure;
+	wPackage,wPacked,wType:link;
+	debug:BOOLEAN;
+
+PROCEDURE StartLayer;
+PROCEDURE SaveDefinition(dp:link);
+PROCEDURE NewLayer(d:closure);
+PROCEDURE PopLayer;
+PROCEDURE Keep(dp:link);
+
+PROCEDURE Reduce(from:closure);
+
+PROCEDURE Build;
+PROCEDURE BuildReduced;
+
+PROCEDURE Copy(from:closure; VAR to:closure);
+PROCEDURE Root(def:closure):link;
+PROCEDURE Join(VAR def:closure; description:closure);
+PROCEDURE MakeDef(VAR new:closure; root:link);
+PROCEDURE MakePrimitive(VAR new:closure; root:handlerType);
+PROCEDURE MakePacked(VAR d:closure; root:link; contents:ARRAY OF BYTE);
+PROCEDURE MakeString(VAR d:closure; root:link; start:ADDRESS);
+PROCEDURE AddEnv(VAR d:closure; prop:link; value:closure);
+PROCEDURE AddValuedEnv(VAR d:closure; prop:link; value:closure);
+PROCEDURE RemoveEnv(VAR d:closure; prop:link);
+PROCEDURE Equal(d1,d2:closure):BOOLEAN;
+PROCEDURE ExtractPacked(package:closure; VAR contents:ARRAY OF BYTE);
+PROCEDURE Envelope(VAR def:closure; struct:closure; cons,valCons,listEnd,prop,value,next:link);
+
+PROCEDURE MarkString(VAR str:ADDRESS);
+PROCEDURE MarkClosure(VAR d:closure);
+PROCEDURE MarkLink(VAR dp:link);
+
+END Machine.
+
+
+
+
diff --git a/examples/Dipl/MACHINE.MOD b/examples/Dipl/MACHINE.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/MACHINE.MOD
@@ -0,0 +1,803 @@
+IMPLEMENTATION MODULE Machine;
+FROM SYSTEM IMPORT ADDRESS, WORD, BYTE, ADR, TSIZE, Registers;
+FROM Lib IMPORT IncAddr, Move, WordMove, WordFill, Compare, Intr;
+FROM Memory IMPORT ALLOCATE, MarkNeeded, AddMarker, DropMarker;
+FROM IO IMPORT WrStr, WrChar, WrCharRep, WrInt, WrHex, WrLn, RdKey;
+CONST
+	MaxStack=8000;
+	MaxLayers=8000;
+	indention=3;
+	FillValue=700H;
+	TextScreen=0B000H;
+TYPE
+(*
+	envList=POINTER TO environment;
+	closure=POINTER TO clRec;
+   flag=(defined, primitive, packed, string, length);
+   clRec=RECORD
+            CASE kind:flag OF
+               defined:
+                  root:link
+               ELSE
+                  handler:handlerType
+            END;
+            env,valEnv:envList
+         END;
+	environment=RECORD
+						name:link;
+						newDef:closure;
+						next:envList
+					END;
+*)
+	stackItem=	RECORD
+						name:wdPtr;
+						oldDef:closure
+					END;
+VAR
+	stack:ARRAY[1..MaxStack] OF stackItem;
+	layers:ARRAY[1..MaxLayers] OF [0..MaxStack];
+	sp:[0..MaxStack];
+	topLayer,breakLayer:[0..MaxLayers];
+	runScreen:ARRAY [0..25*80-1] OF WORD;
+	runCurPos:CARDINAL;
+
+PROCEDURE StartLayer;
+BEGIN
+	INC(topLayer);
+	layers[topLayer]:=sp
+END StartLayer;
+
+PROCEDURE SaveDefinition(name:link);
+BEGIN
+	INC(sp);
+	stack[sp].name:=wdPtr(name);
+	stack[sp].oldDef:=name^
+END SaveDefinition;
+
+PROCEDURE NewLayer(d:closure);
+VAR
+	swap:closure;
+	i:CARDINAL;
+	layer:envList;
+BEGIN
+	IF (d^.kind<packed) & (d^.env=NIL) & (d^.valEnv=NIL) THEN
+		RETURN
+	END;
+	IF d^.kind>primitive THEN
+		INC(sp);
+		stack[sp].name:=wdPtr(ADR(parent));
+		stack[sp].oldDef:=parent;
+		parent:=d;
+		INC(sp);
+		stack[sp].name:=wdPtr(wPackage);
+		stack[sp].oldDef:=wPackage^;
+		wPackage^:=d
+	ELSE
+		IF d^.valEnv=NIL THEN
+			layer:=d^.env
+		ELSE
+			i:=sp;
+			layer:=d^.valEnv;
+			WHILE layer#NIL DO
+				INC(sp);
+				WITH stack[sp] DO
+					name:=layer^.name;
+					oldDef:=layer^.newDef;
+					Reduce(oldDef);
+					oldDef:=result
+				END;
+				layer:=layer^.next
+			END;
+			layer:=d^.env;
+			WHILE i<sp DO
+				INC(i);
+	 			WITH stack[i] DO
+					swap:=oldDef;
+					oldDef:=link(name)^;
+					link(name)^:=swap
+				END
+			END
+		END;
+		INC(sp);
+		stack[sp].name:=wdPtr(ADR(parent));
+		stack[sp].oldDef:=parent;
+		parent:=d;
+		WHILE layer#NIL DO
+			INC(sp);
+			WITH stack[sp] DO
+				name:=layer^.name;
+				oldDef:=link(name)^;
+				link(name)^:=layer^.newDef
+			END;
+			layer:=layer^.next
+		END
+	END
+END NewLayer;
+		
+PROCEDURE PopLayer;
+BEGIN
+(*	limit:=layers[topLayer]; *)
+	WHILE sp>layers[topLayer] DO
+		link(stack[sp].name)^:=stack[sp].oldDef;
+		DEC(sp)
+	END;
+	DEC(topLayer)
+END PopLayer;
+
+PROCEDURE Keep(name:link);
+VAR
+	s:CARDINAL;
+BEGIN
+	s:=sp;
+	WHILE (s>layers[topLayer]) AND (link(stack[s].name)#name) DO
+		DEC(s)
+	END;
+	IF s>layers[topLayer] THEN
+		stack[s]:=stack[sp];
+		DEC(sp)
+	END
+END Keep;
+
+PROCEDURE ShowDef(d:closure);
+FORWARD;
+
+PROCEDURE Reduce(def:closure);
+BEGIN
+	StartLayer;
+	WHILE def^.kind#primitive DO
+		IF debug OR (topLayer<=breakLayer) THEN
+			ShowDef(def)
+		END;
+		NewLayer(def);
+		def:=link(def^.root)^
+	END;
+	IF (def^.env#NIL) OR (def^.valEnv#NIL) THEN
+		NewLayer(def)
+	END;
+	def^.handler;
+	PopLayer
+END Reduce;
+
+PROCEDURE DummyHandler;
+BEGIN
+	result:=wPackage^
+END DummyHandler;
+
+PROCEDURE EmptyHandler;
+END EmptyHandler;
+
+PROCEDURE ParentHandler;
+BEGIN
+	result:=parent
+END ParentHandler;
+
+PROCEDURE Root(def:closure):link;
+BEGIN
+	RETURN link(def^.root)
+END Root;
+
+PROCEDURE EnvCopy(source:envList; VAR dest:envList);
+VAR
+	current:POINTER TO envList;
+BEGIN
+	dest:=NIL;
+	current:=ADR(dest);
+	WHILE source#NIL DO
+		NEW(current^);
+		current^^:=source^;
+		current:=ADR(current^^.next);
+		source:=source^.next
+	END
+END EnvCopy;
+
+PROCEDURE Copy(source:closure; VAR dest:closure);
+BEGIN
+	NEW(dest);
+	IF source^.kind>primitive THEN
+		dest^:=source^
+	ELSE
+		dest^.root:=source^.root;
+		dest^.kind:=source^.kind;
+		dest^.valEnv:=NIL;
+		EnvCopy(source^.env,dest^.env);
+		EnvCopy(source^.valEnv,dest^.valEnv)
+	END
+END Copy;
+
+PROCEDURE JoinEnv(VAR union:envList; add:envList);
+VAR
+	newEnv:envList;
+	current:POINTER TO envList;
+BEGIN
+	current:=ADR(union);
+	WHILE add#NIL DO
+		WHILE (current^#NIL) AND (Seg(add^.name^) > Seg(current^^.name^)) DO
+			current:=ADR(current^^.next)
+		END;
+		IF (current^#NIL) AND (add^.name=current^^.name) THEN
+			current^^.newDef:=add^.newDef
+		ELSE
+			NEW(newEnv);
+			newEnv^:=add^;
+			newEnv^.next:=current^;
+			current^:=newEnv
+		END;
+		add:=add^.next
+	END
+END JoinEnv;
+	
+PROCEDURE Join(VAR def:closure; description:closure);
+BEGIN
+	IF (def^.kind<=primitive) AND (description^.kind<=primitive) THEN
+		JoinEnv(def^.env,description^.env);
+		JoinEnv(def^.valEnv,description^.valEnv)
+	ELSIF (def^.kind=defined) AND (def^.env=NIL) AND (def^.valEnv=NIL) THEN
+		def^.kind:=description^.kind;
+		EnvCopy(description^.env,def^.env);
+		EnvCopy(description^.valEnv,def^.valEnv)
+	END
+END Join;
+
+PROCEDURE Build;
+VAR
+	follow,valFollow:envList;
+	current:POINTER TO envList;
+BEGIN
+	IF (parent^.kind<packed) & (parent^.valEnv#NIL) THEN
+		NEW(result);
+		result^:=wType^^;
+		follow:=result^.env;
+		valFollow:=parent^.valEnv;
+		IF link(valFollow^.name)=wType THEN
+			valFollow:=valFollow^.next
+		END;
+		current:=ADR(result^.env);
+		WHILE valFollow#NIL DO
+			WHILE (follow#NIL) & (Seg(follow^.name^) < Seg(valFollow^.name^)) DO
+				current^:=NIL;
+				NEW(current^);
+				current^^.name:=follow^.name;
+				current^^.newDef:=follow^.newDef;
+				current:=ADR(current^^.next);
+				follow:=follow^.next
+			END;
+			IF (follow#NIL) & (follow^.name = valFollow^.name) THEN
+				follow:=follow^.next
+			END;
+			current^:=NIL;
+			NEW(current^);
+			current^^.name:=valFollow^.name;
+			current^^.newDef:=link(valFollow^.name)^;
+			current:=ADR(current^^.next);
+			valFollow:=valFollow^.next
+		END;
+		WHILE follow#NIL DO
+			current^:=NIL;
+			NEW(current^);
+			current^^.name:=follow^.name;
+			current^^.newDef:=follow^.newDef;
+			current:=ADR(current^^.next);
+			follow:=follow^.next
+		END;
+		current^:=NIL
+	ELSE
+		result:=wType^
+	END
+END Build;
+
+PROCEDURE BuildMixed;
+VAR
+	e:envList;
+	dest:POINTER TO envList;
+BEGIN
+	result:=parent;
+	IF (result^.kind<packed) & (result^.valEnv#NIL) THEN
+		NEW(result);
+		result^:=parent^;
+		WITH result^ DO
+			dest:=ADR(env);
+			REPEAT
+				NEW(e);
+				e^.name:=valEnv^.name;
+				e^.newDef:=link(e^.name)^;
+				WHILE (dest^#NIL) & (Seg(e^.name^) > Seg(dest^^.name^)) DO
+					dest:=ADR(dest^^.next)
+				END;
+				e^.next:=dest^;
+				dest^:=e;
+				valEnv:=valEnv^.next
+			UNTIL valEnv=NIL
+		END
+	END
+END BuildMixed;
+
+PROCEDURE BuildReduced;
+VAR
+	follow:envList;
+	i:CARDINAL;
+BEGIN
+	follow:=parent^.env;
+	WHILE follow#NIL DO
+		link(stack[sp].name)^:=stack[sp].oldDef;
+		DEC(sp);
+		follow:=follow^.next
+	END;
+	SaveDefinition(ADR(parent));
+	Copy(parent,parent);
+	follow:=parent^.env;
+	WHILE follow#NIL DO
+		Reduce(follow^.newDef);
+		follow^.newDef:=result;
+		follow:=follow^.next
+	END;
+	follow:=parent^.valEnv;
+	WHILE follow#NIL DO
+		Reduce(link(follow^.name)^);
+		follow^.newDef:=result;
+		follow:=follow^.next
+	END;
+	result:=parent;
+	JoinEnv(result^.env,result^.valEnv);
+	result^.valEnv:=NIL
+END BuildReduced;
+
+PROCEDURE MakeDef(VAR def:closure; defRoot:link);
+BEGIN
+	NEW(def);
+	WITH def^ DO
+		kind:=defined;
+		env:=NIL;
+		valEnv:=NIL;
+		root:=wdPtr(defRoot)
+	END
+END MakeDef;
+
+PROCEDURE MakePrimitive(VAR def:closure; defHandler:handlerType);
+BEGIN
+	NEW(def);
+	WITH def^ DO
+		kind:=primitive;
+		env:=NIL;
+		valEnv:=NIL;
+		handler:=defHandler
+	END
+END MakePrimitive;
+
+PROCEDURE MakePacked(VAR d:closure; root:link; x:ARRAY OF BYTE);
+BEGIN
+	NEW(d);
+	d^.root:=wdPtr(root);
+	d^.kind:=packed;
+	IF HIGH(x)>3 THEN
+		ALLOCATE(d^.env,HIGH(x)+1);
+		d^.kind:=length;
+		Move(ADR(x),d^.env,HIGH(x)+1);
+		d^.valEnv:=envList(HIGH(x)+1)
+	ELSE
+		d^.valEnv:=NIL;
+		d^.env:=NIL;
+		Move(ADR(x),ADR(d^.env),HIGH(x)+1)
+	END
+END MakePacked;
+
+PROCEDURE MakeString(VAR d:closure; root:link; a:ADDRESS);
+BEGIN
+	NEW(d);
+	d^.kind:=string;
+	d^.root:=wdPtr(root);
+	d^.env:=envList(a);
+	d^.valEnv:=NIL
+END MakeString;
+
+PROCEDURE AddEnv(VAR d:closure; prop:link; newValue:closure);
+VAR
+	newProp:envList;
+	current:POINTER TO envList;
+BEGIN
+	IF (prop=NIL) OR (d^.kind>primitive) THEN
+		RETURN
+	END;
+	current:=ADR(d^.env);
+	WHILE (current^#NIL) AND (Seg(current^^.name^) < Seg(prop^)) DO
+		current:=ADR(current^^.next)
+	END;
+	IF (current^#NIL) AND (link(current^^.name)=prop) THEN
+		current^^.newDef:=newValue
+	ELSE
+		NEW(newProp);
+		WITH newProp^ DO
+			name:=wdPtr(prop);
+			newDef:=newValue;
+			next:=current^
+		END;
+		current^:=newProp
+	END
+END AddEnv;
+
+PROCEDURE AddValuedEnv(VAR d:closure; prop:link; newValue:closure);
+VAR
+	newProp:envList;
+	current:POINTER TO envList;
+BEGIN
+	IF (prop=NIL) OR (d^.kind>primitive) THEN
+		RETURN
+	END;
+	current:=ADR(d^.valEnv);
+	WHILE (current^#NIL) AND (Seg(current^^.name^) < Seg(prop^)) DO
+		current:=ADR(current^^.next)
+	END;
+	IF (current^#NIL) AND (link(current^^.name)=prop) THEN
+		current^^.newDef:=newValue
+	ELSE
+		NEW(newProp);
+		WITH newProp^ DO
+			name:=wdPtr(prop);
+			newDef:=newValue;
+			next:=current^
+		END;
+		current^:=newProp
+	END
+END AddValuedEnv;
+
+PROCEDURE RemoveEnv(VAR d:closure; prop:link);
+VAR
+	current:POINTER TO envList;
+BEGIN
+	IF (prop=NIL) OR (d^.kind>primitive) THEN
+		RETURN
+	END;
+	current:=ADR(d^.env);
+	WHILE (current^#NIL) AND (link(current^^.name)#prop) DO
+		current:=ADR(current^^.next)
+	END;
+	IF current^#NIL THEN
+		current^:=current^^.next
+	END;
+	current:=ADR(d^.valEnv);
+	WHILE (current^#NIL) AND (link(current^^.name)#prop) DO
+		current:=ADR(current^^.next)
+	END;
+	IF current^#NIL THEN
+		current^:=current^^.next
+	END
+END RemoveEnv;
+
+PROCEDURE EnvEqual(e1,e2:envList):BOOLEAN;
+BEGIN
+	WHILE e1#NIL DO
+		IF (e2#NIL) AND (e1^.name=e2^.name) AND (e1^.newDef=e2^.newDef) THEN
+			e1:=e1^.next;
+			e2:=e2^.next
+		ELSE
+			RETURN FALSE
+		END
+	END;
+	RETURN e2=NIL
+END EnvEqual;
+	
+TYPE
+	CharPtr=POINTER TO CHAR;
+
+PROCEDURE SameStrings(s1,s2:ADDRESS):BOOLEAN;
+BEGIN
+   WHILE (s1^=s2^) AND (CharPtr(s1)^#0C) DO
+      IncAddr(s1,1);
+      IncAddr(s2,1)
+   END;
+   RETURN s1^=s2^
+END SameStrings;
+
+PROCEDURE Equal(d1,d2:closure):BOOLEAN;
+BEGIN
+	IF (d1=d2) OR (d1^=d2^) THEN
+		RETURN TRUE
+	END;
+	IF (d1^.root#d2^.root) OR (d1^.kind#d2^.kind) THEN
+		RETURN FALSE
+	END;
+	CASE d1^.kind OF
+		|packed:RETURN FALSE
+		|string:RETURN SameStrings(d1^.env,d2^.env)
+		|length:RETURN (d1^.valEnv=d2^.valEnv) AND
+				(CARDINAL(d1^.valEnv)=Compare(d1^.env,d2^.env,CARDINAL(d1^.valEnv)))
+	ELSE
+		RETURN EnvEqual(d1^.env,d2^.env) AND EnvEqual(d1^.valEnv,d2^.valEnv)
+	END
+END Equal;
+		
+PROCEDURE ExtractPacked(package:closure; VAR x:ARRAY OF BYTE);
+BEGIN
+	IF HIGH(x)<4 THEN
+		Move(ADR(package^.env),ADR(x),HIGH(x)+1)
+	ELSE
+		Move(package^.env,ADR(x),HIGH(x)+1)
+	END
+END ExtractPacked;
+
+PROCEDURE Envelope(VAR def:closure; struct:closure;
+						cons,valCons,listEnd,prop,value,next:link);
+	PROCEDURE EnvToList(env:envList;cons:link);
+	BEGIN
+		IF env#NIL THEN
+			EnvToList(env^.next,cons);
+			tempDef:=def;
+			MakeDef(def,cons);
+			AddEnv(def,next,tempDef);
+			MakeDef(tempDef,link(env^.name));
+			AddEnv(def,prop,tempDef);
+			AddEnv(def,value,env^.newDef)
+		END
+	END EnvToList;
+BEGIN
+	MakeDef(def,listEnd);
+	IF struct^.kind>primitive THEN
+		tempDef:=def;
+		MakeDef(def,cons);
+		AddEnv(def,next,tempDef);
+		MakeDef(tempDef,wPackage);
+		AddEnv(def,prop,tempDef);
+		NEW(tempDef);
+		tempDef^:=struct^;
+		tempDef^.root:=wdPtr(wPacked);
+		AddEnv(def,value,tempDef)
+	ELSE
+		EnvToList(struct^.env,cons);
+		EnvToList(struct^.valEnv,valCons)
+	END;
+	tempDef:=EmptyClosure
+END Envelope;
+
+	
+PROCEDURE MarkEnvironment(VAR env:envList);
+VAR
+	fresh:BOOLEAN;
+	ep:POINTER TO envList;
+BEGIN
+	fresh:=TRUE;
+	ep:=ADR(env);
+	WHILE (ep^#NIL) AND fresh DO
+		MarkNeeded(ep^, TSIZE(environment), fresh);
+		MarkClosure(ep^^.newDef);
+		ep:=ADR(ep^^.next)
+	END
+END MarkEnvironment;
+
+PROCEDURE MarkString(VAR str:ADDRESS);
+VAR
+	length:CARDINAL;
+	fresh:BOOLEAN;
+	follow:CharPtr;
+BEGIN
+	IF str#NIL THEN
+		length:=1;
+		follow:=CharPtr(str);
+		WHILE follow^#0C DO
+			INC(length);
+			IncAddr(follow,1)
+		END;
+		MarkNeeded(str,length,fresh)
+	END
+END MarkString;
+
+PROCEDURE MarkClosure(VAR def:closure);
+VAR
+	fresh:BOOLEAN;
+BEGIN
+	IF def=NIL THEN
+		RETURN
+	END;
+	MarkNeeded(def,TSIZE(clRec),fresh);
+	IF fresh THEN
+		CASE def^.kind OF
+			defined:
+				MarkLink(link(def^.root));
+				MarkEnvironment(def^.env);
+				MarkEnvironment(def^.valEnv)
+			|primitive:
+				MarkEnvironment(def^.env);
+				MarkEnvironment(def^.valEnv)
+			|string:
+				MarkLink(link(def^.root));
+				MarkString(def^.env)
+			|length:
+				MarkLink(link(def^.root));
+				MarkNeeded(def^.env,CARDINAL(def^.valEnv),fresh)
+		END
+	END
+END MarkClosure;
+
+PROCEDURE MarkLink(VAR l:link);
+VAR
+	fresh:BOOLEAN;
+BEGIN
+	MarkNeeded(l,TSIZE(closure),fresh);
+	IF fresh THEN
+		MarkClosure(l^)
+	END
+END MarkLink;
+
+PROCEDURE MarkStack;
+VAR
+	i:CARDINAL;
+BEGIN
+	FOR i:=sp TO 1 BY -1 DO
+		MarkLink(link(stack[i].name));
+		MarkClosure(stack[i].oldDef)
+	END
+END MarkStack;
+
+PROCEDURE MarkTemporaries;
+BEGIN
+	MarkClosure(tempDef);
+	MarkClosure(result);
+	MarkClosure(EmptyClosure);
+	MarkClosure(HandlePackage);
+	MarkClosure(HandleParent);
+	MarkLink(wPackage);
+	MarkClosure(parent)
+END MarkTemporaries;
+
+PROCEDURE CursorPos():CARDINAL;
+VAR
+	r:Registers;
+BEGIN
+	r.AH:=3;
+	r.BH:=0;
+	Intr(r,10H);
+	RETURN r.DX
+END CursorPos;
+
+PROCEDURE PlaceCursor(pos:CARDINAL);
+VAR
+	r:Registers;
+BEGIN
+	r.AH:=2;
+	r.BH:=0;
+	r.DX:=pos;
+	Intr(r,10H)
+END PlaceCursor;
+
+PROCEDURE SaveScreen(VAR scr:ARRAY OF WORD);
+BEGIN
+	WordMove([TextScreen:0], ADR(scr), 25*80)
+END SaveScreen;
+
+PROCEDURE RestoreScreen(VAR scr:ARRAY OF WORD);
+BEGIN
+	WordMove(ADR(scr), [TextScreen:0], 25*80)
+END RestoreScreen;
+
+PROCEDURE ClearScreen;
+BEGIN
+	WordFill([TextScreen:0], 50*80, FillValue);
+	PlaceCursor(0)
+END ClearScreen;
+
+PROCEDURE WriteDef(d:closure; indent:CARDINAL);
+VAR
+	follow:CharPtr;
+	
+	PROCEDURE WriteEnv(e:envList; indent:CARDINAL; colon:BOOLEAN);
+	BEGIN
+		WHILE e#NIL DO
+			WrLn;
+			WrCharRep(' ',indent);
+			WrStr(e^.name^.name^);
+			IF colon THEN
+				WrChar(':')
+			END;
+			WrChar('=');
+			WriteDef(e^.newDef, indent);
+			e:=e^.next
+		END
+	END WriteEnv;
+BEGIN
+	CASE d^.kind OF
+		|defined:
+			WrStr(d^.root^.name^);
+			WrChar('(');
+			IF d^.valEnv#NIL THEN
+				WriteEnv(d^.valEnv, indent+indention, TRUE);
+				WrLn
+			END;
+			WriteEnv(d^.env, indent+indention, FALSE);
+			WrChar(')')
+		|string:
+			WrChar('[');
+			WrStr(d^.root^.name^);
+			WrChar(']');
+			WrChar('"');
+			follow:=CharPtr(d^.env);
+			WHILE follow^#0C DO
+				WrChar(follow^);
+				IncAddr(follow,1)
+			END;
+			WrChar('"')
+		|primitive:
+			WrStr('PRIMITIVE[');
+			WrHex(Seg(d^.env),0);
+			WrChar(':');
+			WrHex(Ofs(d^.env),0);
+			WrChar(']')
+		|packed:
+			WrChar('[');
+			WrStr(d^.root^.name^);
+			WrChar(']');
+			WrInt(INTEGER(d^.env),0);
+			IF CHAR(d^.env) >= ' ' THEN
+				WrStr(" - '");
+				WrChar(CHAR(d^.env));
+				WrChar("'")
+			END
+		|length:
+			WrChar('[');
+			WrStr(d^.root^.name^);
+			WrChar(']');
+			WrHex(Seg(d^.valEnv),5)
+	END
+END WriteDef;
+
+PROCEDURE ShowDef(d:closure);
+VAR
+	ch:CHAR;
+BEGIN
+	debug:=TRUE;
+	breakLayer:=0;
+	runCurPos:=CursorPos();
+	SaveScreen(runScreen);
+	ClearScreen;
+	WriteDef(d,0);
+	LOOP
+		ch:=RdKey();
+		CASE ch OF
+(*			|'w','W':
+				Info(debugWin,winfo);
+				SetWrap(NOT winfo.WrapOn);
+				Clear;
+				WriteDef(d,0)
+*)
+		   |' ':
+	   		EXIT
+	   	|'p','P':
+	   		debug:=FALSE;
+	   		breakLayer:=topLayer;
+	   		RestoreScreen(runScreen);
+	   		EXIT
+	   	|'/':
+	   		RestoreScreen(runScreen);
+	   		ch:=RdKey();
+	   		ClearScreen;
+	   		WriteDef(d,0)
+	   	|'g','G':
+	   		debug:=FALSE;
+	   		EXIT
+	   	|'q','Q':
+	   		ch:=RdKey();
+	   		IF ch='!' THEN
+	   			HALT
+	   		END
+	   END
+	END;
+	RestoreScreen(runScreen);
+	PlaceCursor(runCurPos)
+END ShowDef;
+
+BEGIN
+	sp:=0;
+	topLayer:=1;
+	breakLayer:=0;
+	MakePrimitive(EmptyClosure,EmptyHandler);
+	MakePrimitive(HandlePackage,DummyHandler);
+	MakePrimitive(HandleParent,ParentHandler);
+	tempDef:=EmptyClosure;
+	result:=EmptyClosure;
+	parent:=NIL;
+	AddMarker(MarkStack);
+	AddMarker(MarkTemporaries);
+	debug:=FALSE
+END Machine.
+
+
+
+
+
diff --git a/examples/Dipl/MEMORY.DEF b/examples/Dipl/MEMORY.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/MEMORY.DEF
@@ -0,0 +1,12 @@
+DEFINITION MODULE Memory;
+
+PROCEDURE MarkNeeded(VAR ptr:ADDRESS; length:CARDINAL; VAR newDiscovery:BOOLEAN);
+PROCEDURE Collect;
+PROCEDURE AddMarker(marker:PROC);
+PROCEDURE DropMarker;
+PROCEDURE ALLOCATE(VAR ptr:ADDRESS; length:CARDINAL);
+
+END Memory.
+
+
+
diff --git a/examples/Dipl/MEMORY.MOD b/examples/Dipl/MEMORY.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/MEMORY.MOD
@@ -0,0 +1,227 @@
+IMPLEMENTATION MODULE Memory;
+FROM Lib IMPORT AddAddr, DecAddr, IncAddr, SubAddr, Dos;
+FROM SYSTEM IMPORT ADDRESS, BYTE, TSIZE, Registers;
+FROM IO IMPORT WrStr, WrLn;
+CONST
+	MaxMarkers=200;
+	MinParagraph=400H;
+	MaxParagraph=0A000H;
+	MinBitMap=MinParagraph DIV 16;
+	MaxBitMap=MaxParagraph DIV 16;
+	MaxBlockSize=1025;
+VAR
+	markers:ARRAY [1..MaxMarkers] OF PROC;
+	lastMarker:[0..MaxMarkers];
+	bitMap:ARRAY [MinBitMap..MaxBitMap] OF BITSET;
+	HeapTop,HeapBottom:CARDINAL;
+	sizes:ARRAY [0..MaxBlockSize+1] OF
+		RECORD
+			paragraph:CARDINAL;
+			previous,next:[0..MaxBlockSize+1]
+		END;
+	largestBlock:[0..MaxBlockSize];
+	block1,length1:CARDINAL;
+
+PROCEDURE FatalError(text:ARRAY OF CHAR);
+BEGIN
+	WrLn;
+	WrStr('Greska u garbage collector modulu!');
+	WrLn;
+	WrStr(text);
+	HALT
+END FatalError;
+
+PROCEDURE AddMarker(m:PROC);
+BEGIN
+	IF lastMarker<MaxMarkers THEN
+		INC(lastMarker);
+		markers[lastMarker]:=m
+	ELSE
+		FatalError('Prekoracen maximalan broj markera potrebnih celija u HEAPu!')
+	END
+END AddMarker;
+
+PROCEDURE DropMarker;
+BEGIN
+	IF lastMarker>0 THEN
+		DEC(lastMarker)
+	ELSE
+		FatalError('Malo previse brisanja markera potrebnih celija u HEAPu.')
+	END
+END DropMarker;
+
+PROCEDURE MarkNeeded(VAR addr:ADDRESS; length:CARDINAL; VAR discovery:BOOLEAN);
+VAR
+	paragraph:CARDINAL;
+BEGIN
+	paragraph:=Seg(addr^);
+	IF Ofs(addr^)#0 THEN
+		paragraph:=paragraph + Ofs(addr^) DIV 16;
+		length:=length + Ofs(addr^) MOD 16
+	END;
+	length:=(length+15) DIV 16;
+	IF paragraph>=HeapBottom THEN
+		discovery:=FALSE;
+		IF paragraph>HeapTop THEN
+			RETURN
+		END;
+		REPEAT
+			IF NOT (paragraph MOD 16 IN bitMap[paragraph DIV 16]) THEN
+				discovery:=TRUE;
+				INCL(bitMap[paragraph DIV 16],paragraph MOD 16)
+			END;
+			INC(paragraph);
+			DEC(length)
+		UNTIL length=0
+	ELSE
+		discovery:=TRUE
+	END
+END MarkNeeded;
+
+(*#check(index => off) *)
+(*#check(range => off) *)
+(*#check(overflow => off) *)
+(*#check(stack => off) *)
+(*#check(guard => off) *)
+(*#check(nil_ptr => off) *)
+
+PROCEDURE Collect;
+VAR
+	i,blockSize,previous:CARDINAL;
+BEGIN
+	FOR i:=HeapBottom DIV 16 TO HeapTop DIV 16 DO
+		bitMap[i]:=BITSET(0)
+	END;
+	FOR i:=1 TO lastMarker DO
+		markers[i]
+	END;
+	largestBlock:=0;
+	FOR i:=1 TO MaxBlockSize DO
+		sizes[i].paragraph:=0
+	END;
+	EXCL(bitMap[HeapBottom DIV 16],HeapBottom MOD 16);
+	INCL(bitMap[(HeapBottom+1) DIV 16],(HeapBottom+1) MOD 16);
+	i:=HeapTop-1;
+	LOOP
+		WHILE i MOD 16 IN bitMap[i DIV 16] DO
+			DEC(i)
+		END;
+		IF i=HeapBottom THEN
+			EXIT
+		END;
+		blockSize:=0;
+		REPEAT
+			INC(blockSize);
+			DEC(i);
+		UNTIL i MOD 16 IN bitMap[i DIV 16];
+		IF blockSize>largestBlock THEN
+			IF blockSize>MaxBlockSize THEN
+				INC(i,blockSize-MaxBlockSize);
+				blockSize:=MaxBlockSize
+			END;
+			largestBlock:=blockSize
+		END;
+		[i+1:0]^:=sizes[blockSize].paragraph;
+		sizes[blockSize].paragraph:=i+1
+	END;
+	IF largestBlock=0 THEN
+		FatalError( 'Heap je definitivno prepunjen. Zaboravi na taj algoritam!' )
+	END;
+	previous:=0;
+	FOR blockSize:=1 TO largestBlock DO
+		IF sizes[blockSize].paragraph#0 THEN
+			sizes[blockSize].previous:=previous;
+			sizes[previous].next:=blockSize;
+			previous:=blockSize
+		END
+	END;
+	sizes[largestBlock].next:=MaxBlockSize+1;
+	length1:=0
+END Collect;
+
+PROCEDURE ALLOCATE(VAR ptr:ADDRESS; length:CARDINAL);
+VAR
+	original:CARDINAL;
+BEGIN
+	IF length<=16 THEN
+		IF sizes[1].paragraph#0 THEN
+			ptr:=[sizes[1].paragraph:0];
+			sizes[1].paragraph:=ptr^;
+			IF sizes[1].paragraph=0 THEN
+				sizes[0].next:=sizes[1].next;
+				sizes[sizes[1].next].previous:=0
+			END
+		ELSE
+			IF length1=0 THEN
+				length1:=sizes[0].next;
+				IF length1>MaxBlockSize THEN
+					Collect;
+					ALLOCATE(ptr,length);
+					RETURN
+				END;
+				block1:=sizes[length1].paragraph;
+				sizes[length1].paragraph:=[block1:0]^;
+				IF sizes[length1].paragraph=0 THEN
+					sizes[0].next:=sizes[length1].next;
+					sizes[sizes[length1].next].previous:=0
+				END
+			END;
+			ptr:=[block1:0];
+			INC(block1);
+			DEC(length1)
+		END
+	ELSE
+		length:=(length+15) DIV 16;
+		original:=length;
+		IF sizes[length].paragraph=0 THEN
+			length:=0;
+			REPEAT
+				length:=sizes[length].next
+			UNTIL length>=original;
+			IF length>MaxBlockSize THEN
+				Collect;
+				IF original>largestBlock THEN
+					FatalError( 'Heap je definitivno prepunjen. Zaboravi na taj algoritam!' )
+				END;
+				ALLOCATE(ptr,original*16);
+				RETURN
+			END
+		END;
+		WITH sizes[length] DO
+			IF length#original THEN
+				[paragraph+original:0]^:=sizes[length-original].paragraph;
+				sizes[length-original].paragraph:=paragraph+original;
+				IF [paragraph+original:0]^=WORD(0) THEN
+					sizes[previous].next:=length-original;
+					sizes[length-original].previous:=previous;
+					previous:=length-original;
+					sizes[length-original].next:=length
+				END
+			END;
+			ptr:=[paragraph:0];
+			paragraph:=ptr^;
+			IF paragraph=0 THEN
+				sizes[previous].next:=next;
+				sizes[next].previous:=previous
+			END
+		END
+	END
+END ALLOCATE;
+
+VAR
+	r:Registers;
+	
+BEGIN
+	r.AH:=48H;
+	r.BX:=0FFFFH;
+	Dos(r);
+	r.AH:=48H;
+	Dos(r);
+	HeapBottom:=r.AX;
+	HeapTop:=r.AX+r.BX-1;
+	lastMarker:=0;
+	Collect
+END Memory.
+
+
+
diff --git a/examples/Dipl/NAMES.DEF b/examples/Dipl/NAMES.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/NAMES.DEF
@@ -0,0 +1,24 @@
+DEFINITION MODULE Names;
+
+FROM Machine IMPORT link, closure, handlerType;
+
+PROCEDURE DefName(dp:link):ADDRESS;
+PROCEDURE DefEntry(dp:link):closure;
+PROCEDURE SetDefEntry(dp:link; newEntry:closure);
+PROCEDURE FindWord(wd:ARRAY OF CHAR):link;
+
+PROCEDURE NewDictionary;
+PROCEDURE OldDictionary;
+
+PROCEDURE DefineWord(VAR newDef:link; name:ARRAY OF CHAR; wordMeaning:closure);
+PROCEDURE AddPrimWord(VAR newDef:link; name:ARRAY OF CHAR;
+								handler:handlerType);
+PROCEDURE AddArgument(VAR worDef:link; wordName:ARRAY OF CHAR);
+PROCEDURE AddAtom(VAR worDef:link; wordName:ARRAY OF CHAR);
+PROCEDURE vList;
+
+VAR
+	wParent, wString, wMeaning, wName, wEntry, wUndefined:link;
+END Names.
+
+
diff --git a/examples/Dipl/NAMES.MOD b/examples/Dipl/NAMES.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/NAMES.MOD
@@ -0,0 +1,337 @@
+IMPLEMENTATION MODULE Names;
+
+FROM SYSTEM IMPORT TSIZE;
+FROM Lib IMPORT AddAddr, SubAddr, HashString;
+FROM IO IMPORT WrStrAdj, WrLn;
+FROM Str IMPORT Caps;
+FROM Memory IMPORT ALLOCATE, MarkNeeded, AddMarker, DropMarker;
+FROM Machine IMPORT link, closure, parent, tempDef;
+FROM Machine IMPORT EmptyClosure, MarkClosure, MarkString;
+FROM Machine IMPORT wType, Build, HandlePackage, HandleParent, SaveDefinition;
+FROM Machine IMPORT AddEnv, RemoveEnv, MakeDef, MakePrimitive, MakeString;
+CONST
+	FormalMaximum=10000;
+	MaxEntries=64;
+	LastEntry=MaxEntries-1;
+TYPE
+	wordPtr=POINTER TO wordType;
+	wordType=RECORD
+					next:wordPtr;
+					def:closure;
+					name:POINTER TO ARRAY [0..FormalMaximum] OF CHAR;
+					entry:closure;
+				END;
+	dictionary=POINTER TO dictRec;
+	dictRec= RECORD
+					info:ARRAY [0..LastEntry] OF wordPtr;
+					next:dictionary
+				 END;
+VAR
+	i:CARDINAL;
+	top:dictionary;
+	UndefinedMeaning:closure;
+	
+PROCEDURE DefWord(l:link):wordPtr;
+BEGIN
+	RETURN wordPtr(SubAddr(l,TSIZE(wordPtr)))
+END DefWord;
+
+PROCEDURE vList;
+CONST
+	WordsInRow=3;
+	MaxLength=25;
+VAR
+	follow:wordPtr;
+	i,counter:CARDINAL;
+BEGIN
+	counter:=1;
+	FOR i:=0 TO LastEntry DO
+		follow:=top^.info[i];
+		WHILE follow#NIL DO
+			DEC(counter);
+			IF counter=0 THEN
+				counter:=WordsInRow;
+				WrLn
+			END;
+			WrStrAdj(follow^.name^,-MaxLength);
+			follow:=follow^.next
+		END
+	END;
+	WrLn
+END vList;
+
+PROCEDURE NewDictionary;
+VAR
+	d:dictionary;
+	i:CARDINAL;
+BEGIN
+	NEW(d);
+	FOR i:=0 TO LastEntry DO
+		d^.info[i]:=top^.info[i]
+	END;
+	d^.next:=top;
+	top:=d
+END NewDictionary;
+
+PROCEDURE OldDictionary;
+BEGIN
+	top:=top^.next
+END OldDictionary;
+
+PROCEDURE DefineWord(VAR worDef:link; wordName:ARRAY OF CHAR;
+								wordMeaning:closure);
+VAR
+	newWord:wordPtr;
+	hash:CARDINAL;
+BEGIN
+	hash:=HashString(wordName,MaxEntries);
+	NEW(newWord);
+	WITH newWord^ DO
+		next:=top^.info[hash];
+		top^.info[hash]:=newWord;
+		name:=ADR(wordName);
+		def:=EmptyClosure;
+		entry:=EmptyClosure;
+		worDef:=ADR(def);
+		MakeDef(entry,wEntry);
+		MakeDef(def,worDef);
+		AddEnv(entry,wMeaning,def);
+		MakeString(def,wString,name);
+		AddEnv(entry,wName,def);
+		def:=wordMeaning
+	END
+END DefineWord;
+
+(*
+PROCEDURE UndefineWord(l:link);
+VAR
+	hash:CARDINAL;
+BEGIN
+	hash:=HashString(DefWord(l)^.name^,MaxEntries);
+	top^.info[hash]:=top^.info[hash]^.next
+END UndefineWord;
+
+PROCEDURE MoveWord(l:link; fromVoc, toVoc:dictionary);
+VAR
+	hash:CARDINAL;
+	follow:POINTER TO wordPtr;
+	wd:wordPtr;
+BEGIN
+	wd:=DefWord(l);
+	hash:=HashString(wd^.name^,MaxEntries);
+	IF fromVoc#EmptyDict THEN
+		follow:=ADR(fromVoc^.info[hash]);
+		WHILE (follow^#wd) AND (follow^#NIL) DO
+			follow:=ADR(follow^^.next)
+		END;
+		IF follow^=wd THEN
+			follow^:=follow^^.next
+		END
+	END;
+	wd^.next:=toVoc^.info[hash];
+	toVoc^.info[hash]:=wd
+END MoveWord;
+
+PROCEDURE Forget(dp:link):BOOLEAN;
+VAR
+	follow,target:wordPtr;
+BEGIN
+	target:=wordPtr(dp);
+	follow:=lastWord;
+	WHILE (follow#NIL) AND (follow#target) DO
+		follow:=follow^.next
+	END;
+	IF follow=NIL THEN
+		RETURN FALSE
+	ELSE
+		lastWord:=follow^.next;
+		RETURN TRUE
+	END
+END Forget;
+*)
+
+PROCEDURE AddPrimWord(VAR worDef:link; wordName:ARRAY OF CHAR;
+								handler:handlerType);
+BEGIN
+	MakePrimitive(tempDef,handler);
+	DefineWord(worDef,wordName,tempDef);
+	tempDef:=EmptyClosure
+END AddPrimWord;
+
+PROCEDURE AddArgument(VAR worDef:link; wordName:ARRAY OF CHAR);
+BEGIN
+	DefineWord(worDef,wordName,UndefinedMeaning)
+END AddArgument;
+
+PROCEDURE AddAtom(VAR worDef:link; wordName:ARRAY OF CHAR);
+BEGIN
+	AddPrimWord(worDef,wordName,Build);
+	MakeDef(tempDef,worDef);
+	AddEnv(worDef^,wType,tempDef);
+	tempDef:=EmptyClosure
+END AddAtom;
+	
+PROCEDURE MarkWords;
+VAR
+	i:[0..LastEntry];
+	wdCurrent:wordPtr;
+	dictFollow:dictionary;
+	fresh:BOOLEAN;
+BEGIN
+	MarkClosure(UndefinedMeaning);
+	dictFollow:=top;
+	WHILE dictFollow#NIL DO
+		MarkNeeded(dictFollow,TSIZE(dictRec),fresh);
+		dictFollow:=dictFollow^.next
+	END;
+	FOR i:=0 TO LastEntry DO
+		wdCurrent:=top^.info[i];
+		WHILE wdCurrent#NIL DO
+			MarkNeeded(wdCurrent,TSIZE(wordType),fresh);
+			WITH wdCurrent^ DO
+				MarkString(name);
+				MarkClosure(def);
+				MarkClosure(entry);
+				wdCurrent:=next
+			END
+		END
+	END
+END MarkWords;
+
+PROCEDURE FindWord(wd:ARRAY OF CHAR):link;
+VAR
+	follow:wordPtr;
+	letter:CARDINAL;
+BEGIN
+	follow:=top^.info[HashString(wd,MaxEntries)];
+	WHILE follow#NIL DO
+		IF follow^.name^[0]=wd[0] THEN
+			letter:=1;
+			WITH follow^ DO
+				WHILE (wd[letter]=name^[letter]) AND (name^[letter]#0C) DO
+					INC(letter)
+				END;
+				IF wd[letter]=name^[letter] THEN
+					RETURN ADR(def)
+				END;
+			END
+		END;
+		follow:=follow^.next
+	END;
+	RETURN NIL
+END FindWord;
+
+(*# call( o_a_copy => on ) *)
+
+PROCEDURE FindWordNoCase(wd:ARRAY OF CHAR):link;
+VAR
+	follow:wordPtr;
+	letter:CARDINAL;
+BEGIN
+	Caps(wd);
+	follow:=top^.info[HashString(wd,MaxEntries)];
+	WHILE follow#NIL DO
+		IF CAP(follow^.name^[0])=wd[0] THEN
+			letter:=1;
+			WITH follow^ DO
+				WHILE (wd[letter]=CAP(name^[letter])) AND (name^[letter]#0C) DO
+					INC(letter)
+				END;
+				IF wd[letter]=name^[letter] THEN
+					RETURN ADR(def)
+				END;
+			END
+		END;
+		follow:=follow^.next
+	END;
+	RETURN NIL
+END FindWordNoCase;
+
+PROCEDURE DefName(dp:link):ADDRESS;
+TYPE
+	AddrPtr=POINTER TO ADDRESS;
+BEGIN
+	RETURN AddrPtr(AddAddr(dp,TSIZE(closure)))^
+END DefName;
+
+PROCEDURE DefEntry(dp:link):closure;
+BEGIN
+	RETURN link(AddAddr(dp, TSIZE(closure) + TSIZE(ADDRESS)))^
+END DefEntry;
+
+PROCEDURE SetDefEntry(dp:link;newEntry:closure);
+VAR
+	entry:link;
+BEGIN
+	entry:=link(AddAddr(dp, TSIZE(closure) + TSIZE(ADDRESS)));
+	SaveDefinition(entry);
+	entry^:=newEntry
+END SetDefEntry;
+
+VAR
+	name:closure;		(* unmarked temporary, used only during initialisation *)
+
+BEGIN
+	AddMarker( MarkWords );
+	NEW(top);
+	top^.next:=NIL;
+	FOR i:=0 TO LastEntry DO
+		top^.info[i]:=NIL
+	END;
+
+	AddArgument(wEntry, 'Entry');
+	tempDef:=DefEntry(wEntry);
+	RemoveEnv(tempDef,wMeaning);
+	RemoveEnv(tempDef,wName);
+
+	DefineWord(wParent, 'Parent', HandleParent);
+	tempDef:=DefEntry(wParent);
+	RemoveEnv(tempDef,wMeaning);
+	RemoveEnv(tempDef,wName);
+
+	AddAtom(wUndefined, 'Undefined');
+	tempDef:=DefEntry(wUndefined);
+	RemoveEnv(tempDef,wMeaning);
+	RemoveEnv(tempDef,wName);
+	MakeDef(UndefinedMeaning,wUndefined);
+	parent:= UndefinedMeaning;
+
+	AddArgument(wMeaning,'Meaning');
+	tempDef:=DefEntry(wMeaning);
+	RemoveEnv(tempDef,wName);
+
+	AddArgument(wName,'Name');
+
+	DefineWord(wString,'STRING',HandlePackage);
+
+	MakeString(name,wString,DefName(wName));
+	tempDef:=DefEntry(wName);
+	AddEnv(tempDef,wName,name);
+
+	MakeString(name,wString,DefName(wMeaning));
+	tempDef:=DefEntry(wMeaning);
+	AddEnv(tempDef,wName,name);
+
+	MakeString(name,wString,DefName(wUndefined));
+	tempDef:=DefEntry(wUndefined);
+	AddEnv(tempDef,wName,name);
+	MakeDef(name,wUndefined);
+	AddEnv(tempDef,wMeaning,name);
+
+	MakeString(name,wString,DefName(wParent));
+	tempDef:=DefEntry(wParent);
+	AddEnv(tempDef,wName,name);
+	MakeDef(name,wParent);
+	AddEnv(tempDef,wMeaning,name);
+
+	MakeString(name,wString,DefName(wEntry));
+	tempDef:=DefEntry(wEntry);
+	AddEnv(tempDef,wName,name);
+	MakeDef(name,wEntry);
+	AddEnv(tempDef,wMeaning,name);
+	wEntry^:=UndefinedMeaning;
+
+	tempDef:=EmptyClosure
+END Names.
+
+
diff --git a/examples/Dipl/PARSELOW.DEF b/examples/Dipl/PARSELOW.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/PARSELOW.DEF
@@ -0,0 +1,13 @@
+DEFINITION MODULE ParseLow;
+
+VAR
+	buildTree:BOOLEAN;
+
+PROCEDURE ParsePrimitive;
+PROCEDURE ParseSequencePrimitive(valuedProperty:BOOLEAN);
+PROCEDURE ParseEndSequence;
+PROCEDURE ParseChoice;
+PROCEDURE ParseOption;
+
+END ParseLow.
+
diff --git a/examples/Dipl/PARSELOW.MOD b/examples/Dipl/PARSELOW.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/PARSELOW.MOD
@@ -0,0 +1,290 @@
+IMPLEMENTATION MODULE ParseLow;
+
+FROM SYSTEM IMPORT TSIZE;
+FROM Buffers IMPORT Rewind, position;
+FROM Memory IMPORT ALLOCATE, AddMarker, DropMarker, MarkNeeded;
+FROM Machine IMPORT MarkLink, MarkClosure, tempDef, EmptyClosure;
+FROM Machine IMPORT closure, result, MakeDef, Reduce;
+FROM Machine IMPORT Root, AddEnv, AddValuedEnv, Join, Copy;
+FROM Library IMPORT wProperty, wStruct;
+FROM Grammars IMPORT wDummy, wFail, wRaise, wDiscard, wGrammar, wNext;
+FROM Grammars IMPORT Failure, HoldDummy;
+
+TYPE
+	RestPtr=POINTER TO RestRec;
+	RestRec=RECORD
+				grammar:closure;
+				next:RestPtr
+			  END;
+	ParsedPtr=POINTER TO ParsedRec;
+	ParsedRec=RECORD
+					CASE leaf:BOOLEAN OF
+						FALSE:
+							property:closure;
+							valued:BOOLEAN
+						|TRUE:
+							result:closure
+					END;
+					next:ParsedPtr
+				 END;
+	StackPtr=POINTER TO StackRec;
+	StackRec=RECORD
+					restRec:RestRec;
+					prevLink:ParsedPtr;
+					pos:LONGCARD;
+(*					layer:CARDINAL; *)
+					next:StackPtr
+				END;
+VAR
+	current:closure;
+	parsed,parsedNew,linked:ParsedPtr;
+	rest,restNew:RestPtr;
+	stack,stackNew:StackPtr;
+(*	layers:CARDINAL; *)
+
+PROCEDURE MarkRest(list:RestPtr);
+VAR
+	fresh:BOOLEAN;
+BEGIN
+	WHILE list#NIL DO
+		MarkNeeded(list,TSIZE(RestRec),fresh);
+		IF NOT fresh THEN
+			RETURN
+		END;
+		MarkClosure(list^.grammar);
+		list:=list^.next
+	END
+END MarkRest;
+
+PROCEDURE MarkParsed(list:ParsedPtr);
+VAR
+	fresh:BOOLEAN;
+BEGIN
+	WHILE list#NIL DO
+		MarkNeeded(list,TSIZE(ParsedRec),fresh);
+		IF NOT fresh THEN
+			RETURN
+		END;
+		IF list^.leaf THEN
+			MarkClosure(list^.result)
+		ELSE
+			MarkClosure(list^.property)
+		END;
+		list:=list^.next
+	END
+END MarkParsed;
+
+PROCEDURE MarkAll;
+VAR
+	s:StackPtr;
+	fresh:BOOLEAN;
+BEGIN
+	s:=stack;
+	fresh:=TRUE;
+	WHILE fresh AND (s#NIL) DO
+		MarkNeeded(s,TSIZE(StackRec),fresh);
+		MarkRest(s^.restRec.next);
+		MarkParsed(s^.prevLink);
+		s:=s^.next
+	END;
+	MarkClosure(current);
+	MarkRest(rest);
+	MarkParsed(parsed)
+END MarkAll;
+
+PROCEDURE MarkLinked;
+BEGIN
+	MarkParsed(linked)
+END MarkLinked;
+
+PROCEDURE LinkParsed;
+VAR
+	swap:ParsedPtr;
+BEGIN
+	linked:=NIL;
+	AddMarker(MarkLinked);
+	WHILE parsed#NIL DO
+		IF parsed^.leaf THEN
+			swap:=parsed^.next;
+			parsed^.next:=linked;
+			linked:=parsed;
+			parsed:=swap;
+		ELSE
+         IF Root(parsed^.property)#wDiscard THEN
+         	IF Root(parsed^.property)=wRaise THEN
+         		IF Root(linked^.result)#wDummy THEN
+						IF linked^.leaf THEN
+							Copy(linked^.result,tempDef);
+							linked^.next^.leaf:=FALSE
+						ELSE
+							tempDef:=linked^.result
+						END;
+						Join(tempDef,linked^.next^.result);
+						linked^.next^.result:=tempDef
+					END
+				ELSE
+					IF linked^.next^.leaf THEN
+						tempDef:=linked^.next^.result;
+						Copy(tempDef,linked^.next^.result);
+						linked^.next^.leaf:=FALSE
+					END;
+					IF parsed^.valued THEN
+						AddValuedEnv(linked^.next^.result,Root(parsed^.property),linked^.result)
+					ELSE
+						AddEnv(linked^.next^.result,Root(parsed^.property),linked^.result)
+					END
+				END
+			END;
+			linked:=linked^.next;
+			parsed:=parsed^.next
+		END
+	END;
+	tempDef:=EmptyClosure;
+	IF linked^.next=NIL THEN
+		result:=linked^.result
+	ELSE
+		result:=Failure
+	END;
+	DropMarker
+END LinkParsed;
+				
+PROCEDURE ParsePrimitive;
+VAR
+	prevPos:LONGCARD;
+BEGIN
+	NEW(stackNew);
+	WITH stackNew^ DO
+(*		layer:=layers; *)
+		restRec.next:=rest;
+		restRec.grammar:=NIL;
+		prevLink:=parsed;
+		pos:=MAX(LONGCARD);
+		next:=stack
+	END;
+	stack:=stackNew;
+(*	layers:=0; *)
+	NEW(rest);
+	WITH rest^ DO
+		grammar:=wGrammar^;
+		next:=NIL
+	END;
+	parsed:=NIL;
+	REPEAT
+		REPEAT
+			buildTree:=TRUE;
+			current:=rest^.grammar;
+			rest:=rest^.next;
+			Reduce(current);
+			IF Root(result)=wFail THEN
+				rest:=NIL
+			ELSIF (parsed#NIL) AND NOT parsed^.leaf AND
+					((Root(parsed^.property)=wDiscard) OR
+					(Root(parsed^.property)=wRaise) AND (Root(result)=wDummy)) THEN
+				parsed:=parsed^.next
+			ELSE
+				NEW(parsedNew);
+				parsedNew^.leaf:=TRUE;
+				parsedNew^.result:=result;
+				parsedNew^.next:=parsed;
+				parsed:=parsedNew
+			END
+		UNTIL rest=NIL;
+		IF Root(result)#wFail THEN
+			WHILE stack^.pos#MAX(LONGCARD) DO
+				stack:=stack^.next
+			END;
+			LinkParsed;
+(*			WHILE layers>0 DO
+				PopLayer;
+				DEC(layers)
+			END *)
+		END;
+		prevPos:=stack^.pos;
+		IF prevPos#MAX(LONGCARD) THEN
+			Rewind(prevPos)
+		END;
+		rest:=ADR(stack^.restRec);
+		parsed:=stack^.prevLink;
+(*		WHILE layers>stack^.layer DO
+			PopLayer;
+			DEC(layers)
+		END;
+		layers:=stack^.layer; *)
+		stack:=stack^.next;
+	UNTIL prevPos=MAX(LONGCARD);
+	rest:=rest^.next;
+	current:=NIL
+END ParsePrimitive;
+
+PROCEDURE ParseSequencePrimitive(valuedProperty:BOOLEAN);
+VAR
+	buildOld:BOOLEAN;
+BEGIN
+	NEW(restNew);
+	restNew^.grammar:=wNext^;
+	restNew^.next:=rest;
+	rest:=restNew;
+	buildOld:=buildTree;
+	IF Root(wProperty^)=wDiscard THEN
+		buildTree:=FALSE
+	END;
+	NEW(parsedNew);
+	WITH parsedNew^ DO
+		leaf:=FALSE;
+		property:=wProperty^;
+		valued:=valuedProperty;
+		next:=parsed;
+	END;
+	parsed:=parsedNew;
+	Reduce(wGrammar^);
+	buildTree:=buildOld
+END ParseSequencePrimitive;
+
+PROCEDURE ParseEndSequence;
+BEGIN
+	result:=wStruct^
+END ParseEndSequence;
+
+PROCEDURE ParseChoice;
+BEGIN
+	NEW(stackNew);
+	WITH stackNew^ DO
+(*		StartLayer;
+		INC(layers);
+		layer:=layers; *)
+		pos:=position;
+		prevLink:=parsed;
+		next:=stack;
+		stack:=stackNew;
+		restRec.grammar:=wNext^;
+		restRec.next:=rest
+	END;
+	Reduce(wGrammar^)
+END ParseChoice;
+
+PROCEDURE ParseOption;
+BEGIN
+	NEW(stackNew);
+	WITH stackNew^ DO
+(*		StartLayer;
+		INC(layers);
+		layer:=layers; *)
+		pos:=position;
+		prevLink:=parsed;
+		next:=stack;
+		stack:=stackNew;
+		restRec.grammar:=wGrammar^;
+		restRec.next:=rest
+	END;
+	result:=HoldDummy
+END ParseOption;
+
+BEGIN
+	rest:=NIL;
+	stack:=NIL;
+	parsed:=NIL;
+	current:=NIL;
+	AddMarker(MarkAll)
+END ParseLow.
+
+
diff --git a/examples/Dipl/PARSER.DEF b/examples/Dipl/PARSER.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/PARSER.DEF
@@ -0,0 +1,11 @@
+DEFINITION MODULE Parser;
+
+FROM Machine IMPORT link, closure;
+
+VAR
+	wParse:link;
+
+PROCEDURE Parse;
+
+END Parser.
+
diff --git a/examples/Dipl/PARSER.MOD b/examples/Dipl/PARSER.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/PARSER.MOD
@@ -0,0 +1,466 @@
+IMPLEMENTATION MODULE Parser;
+
+FROM Memory IMPORT ALLOCATE, AddMarker;
+FROM Lib IMPORT IncAddr;
+IMPORT Str;
+FROM FIO IMPORT File, Open, IOresult, Close;
+FROM Buffers IMPORT ReadChar, ReadWord, Rewind, CharSet;
+FROM Buffers IMPORT position, OpenInput, CloseInput, ReportError;
+
+FROM Machine IMPORT EmptyClosure, tempDef, wPackage, link, HandlePackage, Reduce;
+FROM Machine IMPORT Join, AddEnv, AddValuedEnv, Root, Copy, result;
+FROM Machine IMPORT SaveDefinition, NewLayer, StartLayer, PopLayer;
+FROM Machine IMPORT MakeDef, MakePrimitive, MakeString, MakePacked, ExtractPacked;
+FROM Machine IMPORT MarkString, MarkClosure;
+
+FROM Library IMPORT wChar, wString,	wCharSet, wNumber, wError, errorCodes;
+FROM Library IMPORT wType, wStruct, wFile, wUndefined, wDescription;
+
+FROM Names IMPORT FindWord, DefEntry, AddPrimWord, DefineWord, wMeaning;
+FROM Names IMPORT NewDictionary, OldDictionary;
+
+FROM Grammars IMPORT wSequence, wLexSequence, wValSequence, wLexValSequence;
+FROM Grammars IMPORT wEndSeq, wChoice, wOption;
+FROM Grammars IMPORT wDummy, wFail, wDone, wRaise, wDiscard, wGrammar, wNext;
+FROM Grammars IMPORT wSpaceChars, wSpaces, wComment, wFrameGrammar, wCustomGrammar;
+FROM Grammars IMPORT wCharGrammar, wCharSetGrammar, wStrGrammar, wNumGrammar;
+FROM Grammars IMPORT wIdentifier, wIdentGrammar, wFirst, wTail;
+FROM Grammars IMPORT wStructGrammar;
+FROM Grammars IMPORT Failure, Confirmation;
+
+FROM ParseLow IMPORT ParsePrimitive, buildTree;
+FROM ParseLow IMPORT ParseSequencePrimitive, ParseEndSequence, ParseChoice, ParseOption;
+
+CONST
+	MaxStrLength=200;
+	all=CharSet{0C..377C};
+
+TYPE
+	CharPtr=POINTER TO CHAR;
+	string=ARRAY [0..MaxStrLength] OF CHAR;
+
+VAR
+	firstSet,tailSet:CharSet;
+	originalFirst,originalTail:closure;
+	strPtr:POINTER TO string;
+
+PROCEDURE pSpaces;
+VAR
+	prevPos:LONGCARD;
+	spaces:POINTER TO CharSet;
+	str:ARRAY [0..1] OF CHAR;
+BEGIN
+	StartLayer;
+	SaveDefinition(wCharSet);
+	wCharSet^:=HandlePackage;
+	Reduce(wSpaceChars^);
+	PopLayer;
+	ExtractPacked(result,spaces);
+	IF Root(wComment^)=wFail THEN
+		ReadWord(str,spaces^,spaces^)
+	ELSE
+		REPEAT
+			ReadWord(str,spaces^,spaces^);
+			prevPos:=position;
+			StartLayer;
+			SaveDefinition(wGrammar);
+			wGrammar^:=wComment^;
+			ParsePrimitive;
+			PopLayer;
+		UNTIL Root(result)=wFail;
+		Rewind(prevPos)
+	END;
+	result:=Confirmation
+END pSpaces;
+
+PROCEDURE ParseLexValSequence;
+BEGIN
+	ParseSequencePrimitive(TRUE)
+END ParseLexValSequence;
+
+PROCEDURE ParseLexSequence;
+BEGIN
+	ParseSequencePrimitive(FALSE)
+END ParseLexSequence;
+
+PROCEDURE ParseValSequence;
+BEGIN
+	Reduce(wSpaces^);
+	ParseSequencePrimitive(TRUE)
+END ParseValSequence;
+
+PROCEDURE ParseSequence;
+BEGIN
+	Reduce(wSpaces^);
+	ParseSequencePrimitive(FALSE)
+END ParseSequence;
+
+PROCEDURE ParseTheLetter;
+VAR
+	chExpect,chRead:CHAR;
+BEGIN
+	ExtractPacked(wPackage^,chExpect);
+	ReadChar(chRead);
+	IF chRead=chExpect THEN
+		IF buildTree THEN
+			MakePacked(result,wChar,chRead)
+		ELSE
+			result:=Confirmation
+		END
+	ELSE
+		result:=Failure
+	END
+END ParseTheLetter;
+
+VAR
+	strRest:CharPtr;
+
+PROCEDURE ParseTheString;
+VAR
+	ch:CHAR;
+	strExpect:CharPtr;
+BEGIN
+	ExtractPacked(wPackage^,strExpect);
+	strRest:=strExpect;
+	LOOP
+		IF strRest^=0C THEN
+			EXIT
+		END;
+		ReadChar(ch);
+		IF strRest^#ch THEN
+			EXIT
+		END;
+		IncAddr(strRest,1)
+	END;
+	IF strRest^=0C THEN
+		IF buildTree THEN
+			MakeString(result,wString,strExpect)
+		ELSE
+			result:=Confirmation
+		END
+	ELSE
+		result:=Failure
+	END
+END ParseTheString;
+
+PROCEDURE ParseTheCharSet;
+VAR
+	ch:CHAR;
+	s:POINTER TO CharSet;
+BEGIN
+	ExtractPacked(wPackage^,s);
+	ReadChar(ch);
+	IF ch IN s^ THEN
+		IF buildTree THEN
+			MakePacked(result,wChar,ch)
+		ELSE
+			result:=Confirmation
+		END
+	ELSE
+		result:=Failure
+	END
+END ParseTheCharSet;
+
+PROCEDURE ParseNumber;
+VAR
+	ch:CHAR;
+	minus:BOOLEAN;
+	x:CARDINAL;
+BEGIN
+	ReadChar(ch);
+	IF ch='-' THEN
+		minus:=TRUE;
+		ReadChar(ch)
+	ELSE
+		minus:=FALSE;
+		IF ch='+' THEN
+			ReadChar(ch)
+		END
+	END;
+	x:=0;
+	IF ch IN CharSet{'0'..'9'} THEN
+		REPEAT
+			IF x <= (MAX(INTEGER)-ORD(ch)+ORD('0')) DIV 10 THEN
+				x:=10*x+ORD(ch)-ORD('0')
+			END;
+			ReadChar(ch)
+		UNTIL NOT (ch IN CharSet{'0'..'9'});
+		Rewind(position-1);
+ 		IF minus THEN
+  			MakePacked(result,wNumber,-INTEGER(x))
+  		ELSE
+			MakePacked(result,wNumber,x)
+		END
+  	ELSE
+		result:=Failure
+  	END
+END ParseNumber;
+
+PROCEDURE ParseChar;
+VAR
+	delimiter,chRead:CHAR;
+BEGIN
+	ReadChar(delimiter);
+	IF delimiter="'" THEN
+		ReadChar(chRead);
+		ReadChar(delimiter);
+		IF delimiter="'" THEN
+			MakePacked(result,wChar,chRead)
+		ELSE
+			result:=Failure
+		END
+	ELSE
+		result:=Failure
+	END
+END ParseChar;
+
+PROCEDURE ParseCharSET;
+VAR
+	ch,second,i:CHAR;
+	s:CharSet;
+	complement:BOOLEAN;
+BEGIN
+	ReadChar(ch);
+	IF ch='{' THEN
+		s:=CharSet{};
+		ReadChar(ch);
+		IF ch='~' THEN
+			complement:=TRUE;
+		ELSE
+			complement:=FALSE;
+			Rewind(position-1)
+		END;
+		LOOP
+			pSpaces;
+			ReadChar(ch);
+			IF ch='}' THEN
+				EXIT
+			ELSIF ch='\' THEN
+				ReadChar(ch);
+			END;
+			pSpaces;
+			ReadChar(second);
+			IF second='-' THEN
+				pSpaces;
+				ReadChar(second);
+				IF second<ch THEN
+					ch:=0C;
+					EXIT
+				END;
+				FOR i:=ch TO second DO
+					INCL(s,i)
+				END;
+				ReadChar(second)
+			ELSE
+				INCL(s,ch)
+			END;
+			IF second#',' THEN
+				IF second#'}' THEN
+					ch:=0C
+				END;
+				EXIT
+			END
+		END;
+		IF ch#0C THEN
+			IF buildTree THEN
+				IF complement THEN
+					s:=all-s;
+				END;
+				MakePacked(result,wCharSet,s)
+			ELSE
+				result:=Confirmation
+			END;
+			RETURN
+		END
+	END;
+	result:=Failure
+END ParseCharSET;
+
+PROCEDURE ParseIdentifier;
+VAR
+	first,tail:POINTER TO CharSet;
+	wd:link;
+	str:string;
+BEGIN
+	IF (wFirst^=originalFirst) AND (wTail^=originalTail) THEN
+		ReadWord(str,firstSet,tailSet)
+	ELSE
+		SaveDefinition(wCharSet);
+		wCharSet^:=HandlePackage;
+		Reduce(wFirst^);
+		ExtractPacked(result,first);
+		Reduce(wTail^);
+		ExtractPacked(result,tail);
+		ReadWord(str,first^,tail^)
+	END;
+	IF str[0]=0C THEN
+		result:=Failure
+	ELSE
+		wd:=FindWord(str);
+		IF wd=NIL THEN
+			ALLOCATE(strPtr,Str.Length(str)+1);
+			Str.Copy(strPtr^,str);
+			MakeDef(result,wIdentifier);
+			DefineWord(wd,strPtr^,result);
+			AddEnv(wd^,wDescription,DefEntry(wd));
+			strPtr:=NIL
+		END;
+		NewLayer(DefEntry(wd));
+		result:=wMeaning^
+	END
+END ParseIdentifier;
+	
+PROCEDURE ParseString;
+VAR
+	ch,between:CHAR;
+	str:string;
+	length:CARDINAL;
+BEGIN
+	ReadChar(between);
+	IF (between="'") OR (between='"') THEN
+		length:=0;
+		ReadChar(ch);
+		WHILE (ch#between) AND (ch#CHR(13)) AND (length<MaxStrLength) DO
+			str[length]:=ch;
+			INC(length);
+			ReadChar(ch)
+		END;
+		IF ch=between THEN
+			str[length]:=0C;
+			ALLOCATE(strPtr,length+1);
+			Str.Copy(strPtr^,str);
+			MakeString(result,wString,strPtr);
+			strPtr:=NIL;
+			RETURN
+	  	END
+  	END;
+	result:=Failure
+END ParseString;
+
+PROCEDURE ParseCustom;
+VAR
+	wprop:closure;
+BEGIN
+	ParseIdentifier;
+	IF Root(result)#wFail THEN
+		wprop:=DefEntry(Root(result));
+		wFrameGrammar^:=wStructGrammar^;
+		NewLayer(wprop);
+		SaveDefinition(wType);
+		wType^:=result;
+		Reduce(wFrameGrammar^)
+	END
+END ParseCustom;
+
+PROCEDURE Parse;
+VAR
+	saveFirstSet,saveTailSet:CharSet;
+BEGIN
+	StartLayer;
+	SaveDefinition(wSpaces);
+	MakePrimitive(wSpaces^,pSpaces);
+	SaveDefinition(wSequence);
+	MakePrimitive(wSequence^,ParseSequence);
+	SaveDefinition(wLexSequence);
+	MakePrimitive(wLexSequence^,ParseLexSequence);
+	SaveDefinition(wValSequence);
+	MakePrimitive(wValSequence^,ParseValSequence);
+	SaveDefinition(wLexValSequence);
+	MakePrimitive(wLexValSequence^,ParseLexValSequence);
+	SaveDefinition(wEndSeq);
+	MakePrimitive(wEndSeq^,ParseEndSequence);
+	SaveDefinition(wChoice);
+	MakePrimitive(wChoice^,ParseChoice);
+	SaveDefinition(wOption);
+	MakePrimitive(wOption^,ParseOption);
+	SaveDefinition(wChar);
+	MakePrimitive(wChar^,ParseTheLetter);
+	SaveDefinition(wString);
+	MakePrimitive(wString^,ParseTheString);
+
+	originalFirst:=wFirst^;
+	originalTail:=wTail^;
+	Reduce(wFirst^);
+	saveFirstSet:=firstSet;
+	ExtractPacked(result,firstSet);
+	IF Root(result)#wCharSet THEN
+		originalFirst:=NIL
+	END;
+	Reduce(wTail^);
+	saveTailSet:=tailSet;
+	ExtractPacked(result,tailSet);
+	IF Root(result)#wCharSet THEN
+		originalTail:=NIL
+	END;
+	SaveDefinition(wCharSet);
+	MakePrimitive(wCharSet^,ParseTheCharSet);
+
+	SaveDefinition(wNumGrammar);
+	MakePrimitive(wNumGrammar^,ParseNumber);
+	SaveDefinition(wCharGrammar);
+	MakePrimitive(wCharGrammar^,ParseChar);
+	SaveDefinition(wStrGrammar);
+	MakePrimitive(wStrGrammar^,ParseString);
+	SaveDefinition(wCharSetGrammar);
+	MakePrimitive(wCharSetGrammar^,ParseCharSET);
+	SaveDefinition(wIdentGrammar);
+	MakePrimitive(wIdentGrammar^,ParseIdentifier);
+	SaveDefinition(wCustomGrammar);
+	MakePrimitive(wCustomGrammar^,ParseCustom);
+	SaveDefinition(wFrameGrammar);
+	wFrameGrammar^:=Failure;
+	pSpaces;
+	ParsePrimitive;
+	PopLayer;
+	originalFirst:=EmptyClosure;
+	originalTail:=EmptyClosure;
+	IF Root(result)=wFail THEN
+		ReportError;
+		MakePacked(result,wError,SyntaxError)
+	ELSE
+		SaveDefinition(wStruct);
+		wStruct^:=result;
+		Reduce(result)
+	END;
+END Parse;
+
+PROCEDURE pParse;
+VAR
+	filename:POINTER TO string;
+	newFile:BOOLEAN;
+BEGIN
+	Reduce(wFile^);
+	newFile:=(Root(result)=wString);
+	IF newFile THEN
+		ExtractPacked(result,filename);
+		IF NOT OpenInput(filename^) THEN
+			MakePacked(result,wError,IOError);
+			RETURN
+		END;
+		SaveDefinition(wFile);
+		MakeDef(wFile^,wUndefined)
+	END;
+	NewDictionary;
+	Parse;
+	OldDictionary;
+	IF newFile THEN
+		CloseInput
+	END
+END pParse;
+
+PROCEDURE MarkInternals;
+BEGIN
+	MarkString(strPtr);
+	MarkClosure(originalFirst);
+	MarkClosure(originalTail)
+END MarkInternals;
+
+BEGIN
+	strPtr:=NIL;
+	originalFirst:=EmptyClosure;
+	originalTail:=EmptyClosure;
+	AddMarker(MarkInternals);
+	AddPrimWord(wParse,'Parse',pParse)
+END Parser.
+
+
diff --git a/examples/Dipl/W.MOD b/examples/Dipl/W.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Dipl/W.MOD
@@ -0,0 +1,101 @@
+MODULE W;
+
+FROM IO IMPORT WrStr, WrLn, WrCard, EndOfRd, RdChar;
+IMPORT IO;
+FROM Machine IMPORT link, Root, result;
+FROM Machine IMPORT Reduce, StartLayer, PopLayer, SaveDefinition;
+FROM Machine IMPORT MakeDef, MakePacked, MakeString, ExtractPacked;
+FROM Library IMPORT wStruct, wFile, wAncestor;
+FROM Library IMPORT wString, wError, errorCodes, wTrue, wUndefined;
+FROM Names IMPORT AddAtom, AddPrimWord, NewDictionary, OldDictionary;
+FROM Buffers IMPORT ReportError, OpenInput, CloseInput;
+FROM Parser IMPORT Parse;
+FROM Decoder IMPORT wWrite;
+FROM Grammars IMPORT wGrammar, wFail, wSentence;
+(* FROM Graph IMPORT SetVideoMode, InitGraph; *)
+IMPORT PMD;
+
+VAR
+	wInterpret,wQuit,wLoad:link;
+	level:CARDINAL;
+
+(*# data(stack_size => 0FF00H) *)
+	
+PROCEDURE pInterpret;
+VAR
+	ch,empty:CHAR;
+BEGIN
+	empty:=0C;
+	INC(level);
+	LOOP
+		MakeString(wFile^,wString,ADR(empty));
+		WrLn;
+		WrStr('Reduce[');
+		WrCard(level,0);
+		WrStr(']>');
+		Reduce(wLoad^);
+		WHILE NOT EndOfRd(FALSE) DO
+			ch:=RdChar()
+		END;
+		IF Root(result)=wQuit THEN
+			MakeDef(result,wTrue);
+			EXIT
+		ELSE
+			StartLayer;
+			SaveDefinition(wStruct);
+			wStruct^:=result;
+			Reduce(wWrite^);
+			IF Root(result)=wFail THEN
+				WrStr('Output error!')
+			END;
+			PopLayer
+		END
+	END;
+	DEC(level)
+END pInterpret;
+
+PROCEDURE pLoad;
+VAR
+	filename:ARRAY [0..30] OF CHAR;
+	newFile:BOOLEAN;
+	ch:CHAR;
+BEGIN
+	Reduce(wFile^);
+	newFile:=(Root(result)=wString);
+	IF newFile THEN
+		ExtractPacked(result,filename);
+		IF NOT OpenInput(filename) THEN
+			MakePacked(result,wError,IOError);
+			RETURN
+		END;
+      SaveDefinition(wFile);
+      MakeDef(wFile^,wUndefined)
+	END;
+	NewDictionary;
+	StartLayer;
+	SaveDefinition(wGrammar);
+	wGrammar^:=wSentence^;
+	Parse;
+	PopLayer;
+	SaveDefinition(wAncestor);
+	wAncestor^:=result;
+	Reduce(result);
+	OldDictionary;
+	IF newFile THEN
+		CloseInput
+	END
+END pLoad;
+
+BEGIN
+	level:=0;
+	AddAtom(wQuit,'Quit');
+	AddPrimWord(wInterpret, 'Interpret', pInterpret);
+	AddPrimWord(wLoad, 'Load', pLoad);
+(*	InitGraph;
+	IF NOT SetVideoMode(7) THEN
+		WrStr('Prebacivanje u tekst mod nije uspelo!')
+	END;
+*)
+	pInterpret
+END W.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGCSBMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGCSBMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGCSBMI.DEF
@@ -0,0 +1,134 @@
+DEFINITION MODULE BagCSBMI;
+(*==============================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Character Sequential Bounded Managed Iterator
+
+    INTRODUCTION
+    This module supports the abstract data type bag for discrete
+    values of ASCII CHARs.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+================================================================*)
+
+FROM CharItems IMPORT
+    (*--Type*) Item, Continue;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions;
+
+    (*-----------------------*)
+
+TYPE  Bag;
+TYPE  SizeRange = [1..256];
+CONST NullBag   = Bag(NIL);
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+CONST ModuleID = 1;
+
+PROCEDURE BagError    ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        ()           : Bag         (*-- out   *);
+
+PROCEDURE Destroy       (VAR theBag  : Bag         (*-- inout *));
+
+PROCEDURE Clear         (VAR theBag  : Bag         (*-- inout *));
+
+PROCEDURE Assign        (    theBag  : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Include       (    theItem : Item        (*-- in    *);
+       	       	         VAR inBag   : Bag         (*-- inout *));
+
+PROCEDURE Exclude       (    theItem : Item        (*-- in    *);
+       	       	         VAR fromBag : Bag         (*-- inout *));
+
+PROCEDURE Union         (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Intersection  (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Difference    (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE SymDifference (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theSet  : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEmpty       (    theSet  : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Bag         (*-- in    *);
+                             right   : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE NumMembers    (    theBag  : Bag         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE UniqueMembers (    theBag  : Bag         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+       	       	             theBag  : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE NumberOf      (    theItem : Item        (*-- in    *);
+       	       	             theBag  : Bag         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Bag         (*-- in    *);
+                             right   : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+
+    (*---------------------------------*)
+    (*--         ITERATORS           --*)
+
+TYPE  LoopAccessProc = PROCEDURE (Item, CARDINAL) : Continue;
+
+PROCEDURE LoopOver    (    theSet  : Bag            (*-- in    *);
+       	       	       	   process : LoopAccessProc (*-- in    *));
+
+
+TYPE  AccessProc = PROCEDURE (Item, CARDINAL);
+
+PROCEDURE Traverse    (    theSet  : Bag            (*-- in    *);
+       	       	       	   process : AccessProc     (*-- in    *));
+
+END BagCSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGCSBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGCSBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGCSBMI.MOD
@@ -0,0 +1,512 @@
+IMPLEMENTATION MODULE BagCSBMI;
+(*==============================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structure - Bag
+               Character Sequential Bounded Managed Iterator
+
+    INTRODUCTION
+    This module supports the abstract data type bag for discrete
+    values of CHARs.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM CharItems IMPORT
+    (*--Type*) Item, Continue;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, Raise, ExitOnError;
+
+    (*-----------------------*)
+
+TYPE  ItemsArray = ARRAY Item OF CARDINAL;
+TYPE  BoundedBag = RECORD
+        items : ItemsArray;
+      END (*-- BoundedBag *);
+
+TYPE  Bag = POINTER TO BoundedBag;
+
+
+    (*-----------------------*)
+
+VAR   theEmptyBag : ItemsArray; (*-- Predefined bag, initialized to 0 *)
+
+    (*-----------------------*)
+    (*--     EXCEPTIONS    --*)
+
+VAR   bagError   : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+PROCEDURE BagError    ()             : Exceptions (*-- out   *);
+BEGIN
+  RETURN bagError;
+END BagError;
+(*----------------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  bagError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+PROCEDURE Recreate   (VAR theBag : Bag     (*-- inout *))
+                                 : BOOLEAN (*-- out   *);
+BEGIN
+  IF (theBag = NullBag) THEN
+    theBag := Create();
+  END (*--if*);
+  RETURN (theBag # NIL);
+END Recreate;
+(*----------------------------*)
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        ()           : Bag         (*-- out   *);
+
+VAR   newBag : Bag;
+
+BEGIN
+  bagError := noerr;
+  Allocate(newBag, SIZE(BoundedBag));
+  IF (newBag = NullBag) THEN
+	RaiseErrIn(create, overflow);
+  ELSE
+    newBag^.items := theEmptyBag;
+  END (*--if*);
+  RETURN newBag;
+END Create;
+(*----------------------------*)
+
+PROCEDURE Destroy       (VAR theBag    : Bag         (*-- inout *));
+BEGIN
+  Clear(theBag);
+  IF (bagError = noerr) THEN
+    Deallocate(theBag, SIZE(BoundedBag));
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+PROCEDURE Clear         (VAR theBag    : Bag         (*-- inout *));
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    theBag^.items := theEmptyBag;
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+PROCEDURE Assign        (    theBag  : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+BEGIN 
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    IF Recreate(toBag) THEN
+      toBag^.items := theBag^.items;
+    END (*--if*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+PROCEDURE Include       (    theItem : Item        (*-- in    *);
+       	       	         VAR inBag   : Bag         (*-- inout *));
+BEGIN
+  bagError := noerr;
+  IF (inBag # NullBag) THEN
+    WITH inBag^ DO
+      IF (items[theItem] < MAX(CARDINAL)) THEN
+	INC(items[theItem]);
+      ELSE
+	RaiseErrIn(include, overflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*----------------------------*)
+
+PROCEDURE Exclude       (    theItem : Item        (*-- in    *);
+       	       	         VAR fromBag : Bag         (*-- inout *));
+BEGIN
+  bagError := noerr;
+  IF (fromBag # NullBag) THEN
+    WITH fromBag^ DO
+      IF (items[theItem] > MIN(CARDINAL)) THEN
+	DEC(items[theItem]);
+      ELSE
+	RaiseErrIn(exclude, notinbag);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*----------------------------*)
+
+PROCEDURE Union         (    left   : Bag         (*-- in    *);
+       	       	             right  : Bag         (*-- in    *);
+                         VAR toBag  : Bag         (*-- inout *));
+
+VAR   index : Item; (*-- loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF Recreate(toBag) THEN
+      WITH toBag^ DO
+        FOR index := MIN(Item) TO MAX(Item) DO
+          items[index] := left^.items[index] + right^.items[index];
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(union, undefined);
+  END (*--if*);
+END Union;
+(*----------------------------*)
+
+PROCEDURE Intersection  (    left   : Bag         (*-- in    *);
+       	       	             right  : Bag         (*-- in    *);
+                         VAR toBag  : Bag         (*-- inout *));
+
+VAR   index : Item; (*-- loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF Recreate(toBag) THEN
+      WITH toBag^ DO
+        FOR index := MIN(Item) TO MAX(Item) DO
+          IF (left^.items[index] < right^.items[index]) THEN
+            items[index] := left^.items[index];
+	  ELSE
+            items[index] := right^.items[index];
+	  END (*--if*);
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(intersection, undefined);
+  END (*--if*);
+END Intersection;
+(*----------------------------*)
+
+PROCEDURE Difference    (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+VAR   index : Item; (*-- loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF Recreate(toBag) THEN
+      WITH toBag^ DO
+        FOR index := MIN(Item) TO MAX(Item) DO
+	  IF (right^.items[index] = 0) THEN
+	    items[index] := left^.items[index];
+	  ELSIF (left^.items[index] > right^.items[index]) THEN
+            items[index] := left^.items[index] - right^.items[index];
+	  ELSE
+	    items[index] := 0;
+	  END (*--if*);
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(difference, undefined);
+  END (*--if*);
+END Difference;
+(*----------------------------*)
+
+PROCEDURE SymDifference (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+VAR   index : Item; (*-- loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF Recreate(toBag) THEN
+      WITH toBag^ DO
+        FOR index := MIN(Item) TO MAX(Item) DO
+	  IF (right^.items[index] = 0) THEN
+	    items[index] := left^.items[index];
+	  ELSIF (left^.items[index] > right^.items[index]) THEN
+            items[index] := left^.items[index] - right^.items[index];
+	  ELSE
+            items[index] := right^.items[index] - left^.items[index];
+	  END (*--if*);
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(symdifference, undefined);
+  END (*--if*);
+END SymDifference;
+(*----------------------------*)
+
+
+    (*---------------------------------*)
+    (*--          SELECTORS          --*)
+
+PROCEDURE IsDefined     (    theBag    : Bag         (*-- in    *))
+                                       : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN theBag # NullBag;
+END IsDefined;
+(*----------------------------*)
+
+PROCEDURE IsEmpty       (    theBag    : Bag         (*-- in    *))
+                                       : BOOLEAN     (*-- out   *);
+
+VAR   index : Item; (*-- loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      FOR index := MIN(Item) TO MAX(Item) DO
+        IF (items[index] # 0) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(isempty, undefined);
+  END (*--if*);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+PROCEDURE IsEqual       (    left      : Bag         (*-- in    *);
+       	       	       	     right     : Bag         (*-- in    *))
+                                       : BOOLEAN     (*-- out   *);
+
+VAR   index : Item;   (*-- loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    WITH left^ DO
+      FOR index := MIN(Item) TO MAX(Item) DO
+        IF (items[index] # right^.items[index]) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+    RETURN TRUE;
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE NumMembers    (    theBag  : Bag         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+VAR   index : Item;     (*-- loop index over items *)
+      count : CARDINAL; (*-- working sum of items in the bag *)
+
+BEGIN
+  bagError := noerr;
+  count    := 0;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      FOR index := MIN(Item) TO MAX(Item) DO
+        INC(count, items[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(nummembers, undefined);
+  END (*--if*);
+  RETURN count;
+END NumMembers;
+(*----------------------------*)
+
+PROCEDURE UniqueMembers (    theBag  : Bag         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+VAR   index : Item;     (*-- loop index over items *)
+      count : CARDINAL; (*-- working sum of unique items in the bag *)
+
+BEGIN
+  bagError := noerr;
+  count    := 0;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      FOR index := MIN(Item) TO MAX(Item) DO
+	IF (items[index] > 0) THEN
+          INC(count);
+	END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(uniquemembers, undefined);
+  END (*--if*);
+  RETURN count;
+END UniqueMembers;
+(*----------------------------*)
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+       	       	             theBag  : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.items[theItem] > 0;
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+PROCEDURE NumberOf      (    theItem : Item        (*-- in    *);
+       	       	             theBag  : Bag         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.items[theItem];
+  ELSE
+    RaiseErrIn(numberof, undefined);
+  END (*--if*);
+  RETURN 0;
+END NumberOf;
+(*----------------------------*)
+
+PROCEDURE IsSubset      (    left    : Bag         (*-- in    *);
+                             right   : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index : Item; (*-- loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    WITH left^ DO
+      FOR index := MIN(Item) TO MAX(Item) DO
+        IF (items[index] > right^.items[index]) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+    RETURN TRUE;
+  ELSE
+    RaiseErrIn(issubset, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset (    left   : Bag        (*-- in    *);
+       	       	       	      right  : Bag        (*-- in    *))
+                                     : BOOLEAN    (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & ~IsEqual(left, right);
+END IsProperSubset;
+(*----------------------------*)
+
+PROCEDURE LoopOver      (    theBag  : Bag            (*-- in    *);
+       	       	       	     process : LoopAccessProc (*-- in    *));
+
+VAR   index : Item; (*-- loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      FOR index := MIN(Item) TO MAX(Item) DO
+        IF (items[index] # 0) THEN
+          IF ~process(index, items[index]) THEN
+            RETURN; (*-- Premature exit, by command of visiting process *)
+          END (*--if*);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE Traverse      (    theBag  : Bag         (*-- in    *);
+       	       	       	     process : AccessProc  (*-- in    *));
+
+VAR   index : Item; (*-- loop index over bitsets *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      FOR index := MIN(Item) TO MAX(Item) DO
+        IF (items[index] # 0) THEN
+          process(index, items[index]);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+
+(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
+(*~~ MODULE INITIALIZATION  ~~*)
+
+VAR   index : Item; (*-- loop index over items *)
+
+BEGIN
+  FOR index := MIN(Item) TO MAX(Item) DO
+    theEmptyBag[index] := 0;
+  END (*--for*);
+
+  FOR bagError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[bagError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  bagError := noerr;
+END BagCSBMI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGCSBMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGCSBMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGCSBMN.DEF
@@ -0,0 +1,119 @@
+DEFINITION MODULE BagCSBMN;
+(*==============================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Character Sequential Bounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module supports the abstract data type bag for discrete
+    values of ASCII CHARs.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+================================================================*)
+
+FROM CharItems IMPORT
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions;
+
+    (*-----------------------*)
+
+TYPE  Bag;
+TYPE  SizeRange = [1..256];
+CONST NullBag   = Bag(NIL);
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+CONST ModuleID = 2;
+
+PROCEDURE BagError    ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        ()           : Bag         (*-- out   *);
+
+PROCEDURE Destroy       (VAR theBag  : Bag         (*-- inout *));
+
+PROCEDURE Clear         (VAR theBag  : Bag         (*-- inout *));
+
+PROCEDURE Assign        (    theBag  : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Include       (    theItem : Item        (*-- in    *);
+       	       	         VAR inBag   : Bag         (*-- inout *));
+
+PROCEDURE Exclude       (    theItem : Item        (*-- in    *);
+       	       	         VAR fromBag : Bag         (*-- inout *));
+
+PROCEDURE Union         (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Intersection  (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Difference    (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE SymDifference (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theSet  : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEmpty       (    theSet  : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Bag         (*-- in    *);
+                             right   : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE NumMembers    (    theBag  : Bag         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE UniqueMembers (    theBag  : Bag         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+       	       	             theBag  : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE NumberOf      (    theItem : Item        (*-- in    *);
+       	       	             theBag  : Bag         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Bag         (*-- in    *);
+                             right   : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+END BagCSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGCSBMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGCSBMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGCSBMN.MOD
@@ -0,0 +1,468 @@
+IMPLEMENTATION MODULE BagCSBMN;
+(*==============================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structure - Bag
+               Character Sequential Bounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module supports the abstract data type bag for discrete
+    values of CHARs.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM CharItems IMPORT
+    (*--Type*) Item;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, Raise, ExitOnError;
+
+    (*-----------------------*)
+
+TYPE  ItemsArray = ARRAY Item OF CARDINAL;
+TYPE  BoundedBag = RECORD
+        items : ItemsArray;
+      END (*-- BoundedBag *);
+
+TYPE  Bag = POINTER TO BoundedBag;
+
+
+    (*-----------------------*)
+
+VAR   theEmptyBag : ItemsArray; (*-- Predefined bag, initialized to 0 *)
+
+    (*-----------------------*)
+    (*--     EXCEPTIONS    --*)
+
+VAR   bagError   : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+PROCEDURE BagError    ()             : Exceptions (*-- out   *);
+BEGIN
+  RETURN bagError;
+END BagError;
+(*----------------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  bagError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+PROCEDURE Recreate   (VAR theBag : Bag     (*-- inout *))
+                                 : BOOLEAN (*-- out   *);
+BEGIN
+  IF (theBag = NullBag) THEN
+    theBag := Create();
+  END (*--if*);
+  RETURN (theBag # NIL);
+END Recreate;
+(*----------------------------*)
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        ()           : Bag         (*-- out   *);
+
+VAR   newBag : Bag;
+
+BEGIN
+  bagError := noerr;
+  Allocate(newBag, SIZE(BoundedBag));
+  IF (newBag = NullBag) THEN
+	RaiseErrIn(create, overflow);
+  ELSE
+    newBag^.items := theEmptyBag;
+  END (*--if*);
+  RETURN newBag;
+END Create;
+(*----------------------------*)
+
+PROCEDURE Destroy       (VAR theBag    : Bag         (*-- inout *));
+BEGIN
+  Clear(theBag);
+  IF (bagError = noerr) THEN
+    Deallocate(theBag, SIZE(BoundedBag));
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+PROCEDURE Clear         (VAR theBag    : Bag         (*-- inout *));
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    theBag^.items := theEmptyBag;
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+PROCEDURE Assign        (    theBag  : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+BEGIN 
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    IF Recreate(toBag) THEN
+      toBag^.items := theBag^.items;
+    END (*--if*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+PROCEDURE Include       (    theItem : Item        (*-- in    *);
+       	       	         VAR inBag   : Bag         (*-- inout *));
+BEGIN
+  bagError := noerr;
+  IF (inBag # NullBag) THEN
+    WITH inBag^ DO
+      IF (items[theItem] < MAX(CARDINAL)) THEN
+	INC(items[theItem]);
+      ELSE
+	RaiseErrIn(include, overflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*----------------------------*)
+
+PROCEDURE Exclude       (    theItem : Item        (*-- in    *);
+       	       	         VAR fromBag : Bag         (*-- inout *));
+BEGIN
+  bagError := noerr;
+  IF (fromBag # NullBag) THEN
+    WITH fromBag^ DO
+      IF (items[theItem] > MIN(CARDINAL)) THEN
+	DEC(items[theItem]);
+      ELSE
+	RaiseErrIn(exclude, notinbag);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*----------------------------*)
+
+PROCEDURE Union         (    left   : Bag         (*-- in    *);
+       	       	             right  : Bag         (*-- in    *);
+                         VAR toBag  : Bag         (*-- inout *));
+
+VAR   index : Item; (*-- loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF Recreate(toBag) THEN
+      WITH toBag^ DO
+        FOR index := MIN(Item) TO MAX(Item) DO
+          items[index] := left^.items[index] + right^.items[index];
+        END (*--for*);
+      END (*--with*)
+    END (*--if*);
+  ELSE
+    RaiseErrIn(union, undefined);
+  END (*--if*);
+END Union;
+(*----------------------------*)
+
+PROCEDURE Intersection  (    left   : Bag         (*-- in    *);
+       	       	             right  : Bag         (*-- in    *);
+                         VAR toBag  : Bag         (*-- inout *));
+
+VAR   index : Item; (*-- loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF Recreate(toBag) THEN
+      WITH toBag^ DO
+        FOR index := MIN(Item) TO MAX(Item) DO
+	  IF (left^.items[index] < right^.items[index]) THEN
+            items[index] := left^.items[index];
+	  ELSE
+            items[index] := right^.items[index];
+	  END (*--if*);
+        END (*--for*);
+       END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(intersection, undefined);
+  END (*--if*);
+END Intersection;
+(*----------------------------*)
+
+PROCEDURE Difference    (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+VAR   index : Item; (*-- loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF Recreate(toBag) THEN
+      WITH toBag^ DO
+        FOR index := MIN(Item) TO MAX(Item) DO
+	  IF (right^.items[index] = 0) THEN
+	    items[index] := left^.items[index];
+	  ELSIF (left^.items[index] > right^.items[index]) THEN
+            items[index] := left^.items[index] - right^.items[index];
+	  ELSE
+	    items[index] := 0;
+	  END (*--if*);
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(difference, undefined);
+  END (*--if*);
+END Difference;
+(*----------------------------*)
+
+PROCEDURE SymDifference (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+VAR   index : Item; (*-- loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF Recreate(toBag) THEN
+      WITH toBag^ DO
+        FOR index := MIN(Item) TO MAX(Item) DO
+	  IF (right^.items[index] = 0) THEN
+	    items[index] := left^.items[index];
+	  ELSIF (left^.items[index] > right^.items[index]) THEN
+            items[index] := left^.items[index] - right^.items[index];
+	  ELSE
+            items[index] := right^.items[index] - left^.items[index];
+	  END (*--if*);
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(symdifference, undefined);
+  END (*--if*);
+END SymDifference;
+(*----------------------------*)
+
+
+    (*---------------------------------*)
+    (*--          SELECTORS          --*)
+
+PROCEDURE IsDefined     (    theBag    : Bag         (*-- in    *))
+                                       : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN theBag # NullBag;
+END IsDefined;
+(*----------------------------*)
+
+PROCEDURE IsEmpty       (    theBag    : Bag         (*-- in    *))
+                                       : BOOLEAN     (*-- out   *);
+
+VAR   index : Item; (*-- loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      FOR index := MIN(Item) TO MAX(Item) DO
+        IF (items[index] # 0) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(isempty, undefined);
+  END (*--if*);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+PROCEDURE IsEqual       (    left      : Bag         (*-- in    *);
+       	       	       	     right     : Bag         (*-- in    *))
+                                       : BOOLEAN     (*-- out   *);
+
+VAR   index : Item;   (*-- loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    WITH left^ DO
+      FOR index := MIN(Item) TO MAX(Item) DO
+        IF (items[index] # right^.items[index]) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+    RETURN TRUE;
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE NumMembers    (    theBag  : Bag         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+VAR   index : Item;     (*-- loop index over items *)
+      count : CARDINAL; (*-- working sum of items in the bag *)
+
+BEGIN
+  bagError := noerr;
+  count    := 0;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      FOR index := MIN(Item) TO MAX(Item) DO
+        INC(count, items[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(nummembers, undefined);
+  END (*--if*);
+  RETURN count;
+END NumMembers;
+(*----------------------------*)
+
+PROCEDURE UniqueMembers (    theBag  : Bag         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+VAR   index : Item;     (*-- loop index over items *)
+      count : CARDINAL; (*-- working sum of unique items in the bag *)
+
+BEGIN
+  bagError := noerr;
+  count    := 0;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      FOR index := MIN(Item) TO MAX(Item) DO
+	IF (items[index] > 0) THEN
+          INC(count);
+	END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(uniquemembers, undefined);
+  END (*--if*);
+  RETURN count;
+END UniqueMembers;
+(*----------------------------*)
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+       	       	             theBag  : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.items[theItem] > 0;
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+PROCEDURE NumberOf      (    theItem : Item        (*-- in    *);
+       	       	             theBag  : Bag         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.items[theItem];
+  ELSE
+    RaiseErrIn(numberof, undefined);
+  END (*--if*);
+  RETURN 0;
+END NumberOf;
+(*----------------------------*)
+
+PROCEDURE IsSubset      (    left    : Bag         (*-- in    *);
+                             right   : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index : Item; (*-- loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    WITH left^ DO
+      FOR index := MIN(Item) TO MAX(Item) DO
+        IF (items[index] > right^.items[index]) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+    RETURN TRUE;
+  ELSE
+    RaiseErrIn(issubset, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset (    left   : Bag        (*-- in    *);
+       	       	       	      right  : Bag        (*-- in    *))
+                                     : BOOLEAN    (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & ~IsEqual(left, right);
+END IsProperSubset;
+(*----------------------------*)
+
+
+(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
+(*~~ MODULE INITIALIZATION  ~~*)
+
+VAR   index : Item; (*-- loop index over items *)
+
+BEGIN
+  FOR index := MIN(Item) TO MAX(Item) DO
+    theEmptyBag[index] := 0;
+  END (*--for*);
+
+  FOR bagError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[bagError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  bagError := noerr;
+END BagCSBMN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGENUM.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGENUM.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGENUM.DEF
@@ -0,0 +1,73 @@
+DEFINITION MODULE BagEnum;
+(*==============================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Bag Enumerations Utility
+
+    THE ABSTRACTION
+    This module provides definitions of the standard bag exceptions
+    and operations.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins:
+        Initial TopSpeed implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+CONST ComponentID = 1024;	(*-- must be a multiple of 256 *)
+
+    (*---------------------------------*)
+    (*--        BAG OPERATIONS       --*)
+
+TYPE  Operations = (
+                    (*-- Module Initialization *)
+                    modinit,
+
+                    (*-- Constructors *)
+                    create, destroy, clear, assign, include, exclude,
+                    union, intersection, difference, symdifference,
+
+
+                    (*-- Selectors *)
+                    isdefined, isempty, isequal, sizeof, typeof,
+                    ismember, issubset, ispropersubset,
+					nummembers, uniquemembers, numberof,
+
+                    (*-- Iterators *)
+                    loopover, traverse,
+
+                    (*-- Guarded Concurrent Operations *)
+                    seize, release
+                   );
+
+TYPE  Constructors = Operations [ create    .. symdifference ];
+TYPE  Selectors    = Operations [ isdefined .. numberof ];
+TYPE  Iterators    = Operations [ loopover  .. traverse ];
+TYPE  GuardedOps   = Operations [ seize     .. release ];
+
+
+    (*---------------------------------*)
+    (*--       BAG EXCEPTIONS        --*)
+
+TYPE  Exceptions = (noerr,      (*-- Nothing went wrong, all's well. *)
+                    initfailed, (*-- Module initialization failure. *)
+
+                    domainerr,  (*-- Item outside the Universe, or
+                                  -- Bag Universes mismatched, or
+                                  -- Invalid Universe definition *)
+
+                    notinbag,   (*-- Item does not exist in bag *)
+
+                    overflow,   (*-- Bag cannot grow big enough for
+                                  -- the requested operation. *)
+
+                    typeerror,  (*-- TypeID mismatch between bags *)
+
+                    undefined   (*-- Bag has not been Created, or
+                                  -- bag has been Destroyed. *)
+                   );
+
+TYPE  ExceptionSet = SET OF Exceptions;
+
+END BagEnum.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGENUM.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGENUM.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGENUM.MOD
@@ -0,0 +1,39 @@
+IMPLEMENTATION MODULE BagEnum; 
+
+(*====================================================================
+
+    Version  : 1.00  22 Dec 1987  C. Lins
+
+    Compiler : TML Modula-2 Compiler for the Apple Macintosh
+
+    Code Size: R+ 32 bytes, R- 32 bytes
+
+    Component: Structure Utility - Bag Enumerations
+
+
+
+    INTRODUCTION
+
+    This module provides enumerations for Bag operations and exceptions.
+
+
+
+    REVISION HISTORY
+
+    v1.00  22 Dec 1987  C. Lins:
+
+	  Initial TML Modula-2 implementation.
+
+
+
+    PROPRIETARY NOTICES
+
+    "BagEnum.IMP", by C. Lins, Copyright ⌐ 1987 Chuck Lins Software.
+
+    5063 Clairemont Mesa Blvd. # 6, San Diego, Calif., USA  92117.
+
+====================================================================*)
+
+
+
+END BagEnum.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGHANDL.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGHANDL.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGHANDL.DEF
@@ -0,0 +1,29 @@
+(*
+This module provides a simple exception handler for the
+various Bag abstractions. Given an error code, it reports
+the exception to standard output in the following format:
+### Error "<error text>" raised in Routine "<routine name>" in Module <module #>
+*)
+
+DEFINITION MODULE BagHandlers;
+(*==============================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Bag Exception Handlers Utility
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins:
+        Initial implementation
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM BagEnum IMPORT
+	(*--type*) Exceptions, Operations;
+
+
+PROCEDURE WriteHandler (    theModule  : CARDINAL   (*--in   *);
+                            theRoutine : Operations (*--in   *);
+                            theError   : Exceptions (*--in   *));
+
+END BagHandlers.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGHANDL.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGHANDL.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGHANDL.MOD
@@ -0,0 +1,73 @@
+IMPLEMENTATION MODULE BagHandlers;
+(*==============================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Set Exception Handlers Utility
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins:
+        Initial implementation
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM BagEnum IMPORT
+	(*--type*) Exceptions, Operations;
+
+FROM IO IMPORT
+	(*--proc*) WrStr, WrLn, WrCard;
+
+
+PROCEDURE WriteHandler (    theModule  : CARDINAL   (*--in   *);
+                            theRoutine : Operations (*--in   *);
+                            theError   : Exceptions (*--in   *));
+BEGIN
+  WrStr('### Error "');
+
+  CASE theError OF
+  	noerr     : WrStr('No Error');
+  |	domainerr : WrStr('Domain Error');
+  | notinbag  : WrStr('Item not in Bag');
+  | overflow  : WrStr('Overflow');
+  | typeerror : WrStr('Type mismatch between sets');
+  | undefined : WrStr('Undefined Set');
+  END (*--case*);
+
+  WrStr('" raised in Routine "');
+
+  CASE theRoutine OF
+  	assign        : WrStr('Assign');
+  | create        : WrStr('Create');
+  | destroy       : WrStr('Destroy');
+  | clear         : WrStr('Clear');
+  | include       : WrStr('Include');
+  | exclude       : WrStr('Exclude');
+  | union         : WrStr('Union');
+  | intersection  : WrStr('Intersection');
+  | difference    : WrStr('Difference');
+  | symdifference : WrStr('Symmetric Difference');
+
+  | isempty       : WrStr('IsEmpty');
+  | isequal       : WrStr('IsEqual');
+  | typeof        : WrStr('TypeOf');
+  | sizeof        : WrStr('SizeOf');
+  | nummembers    : WrStr('NumMembers');
+  | uniquemembers : WrStr('UniqueMembers');
+  | ismember      : WrStr('IsMember');
+  | issubset      : WrStr('IsSubset');
+  | ispropersubset: WrStr('IsProperSubset');
+  | numberof      : WrStr('NumberOf');
+	
+	| loopover      : WrStr('LoopOver');
+	| traverse      : WrStr('Traverse');
+
+  ELSE
+    WrStr('?????');
+  END (*--case*);
+
+  WrStr('" in Module ');
+	WrCard(theModule, 1);
+  WrLn;
+END WriteHandler;
+
+END BagHandlers.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBMI.DEF
@@ -0,0 +1,145 @@
+DEFINITION MODULE BagSBMI;
+(*==============================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Sequential Bounded Managed Iterator
+
+    THE ABSTRACTION
+    This module supports the abstraction of the bag data type.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item, Continue;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  Bag;
+TYPE  BagSize = [ 1 .. 5300 ];
+CONST NullBag = Bag(NIL);
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+CONST ModuleID = 3;
+
+PROCEDURE BagError    ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        (    theSize : BagSize     (*-- in    *);
+                             theType : TypeID      (*-- in    *))
+                                     : Bag         (*-- out   *);
+
+PROCEDURE Destroy       (VAR theBag  : Bag         (*-- inout *));
+
+PROCEDURE Clear         (VAR theBag  : Bag         (*-- inout *));
+
+PROCEDURE Assign        (    theBag  : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Include       (    theItem : Item        (*-- in    *);
+       	       	         VAR inBag   : Bag         (*-- inout *));
+
+PROCEDURE Exclude       (    theItem : Item        (*-- in    *);
+       	       	         VAR fromBag : Bag         (*-- inout *));
+
+PROCEDURE Union         (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Intersection  (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Difference    (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE SymDifference (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty       (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE SizeOf        (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf        (    theBag  : Bag      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+
+PROCEDURE NumMembers    (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE UniqueMembers (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE NumberOf      (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+
+    (*---------------------------------*)
+    (*--         ITERATORS           --*)
+
+TYPE  LoopAccessProc = PROCEDURE (Item, CARDINAL) : Continue;
+
+PROCEDURE LoopOver   (    theBag  : Bag            (*-- in    *);
+                          process : LoopAccessProc (*-- in    *));
+
+
+TYPE  AccessProc = PROCEDURE (Item, CARDINAL);
+
+PROCEDURE Traverse   (    theBag  : Bag            (*-- in    *);
+                          process : AccessProc     (*-- in    *));
+
+END BagSBMI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBMI.MOD
@@ -0,0 +1,1004 @@
+IMPLEMENTATION MODULE BagSBMI;
+(*==============================================================
+    Version  : 1.00 30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Sequential Bounded Managed Iterator
+    Code Size: R-  bytes
+
+    INTRODUCTION
+    This module provides the Bag ADT for generic Items.
+    Implements a Bag using an ordered array.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+        Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+================================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, CompareOf, DisposeOf;
+
+    (*--------------------*)
+
+TYPE  ItemNode = RECORD
+        item : Item;     (*-- the actual value *)
+	count: CARDINAL; (*-- number of times the value occurs *)
+      END (*-- ItemNode *);
+
+TYPE  ItemsArray = ARRAY BagSize OF ItemNode;
+TYPE  BoundedBag = RECORD
+	dataID : TypeID;     (*-- defined data type *)
+        size   : BagSize;    (*-- defined Bag size *)
+        length : CARDINAL;   (*-- current Bag length, := 0 *)
+        items  : ItemsArray; (*-- ordered array [1..size] of ItemNode *)
+      END (*-- BoundedBag *);
+
+TYPE  Bag = POINTER TO BoundedBag;
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+VAR   bagError  : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+PROCEDURE BagError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN bagError;
+END BagError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  bagError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--       LOCAL ROUTINES        --*)
+
+PROCEDURE CopySubset (    routine : Operations (*-- in    *);
+                          fromBag : Bag        (*-- in    *);
+                          index   : BagSize    (*-- in    *);
+                      VAR toBag   : Bag        (*-- inout *));
+
+VAR   assignItem : AssignProc; (*-- Item assignment routine, if any *)
+
+BEGIN
+  assignItem := AssignOf(fromBag^.dataID);
+  WITH toBag^ DO
+    WHILE (index <=fromBag^.length) DO
+      INC(length);
+      WITH items[length] DO
+        item  := assignItem(fromBag^.items[index].item);
+	count := fromBag^.items[index].count;
+      END (*--with*);
+      INC(index);
+    END (*--while*);
+  END (*--with*);
+END CopySubset;
+(*--------------------*)
+
+
+PROCEDURE MinCount      (    left     : CARDINAL  (*-- in    *);
+                             right    : CARDINAL  (*-- in    *))
+			              : CARDINAL  (*-- out   *);
+BEGIN
+  IF (left < right) THEN
+    RETURN left;
+  END (*--if*);
+  RETURN right;
+END MinCount;
+(*--------------------*)
+
+PROCEDURE Max (    left     : CARDINAL  (*--in   *);
+                   right    : CARDINAL  (*--in   *))
+			    : CARDINAL  (*--out  *);
+BEGIN
+  IF (left > right) THEN
+    RETURN left;
+  END (*--if*);
+  RETURN right;
+END Max;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        (    theSize  : BagSize   (*-- in    *);
+                             theType  : TypeID    (*-- in    *))
+                                      : Bag       (*-- out   *);
+
+CONST staticSize = SIZE(BoundedBag) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(ItemNode);
+
+VAR   newBag : Bag;
+
+BEGIN
+  bagError := noerr;
+  Allocate(newBag, staticSize + itemSize * theSize);
+  IF (newBag = NullBag) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newBag^ DO
+      dataID := theType;
+      size   := theSize;
+      length := 0;
+    END (*--with*);
+  END (*--if*);
+  RETURN newBag;
+END Create;
+(*--------------------*)
+
+PROCEDURE Destroy       (VAR theBag   : Bag       (*-- inout *));
+
+CONST staticSize = SIZE(BoundedBag) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(ItemNode);
+
+BEGIN
+  Clear(theBag);
+  IF (bagError = noerr) THEN
+    Deallocate(theBag, staticSize + itemSize * theBag^.size);
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+PROCEDURE Clear         (VAR theBag   : Bag    (*-- inout *));
+
+VAR   freeItem : DisposeProc; (*-- Item disposal routine, if any *)
+      index    : CARDINAL;    (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      freeItem := DisposeOf(dataID);
+      FOR index := MIN(BagSize) TO length DO
+	freeItem(items[index].item);
+      END (*--for*);
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+PROCEDURE Assign        (    theBag   : Bag    (*-- in    *);
+                         VAR toBag    : Bag    (*-- inout *));
+
+  PROCEDURE Recreate () : BOOLEAN (*--out  *);
+  BEGIN
+    IF (toBag = NullBag) THEN
+      toBag := Create(theBag^.size, theBag^.dataID);
+    ELSIF (theBag^.length <= toBag^.size) THEN
+      Clear(toBag);
+      toBag^.dataID := theBag^.dataID;
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    RETURN (bagError = noerr);
+  END Recreate;
+  (*--------------------*)
+
+VAR   assignItem : AssignProc; (*-- Item assignment routine, if any *)
+      index      : CARDINAL;   (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    IF Recreate() THEN
+      WITH theBag^ DO
+	assignItem := AssignOf(dataID);
+        FOR index := MIN(BagSize) TO length DO
+	  WITH items[index] DO
+            toBag^.items[index].item := assignItem(item);
+	    toBag^.items[index].count:= count;
+	  END (*--with*);
+        END (*--for*);
+        toBag^.length := length;
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+PROCEDURE Include       (    theItem  : Item   (*-- in    *);
+       	       	         VAR inBag    : Bag    (*-- inout *));
+
+VAR   index       : CARDINAL; (*-- Loop index in search for theItem *)
+      jndex       : CARDINAL; (*-- Loop index in shifting items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (inBag # NullBag) THEN
+    WITH inBag^ DO
+      compareItem := CompareOf(dataID);
+      index := MIN(BagSize);
+      LOOP
+        IF (index > length) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+	itemOrder := compareItem(items[index].item, theItem);
+
+        IF (itemOrder = equal) THEN
+	  INC(items[index].count);
+          RETURN;
+
+        ELSIF (itemOrder = greater) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+        INC(index);
+      END (*--loop*);
+
+      IF (length < size) THEN
+
+        (*-- Make room for new item at the current index *)
+
+        FOR jndex := length TO index BY -1 DO
+          items[jndex + 1] := items[jndex];
+        END (*--for*);
+
+        (*-- Insert the new item *)
+
+        INC(length);
+        WITH items[index] DO
+	  item := theItem;
+	  count:= 1;
+	END (*--with*);
+
+      ELSE
+        RaiseErrIn(include, overflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*--------------------*)
+
+PROCEDURE Exclude       (    theItem  : Item   (*-- in    *);
+       	       	         VAR fromBag  : Bag    (*-- inout *));
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+      jndex       : CARDINAL;    (*-- Loop index for item deletion *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (fromBag # NullBag) THEN
+    WITH fromBag^ DO
+      compareItem := CompareOf(dataID);
+      FOR index := MIN(BagSize) TO length DO
+
+	itemOrder := compareItem(items[index].item, theItem);
+
+        IF (itemOrder = equal) THEN
+          IF (items[index].count > 1) THEN
+            DEC(items[index].count);
+          ELSE
+
+            (*-- Remove the Item at index by shifting all items
+              -- above index down one position. Then adjust the length
+	      -- to account for the removal of the item. *)
+
+            WHILE (jndex < length) DO
+              INC(jndex);
+              items[jndex - 1] := items[jndex];
+            END (*--while*);
+            DEC(length);
+          END (*--if*);
+	  RETURN;
+
+	ELSIF (itemOrder = greater) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*--------------------*)
+
+PROCEDURE Union         (    left     : Bag    (*-- in    *);
+       	       	             right    : Bag    (*-- in    *);
+                         VAR toBag    : Bag    (*-- inout *));
+
+(*-- Compute the Bag containing all members of left and right.
+  -- x IN toBag iff (x IN left) OR (x IN right).
+  -- The toBag length is used as the running index for adding
+  -- the resulting items of the union.
+  -- The algorithm used is a variation on the array merge from
+  -- reference [1], pg. 414. *)
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+      assignItem  : AssignProc;  (*-- Item assignment routine *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(union, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(union, typeerror);
+    RETURN;
+  END (*--if*);
+
+  IF (toBag = NullBag) THEN
+    WITH left^ DO
+      IF (length + right^.length > MAX(BagSize)) THEN
+        RaiseErrIn(union, overflow);
+        RETURN;
+      END (*--if*);
+      toBag := Create(length + right^.length, dataID);
+      IF (toBag = NullBag) THEN
+	RETURN;
+      END (*--if*);
+    END (*--with*);
+  ELSIF (left^.length + right^.length > toBag^.size) THEN
+    RaiseErrIn(union, overflow);
+    RETURN;
+  ELSE
+    Clear(toBag);
+    toBag^.dataID := left^.dataID;
+  END (*--if*);
+
+  WITH toBag^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(BagSize);
+  rightIndex := MIN(BagSize);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex].item,
+                     right^.items[rightIndex].item);
+    WITH toBag^ DO
+      INC(length);
+      WITH items[length] DO
+        IF (order = less) THEN
+          item := assignItem(left^.items[leftIndex].item);
+	  count:= left^.items[leftIndex].count;
+          INC(leftIndex);
+	ELSIF (order = equal) THEN
+          item := assignItem(left^.items[leftIndex].item);
+	  count:= left^.items[leftIndex].count +
+	          right^.items[rightIndex].count;
+          INC(leftIndex);
+          INC(rightIndex);
+        ELSE
+          item := assignItem(right^.items[rightIndex].item);
+	  count:= right^.items[rightIndex].count;
+          INC(rightIndex);
+        END (*--if*);
+      END (*--with*);
+    END (*--with*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from either the left bag or
+    -- the right bag to the destination bag. *)
+
+  IF (leftIndex > left^.length) THEN
+    CopySubset(union, right, rightIndex, toBag);
+  ELSIF (rightIndex > right^.length) THEN
+    CopySubset(union, left, leftIndex, toBag);
+  END (*--if*);
+END Union;
+(*--------------------*)
+
+PROCEDURE Intersection  (    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *);
+                         VAR toBag   : Bag      (*-- inout *));
+
+(*-- Compute the bag containing all members in both left and right.
+  -- x IN toBag iff (x IN left) AND (x IN right).
+  -- The toBag length is used as the running index for adding
+  -- the resulting items of the intersection. The count field for
+  -- any item added to the destination is the smaller of the two
+  -- count fields from the source bags. *)
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+      assignItem  : AssignProc;  (*-- Item assignment routine *)
+      largerLength: BagSize;	 (*-- Larger length of left & right bags *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(intersection, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(intersection, typeerror);
+    RETURN;
+  END (*--if*);
+
+  largerLength := Max(left^.length, right^.length);
+  IF (toBag = NullBag) THEN
+    toBag := Create(largerLength, left^.dataID);
+    IF (toBag = NullBag) THEN
+      RETURN;
+    END (*--if*);
+
+  ELSIF (largerLength > toBag^.size) THEN
+    RaiseErrIn(intersection, overflow);
+    RETURN;
+  ELSE
+    Clear(toBag);
+    toBag^.dataID := left^.dataID;
+  END (*--if*);
+
+  WITH toBag^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(BagSize);
+  rightIndex := MIN(BagSize);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex].item,
+	                     right^.items[rightIndex].item);
+    IF (order = equal) THEN
+      WITH toBag^ DO
+	INC(length);
+	WITH items[length] DO
+          item := assignItem(left^.items[leftIndex].item);
+	  count:= MinCount(left^.items[leftIndex].count,
+	                   right^.items[rightIndex].count);
+	END (*--with*);
+      END (*--with*);
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      INC(leftIndex);
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+END Intersection;
+(*--------------------*)
+
+PROCEDURE Difference    (    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *);
+                         VAR toBag   : Bag      (*-- inout *));
+
+(*-- Compute the bag containing all members of left that are not
+  -- members of right. x IN toBag iff (x IN left) & ┬(x IN right)
+  -- If there is no match, then the item is added to the destination
+  -- bag. If there is a match, a positive difference between the
+  -- left and right bag counts for the item causes that value to
+  -- be used as the count for the new item. *)
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+      assignItem  : AssignProc;  (*-- Item assignment routine *)
+      largerLength: BagSize;	 (*-- Larger length of left & right bags *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(difference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(difference, typeerror);
+    RETURN;
+  END (*--if*);
+
+  largerLength := Max(left^.length, right^.length);
+  IF (toBag = NullBag) THEN
+    toBag := Create(largerLength, left^.dataID);
+    IF (toBag = NullBag) THEN
+      RETURN;
+    END (*--if*);
+
+  ELSIF (largerLength > toBag^.size) THEN
+    RaiseErrIn(intersection, overflow);
+    RETURN;
+  ELSE
+    Clear(toBag);
+    toBag^.dataID := left^.dataID;
+  END (*--if*);
+
+  WITH toBag^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(BagSize);
+  rightIndex := MIN(BagSize);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex].item,
+                     right^.items[rightIndex].item);
+    IF (order = equal) THEN
+      IF (left^.items[leftIndex].count >
+	  right^.items[rightIndex].count) THEN
+        WITH toBag^ DO
+          INC(length);
+	  WITH items[length] DO
+            item  := assignItem(left^.items[leftIndex].item);
+	    count := left^.items[leftIndex].count - right^.items[rightIndex].count;
+          END (*--with*);
+        END (*--with*);
+      END (*--if*);
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      WITH toBag^ DO
+        INC(length);
+        WITH items[length] DO
+          item  := assignItem(left^.items[leftIndex].item);
+	  count := left^.items[leftIndex].count;
+        END (*--with*);
+      END (*--with*);
+      INC(leftIndex);
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from the left bag to the
+    -- destination bag. *)
+
+  CopySubset(difference, left, leftIndex, toBag);
+END Difference;
+(*--------------------*)
+
+PROCEDURE SymDifference (    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *);
+                         VAR toBag   : Bag      (*-- inout *));
+
+(*-- Compute the Bag containing all members of left or right that
+  -- are not members of both.
+  -- x IN toBag iff (x IN left) # (x IN right) *)
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+      assignItem  : AssignProc;  (*-- Item assignment routine *)
+      largerLength: BagSize;	 (*-- Larger length of left & right bags *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(symdifference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(symdifference, typeerror);
+    RETURN;
+  END (*--if*);
+
+  largerLength := Max(left^.length, right^.length);
+  IF (toBag = NullBag) THEN
+    toBag := Create(largerLength, left^.dataID);
+    IF (toBag = NullBag) THEN
+      RETURN;
+    END (*--if*);
+
+  ELSIF (largerLength > toBag^.size) THEN
+    RaiseErrIn(symdifference, overflow);
+    RETURN;
+  ELSE
+    Clear(toBag);
+    toBag^.dataID := left^.dataID;
+  END (*--if*);
+
+  WITH toBag^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(BagSize);
+  rightIndex := MIN(BagSize);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex].item,
+                     right^.items[rightIndex].item);
+    IF (order = equal) THEN
+      IF (left^.items[leftIndex].count >
+	  right^.items[rightIndex].count) THEN
+        WITH toBag^ DO
+          INC(length);
+	  WITH items[length] DO
+            item  := assignItem(left^.items[leftIndex].item);
+	    count := left^.items[leftIndex].count - right^.items[rightIndex].count;
+          END (*--with*);
+        END (*--with*);
+      END (*--if*);
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSE
+      WITH toBag^ DO
+        IF (length < size) THEN
+          INC(length);
+        ELSE
+          RaiseErrIn(symdifference, overflow);
+          RETURN;
+        END (*--if*);
+        IF (order = less) THEN
+	  WITH items[length] DO
+            item  := assignItem(left^.items[leftIndex].item);
+	    count := left^.items[leftIndex].count;
+          END (*--with*);
+          INC(leftIndex);
+        ELSE
+	  WITH items[length] DO
+            item  := assignItem(right^.items[rightIndex].item);
+	    count := right^.items[rightIndex].count;
+          END (*--with*);
+          INC(rightIndex);
+        END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from either the left set or
+    -- the right set to the destination set. *)
+
+  IF (leftIndex > left^.length) THEN
+    CopySubset(symdifference, right, rightIndex, toBag);
+  ELSIF (rightIndex > right^.length) THEN
+    CopySubset(symdifference, left, leftIndex, toBag);
+  END (*--if*);
+END SymDifference;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theBag # NullBag;
+END IsDefined;
+(*--------------------*)
+
+PROCEDURE IsEmpty       (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN (theBag^.length = 0);
+  END (*--if*);
+
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*--------------------*)
+
+PROCEDURE SizeOf        (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.size;
+  END (*--if*);
+
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*--------------------*)
+
+PROCEDURE TypeOf        (    theBag  : Bag      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.dataID;
+  END (*--if*);
+
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*--------------------*)
+
+PROCEDURE IsEqual       (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   index   : CARDINAL;		(*-- Loop index over items *)
+      compare : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.length = right^.length) THEN
+
+(*
+Scan both Bags looking for the first mismatch (inequality) indicating that the
+Bags are unequal. If the FOR loop completes then the Bags must be equal.
+*)
+	compare := CompareOf(left^.dataID);
+        FOR index := MIN(BagSize) TO left^.length DO
+          IF compare(left^.items[index].item,
+                     right^.items[index].item) # equal THEN
+            RETURN FALSE;
+	  ELSIF (left^.items[index].count # right^.items[index].count) THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--for*);
+        RETURN TRUE;
+      END (*--if*);
+    ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+
+  (*-- the Bags must be unequal, either by having different
+    -- lengths, mismatched types, or an undefined Bag exception. *)
+
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE NumMembers    (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+VAR   totalCount : CARDINAL;
+      index      : CARDINAL;
+
+BEGIN
+  bagError   := noerr;
+  totalCount := 0;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      FOR index := MIN(BagSize) TO length DO
+	INC(totalCount, items[index].count);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(nummembers, undefined);
+  END (*--if*);
+
+  RETURN totalCount;
+END NumMembers;
+(*----------------------------*)
+
+PROCEDURE UniqueMembers (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.length;
+  END (*--if*);
+
+  RaiseErrIn(uniquemembers, undefined);
+  RETURN 0;
+END UniqueMembers;
+(*----------------------------*)
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      compareItem := CompareOf(dataID);
+      FOR index := MIN(BagSize) TO length DO
+        IF (theItem = items[index].item) THEN
+          RETURN TRUE;
+	ELSE
+	  order := compareItem(items[index].item, theItem);
+          IF (order = greater) THEN
+	    RETURN FALSE;
+          END (*--if*);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+PROCEDURE NumberOf      (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      compareItem := CompareOf(dataID);
+      FOR index := MIN(BagSize) TO length DO
+        WITH items[index] DO
+          IF (theItem = item) THEN
+            RETURN count;
+	  ELSE
+	    order := compareItem(item, theItem);
+            IF (order = greater) THEN
+	      RETURN 0;
+            END (*--if*);
+          END (*--if*);
+	END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(numberof, undefined);
+  END (*--if*);
+
+  RETURN 0;
+END NumberOf;
+(*----------------------------*)
+
+PROCEDURE IsSubset      (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF (left^.dataID # right^.dataID) THEN
+      RaiseErrIn(issubset, typeerror);
+    ELSE
+
+      compareItem:= CompareOf(left^.dataID);
+      leftIndex  := MIN(BagSize);
+      rightIndex := MIN(BagSize);
+      WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+        order := compareItem(left^.items[leftIndex].item,
+         	        right^.items[rightIndex].item);
+        IF (order = equal) THEN
+	  IF (left^.items[leftIndex].count >
+	      right^.items[rightIndex].count) THEN
+            RETURN FALSE;
+	  END (*--if*);
+	  INC(leftIndex);
+	  INC(rightIndex);
+	ELSIF (order = less) THEN
+	  RETURN FALSE;
+	ELSE
+	  INC(rightIndex);
+	END (*--if*);
+      END (*--while*);
+      RETURN (leftIndex > left^.length);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(issubset, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset(    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & (left^.length < right^.length);
+END IsProperSubset;
+(*----------------------------*)
+
+
+    (*---------------------------------*)
+    (*--         ITERATORS           --*)
+
+PROCEDURE LoopOver   (    theBag  : Bag            (*-- in    *);
+                          process : LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      FOR index := MIN(BagSize) TO length DO
+        WITH items[index] DO
+          IF ~process(item, count) THEN
+            RETURN;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE Traverse   (    theBag  : Bag            (*-- in    *);
+                          process : AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      FOR index := MIN(BagSize) TO length DO
+	WITH items[index] DO
+          process(item, count);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+
+(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
+(*~~ MODULE INITIALIZATION  ~~*)
+
+BEGIN
+  FOR bagError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[bagError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  bagError := noerr;
+END BagSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBMN.DEF
@@ -0,0 +1,130 @@
+DEFINITION MODULE BagSBMN;
+(*==============================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Sequential Bounded Managed Non-Iterator
+
+    THE ABSTRACTION
+    This module supports the abstraction of the bag data type.
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins
+      Initial implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  Bag;
+TYPE  BagSize = [ 1 .. 5300 ];
+CONST NullBag = Bag(NIL);
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+CONST ModuleID = 4;
+
+PROCEDURE BagError    ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        (    theSize : BagSize     (*-- in    *);
+                             theType : TypeID      (*-- in    *))
+                                     : Bag         (*-- out   *);
+
+PROCEDURE Destroy       (VAR theBag  : Bag         (*-- inout *));
+
+PROCEDURE Clear         (VAR theBag  : Bag         (*-- inout *));
+
+PROCEDURE Assign        (    theBag  : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Include       (    theItem : Item        (*-- in    *);
+       	       	         VAR inBag   : Bag         (*-- inout *));
+
+PROCEDURE Exclude       (    theItem : Item        (*-- in    *);
+       	       	         VAR fromBag : Bag         (*-- inout *));
+
+PROCEDURE Union         (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Intersection  (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Difference    (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE SymDifference (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty       (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE SizeOf        (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf        (    theBag  : Bag      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+
+PROCEDURE NumMembers    (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE UniqueMembers (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE NumberOf      (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+END BagSBMN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBMN.MOD
@@ -0,0 +1,955 @@
+IMPLEMENTATION MODULE BagSBMN;
+(*========================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Sequential Bounded Managed Non-Iterator
+    Code Size: R-  bytes
+
+    INTRODUCTION
+    This module provides the Bag ADT for generic Items.
+    Implements a Bag using an ordered array.
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins
+        Initial implementation. Derived from BagSBMI
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, CompareOf, DisposeOf;
+
+    (*--------------------*)
+
+TYPE  ItemNode = RECORD
+        item : Item;     (*-- the actual value *)
+	count: CARDINAL; (*-- number of times the value occurs *)
+      END (*-- ItemNode *);
+
+TYPE  ItemsArray = ARRAY BagSize OF ItemNode;
+TYPE  BoundedBag = RECORD
+	dataID : TypeID;     (*-- defined data type *)
+        size   : BagSize;    (*-- defined Bag size *)
+        length : CARDINAL;   (*-- current Bag length, := 0 *)
+        items  : ItemsArray; (*-- ordered array [1..size] of ItemNode *)
+      END (*-- BoundedBag *);
+
+TYPE  Bag = POINTER TO BoundedBag;
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+VAR   bagError  : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+PROCEDURE BagError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN bagError;
+END BagError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  bagError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--       LOCAL ROUTINES        --*)
+
+PROCEDURE CopySubset (    routine : Operations (*-- in    *);
+                          fromBag : Bag        (*-- in    *);
+                          index   : BagSize    (*-- in    *);
+                      VAR toBag   : Bag        (*-- inout *));
+
+VAR   assignItem : AssignProc; (*-- Item assignment routine, if any *)
+
+BEGIN
+  assignItem := AssignOf(fromBag^.dataID);
+  WITH toBag^ DO
+    WHILE (index <= fromBag^.length) DO
+      INC(length);
+      WITH items[length] DO
+        item  := assignItem(fromBag^.items[index].item);
+	count := fromBag^.items[index].count;
+      END (*--with*);
+      INC(index);
+    END (*--while*);
+  END (*--with*);
+END CopySubset;
+(*--------------------*)
+
+
+PROCEDURE MinCount      (    left     : CARDINAL  (*-- in    *);
+                             right    : CARDINAL  (*-- in    *))
+			          : CARDINAL  (*-- out   *);
+BEGIN
+  IF (left < right) THEN
+    RETURN left;
+  END (*--if*);
+  RETURN right;
+END MinCount;
+(*--------------------*)
+
+PROCEDURE Max (    left     : CARDINAL  (*--in   *);
+                   right    : CARDINAL  (*--in   *))
+			: CARDINAL  (*--out  *);
+BEGIN
+  IF (left > right) THEN
+    RETURN left;
+  END (*--if*);
+  RETURN right;
+END Max;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        (    theSize  : BagSize   (*-- in    *);
+                             theType  : TypeID    (*-- in    *))
+                                      : Bag       (*-- out   *);
+
+CONST staticSize = SIZE(BoundedBag) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(ItemNode);
+
+VAR   newBag : Bag;
+
+BEGIN
+  bagError := noerr;
+  Allocate(newBag, staticSize + itemSize * theSize);
+  IF (newBag = NullBag) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newBag^ DO
+      dataID := theType;
+      size   := theSize;
+      length := 0;
+    END (*--with*);
+  END (*--if*);
+  RETURN newBag;
+END Create;
+(*--------------------*)
+
+PROCEDURE Destroy       (VAR theBag   : Bag       (*-- inout *));
+
+CONST staticSize = SIZE(BoundedBag) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(ItemNode);
+
+BEGIN
+  Clear(theBag);
+  IF (bagError = noerr) THEN
+    Deallocate(theBag, staticSize + itemSize * theBag^.size);
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+PROCEDURE Clear         (VAR theBag   : Bag    (*-- inout *));
+
+VAR   freeItem : DisposeProc; (*-- Item disposal routine, if any *)
+      index    : CARDINAL;    (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      freeItem := DisposeOf(dataID);
+      FOR index := MIN(BagSize) TO length DO
+ 	freeItem(items[index].item);
+      END (*--for*);
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+PROCEDURE Assign        (    theBag   : Bag    (*-- in    *);
+                         VAR toBag    : Bag    (*-- inout *));
+
+  PROCEDURE Recreate () : BOOLEAN (*--out  *);
+  BEGIN
+    IF (toBag = NullBag) THEN
+      toBag := Create(theBag^.size, theBag^.dataID);
+    ELSIF (theBag^.length <= toBag^.size) THEN
+      Clear(toBag);
+      toBag^.dataID := theBag^.dataID;
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    RETURN (bagError = noerr);
+  END Recreate;
+  (*--------------------*)
+
+VAR   assignItem : AssignProc; (*-- Item assignment routine, if any *)
+      index      : CARDINAL;   (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    IF Recreate() THEN
+      WITH theBag^ DO
+	assignItem := AssignOf(dataID);
+        FOR index := MIN(BagSize) TO length DO
+	  WITH items[index] DO
+            toBag^.items[index].item := assignItem(item);
+	    toBag^.items[index].count:= count;
+	  END (*--with*);
+        END (*--for*);
+        toBag^.length := length;
+      END (*--with*);
+	END (*--if*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+PROCEDURE Include       (    theItem  : Item   (*-- in    *);
+       	       	         VAR inBag    : Bag    (*-- inout *));
+
+VAR   index       : CARDINAL; (*-- Loop index in search for theItem *)
+      jndex       : CARDINAL; (*-- Loop index in shifting items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (inBag # NullBag) THEN
+    WITH inBag^ DO
+      compareItem := CompareOf(dataID);
+      index := MIN(BagSize);
+      LOOP
+        IF (index > length) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+	itemOrder := compareItem(items[index].item, theItem);
+
+        IF (itemOrder = equal) THEN
+	  INC(items[index].count);
+          RETURN;
+
+	ELSIF (itemOrder = greater) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+        INC(index);
+      END (*--loop*);
+
+      IF (length < size) THEN
+
+        (*-- Make room for new item at the current index *)
+
+        FOR jndex := length TO index BY -1 DO
+          items[jndex + 1] := items[jndex];
+        END (*--for*);
+
+        (*-- Insert the new item *)
+
+        INC(length);
+        WITH items[index] DO
+	  item := theItem;
+	  count:= 1;
+	END (*--with*);
+
+      ELSE
+        RaiseErrIn(include, overflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*--------------------*)
+
+PROCEDURE Exclude       (    theItem  : Item   (*-- in    *);
+       	       	         VAR fromBag  : Bag    (*-- inout *));
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+      jndex       : CARDINAL;    (*-- Loop index for item deletion *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (fromBag # NullBag) THEN
+    WITH fromBag^ DO
+      compareItem := CompareOf(dataID);
+      FOR index := MIN(BagSize) TO length DO
+
+	itemOrder := compareItem(items[index].item, theItem);
+
+        IF (itemOrder = equal) THEN
+          IF (items[index].count > 1) THEN
+            DEC(items[index].count);
+          ELSE
+
+            (*-- Remove the Item at index by shifting all items
+              -- above index down one position. Then adjust the length
+	      -- to account for the removal of the item. *)
+
+            WHILE (jndex < length) DO
+              INC(jndex);
+              items[jndex - 1] := items[jndex];
+            END (*--while*);
+            DEC(length);
+          END (*--if*);
+	  RETURN;
+
+	ELSIF (itemOrder = greater) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*--------------------*)
+
+PROCEDURE Union         (    left     : Bag    (*-- in    *);
+       	       	             right    : Bag    (*-- in    *);
+                         VAR toBag    : Bag    (*-- inout *));
+
+(*-- Compute the Bag containing all members of left and right.
+  -- x IN toBag iff (x IN left) OR (x IN right).
+  -- The toBag length is used as the running index for adding
+  -- the resulting items of the union.
+  -- The algorithm used is a variation on the array merge from
+  -- reference [1], pg. 414. *)
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+      assignItem  : AssignProc;  (*-- Item assignment routine *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(union, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(union, typeerror);
+    RETURN;
+  END (*--if*);
+
+  IF (toBag = NullBag) THEN
+    WITH left^ DO
+      IF (length + right^.length > MAX(BagSize)) THEN
+	RaiseErrIn(union, overflow);
+	RETURN;
+      END (*--if*);
+      toBag := Create(length + right^.length, dataID);
+      IF (toBag = NullBag) THEN
+	RETURN;
+      END (*--if*);
+    END (*--with*);
+  ELSIF (left^.length + right^.length > toBag^.size) THEN
+    RaiseErrIn(union, overflow);
+    RETURN;
+  ELSE
+    Clear(toBag);
+    toBag^.dataID := left^.dataID;
+  END (*--if*);
+
+  WITH toBag^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(BagSize);
+  rightIndex := MIN(BagSize);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex].item,
+	                 right^.items[rightIndex].item);
+    WITH toBag^ DO
+      INC(length);
+      WITH items[length] DO
+        IF (order = less) THEN
+          item := assignItem(left^.items[leftIndex].item);
+	  count:= left^.items[leftIndex].count;
+          INC(leftIndex);
+	ELSIF (order = equal) THEN
+          item := assignItem(left^.items[leftIndex].item);
+	  count:= left^.items[leftIndex].count +
+	          right^.items[rightIndex].count;
+          INC(leftIndex);
+          INC(rightIndex);
+        ELSE
+          item := assignItem(right^.items[rightIndex].item);
+	  count:= right^.items[rightIndex].count;
+          INC(rightIndex);
+        END (*--if*);
+      END (*--with*);
+    END (*--with*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from either the left bag or
+    -- the right bag to the destination bag. *)
+
+  IF (leftIndex > left^.length) THEN
+    CopySubset(union, right, rightIndex, toBag);
+  ELSIF (rightIndex > right^.length) THEN
+    CopySubset(union, left, leftIndex, toBag);
+  END (*--if*);
+END Union;
+(*--------------------*)
+
+PROCEDURE Intersection  (    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *);
+                         VAR toBag   : Bag      (*-- inout *));
+
+(*-- Compute the bag containing all members in both left and right.
+  -- x IN toBag iff (x IN left) AND (x IN right).
+  -- The toBag length is used as the running index for adding
+  -- the resulting items of the intersection. The count field for
+  -- any item added to the destination is the smaller of the two
+  -- count fields from the source bags. *)
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+      assignItem  : AssignProc;  (*-- Item assignment routine *)
+      largerLength: BagSize;	 (*-- Larger length of left & right bags *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(intersection, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(intersection, typeerror);
+    RETURN;
+  END (*--if*);
+
+  largerLength := Max(left^.length, right^.length);
+  IF (toBag = NullBag) THEN
+    toBag := Create(largerLength, left^.dataID);
+    IF (toBag = NullBag) THEN
+      RETURN;
+    END (*--if*);
+
+  ELSIF (largerLength > toBag^.size) THEN
+    RaiseErrIn(intersection, overflow);
+    RETURN;
+  ELSE
+    Clear(toBag);
+    toBag^.dataID := left^.dataID;
+  END (*--if*);
+
+  WITH toBag^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(BagSize);
+  rightIndex := MIN(BagSize);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex].item,
+                     right^.items[rightIndex].item);
+    IF (order = equal) THEN
+      WITH toBag^ DO
+	INC(length);
+	WITH items[length] DO
+          item := assignItem(left^.items[leftIndex].item);
+	  count:= MinCount(left^.items[leftIndex].count,
+	                   right^.items[rightIndex].count);
+	END (*--with*);
+      END (*--with*);
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      INC(leftIndex);
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+END Intersection;
+(*--------------------*)
+
+PROCEDURE Difference    (    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *);
+                         VAR toBag   : Bag      (*-- inout *));
+
+(*-- Compute the bag containing all members of left that are not
+  -- members of right. x IN toBag iff (x IN left) & ┬(x IN right)
+  -- If there is no match, then the item is added to the destination
+  -- bag. If there is a match, a positive difference between the
+  -- left and right bag counts for the item causes that value to
+  -- be used as the count for the new item. *)
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+      assignItem  : AssignProc;  (*-- Item assignment routine *)
+      largerLength: BagSize;	 (*-- Larger length of left & right bags *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(difference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(difference, typeerror);
+    RETURN;
+  END (*--if*);
+
+  largerLength := Max(left^.length, right^.length);
+  IF (toBag = NullBag) THEN
+    toBag := Create(largerLength, left^.dataID);
+    IF (toBag = NullBag) THEN
+      RETURN;
+    END (*--if*);
+
+  ELSIF (largerLength > toBag^.size) THEN
+    RaiseErrIn(intersection, overflow);
+    RETURN;
+  ELSE
+    Clear(toBag);
+    toBag^.dataID := left^.dataID;
+  END (*--if*);
+
+  WITH toBag^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(BagSize);
+  rightIndex := MIN(BagSize);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex].item,
+	                 right^.items[rightIndex].item);
+    IF (order = equal) THEN
+      IF (left^.items[leftIndex].count >
+	  right^.items[rightIndex].count) THEN
+	WITH toBag^ DO
+          INC(length);
+	  WITH items[length] DO
+            item  := assignItem(left^.items[leftIndex].item);
+	    count := left^.items[leftIndex].count - right^.items[rightIndex].count;
+          END (*--with*);
+        END (*--with*);
+      END (*--if*);
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      WITH toBag^ DO
+        INC(length);
+	WITH items[length] DO
+          item  := assignItem(left^.items[leftIndex].item);
+	  count := left^.items[leftIndex].count;
+        END (*--with*);
+      END (*--with*);
+      INC(leftIndex);
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from the left bag to the
+    -- destination bag. *)
+
+  CopySubset(difference, left, leftIndex, toBag);
+END Difference;
+(*--------------------*)
+
+PROCEDURE SymDifference (    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *);
+                         VAR toBag   : Bag      (*-- inout *));
+
+(*-- Compute the Bag containing all members of left or right that
+  -- are not members of both.
+  -- x IN toBag iff (x IN left) # (x IN right) *)
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+      assignItem  : AssignProc;  (*-- Item assignment routine *)
+      largerLength: BagSize;	 (*-- Larger length of left & right bags *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(symdifference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(symdifference, typeerror);
+    RETURN;
+  END (*--if*);
+
+  largerLength := Max(left^.length, right^.length);
+  IF (toBag = NullBag) THEN
+    toBag := Create(largerLength, left^.dataID);
+    IF (toBag = NullBag) THEN
+      RETURN;
+    END (*--if*);
+
+  ELSIF (largerLength > toBag^.size) THEN
+    RaiseErrIn(symdifference, overflow);
+    RETURN;
+  ELSE
+    Clear(toBag);
+    toBag^.dataID := left^.dataID;
+  END (*--if*);
+
+  WITH toBag^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(BagSize);
+  rightIndex := MIN(BagSize);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex].item,
+	                 right^.items[rightIndex].item);
+    IF (order = equal) THEN
+      IF (left^.items[leftIndex].count >
+	  right^.items[rightIndex].count) THEN
+	WITH toBag^ DO
+          INC(length);
+	  WITH items[length] DO
+            item  := assignItem(left^.items[leftIndex].item);
+	    count := left^.items[leftIndex].count - right^.items[rightIndex].count;
+          END (*--with*);
+        END (*--with*);
+      END (*--if*);
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSE
+      WITH toBag^ DO
+        IF (length < size) THEN
+          INC(length);
+        ELSE
+          RaiseErrIn(symdifference, overflow);
+          RETURN;
+        END (*--if*);
+        IF (order = less) THEN
+	  WITH items[length] DO
+            item  := assignItem(left^.items[leftIndex].item);
+	    count := left^.items[leftIndex].count;
+          END (*--with*);
+          INC(leftIndex);
+        ELSE
+	  WITH items[length] DO
+            item  := assignItem(right^.items[rightIndex].item);
+	    count := right^.items[rightIndex].count;
+          END (*--with*);
+          INC(rightIndex);
+        END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from either the left set or
+    -- the right set to the destination set. *)
+
+  IF (leftIndex > left^.length) THEN
+    CopySubset(symdifference, right, rightIndex, toBag);
+  ELSIF (rightIndex > right^.length) THEN
+    CopySubset(symdifference, left, leftIndex, toBag);
+  END (*--if*);
+END SymDifference;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theBag # NullBag;
+END IsDefined;
+(*--------------------*)
+
+PROCEDURE IsEmpty       (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN (theBag^.length = 0);
+  END (*--if*);
+
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*--------------------*)
+
+PROCEDURE SizeOf        (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.size;
+  END (*--if*);
+
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*--------------------*)
+
+PROCEDURE TypeOf        (    theBag  : Bag      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.dataID;
+  END (*--if*);
+
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*--------------------*)
+
+PROCEDURE IsEqual       (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   index   : CARDINAL;		(*-- Loop index over items *)
+	  compare : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.length = right^.length) THEN
+
+(*
+Scan both Bags looking for the first mismatch (inequality) indicating that the
+Bags are unequal. If the FOR loop completes then the Bags must be equal.
+*)
+	compare := CompareOf(left^.dataID);
+        FOR index := MIN(BagSize) TO left^.length DO
+          IF compare(left^.items[index].item, right^.items[index].item) # equal THEN
+            RETURN FALSE;
+	  ELSIF (left^.items[index].count # right^.items[index].count) THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--for*);
+        RETURN TRUE;
+      END (*--if*);
+    ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+
+  (*-- the Bags must be unequal, either by having different
+    -- lengths, mismatched types, or an undefined Bag exception. *)
+
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE NumMembers    (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+VAR   totalCount : CARDINAL;
+      index      : CARDINAL;
+
+BEGIN
+  bagError   := noerr;
+  totalCount := 0;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      FOR index := MIN(BagSize) TO length DO
+	INC(totalCount, items[index].count);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(nummembers, undefined);
+  END (*--if*);
+
+  RETURN totalCount;
+END NumMembers;
+(*----------------------------*)
+
+PROCEDURE UniqueMembers (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.length;
+  END (*--if*);
+
+  RaiseErrIn(uniquemembers, undefined);
+  RETURN 0;
+END UniqueMembers;
+(*----------------------------*)
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      compareItem := CompareOf(dataID);
+      FOR index := MIN(BagSize) TO length DO
+        IF (theItem = items[index].item) THEN
+          RETURN TRUE;
+	ELSE
+	  order := compareItem(items[index].item, theItem);
+          IF (order = greater) THEN
+	    RETURN FALSE;
+          END (*--if*);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+PROCEDURE NumberOf      (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      compareItem := CompareOf(dataID);
+      FOR index := MIN(BagSize) TO length DO
+        WITH items[index] DO
+          IF (theItem = item) THEN
+            RETURN count;
+	  ELSE
+	    order := compareItem(item, theItem);
+            IF (order = greater) THEN
+	      RETURN 0;
+            END (*--if*);
+          END (*--if*);
+	END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(numberof, undefined);
+  END (*--if*);
+
+  RETURN 0;
+END NumberOf;
+(*----------------------------*)
+
+PROCEDURE IsSubset      (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF (left^.dataID # right^.dataID) THEN
+      RaiseErrIn(issubset, typeerror);
+    ELSE
+
+      compareItem:= CompareOf(left^.dataID);
+      leftIndex  := MIN(BagSize);
+      rightIndex := MIN(BagSize);
+      WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+        order := compareItem(left^.items[leftIndex].item,
+             	        right^.items[rightIndex].item);
+        IF (order = equal) THEN
+	  IF (left^.items[leftIndex].count >
+	      right^.items[rightIndex].count) THEN
+	    RETURN FALSE;
+	  END (*--if*);
+	  INC(leftIndex);
+	  INC(rightIndex);
+	ELSIF (order = less) THEN
+	  RETURN FALSE;
+	ELSE
+	  INC(rightIndex);
+	END (*--if*);
+      END (*--while*);
+      RETURN (leftIndex > left^.length);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(issubset, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset(    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & (left^.length < right^.length);
+END IsProperSubset;
+(*----------------------------*)
+
+
+(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
+(*~~ MODULE INITIALIZATION  ~~*)
+
+BEGIN
+  FOR bagError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[bagError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  bagError := noerr;
+END BagSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBUI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBUI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBUI.DEF
@@ -0,0 +1,146 @@
+DEFINITION MODULE BagSBUI;
+(*==============================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Sequential Bounded Unmanaged Iterator
+
+    THE ABSTRACTION
+    This module supports the abstraction of the bag data type.
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins
+      Initial implementation derived from BagSBMI module. The
+	  TypeID is used for retrieval of an Item comparison routine.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item, Continue;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  Bag;
+TYPE  BagSize = [ 1 .. 5300 ];
+CONST NullBag = Bag(NIL);
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+CONST ModuleID = 5;
+
+PROCEDURE BagError    ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        (    theSize : BagSize     (*-- in    *);
+                             theType : TypeID      (*-- in    *))
+                                     : Bag         (*-- out   *);
+
+PROCEDURE Destroy       (VAR theBag  : Bag         (*-- inout *));
+
+PROCEDURE Clear         (VAR theBag  : Bag         (*-- inout *));
+
+PROCEDURE Assign        (    theBag  : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Include       (    theItem : Item        (*-- in    *);
+       	       	         VAR inBag   : Bag         (*-- inout *));
+
+PROCEDURE Exclude       (    theItem : Item        (*-- in    *);
+       	       	         VAR fromBag : Bag         (*-- inout *));
+
+PROCEDURE Union         (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Intersection  (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Difference    (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE SymDifference (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty       (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE SizeOf        (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf        (    theBag  : Bag      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+
+PROCEDURE NumMembers    (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE UniqueMembers (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE NumberOf      (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+
+    (*---------------------------------*)
+    (*--         ITERATORS           --*)
+
+TYPE  LoopAccessProc = PROCEDURE (Item, CARDINAL) : Continue;
+
+PROCEDURE LoopOver   (    theBag  : Bag            (*-- in    *);
+                          process : LoopAccessProc (*-- in    *));
+
+
+TYPE  AccessProc = PROCEDURE (Item, CARDINAL);
+
+PROCEDURE Traverse   (    theBag  : Bag            (*-- in    *);
+                          process : AccessProc     (*-- in    *));
+
+END BagSBUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBUI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBUI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBUI.MOD
@@ -0,0 +1,973 @@
+IMPLEMENTATION MODULE BagSBUI;
+(*==============================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Sequential Bounded Unmanaged Iterator
+    Code Size: R-  bytes
+
+    INTRODUCTION
+    This module provides the Bag ADT for generic Items.
+    Implements a Bag using an ordered array.
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins
+      Initial implementation derived from BagSBMI module. The
+	  TypeID is used for retrieval of an Item comparison routine.
+
+    (C) Copyright 1989 Charles A. Lins
+================================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) CompareOf;
+
+    (*--------------------*)
+
+TYPE  ItemNode = RECORD
+        item : Item;     (*-- the actual value *)
+		count: CARDINAL; (*-- number of times the value occurs *)
+      END (*-- ItemNode *);
+
+TYPE  ItemsArray = ARRAY BagSize OF ItemNode;
+TYPE  BoundedBag = RECORD
+		dataID : TypeID;     (*-- defined data type *)
+        size   : BagSize;    (*-- defined Bag size *)
+        length : CARDINAL;   (*-- current Bag length, := 0 *)
+        items  : ItemsArray; (*-- ordered array [1..size] of ItemNode *)
+      END (*-- BoundedBag *);
+
+TYPE  Bag = POINTER TO BoundedBag;
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+VAR   bagError  : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+PROCEDURE BagError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN bagError;
+END BagError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  bagError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--       LOCAL ROUTINES        --*)
+
+PROCEDURE CopySubset (    routine : Operations (*-- in    *);
+                          fromBag : Bag        (*-- in    *);
+                          index   : BagSize    (*-- in    *);
+                      VAR toBag   : Bag        (*-- inout *));
+BEGIN
+  WITH toBag^ DO
+    WHILE (index <= fromBag^.length) DO
+      INC(length);
+	  WITH items[length] DO
+        item  := fromBag^.items[index].item;
+	    count := fromBag^.items[index].count;
+      END (*--with*);
+      INC(index);
+    END (*--while*);
+  END (*--with*);
+END CopySubset;
+(*--------------------*)
+
+
+PROCEDURE MinCount      (    left     : CARDINAL  (*-- in    *);
+                             right    : CARDINAL  (*-- in    *))
+							          : CARDINAL  (*-- out   *);
+BEGIN
+  IF (left < right) THEN
+    RETURN left;
+  END (*--if*);
+  RETURN right;
+END MinCount;
+(*--------------------*)
+
+PROCEDURE Max (    left     : CARDINAL  (*--in   *);
+                   right    : CARDINAL  (*--in   *))
+							: CARDINAL  (*--out  *);
+BEGIN
+  IF (left > right) THEN
+    RETURN left;
+  END (*--if*);
+  RETURN right;
+END Max;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        (    theSize  : BagSize   (*-- in    *);
+                             theType  : TypeID    (*-- in    *))
+                                      : Bag       (*-- out   *);
+
+CONST staticSize = SIZE(BoundedBag) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(ItemNode);
+
+VAR   newBag : Bag;
+
+BEGIN
+  bagError := noerr;
+  Allocate(newBag, staticSize + itemSize * theSize);
+  IF (newBag = NullBag) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newBag^ DO
+	  dataID := theType;
+      size   := theSize;
+      length := 0;
+    END (*--with*);
+  END (*--if*);
+  RETURN newBag;
+END Create;
+(*--------------------*)
+
+PROCEDURE Destroy       (VAR theBag   : Bag       (*-- inout *));
+
+CONST staticSize = SIZE(BoundedBag) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(ItemNode);
+
+BEGIN
+  Clear(theBag);
+  IF (bagError = noerr) THEN
+    Deallocate(theBag, staticSize + itemSize * theBag^.size);
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+PROCEDURE Clear         (VAR theBag   : Bag    (*-- inout *));
+
+VAR   index    : CARDINAL;    (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+  	theBag^.length := 0;
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+PROCEDURE Assign        (    theBag   : Bag    (*-- in    *);
+                         VAR toBag    : Bag    (*-- inout *));
+
+  PROCEDURE Recreate () : BOOLEAN (*--out  *);
+  BEGIN
+    IF (toBag = NullBag) THEN
+      toBag := Create(theBag^.size, theBag^.dataID);
+    ELSIF (theBag^.length <= toBag^.size) THEN
+      Clear(toBag);
+	  toBag^.dataID := theBag^.dataID;
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    RETURN (bagError = noerr);
+  END Recreate;
+  (*--------------------*)
+
+VAR   index : CARDINAL;   (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    IF Recreate() THEN
+      WITH theBag^ DO
+        FOR index := MIN(BagSize) TO length DO
+		  WITH items[index] DO
+            toBag^.items[index].item := item;
+			toBag^.items[index].count:= count;
+		  END (*--with*);
+        END (*--for*);
+        toBag^.length := length;
+      END (*--with*);
+	END (*--if*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+PROCEDURE Include       (    theItem  : Item   (*-- in    *);
+       	       	         VAR inBag    : Bag    (*-- inout *));
+
+VAR   index       : CARDINAL; (*-- Loop index in search for theItem *)
+      jndex       : CARDINAL; (*-- Loop index in shifting items *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (inBag # NullBag) THEN
+    WITH inBag^ DO
+	  compareItem := CompareOf(dataID);
+      index := MIN(BagSize);
+      LOOP
+	    IF (index > length) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+		itemOrder := compareItem(items[index].item, theItem);
+
+        IF (itemOrder = equal) THEN
+		  INC(items[index].count);
+          RETURN;
+
+		ELSIF (itemOrder = greater) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+        INC(index);
+      END (*--loop*);
+
+      IF (length < size) THEN
+
+        (*-- Make room for new item at the current index *)
+
+        FOR jndex := length TO index BY -1 DO
+          items[jndex + 1] := items[jndex];
+        END (*--for*);
+
+        (*-- Insert the new item *)
+
+        INC(length);
+        WITH items[index] DO
+		  item := theItem;
+		  count:= 1;
+		END (*--with*);
+
+      ELSE
+        RaiseErrIn(include, overflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*--------------------*)
+
+PROCEDURE Exclude       (    theItem  : Item   (*-- in    *);
+       	       	         VAR fromBag  : Bag    (*-- inout *));
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+      jndex       : CARDINAL;    (*-- Loop index for item deletion *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (fromBag # NullBag) THEN
+    WITH fromBag^ DO
+	  compareItem := CompareOf(dataID);
+      FOR index := MIN(BagSize) TO length DO
+
+		itemOrder := compareItem(items[index].item, theItem);
+
+        IF (itemOrder = equal) THEN
+          IF (items[index].count > 1) THEN
+            DEC(items[index].count);
+          ELSE
+
+            (*-- Remove the Item at index by shifting all items
+              -- above index down one position. Then adjust the length
+		      -- to account for the removal of the item. *)
+
+            WHILE (jndex < length) DO
+              INC(jndex);
+              items[jndex - 1] := items[jndex];
+            END (*--while*);
+            DEC(length);
+          END (*--if*);
+		  RETURN;
+
+		ELSIF (itemOrder = greater) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*--------------------*)
+
+PROCEDURE Union         (    left     : Bag    (*-- in    *);
+       	       	             right    : Bag    (*-- in    *);
+                         VAR toBag    : Bag    (*-- inout *));
+
+(*-- Compute the Bag containing all members of left and right.
+  -- x IN toBag iff (x IN left) OR (x IN right).
+  -- The toBag length is used as the running index for adding
+  -- the resulting items of the union.
+  -- The algorithm used is a variation on the array merge from
+  -- reference [1], pg. 414. *)
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(union, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(union, typeerror);
+	RETURN;
+  END (*--if*);
+
+  IF (toBag = NullBag) THEN
+    WITH left^ DO
+  	  IF (length + right^.length > MAX(BagSize)) THEN
+	    RaiseErrIn(union, overflow);
+	    RETURN;
+	  END (*--if*);
+      toBag := Create(length + right^.length, dataID);
+	  IF (toBag = NullBag) THEN
+	    RETURN;
+	  END (*--if*);
+	END (*--with*);
+  ELSIF (left^.length + right^.length > toBag^.size) THEN
+	RaiseErrIn(union, overflow);
+	RETURN;
+  ELSE
+    Clear(toBag);
+    toBag^.dataID := left^.dataID;
+  END (*--if*);
+
+  compareItem := CompareOf(toBag^.dataID);
+
+  leftIndex  := MIN(BagSize);
+  rightIndex := MIN(BagSize);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex].item,
+	                     right^.items[rightIndex].item);
+	WITH toBag^ DO
+	  INC(length);
+	  WITH items[length] DO
+        IF (order = less) THEN
+          item := left^.items[leftIndex].item;
+		  count:= left^.items[leftIndex].count;
+          INC(leftIndex);
+	    ELSIF (order = equal) THEN
+          item := left^.items[leftIndex].item;
+		  count:= left^.items[leftIndex].count +
+		          right^.items[rightIndex].count;
+          INC(leftIndex);
+          INC(rightIndex);
+        ELSE
+          item := right^.items[rightIndex].item;
+		  count:= right^.items[rightIndex].count;
+          INC(rightIndex);
+        END (*--if*);
+      END (*--with*);
+    END (*--with*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from either the left bag or
+    -- the right bag to the destination bag. *)
+
+  IF (leftIndex > left^.length) THEN
+    CopySubset(union, right, rightIndex, toBag);
+  ELSIF (rightIndex > right^.length) THEN
+    CopySubset(union, left, leftIndex, toBag);
+  END (*--if*);
+END Union;
+(*--------------------*)
+
+PROCEDURE Intersection  (    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *);
+                         VAR toBag   : Bag      (*-- inout *));
+
+(*-- Compute the bag containing all members in both left and right.
+  -- x IN toBag iff (x IN left) AND (x IN right).
+  -- The toBag length is used as the running index for adding
+  -- the resulting items of the intersection. The count field for
+  -- any item added to the destination is the smaller of the two
+  -- count fields from the source bags. *)
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+	  largerLength: BagSize;	 (*-- Larger length of left & right bags *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(intersection, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(intersection, typeerror);
+	RETURN;
+  END (*--if*);
+  
+  largerLength := Max(left^.length, right^.length);
+  IF (toBag = NullBag) THEN
+    toBag := Create(largerLength, left^.dataID);
+	IF (toBag = NullBag) THEN
+	  RETURN;
+	END (*--if*);
+
+  ELSIF (largerLength > toBag^.size) THEN
+	RaiseErrIn(intersection, overflow);
+	RETURN;
+  ELSE
+    Clear(toBag);
+    toBag^.dataID := left^.dataID;
+  END (*--if*);
+
+  compareItem := CompareOf(toBag^.dataID);
+
+  leftIndex  := MIN(BagSize);
+  rightIndex := MIN(BagSize);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex].item,
+	                     right^.items[rightIndex].item);
+    IF (order = equal) THEN
+	  WITH toBag^ DO
+	    INC(length);
+		WITH items[length] DO
+          item := left^.items[leftIndex].item;
+		  count:= MinCount(left^.items[leftIndex].count,
+	                       right^.items[rightIndex].count);
+	    END (*--with*);
+	  END (*--with*);
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      INC(leftIndex);
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+END Intersection;
+(*--------------------*)
+
+PROCEDURE Difference    (    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *);
+                         VAR toBag   : Bag      (*-- inout *));
+
+(*-- Compute the bag containing all members of left that are not
+  -- members of right. x IN toBag iff (x IN left) & ┬(x IN right)
+  -- If there is no match, then the item is added to the destination
+  -- bag. If there is a match, a positive difference between the
+  -- left and right bag counts for the item causes that value to
+  -- be used as the count for the new item. *)
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+	  largerLength: BagSize;	 (*-- Larger length of left & right bags *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(difference, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(difference, typeerror);
+	RETURN;
+  END (*--if*);
+  
+  largerLength := Max(left^.length, right^.length);
+  IF (toBag = NullBag) THEN
+    toBag := Create(largerLength, left^.dataID);
+	IF (toBag = NullBag) THEN
+	  RETURN;
+	END (*--if*);
+
+  ELSIF (largerLength > toBag^.size) THEN
+	RaiseErrIn(intersection, overflow);
+	RETURN;
+  ELSE
+    Clear(toBag);
+    toBag^.dataID := left^.dataID;
+  END (*--if*);
+
+  compareItem := CompareOf(toBag^.dataID);
+
+  leftIndex  := MIN(BagSize);
+  rightIndex := MIN(BagSize);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex].item,
+	                     right^.items[rightIndex].item);
+    IF (order = equal) THEN
+	  IF (left^.items[leftIndex].count >
+	      right^.items[rightIndex].count) THEN
+	    WITH toBag^ DO
+          INC(length);
+	      WITH items[length] DO
+            item  := left^.items[leftIndex].item;
+		    count := left^.items[leftIndex].count - right^.items[rightIndex].count;
+          END (*--with*);
+        END (*--with*);
+	  END (*--if*);
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+	  WITH toBag^ DO
+        INC(length);
+	    WITH items[length] DO
+          item  := left^.items[leftIndex].item;
+		  count := left^.items[leftIndex].count;
+        END (*--with*);
+      END (*--with*);
+      INC(leftIndex);
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from the left bag to the
+    -- destination bag. *)
+
+  CopySubset(difference, left, leftIndex, toBag);
+END Difference;
+(*--------------------*)
+
+PROCEDURE SymDifference (    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *);
+                         VAR toBag   : Bag      (*-- inout *));
+
+(*-- Compute the Bag containing all members of left or right that
+  -- are not members of both.
+  -- x IN toBag iff (x IN left) # (x IN right) *)
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+	  largerLength: BagSize;	 (*-- Larger length of left & right bags *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(symdifference, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(symdifference, typeerror);
+	RETURN;
+  END (*--if*);
+  
+  largerLength := Max(left^.length, right^.length);
+  IF (toBag = NullBag) THEN
+    toBag := Create(largerLength, left^.dataID);
+	IF (toBag = NullBag) THEN
+	  RETURN;
+	END (*--if*);
+
+  ELSIF (largerLength > toBag^.size) THEN
+	RaiseErrIn(symdifference, overflow);
+	RETURN;
+  ELSE
+    Clear(toBag);
+    toBag^.dataID := left^.dataID;
+  END (*--if*);
+
+  compareItem := CompareOf(toBag^.dataID);
+
+  leftIndex  := MIN(BagSize);
+  rightIndex := MIN(BagSize);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex].item,
+	                     right^.items[rightIndex].item);
+    IF (order = equal) THEN
+	  IF (left^.items[leftIndex].count >
+	      right^.items[rightIndex].count) THEN
+	    WITH toBag^ DO
+          INC(length);
+	      WITH items[length] DO
+            item  := left^.items[leftIndex].item;
+		    count := left^.items[leftIndex].count - right^.items[rightIndex].count;
+          END (*--with*);
+        END (*--with*);
+	  END (*--if*);
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSE
+      WITH toBag^ DO
+        IF (length < size) THEN
+          INC(length);
+        ELSE
+          RaiseErrIn(symdifference, overflow);
+          RETURN;
+        END (*--if*);
+        IF (order = less) THEN
+	      WITH items[length] DO
+            item  := left^.items[leftIndex].item;
+			count := left^.items[leftIndex].count;
+          END (*--with*);
+          INC(leftIndex);
+        ELSE
+	      WITH items[length] DO
+            item  := right^.items[rightIndex].item;
+			count := right^.items[rightIndex].count;
+          END (*--with*);
+          INC(rightIndex);
+        END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from either the left set or
+    -- the right set to the destination set. *)
+
+  IF (leftIndex > left^.length) THEN
+    CopySubset(symdifference, right, rightIndex, toBag);
+  ELSIF (rightIndex > right^.length) THEN
+    CopySubset(symdifference, left, leftIndex, toBag);
+  END (*--if*);
+END SymDifference;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theBag # NullBag;
+END IsDefined;
+(*--------------------*)
+
+PROCEDURE IsEmpty       (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN (theBag^.length = 0);
+  END (*--if*);
+
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*--------------------*)
+
+PROCEDURE SizeOf        (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.size;
+  END (*--if*);
+
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*--------------------*)
+
+PROCEDURE TypeOf        (    theBag  : Bag      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.dataID;
+  END (*--if*);
+
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*--------------------*)
+
+PROCEDURE IsEqual       (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.length = right^.length) THEN
+
+(*
+Scan both Bags looking for the first mismatch (inequality) indicating that the
+Bags are unequal. If the FOR loop completes then the Bags must be equal.
+*)
+        FOR index := MIN(BagSize) TO left^.length DO
+          IF (left^.items[index].item # right^.items[index].item) THEN
+            RETURN FALSE;
+		  ELSIF (left^.items[index].count # right^.items[index].count) THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--for*);
+        RETURN TRUE;
+	  END (*--if*);
+	ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+
+  (*-- the Bags must be unequal, either by having different
+    -- lengths, mismatched types, or an undefined Bag exception. *)
+
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE NumMembers    (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+VAR   totalCount : CARDINAL;
+      index      : CARDINAL;
+
+BEGIN
+  bagError   := noerr;
+  totalCount := 0;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      FOR index := MIN(BagSize) TO length DO
+	    INC(totalCount, items[index].count);
+	  END (*--for*);
+	END (*--with*);
+  ELSE
+    RaiseErrIn(nummembers, undefined);
+  END (*--if*);
+
+  RETURN totalCount;
+END NumMembers;
+(*----------------------------*)
+
+PROCEDURE UniqueMembers (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.length;
+  END (*--if*);
+
+  RaiseErrIn(uniquemembers, undefined);
+  RETURN 0;
+END UniqueMembers;
+(*----------------------------*)
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+	  compareItem := CompareOf(dataID);
+      FOR index := MIN(BagSize) TO length DO
+        IF (theItem = items[index].item) THEN
+          RETURN TRUE;
+		ELSE
+	      order := compareItem(items[index].item, theItem);
+          IF (order = greater) THEN
+		    RETURN FALSE;
+          END (*--if*);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+PROCEDURE NumberOf      (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+	  compareItem := CompareOf(dataID);
+      FOR index := MIN(BagSize) TO length DO
+        WITH items[index] DO
+          IF (theItem = item) THEN
+            RETURN count;
+		  ELSE
+	        order := compareItem(item, theItem);
+            IF (order = greater) THEN
+		      RETURN 0;
+            END (*--if*);
+          END (*--if*);
+		END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(numberof, undefined);
+  END (*--if*);
+
+  RETURN 0;
+END NumberOf;
+(*----------------------------*)
+
+PROCEDURE IsSubset      (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF (left^.dataID # right^.dataID) THEN
+      RaiseErrIn(issubset, typeerror);
+    ELSE
+
+	  compareItem:= CompareOf(left^.dataID);
+	  leftIndex  := MIN(BagSize);
+	  rightIndex := MIN(BagSize);
+	  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+	    order := compareItem(left^.items[leftIndex].item,
+	             	        right^.items[rightIndex].item);
+	    IF (order = equal) THEN
+		  IF (left^.items[leftIndex].count >
+		      right^.items[rightIndex].count) THEN
+	        RETURN FALSE;
+	      END (*--if*);
+	      INC(leftIndex);
+	      INC(rightIndex);
+	    ELSIF (order = less) THEN
+	      RETURN FALSE;
+	    ELSE
+	      INC(rightIndex);
+	    END (*--if*);
+	  END (*--while*);
+	  RETURN (leftIndex > left^.length);
+	END (*--if*);
+  ELSE
+    RaiseErrIn(issubset, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset(    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & (left^.length < right^.length);
+END IsProperSubset;
+(*----------------------------*)
+
+
+    (*---------------------------------*)
+    (*--         ITERATORS           --*)
+
+PROCEDURE LoopOver   (    theBag  : Bag            (*-- in    *);
+                          process : LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      FOR index := MIN(BagSize) TO length DO
+	    WITH items[index] DO
+          IF ~process(item, count) THEN
+            RETURN;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE Traverse   (    theBag  : Bag            (*-- in    *);
+                          process : AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      FOR index := MIN(BagSize) TO length DO
+	    WITH items[index] DO
+          process(item, count);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+
+(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
+(*~~ MODULE INITIALIZATION  ~~*)
+
+BEGIN
+  FOR bagError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[bagError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  bagError := noerr;
+END BagSBUI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBUN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBUN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBUN.DEF
@@ -0,0 +1,131 @@
+DEFINITION MODULE BagSBUN;
+(*==============================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Sequential Bounded Unmanaged Non-Iterator
+
+    THE ABSTRACTION
+    This module supports the abstraction of the bag data type.
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins
+      Initial implementation derived from BagSBUI module. The
+	  TypeID is used for retrieval of an Item comparison routine.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  Bag;
+TYPE  BagSize = [ 1 .. 5300 ];
+CONST NullBag = Bag(NIL);
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+CONST ModuleID = 6;
+
+PROCEDURE BagError    ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        (    theSize : BagSize     (*-- in    *);
+                             theType : TypeID      (*-- in    *))
+                                     : Bag         (*-- out   *);
+
+PROCEDURE Destroy       (VAR theBag  : Bag         (*-- inout *));
+
+PROCEDURE Clear         (VAR theBag  : Bag         (*-- inout *));
+
+PROCEDURE Assign        (    theBag  : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Include       (    theItem : Item        (*-- in    *);
+       	       	         VAR inBag   : Bag         (*-- inout *));
+
+PROCEDURE Exclude       (    theItem : Item        (*-- in    *);
+       	       	         VAR fromBag : Bag         (*-- inout *));
+
+PROCEDURE Union         (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Intersection  (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE Difference    (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+PROCEDURE SymDifference (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty       (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE SizeOf        (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf        (    theBag  : Bag      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+
+PROCEDURE NumMembers    (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE UniqueMembers (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE NumberOf      (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+END BagSBUN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBUN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBUN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSBUN.MOD
@@ -0,0 +1,925 @@
+IMPLEMENTATION MODULE BagSBUN;
+(*==============================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Sequential Bounded Unmanaged Non-Iterator
+    Code Size: R-  bytes
+
+    INTRODUCTION
+    This module provides the Bag ADT for generic Items.
+    Implements a Bag using an ordered array.
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins
+      Initial implementation derived from BagSBUI module. The
+	  TypeID is used for retrieval of an Item comparison routine.
+
+    (C) Copyright 1989 Charles A. Lins
+================================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) CompareOf;
+
+    (*--------------------*)
+
+TYPE  ItemNode = RECORD
+        item : Item;     (*-- the actual value *)
+		count: CARDINAL; (*-- number of times the value occurs *)
+      END (*-- ItemNode *);
+
+TYPE  ItemsArray = ARRAY BagSize OF ItemNode;
+TYPE  BoundedBag = RECORD
+		dataID : TypeID;     (*-- defined data type *)
+        size   : BagSize;    (*-- defined Bag size *)
+        length : CARDINAL;   (*-- current Bag length, := 0 *)
+        items  : ItemsArray; (*-- ordered array [1..size] of ItemNode *)
+      END (*-- BoundedBag *);
+
+TYPE  Bag = POINTER TO BoundedBag;
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+VAR   bagError  : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+PROCEDURE BagError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN bagError;
+END BagError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  bagError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--       LOCAL ROUTINES        --*)
+
+PROCEDURE CopySubset (    routine : Operations (*-- in    *);
+                          fromBag : Bag        (*-- in    *);
+                          index   : BagSize    (*-- in    *);
+                      VAR toBag   : Bag        (*-- inout *));
+BEGIN
+  WITH toBag^ DO
+    WHILE (index <= fromBag^.length) DO
+      INC(length);
+	  WITH items[length] DO
+        item  := fromBag^.items[index].item;
+	    count := fromBag^.items[index].count;
+      END (*--with*);
+      INC(index);
+    END (*--while*);
+  END (*--with*);
+END CopySubset;
+(*--------------------*)
+
+
+PROCEDURE MinCount      (    left     : CARDINAL  (*-- in    *);
+                             right    : CARDINAL  (*-- in    *))
+							          : CARDINAL  (*-- out   *);
+BEGIN
+  IF (left < right) THEN
+    RETURN left;
+  END (*--if*);
+  RETURN right;
+END MinCount;
+(*--------------------*)
+
+PROCEDURE Max (    left     : CARDINAL  (*--in   *);
+                   right    : CARDINAL  (*--in   *))
+							: CARDINAL  (*--out  *);
+BEGIN
+  IF (left > right) THEN
+    RETURN left;
+  END (*--if*);
+  RETURN right;
+END Max;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        (    theSize  : BagSize   (*-- in    *);
+                             theType  : TypeID    (*-- in    *))
+                                      : Bag       (*-- out   *);
+
+CONST staticSize = SIZE(BoundedBag) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(ItemNode);
+
+VAR   newBag : Bag;
+
+BEGIN
+  bagError := noerr;
+  Allocate(newBag, staticSize + itemSize * theSize);
+  IF (newBag = NullBag) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newBag^ DO
+	  dataID := theType;
+      size   := theSize;
+      length := 0;
+    END (*--with*);
+  END (*--if*);
+  RETURN newBag;
+END Create;
+(*--------------------*)
+
+PROCEDURE Destroy       (VAR theBag   : Bag       (*-- inout *));
+
+CONST staticSize = SIZE(BoundedBag) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(ItemNode);
+
+BEGIN
+  Clear(theBag);
+  IF (bagError = noerr) THEN
+    Deallocate(theBag, staticSize + itemSize * theBag^.size);
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+PROCEDURE Clear         (VAR theBag   : Bag    (*-- inout *));
+
+VAR   index    : CARDINAL;    (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+  	theBag^.length := 0;
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+PROCEDURE Assign        (    theBag   : Bag    (*-- in    *);
+                         VAR toBag    : Bag    (*-- inout *));
+
+  PROCEDURE Recreate () : BOOLEAN (*--out  *);
+  BEGIN
+    IF (toBag = NullBag) THEN
+      toBag := Create(theBag^.size, theBag^.dataID);
+    ELSIF (theBag^.length <= toBag^.size) THEN
+      Clear(toBag);
+	  toBag^.dataID := theBag^.dataID;
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    RETURN (bagError = noerr);
+  END Recreate;
+  (*--------------------*)
+
+VAR   index : CARDINAL;   (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    IF Recreate() THEN
+      WITH theBag^ DO
+        FOR index := MIN(BagSize) TO length DO
+		  WITH items[index] DO
+            toBag^.items[index].item := item;
+			toBag^.items[index].count:= count;
+		  END (*--with*);
+        END (*--for*);
+        toBag^.length := length;
+      END (*--with*);
+	END (*--if*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+PROCEDURE Include       (    theItem  : Item   (*-- in    *);
+       	       	         VAR inBag    : Bag    (*-- inout *));
+
+VAR   index       : CARDINAL; (*-- Loop index in search for theItem *)
+      jndex       : CARDINAL; (*-- Loop index in shifting items *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (inBag # NullBag) THEN
+    WITH inBag^ DO
+	  compareItem := CompareOf(dataID);
+      index := MIN(BagSize);
+      LOOP
+	    IF (index > length) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+		itemOrder := compareItem(items[index].item, theItem);
+
+        IF (itemOrder = equal) THEN
+		  INC(items[index].count);
+          RETURN;
+
+		ELSIF (itemOrder = greater) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+        INC(index);
+      END (*--loop*);
+
+      IF (length < size) THEN
+
+        (*-- Make room for new item at the current index *)
+
+        FOR jndex := length TO index BY -1 DO
+          items[jndex + 1] := items[jndex];
+        END (*--for*);
+
+        (*-- Insert the new item *)
+
+        INC(length);
+        WITH items[index] DO
+		  item := theItem;
+		  count:= 1;
+		END (*--with*);
+
+      ELSE
+        RaiseErrIn(include, overflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*--------------------*)
+
+PROCEDURE Exclude       (    theItem  : Item   (*-- in    *);
+       	       	         VAR fromBag  : Bag    (*-- inout *));
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+      jndex       : CARDINAL;    (*-- Loop index for item deletion *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (fromBag # NullBag) THEN
+    WITH fromBag^ DO
+	  compareItem := CompareOf(dataID);
+      FOR index := MIN(BagSize) TO length DO
+
+		itemOrder := compareItem(items[index].item, theItem);
+
+        IF (itemOrder = equal) THEN
+          IF (items[index].count > 1) THEN
+            DEC(items[index].count);
+          ELSE
+
+            (*-- Remove the Item at index by shifting all items
+              -- above index down one position. Then adjust the length
+		      -- to account for the removal of the item. *)
+
+            WHILE (jndex < length) DO
+              INC(jndex);
+              items[jndex - 1] := items[jndex];
+            END (*--while*);
+            DEC(length);
+          END (*--if*);
+		  RETURN;
+
+		ELSIF (itemOrder = greater) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*--------------------*)
+
+PROCEDURE Union         (    left     : Bag    (*-- in    *);
+       	       	             right    : Bag    (*-- in    *);
+                         VAR toBag    : Bag    (*-- inout *));
+
+(*-- Compute the Bag containing all members of left and right.
+  -- x IN toBag iff (x IN left) OR (x IN right).
+  -- The toBag length is used as the running index for adding
+  -- the resulting items of the union.
+  -- The algorithm used is a variation on the array merge from
+  -- reference [1], pg. 414. *)
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(union, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(union, typeerror);
+	RETURN;
+  END (*--if*);
+
+  IF (toBag = NullBag) THEN
+    WITH left^ DO
+  	  IF (length + right^.length > MAX(BagSize)) THEN
+	    RaiseErrIn(union, overflow);
+	    RETURN;
+	  END (*--if*);
+      toBag := Create(length + right^.length, dataID);
+	  IF (toBag = NullBag) THEN
+	    RETURN;
+	  END (*--if*);
+	END (*--with*);
+  ELSIF (left^.length + right^.length > toBag^.size) THEN
+	RaiseErrIn(union, overflow);
+	RETURN;
+  ELSE
+    Clear(toBag);
+    toBag^.dataID := left^.dataID;
+  END (*--if*);
+
+  compareItem := CompareOf(toBag^.dataID);
+
+  leftIndex  := MIN(BagSize);
+  rightIndex := MIN(BagSize);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex].item,
+	                     right^.items[rightIndex].item);
+	WITH toBag^ DO
+	  INC(length);
+	  WITH items[length] DO
+        IF (order = less) THEN
+          item := left^.items[leftIndex].item;
+		  count:= left^.items[leftIndex].count;
+          INC(leftIndex);
+	    ELSIF (order = equal) THEN
+          item := left^.items[leftIndex].item;
+		  count:= left^.items[leftIndex].count +
+		          right^.items[rightIndex].count;
+          INC(leftIndex);
+          INC(rightIndex);
+        ELSE
+          item := right^.items[rightIndex].item;
+		  count:= right^.items[rightIndex].count;
+          INC(rightIndex);
+        END (*--if*);
+      END (*--with*);
+    END (*--with*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from either the left bag or
+    -- the right bag to the destination bag. *)
+
+  IF (leftIndex > left^.length) THEN
+    CopySubset(union, right, rightIndex, toBag);
+  ELSIF (rightIndex > right^.length) THEN
+    CopySubset(union, left, leftIndex, toBag);
+  END (*--if*);
+END Union;
+(*--------------------*)
+
+PROCEDURE Intersection  (    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *);
+                         VAR toBag   : Bag      (*-- inout *));
+
+(*-- Compute the bag containing all members in both left and right.
+  -- x IN toBag iff (x IN left) AND (x IN right).
+  -- The toBag length is used as the running index for adding
+  -- the resulting items of the intersection. The count field for
+  -- any item added to the destination is the smaller of the two
+  -- count fields from the source bags. *)
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+	  largerLength: BagSize;	 (*-- Larger length of left & right bags *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(intersection, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(intersection, typeerror);
+	RETURN;
+  END (*--if*);
+  
+  largerLength := Max(left^.length, right^.length);
+  IF (toBag = NullBag) THEN
+    toBag := Create(largerLength, left^.dataID);
+	IF (toBag = NullBag) THEN
+	  RETURN;
+	END (*--if*);
+
+  ELSIF (largerLength > toBag^.size) THEN
+	RaiseErrIn(intersection, overflow);
+	RETURN;
+  ELSE
+    Clear(toBag);
+    toBag^.dataID := left^.dataID;
+  END (*--if*);
+
+  compareItem := CompareOf(toBag^.dataID);
+
+  leftIndex  := MIN(BagSize);
+  rightIndex := MIN(BagSize);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex].item,
+	                     right^.items[rightIndex].item);
+    IF (order = equal) THEN
+	  WITH toBag^ DO
+	    INC(length);
+		WITH items[length] DO
+          item := left^.items[leftIndex].item;
+		  count:= MinCount(left^.items[leftIndex].count,
+	                       right^.items[rightIndex].count);
+	    END (*--with*);
+	  END (*--with*);
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      INC(leftIndex);
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+END Intersection;
+(*--------------------*)
+
+PROCEDURE Difference    (    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *);
+                         VAR toBag   : Bag      (*-- inout *));
+
+(*-- Compute the bag containing all members of left that are not
+  -- members of right. x IN toBag iff (x IN left) & ┬(x IN right)
+  -- If there is no match, then the item is added to the destination
+  -- bag. If there is a match, a positive difference between the
+  -- left and right bag counts for the item causes that value to
+  -- be used as the count for the new item. *)
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+	  largerLength: BagSize;	 (*-- Larger length of left & right bags *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(difference, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(difference, typeerror);
+	RETURN;
+  END (*--if*);
+  
+  largerLength := Max(left^.length, right^.length);
+  IF (toBag = NullBag) THEN
+    toBag := Create(largerLength, left^.dataID);
+	IF (toBag = NullBag) THEN
+	  RETURN;
+	END (*--if*);
+
+  ELSIF (largerLength > toBag^.size) THEN
+	RaiseErrIn(intersection, overflow);
+	RETURN;
+  ELSE
+    Clear(toBag);
+    toBag^.dataID := left^.dataID;
+  END (*--if*);
+
+  compareItem := CompareOf(toBag^.dataID);
+
+  leftIndex  := MIN(BagSize);
+  rightIndex := MIN(BagSize);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex].item,
+	                     right^.items[rightIndex].item);
+    IF (order = equal) THEN
+	  IF (left^.items[leftIndex].count >
+	      right^.items[rightIndex].count) THEN
+	    WITH toBag^ DO
+          INC(length);
+	      WITH items[length] DO
+            item  := left^.items[leftIndex].item;
+		    count := left^.items[leftIndex].count - right^.items[rightIndex].count;
+          END (*--with*);
+        END (*--with*);
+	  END (*--if*);
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+	  WITH toBag^ DO
+        INC(length);
+	    WITH items[length] DO
+          item  := left^.items[leftIndex].item;
+		  count := left^.items[leftIndex].count;
+        END (*--with*);
+      END (*--with*);
+      INC(leftIndex);
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from the left bag to the
+    -- destination bag. *)
+
+  CopySubset(difference, left, leftIndex, toBag);
+END Difference;
+(*--------------------*)
+
+PROCEDURE SymDifference (    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *);
+                         VAR toBag   : Bag      (*-- inout *));
+
+(*-- Compute the Bag containing all members of left or right that
+  -- are not members of both.
+  -- x IN toBag iff (x IN left) # (x IN right) *)
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+	  largerLength: BagSize;	 (*-- Larger length of left & right bags *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(symdifference, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(symdifference, typeerror);
+	RETURN;
+  END (*--if*);
+  
+  largerLength := Max(left^.length, right^.length);
+  IF (toBag = NullBag) THEN
+    toBag := Create(largerLength, left^.dataID);
+	IF (toBag = NullBag) THEN
+	  RETURN;
+	END (*--if*);
+
+  ELSIF (largerLength > toBag^.size) THEN
+	RaiseErrIn(symdifference, overflow);
+	RETURN;
+  ELSE
+    Clear(toBag);
+    toBag^.dataID := left^.dataID;
+  END (*--if*);
+
+  compareItem := CompareOf(toBag^.dataID);
+
+  leftIndex  := MIN(BagSize);
+  rightIndex := MIN(BagSize);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex].item,
+	                     right^.items[rightIndex].item);
+    IF (order = equal) THEN
+	  IF (left^.items[leftIndex].count >
+	      right^.items[rightIndex].count) THEN
+	    WITH toBag^ DO
+          INC(length);
+	      WITH items[length] DO
+            item  := left^.items[leftIndex].item;
+		    count := left^.items[leftIndex].count - right^.items[rightIndex].count;
+          END (*--with*);
+        END (*--with*);
+	  END (*--if*);
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSE
+      WITH toBag^ DO
+        IF (length < size) THEN
+          INC(length);
+        ELSE
+          RaiseErrIn(symdifference, overflow);
+          RETURN;
+        END (*--if*);
+        IF (order = less) THEN
+	      WITH items[length] DO
+            item  := left^.items[leftIndex].item;
+			count := left^.items[leftIndex].count;
+          END (*--with*);
+          INC(leftIndex);
+        ELSE
+	      WITH items[length] DO
+            item  := right^.items[rightIndex].item;
+			count := right^.items[rightIndex].count;
+          END (*--with*);
+          INC(rightIndex);
+        END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from either the left set or
+    -- the right set to the destination set. *)
+
+  IF (leftIndex > left^.length) THEN
+    CopySubset(symdifference, right, rightIndex, toBag);
+  ELSIF (rightIndex > right^.length) THEN
+    CopySubset(symdifference, left, leftIndex, toBag);
+  END (*--if*);
+END SymDifference;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theBag # NullBag;
+END IsDefined;
+(*--------------------*)
+
+PROCEDURE IsEmpty       (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN (theBag^.length = 0);
+  END (*--if*);
+
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*--------------------*)
+
+PROCEDURE SizeOf        (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.size;
+  END (*--if*);
+
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*--------------------*)
+
+PROCEDURE TypeOf        (    theBag  : Bag      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.dataID;
+  END (*--if*);
+
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*--------------------*)
+
+PROCEDURE IsEqual       (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.length = right^.length) THEN
+
+(*
+Scan both Bags looking for the first mismatch (inequality) indicating that the
+Bags are unequal. If the FOR loop completes then the Bags must be equal.
+*)
+        FOR index := MIN(BagSize) TO left^.length DO
+          IF (left^.items[index].item # right^.items[index].item) THEN
+            RETURN FALSE;
+		  ELSIF (left^.items[index].count # right^.items[index].count) THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--for*);
+        RETURN TRUE;
+	  END (*--if*);
+	ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+
+  (*-- the Bags must be unequal, either by having different
+    -- lengths, mismatched types, or an undefined Bag exception. *)
+
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE NumMembers    (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+VAR   totalCount : CARDINAL;
+      index      : CARDINAL;
+
+BEGIN
+  bagError   := noerr;
+  totalCount := 0;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+      FOR index := MIN(BagSize) TO length DO
+	    INC(totalCount, items[index].count);
+	  END (*--for*);
+	END (*--with*);
+  ELSE
+    RaiseErrIn(nummembers, undefined);
+  END (*--if*);
+
+  RETURN totalCount;
+END NumMembers;
+(*----------------------------*)
+
+PROCEDURE UniqueMembers (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.length;
+  END (*--if*);
+
+  RaiseErrIn(uniquemembers, undefined);
+  RETURN 0;
+END UniqueMembers;
+(*----------------------------*)
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+	  compareItem := CompareOf(dataID);
+      FOR index := MIN(BagSize) TO length DO
+        IF (theItem = items[index].item) THEN
+          RETURN TRUE;
+		ELSE
+	      order := compareItem(items[index].item, theItem);
+          IF (order = greater) THEN
+		    RETURN FALSE;
+          END (*--if*);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+PROCEDURE NumberOf      (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+	  compareItem := CompareOf(dataID);
+      FOR index := MIN(BagSize) TO length DO
+        WITH items[index] DO
+          IF (theItem = item) THEN
+            RETURN count;
+		  ELSE
+	        order := compareItem(item, theItem);
+            IF (order = greater) THEN
+		      RETURN 0;
+            END (*--if*);
+          END (*--if*);
+		END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(numberof, undefined);
+  END (*--if*);
+
+  RETURN 0;
+END NumberOf;
+(*----------------------------*)
+
+PROCEDURE IsSubset      (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left bag *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right bag *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF (left^.dataID # right^.dataID) THEN
+      RaiseErrIn(issubset, typeerror);
+    ELSE
+
+	  compareItem:= CompareOf(left^.dataID);
+	  leftIndex  := MIN(BagSize);
+	  rightIndex := MIN(BagSize);
+	  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+	    order := compareItem(left^.items[leftIndex].item,
+	             	        right^.items[rightIndex].item);
+	    IF (order = equal) THEN
+		  IF (left^.items[leftIndex].count >
+		      right^.items[rightIndex].count) THEN
+	        RETURN FALSE;
+	      END (*--if*);
+	      INC(leftIndex);
+	      INC(rightIndex);
+	    ELSIF (order = less) THEN
+	      RETURN FALSE;
+	    ELSE
+	      INC(rightIndex);
+	    END (*--if*);
+	  END (*--while*);
+	  RETURN (leftIndex > left^.length);
+	END (*--if*);
+  ELSE
+    RaiseErrIn(issubset, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset(    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & (left^.length < right^.length);
+END IsProperSubset;
+(*----------------------------*)
+
+
+(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
+(*~~ MODULE INITIALIZATION  ~~*)
+
+BEGIN
+  FOR bagError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[bagError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  bagError := noerr;
+END BagSBUN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUMI.DEF
@@ -0,0 +1,139 @@
+DEFINITION MODULE BagSUMI;
+(*==============================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Sequential Unbounded Managed Iterator
+
+    INTRODUCTION
+    This module provides the Bag ADT for generic Items.
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+================================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item, Continue;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  Bag;
+CONST NullBag = Bag(NIL);
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+CONST ModuleID = 7;
+
+PROCEDURE BagError    ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        (    theType : TypeID (*-- in    *))
+                                     : Bag    (*-- out   *);
+
+PROCEDURE Destroy       (VAR theBag  : Bag    (*-- inout *));
+
+PROCEDURE Clear         (VAR theBag  : Bag    (*-- inout *));
+
+PROCEDURE Assign        (    theBag  : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+PROCEDURE Include       (    theItem : Item   (*-- in    *);
+       	       	         VAR inBag   : Bag    (*-- inout *));
+
+PROCEDURE Exclude       (    theItem : Item   (*-- in    *);
+       	       	         VAR fromBag : Bag    (*-- inout *));
+
+PROCEDURE Union         (    left    : Bag    (*-- in    *);
+       	       	             right   : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+PROCEDURE Intersection  (    left    : Bag    (*-- in    *);
+       	       	             right   : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+PROCEDURE Difference    (    left    : Bag    (*-- in    *);
+       	       	             right   : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+PROCEDURE SymDifference (    left    : Bag    (*-- in    *);
+       	       	             right   : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty       (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE TypeOf        (    theBag  : Bag      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+
+PROCEDURE NumMembers    (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE UniqueMembers (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE NumberOf      (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+
+    (*---------------------------------*)
+    (*--         ITERATORS           --*)
+
+TYPE  LoopAccessProc = PROCEDURE (Item, CARDINAL) : Continue;
+
+PROCEDURE LoopOver   (    theBag  : Bag            (*-- in    *);
+                          process : LoopAccessProc (*-- in    *));
+
+
+TYPE  AccessProc = PROCEDURE (Item, CARDINAL);
+
+PROCEDURE Traverse   (    theBag  : Bag            (*-- in    *);
+                          process : AccessProc     (*-- in    *));
+
+END BagSUMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUMI.MOD
@@ -0,0 +1,1074 @@
+IMPLEMENTATION MODULE BagSUMI;
+(*==============================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Sequential Unbounded Managed Iterator
+    Code Size: R-  bytes
+
+    INTRODUCTION
+    This module provides the Bag ADT for generic Items. Uses an
+	ordered, linear list for the items.
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins
+        Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+================================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, CompareOf, DisposeOf;
+
+    (*--------------------*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD      (*-- a bag item node *)
+        item : Item;     (*-- the item nodes' data *)
+		count: CARDINAL; (*-- number of these items *)
+		next : Link;     (*-- link to next node in list *)
+	  END (*-- Node *);
+CONST NullLink = NIL;
+
+TYPE  UnboundedBag = RECORD (*-- bag header *)
+		dataID : TypeID;    (*-- defined data type *)
+        length : CARDINAL;  (*-- current bag length, := 0 *)
+        first  : Link;      (*-- link to first Item node *)
+      END (*-- UnboundedBag *);
+
+TYPE  Bag = POINTER TO UnboundedBag;
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+VAR   bagError  : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+PROCEDURE BagError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN bagError;
+END BagError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  bagError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--       LOCAL ROUTINES        --*)
+
+VAR   bagRoutine : Operations;  (*-- Routine calling NewNode *)
+VAR   assignItem : AssignProc;  (*-- Item assignment routine *)
+
+PROCEDURE NewNode       (    theItem : Item        (*-- in    *);
+       	       	             theCount: CARDINAL    (*-- in    *);
+       	       	             theNext : Link        (*-- in    *))
+							         : Link        (*-- out   *);
+
+VAR   newLink : Link;
+
+BEGIN
+  Allocate(newLink, SIZE(Node));
+  IF (newLink = NullLink) THEN
+    RaiseErrIn(bagRoutine, overflow);
+  ELSE
+    WITH newLink^ DO
+	  item  := assignItem(theItem);
+	  count := theCount;
+	  next  := theNext;
+	END (*--with*);
+  END (*--if*);
+  RETURN newLink;
+END NewNode;
+(*--------------------*)
+
+PROCEDURE TailInsert (    theNode : Link (*--in   *);
+					  VAR first   : Link (*--inout*);
+					  VAR last    : Link (*--inout*));
+BEGIN
+  IF (first = NullLink) THEN
+	first := theNode;
+  ELSE
+	last^.next := theNode;
+  END (*--if*);
+  last := theNode;
+END TailInsert;
+(*--------------------*)
+
+PROCEDURE CopySubset (    fromIndex  : Link       (*-- in    *);
+                          toIndex    : Link       (*-- in    *);
+                      VAR toBag      : Bag        (*-- inout *));
+
+VAR   tempNode : Link;
+
+BEGIN
+  LOOP
+    IF (fromIndex = NullLink) THEN
+	  EXIT (*--loop*);
+	ELSE
+	  WITH fromIndex^ DO
+	    tempNode := NewNode(item, count, NIL);
+	  END (*--with*);
+	  IF (tempNode = NullLink) THEN
+	    EXIT (*--loop*);
+	  END (*--if*);
+	  INC(toBag^.length);
+	  TailInsert(tempNode, toBag^.first, toIndex);
+      fromIndex := fromIndex^.next;
+	END (*--if*);
+  END (*--loop*);
+END CopySubset;
+(*--------------------*)
+
+PROCEDURE Recreate (VAR theBag  : Bag       (*--inout*);
+                        theType : TypeID    (*--in   *))
+                                : BOOLEAN   (*--out  *);
+BEGIN
+  IF (theBag = NullBag) THEN
+    theBag := Create(theType);
+  ELSE
+    Clear(theBag);
+    theBag^.dataID := theType;
+  END (*--if*);
+  RETURN (bagError = noerr);
+END Recreate;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        (    theType  : TypeID    (*-- in    *))
+                                      : Bag       (*-- out   *);
+
+(*-- Attempt to create a new bag variable of the given type.
+  -- Algorithm:
+  --  attempt to create the header for the bag
+  --  if successful
+  --    attempt to add the header to the list of valid bags
+  --    if successful
+  --      initialize the bag header, and
+  --      return the new bag
+  --    otherwise, release the bag header
+  --    fi
+  --  fi
+  --  raise the overflow exception
+  -- end. *)
+
+VAR   newBag : Bag; (*-- new bag variable being created *)
+
+BEGIN
+  bagError := noerr;
+  Allocate(newBag, SIZE(UnboundedBag));
+  IF (newBag = NullBag) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newBag^ DO
+	  dataID := theType;
+      length := 0;
+	  first  := NullLink;
+    END (*--with*);
+  END (*--if*);
+  RETURN newBag;
+END Create;
+(*--------------------*)
+
+PROCEDURE Destroy       (VAR theBag   : Bag       (*-- inout *));
+
+(*-- Destroy a previously created bag.
+  -- Algorithm:
+  -- clear the bag of existing nodes and their items, setting the
+  -- bag error flag to ╥noerr╙ if the bag is defined
+  -- if successful
+  --   remove the bag from the list of valid bags, and
+  --   release the dynamically allocated space used by the header
+  -- fi
+  -- end. *)
+
+BEGIN
+  Clear(theBag);
+  IF (bagError = noerr) THEN
+    Deallocate(theBag, SIZE(UnboundedBag));
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+PROCEDURE Clear         (VAR theBag   : Bag       (*-- inout *));
+
+(*-- Remove all nodes and items from a previously created bag.
+  -- Algorithm:
+  -- if the bag has been defined
+  --   retrieve the item disposal routine for the bags' data type
+  --   loop through each item node of the bag
+  --     release dynamically allocated space for the item, if any
+  --     release dynamically allocated space for the node
+  --   pool
+  --   reset the ╥first╙ link field in the bag header to NIL, and
+  --   reset the ╥length╙ field in the bag header to zero
+  -- otherwise
+  --   raise the undefined exception
+  -- fi
+  -- end. *)
+
+VAR   freeItem : DisposeProc; (*-- Item disposal routine, if any *)
+      theNode  : Link;        (*-- Bag node to be deallocated *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+	  freeItem := DisposeOf(dataID);
+	  WHILE (first # NullLink) DO
+	    theNode := first;
+		first   := first^.next;
+	  	freeItem(theNode^.item);
+		Deallocate(theNode, SIZE(theNode^));
+	  END (*--while*);
+  	  length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+PROCEDURE Assign        (    theBag   : Bag       (*-- in    *);
+                         VAR toBag    : Bag       (*-- inout *));
+
+(*-- Assign the items of one bag to another bag.
+  -- Algorithm:
+  --   if the source bag has been created
+  --     if the target bag has been created
+  --       destroy the target bag in its current incarnation
+  --     fi
+  --     create the target header as a duplicate of the source header
+  --     if the source bag is not empty
+  --       copy the source bag items to the target bag in the same
+  --       order that they appear in the source bag
+  --     fi
+  --   otherwise
+  --     raise the undefined exception
+  --   fi
+  -- end. *)
+
+VAR   fromIndex : Link; (*-- Loop index over source bag items *)
+	  toIndex   : Link; (*-- new item node in target bag *)
+
+BEGIN
+  bagError := noerr;
+  bagRoutine := assign;
+  IF (theBag # NullBag) THEN
+    IF Recreate(toBag, theBag^.dataID) THEN
+	  IF (theBag^.first = NullLink) THEN
+		RETURN;
+	  END (*--if*);
+	  assignItem := AssignOf(theBag^.dataID);
+
+      WITH theBag^.first^ DO
+	    toBag^.first := NewNode(item, count, NullLink);
+	  END (*--with*);
+	  IF (bagError = overflow) THEN
+        RETURN;
+	  END (*--if*);
+	  toIndex   := toBag^.first;
+	  fromIndex := theBag^.first;
+
+      WHILE (fromIndex^.next # NIL) DO
+	    fromIndex := fromIndex^.next;
+        WITH fromIndex^ DO
+	      toIndex^.next := NewNode(item, count, NullLink);
+	    END (*--with*);
+	    IF (bagError = overflow) THEN
+		  RETURN;
+        END (*--if*);
+        toIndex := toIndex^.next;
+      END (*--while*);
+      toBag^.length := theBag^.length;
+    END (*--if*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+PROCEDURE Include       (    theItem  : Item      (*-- in    *);
+       	       	         VAR inBag    : Bag       (*-- inout *));
+
+(*-- Bag Inclusion for linearly ordered list.  Algorithm is similar
+  -- to that from reference [2], pg. 118. *)
+
+VAR   current     : Link;        (*-- Loop index in search of theItem *)
+      previous    : Link;        (*-- Previous node examined *)
+	  newNode     : Link;        (*-- For new node to add *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  itemOrder   : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (inBag # NullBag) THEN
+	compareItem := CompareOf(inBag^.dataID);
+    current     := inBag^.first;
+	previous    := NullLink;
+    LOOP
+	  IF (current = NullLink) THEN
+        EXIT (*--loop*); (*-- theItem is not in the bag *)
+      END (*--if*);
+
+	  itemOrder := compareItem(current^.item, theItem);
+
+      IF (itemOrder = equal) THEN (*-- theItem is in the bag *)
+	    INC(current^.count);
+        RETURN;
+
+	  ELSIF (itemOrder = greater) THEN
+        EXIT (*--loop*); (*-- theItem is not in the bag *)
+      END (*--if*);
+
+      previous := current; (*-- Keep looking *)
+      current  := current^.next;
+    END (*--loop*);
+
+    (*-- Insert the new item *)
+
+	Allocate(newNode, SIZE(Node));
+	IF (newNode = NullLink) THEN
+	  RaiseErrIn(include, overflow);
+    ELSE
+	  WITH newNode^ DO
+	    item  := theItem;
+		count := 1;
+	  END (*--with*);
+	  IF (previous = NullLink) THEN
+	    newNode^.next := inBag^.first;
+		inBag^.first  := newNode;
+	  ELSE
+	    newNode^.next  := current;
+		previous^.next := newNode;
+      END (*--if*);
+      INC(inBag^.length);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*--------------------*)
+
+PROCEDURE Exclude       (    theItem  : Item      (*-- in    *);
+       	       	         VAR fromBag  : Bag       (*-- inout *));
+
+VAR   current     : Link;        (*-- Loop index over items *)
+      previous    : Link;        (*-- Previous node examined *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  itemOrder   : Relation;    (*-- Relation between items *)
+	  freeItem    : DisposeProc; (*-- Item disposal routine *)
+
+BEGIN
+  bagError := noerr;
+  IF (fromBag # NullBag) THEN
+	compareItem := CompareOf(fromBag^.dataID);
+    current     := fromBag^.first;
+	previous    := NullLink;
+    LOOP
+	  IF (current = NullLink) THEN
+        RETURN; (*-- theItem is not in the bag *)
+      END (*--if*);
+
+	  itemOrder := compareItem(current^.item, theItem);
+
+      IF (itemOrder = equal) THEN (*-- theItem is in the bag *)
+	    IF (current^.count > 1) THEN
+		  DEC(current^.count);
+		  RETURN;
+		ELSE
+          EXIT (*--loop*);
+		END (*--if*);
+      ELSIF (itemOrder = greater) THEN
+        RETURN;          (*-- theItem is not in the bag *)
+      END (*--if*);
+
+      previous := current;       (*-- Keep looking *)
+      current  := current^.next;
+    END (*--loop*);
+
+    (*-- ╥current╙ points to the node to be deleted. *)
+
+    IF (previous = NullLink) THEN
+	  fromBag^.first := current^.next;
+	ELSE
+	  previous^.next := current^.next;
+	END (*--if*);
+	freeItem := DisposeOf(fromBag^.dataID);
+	freeItem(current^.item);
+	Deallocate(current, SIZE(current^));
+    DEC(fromBag^.length);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*--------------------*)
+
+PROCEDURE Union         (    left     : Bag       (*-- in    *);
+       	       	             right    : Bag       (*-- in    *);
+                         VAR toBag    : Bag       (*-- inout *));
+
+(*-- Compute the bag containing all members of left and right.
+  -- x IN toBag iff (x IN left) OR (x IN right). *)
+
+VAR   leftIndex   : Link;        (*-- Loop index over left bag *)
+      rightIndex  : Link;        (*-- Loop index over right bag *)
+	  toIndex     : Link;        (*-- List of target bag nodes *)
+	  tempNode    : Link;        (*-- Temporary node *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(union, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(union, typeerror);
+	RETURN;
+  ELSIF ~Recreate(toBag, left^.dataID) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toBag^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  bagRoutine := union;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+	Allocate(tempNode, SIZE(Node));
+	IF (tempNode = NullLink) THEN
+	  RaiseErrIn(union, overflow);
+	  RETURN;
+	END (*--if*);
+	tempNode^.next := NullLink;
+
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+	INC(toBag^.length);
+
+    IF (order = less) THEN
+	  WITH tempNode^ DO
+        item  := assignItem(leftIndex^.item);
+	    count := leftIndex^.count;
+	  END (*--with*);
+      leftIndex := leftIndex^.next;
+	ELSIF (order = equal) THEN
+	  WITH tempNode^ DO
+        item  := assignItem(leftIndex^.item);
+	    count := leftIndex^.count + rightIndex^.count;
+	  END (*--with*);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    ELSE
+	  WITH tempNode^ DO
+        item  := assignItem(rightIndex^.item);
+	    count := rightIndex^.count;
+	  END (*--with*);
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+
+	TailInsert(tempNode, toBag^.first, toIndex);
+
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from either the left bag or
+    -- the right bag to the destination bag. *)
+
+  IF (leftIndex = NullLink) THEN
+    CopySubset(rightIndex, toIndex, toBag);
+  ELSIF (rightIndex = NullLink) THEN
+    CopySubset(leftIndex, toIndex, toBag);
+  END (*--if*);
+END Union;
+(*--------------------*)
+
+PROCEDURE Intersection  (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+(*-- Compute the bag containing all members in both left and right.
+  -- x IN toBag iff (x IN left) AND (x IN right).
+  -- Algorithm:
+  --   if both source bags have been created
+  --     if both source bags have the same data type
+  --       if the target bag has been created
+  --         destroy the target bag in its current incarnation
+  --       fi
+  --       create the target header as a duplicate of the source header
+  --       if creating the target bag header was successful
+  --         loop through both the left and right bags
+  --         pool
+  --       otherwise
+  --         raise the overflow exception
+  --       fi
+  --     otherwise
+  --       raise the type error exception
+  --     fi
+  --   otherwise
+  --     raise the undefined exception
+  --   fi
+  -- end. *)
+
+VAR   leftIndex   : Link;        (*-- Loop link over left bag *)
+      rightIndex  : Link;        (*-- Loop link over right bag *)
+	  toIndex     : Link;        (*-- List of target bag nodes *)
+	  tempNode    : Link;		 (*-- temporary for new node *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+	  newCount    : CARDINAL;    (*-- Smaller of left/right counts *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(intersection, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(intersection, typeerror);
+	RETURN;
+  ELSIF ~Recreate(toBag, left^.dataID) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toBag^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+  bagRoutine := intersection;
+
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+    IF (order = equal) THEN
+
+	  IF (leftIndex^.count < rightIndex^.count) THEN
+	    newCount := leftIndex^.count;
+	  ELSE
+	    newCount := rightIndex^.count;
+	  END (*--if*);
+
+	  tempNode := NewNode(leftIndex^.item, newCount, NullLink);
+	  IF (bagError = overflow) THEN
+	    RETURN;
+	  END (*--if*);
+	  TailInsert(tempNode, toBag^.first, toIndex);
+	  INC(toBag^.length);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSIF (order = less) THEN
+      leftIndex  := leftIndex^.next;
+
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+END Intersection;
+(*--------------------*)
+
+PROCEDURE Difference    (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+(*-- Compute the bag containing all members of left that are not
+  -- members of right. x IN toBag iff (x IN left) & ┬(x IN right) *)
+
+VAR   leftIndex   : Link;        (*-- Loop index over left bag *)
+      rightIndex  : Link;        (*-- Loop index over right bag *)
+	  toIndex     : Link;        (*-- List of target bag nodes *)
+	  tempNode    : Link;        (*-- Temporary for new node *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(difference, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(difference, typeerror);
+	RETURN;
+  ELSIF ~Recreate(toBag, left^.dataID) THEN
+    RETURN;
+  END (*--if*);
+  
+  WITH toBag^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+  bagRoutine := difference;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+	  IF (leftIndex^.count > rightIndex^.count) THEN
+	    tempNode := NewNode(leftIndex^.item,
+		                    leftIndex^.count - rightIndex^.count,
+							NullLink);
+	    IF (bagError = overflow) THEN
+	      RETURN;
+	    END (*--if*);
+
+	    TailInsert(tempNode, toBag^.first, toIndex);
+	    INC(toBag^.length);
+	  END (*--if*);
+
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSIF (order = less) THEN
+	  WITH leftIndex^ DO
+	    tempNode := NewNode(item, count, NullLink);
+	  END (*--with*);
+	  IF (bagError # noerr) THEN
+	    RETURN;
+	  END (*--if*);
+	  TailInsert(tempNode, toBag^.first, toIndex);
+	  INC(toBag^.length);
+
+      leftIndex  := leftIndex^.next;
+
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from the left bag to the
+    -- destination bag. *)
+
+  CopySubset(leftIndex, toIndex, toBag);
+END Difference;
+(*--------------------*)
+
+PROCEDURE SymDifference (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+(*-- Compute the bag containing all members of left or right that
+  -- are not members of both.
+  -- x IN toBag iff (x IN left) # (x IN right) *)
+
+VAR   leftIndex   : Link;        (*-- Loop index over left bag *)
+      rightIndex  : Link;        (*-- Loop index over right bag *)
+	  toIndex     : Link;        (*-- List of target bag nodes *)
+	  tempNode    : Link;        (*-- Temporary node *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+	  newItem     : Item;        (*-- Either left/right item *)
+	  newCount    : CARDINAL;    (*-- Either left/right count *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(symdifference, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(symdifference, typeerror);
+	RETURN;
+  ELSIF ~Recreate(toBag, left^.dataID) THEN
+    RETURN;
+  END (*--if*);
+  
+  WITH toBag^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  bagRoutine := symdifference;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+	  IF (leftIndex^.count > rightIndex^.count) THEN
+	    WITH leftIndex^ DO
+	      tempNode := NewNode(item, count - rightIndex^.count, NullLink);
+	    END (*--with*);
+	    IF (bagError = overflow) THEN
+	      RETURN;
+	    END (*--if*);
+
+	    TailInsert(tempNode, toBag^.first, toIndex);
+	    INC(toBag^.length);
+	  END (*--if*);
+
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSE
+      IF (order = less) THEN
+	    WITH leftIndex^ DO
+	      newItem  := item;
+		  newCount := count;
+		END (*--with*);
+        leftIndex := leftIndex^.next;
+      ELSE
+	    WITH rightIndex^ DO
+	      newItem  := item;
+		  newCount := count;
+		END (*--with*);
+        rightIndex := rightIndex^.next;
+      END (*--if*);
+
+	  tempNode := NewNode(newItem, newCount, NullLink);
+      IF (tempNode = NullLink) THEN
+        RETURN;
+      END (*--if*);
+
+	  TailInsert(tempNode, toBag^.first, toIndex);
+      INC(toBag^.length);
+    END (*--if*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from either the left bag or
+    -- the right bag to the destination bag. *)
+
+  IF (leftIndex = NullLink) THEN
+    CopySubset(rightIndex, toIndex, toBag);
+  ELSIF (rightIndex = NullLink) THEN
+    CopySubset(leftIndex, toIndex, toBag);
+  END (*--if*);
+END SymDifference;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (theBag # NullBag);
+END IsDefined;
+(*--------------------*)
+
+PROCEDURE IsEmpty       (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN (theBag^.length = 0);
+  END (*--if*);
+
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*--------------------*)
+
+PROCEDURE TypeOf        (    theBag  : Bag      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.dataID;
+  END (*--if*);
+
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*--------------------*)
+
+PROCEDURE IsEqual       (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- Loop index over left bag items *)
+      rightIndex: Link; (*-- Loop index over right bag items *)
+	  compare   : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.length = right^.length) THEN
+
+        (*-- Scan both Bags looking for the first mismatch (inequality)
+          -- which indicates that the Bags are unequal.
+          -- If the WHILE loop completes then the Bags must be equal.
+		  -- Because the lengths are equal, rightIndex will be NIL
+		  -- when leftIndex is NIL. *)
+
+		compare   := CompareOf(left^.dataID);
+        leftIndex := left^.first;
+		rightIndex:= right^.first;
+        WHILE (leftIndex # NullLink) DO
+          IF compare(leftIndex^.item, rightIndex^.item) # equal THEN
+            RETURN FALSE;
+          END (*--if*);
+		  leftIndex := leftIndex^.next;
+		  rightIndex:= rightIndex^.next;
+        END (*--while*);
+        RETURN TRUE;
+	  END (*--if*);
+	ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+
+  (*-- the Bags must be unequal, either by having different
+    -- lengths, mismatched types, or an undefined Bag exception. *)
+
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE NumMembers    (    theBag  : Bag         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+VAR   current    : Link;
+      totalCount : CARDINAL;
+
+BEGIN
+  bagError   := noerr;
+  totalCount := 0;
+  IF (theBag # NullBag) THEN
+    current := theBag^.first;
+    WHILE (current # NullLink) DO
+      INC(totalCount, current^.count);
+	  current := current^.next;
+    END (*--while*);
+  END (*--if*);
+
+  RaiseErrIn(nummembers, undefined);
+  RETURN totalCount;
+END NumMembers;
+(*----------------------------*)
+
+PROCEDURE UniqueMembers (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.length;
+  END (*--if*);
+
+  RaiseErrIn(uniquemembers, undefined);
+  RETURN 0;
+END UniqueMembers;
+(*----------------------------*)
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+       	       	             theBag  : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index       : Link;        (*-- Loop index over items *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+	  compareItem := CompareOf(dataID);
+	  index := first;
+	END (*--with*);
+    WHILE (index # NullLink) DO
+      IF (theItem = index^.item) THEN
+        RETURN TRUE;
+      ELSE
+	    order := compareItem(index^.item, theItem);
+        IF (order = greater) THEN
+		  RETURN FALSE;
+        END (*--if*);
+      END (*--if*);
+	  index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+PROCEDURE NumberOf      (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+VAR   index       : Link;        (*-- Loop index over items *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+	  compareItem := CompareOf(dataID);
+	  index := first;
+	END (*--with*);
+    WHILE (index # NullLink) DO
+      IF (theItem = index^.item) THEN
+        RETURN index^.count;
+      ELSE
+	    order := compareItem(index^.item, theItem);
+        IF (order = greater) THEN
+		  RETURN 0;
+        END (*--if*);
+      END (*--if*);
+	  index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(numberof, undefined);
+  END (*--if*);
+
+  RETURN 0;
+END NumberOf;
+(*----------------------------*)
+
+PROCEDURE IsSubset      (    left    : Bag         (*-- in    *);
+                             right   : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   leftIndex   : Link;    (*-- Loop index over left bag *)
+      rightIndex  : Link;    (*-- Loop index over right bag *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(issubset, undefined);
+    RETURN FALSE;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(issubset, typeerror);
+    RETURN FALSE;
+  END (*--if*);
+
+  compareItem:= CompareOf(left^.dataID);
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+    IF (order = equal) THEN
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    ELSIF (order = less) THEN
+      RETURN FALSE;
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+  RETURN (leftIndex = NullLink);
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset(    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & (left^.length < right^.length);
+END IsProperSubset;
+(*----------------------------*)
+
+
+    (*---------------------------------*)
+    (*--         ITERATORS           --*)
+
+PROCEDURE LoopOver   (    theBag  : Bag            (*-- in    *);
+                          process : LoopAccessProc (*-- in    *));
+
+VAR   theNode : Link; (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+	theNode := theBag^.first;
+    WHILE (theNode # NullLink) DO
+	  WITH theNode^ DO
+        IF ~process(item, count) THEN
+          RETURN;
+        END (*--if*);
+	  END (*--with*);
+      theNode := theNode^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE Traverse   (    theBag  : Bag            (*-- in    *);
+                          process : AccessProc     (*-- in    *));
+
+VAR   theNode : Link; (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+	theNode := theBag^.first;
+    WHILE (theNode # NullLink) DO
+	  WITH theNode^ DO
+        process(item, count);
+	  END (*--with*);
+      theNode := theNode^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+
+(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
+(*~~ MODULE INITIALIZATION  ~~*)
+
+BEGIN
+  FOR bagError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[bagError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  bagError := noerr;
+END BagSUMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUMN.DEF
@@ -0,0 +1,124 @@
+DEFINITION MODULE BagSUMN;
+(*==============================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Sequential Unbounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module provides the Bag ADT for generic Items.
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+================================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  Bag;
+CONST NullBag = Bag(NIL);
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+CONST ModuleID = 8;
+
+PROCEDURE BagError    ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        (    theType : TypeID (*-- in    *))
+                                     : Bag    (*-- out   *);
+
+PROCEDURE Destroy       (VAR theBag  : Bag    (*-- inout *));
+
+PROCEDURE Clear         (VAR theBag  : Bag    (*-- inout *));
+
+PROCEDURE Assign        (    theBag  : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+PROCEDURE Include       (    theItem : Item   (*-- in    *);
+       	       	         VAR inBag   : Bag    (*-- inout *));
+
+PROCEDURE Exclude       (    theItem : Item   (*-- in    *);
+       	       	         VAR fromBag : Bag    (*-- inout *));
+
+PROCEDURE Union         (    left    : Bag    (*-- in    *);
+       	       	             right   : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+PROCEDURE Intersection  (    left    : Bag    (*-- in    *);
+       	       	             right   : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+PROCEDURE Difference    (    left    : Bag    (*-- in    *);
+       	       	             right   : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+PROCEDURE SymDifference (    left    : Bag    (*-- in    *);
+       	       	             right   : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty       (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE TypeOf        (    theBag  : Bag      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+
+PROCEDURE NumMembers    (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE UniqueMembers (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE NumberOf      (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+END BagSUMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUMN.MOD
@@ -0,0 +1,1026 @@
+IMPLEMENTATION MODULE BagSUMN;
+(*==============================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Sequential Unbounded Managed Iterator
+    Code Size: R-  bytes
+
+    INTRODUCTION
+    This module provides the Bag ADT for generic Items. Uses an
+	ordered, linear list for the items.
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins
+        Initial implementation derived from BagSUMI module.
+
+    (C) Copyright 1989 Charles A. Lins
+================================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, CompareOf, DisposeOf;
+
+    (*--------------------*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD      (*-- a bag item node *)
+        item : Item;     (*-- the item nodes' data *)
+		count: CARDINAL; (*-- number of these items *)
+		next : Link;     (*-- link to next node in list *)
+	  END (*-- Node *);
+CONST NullLink = NIL;
+
+TYPE  UnboundedBag = RECORD (*-- bag header *)
+		dataID : TypeID;    (*-- defined data type *)
+        length : CARDINAL;  (*-- current bag length, := 0 *)
+        first  : Link;      (*-- link to first Item node *)
+      END (*-- UnboundedBag *);
+
+TYPE  Bag = POINTER TO UnboundedBag;
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+VAR   bagError  : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+PROCEDURE BagError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN bagError;
+END BagError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  bagError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--       LOCAL ROUTINES        --*)
+
+VAR   bagRoutine : Operations;  (*-- Routine calling NewNode *)
+VAR   assignItem : AssignProc;  (*-- Item assignment routine *)
+
+PROCEDURE NewNode       (    theItem : Item        (*-- in    *);
+       	       	             theCount: CARDINAL    (*-- in    *);
+       	       	             theNext : Link        (*-- in    *))
+							         : Link        (*-- out   *);
+
+VAR   newLink : Link;
+
+BEGIN
+  Allocate(newLink, SIZE(Node));
+  IF (newLink = NullLink) THEN
+    RaiseErrIn(bagRoutine, overflow);
+  ELSE
+    WITH newLink^ DO
+	  item  := assignItem(theItem);
+	  count := theCount;
+	  next  := theNext;
+	END (*--with*);
+  END (*--if*);
+  RETURN newLink;
+END NewNode;
+(*--------------------*)
+
+PROCEDURE TailInsert (    theNode : Link (*--in   *);
+					  VAR first   : Link (*--inout*);
+					  VAR last    : Link (*--inout*));
+BEGIN
+  IF (first = NullLink) THEN
+	first := theNode;
+  ELSE
+	last^.next := theNode;
+  END (*--if*);
+  last := theNode;
+END TailInsert;
+(*--------------------*)
+
+PROCEDURE CopySubset (    fromIndex  : Link       (*-- in    *);
+                          toIndex    : Link       (*-- in    *);
+                      VAR toBag      : Bag        (*-- inout *));
+
+VAR   tempNode : Link;
+
+BEGIN
+  LOOP
+    IF (fromIndex = NullLink) THEN
+	  EXIT (*--loop*);
+	ELSE
+	  WITH fromIndex^ DO
+	    tempNode := NewNode(item, count, NIL);
+	  END (*--with*);
+	  IF (tempNode = NullLink) THEN
+	    EXIT (*--loop*);
+	  END (*--if*);
+	  INC(toBag^.length);
+	  TailInsert(tempNode, toBag^.first, toIndex);
+      fromIndex := fromIndex^.next;
+	END (*--if*);
+  END (*--loop*);
+END CopySubset;
+(*--------------------*)
+
+PROCEDURE Recreate (VAR theBag  : Bag       (*--inout*);
+                        theType : TypeID    (*--in   *))
+                                : BOOLEAN   (*--out  *);
+BEGIN
+  IF (theBag = NullBag) THEN
+    theBag := Create(theType);
+  ELSE
+    Clear(theBag);
+    theBag^.dataID := theType;
+  END (*--if*);
+  RETURN (bagError = noerr);
+END Recreate;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        (    theType  : TypeID    (*-- in    *))
+                                      : Bag       (*-- out   *);
+
+(*-- Attempt to create a new bag variable of the given type.
+  -- Algorithm:
+  --  attempt to create the header for the bag
+  --  if successful
+  --    attempt to add the header to the list of valid bags
+  --    if successful
+  --      initialize the bag header, and
+  --      return the new bag
+  --    otherwise, release the bag header
+  --    fi
+  --  fi
+  --  raise the overflow exception
+  -- end. *)
+
+VAR   newBag : Bag; (*-- new bag variable being created *)
+
+BEGIN
+  bagError := noerr;
+  Allocate(newBag, SIZE(UnboundedBag));
+  IF (newBag = NullBag) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newBag^ DO
+	  dataID := theType;
+      length := 0;
+	  first  := NullLink;
+    END (*--with*);
+  END (*--if*);
+  RETURN newBag;
+END Create;
+(*--------------------*)
+
+PROCEDURE Destroy       (VAR theBag   : Bag       (*-- inout *));
+
+(*-- Destroy a previously created bag.
+  -- Algorithm:
+  -- clear the bag of existing nodes and their items, setting the
+  -- bag error flag to ╥noerr╙ if the bag is defined
+  -- if successful
+  --   remove the bag from the list of valid bags, and
+  --   release the dynamically allocated space used by the header
+  -- fi
+  -- end. *)
+
+BEGIN
+  Clear(theBag);
+  IF (bagError = noerr) THEN
+    Deallocate(theBag, SIZE(UnboundedBag));
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+PROCEDURE Clear         (VAR theBag   : Bag       (*-- inout *));
+
+(*-- Remove all nodes and items from a previously created bag.
+  -- Algorithm:
+  -- if the bag has been defined
+  --   retrieve the item disposal routine for the bags' data type
+  --   loop through each item node of the bag
+  --     release dynamically allocated space for the item, if any
+  --     release dynamically allocated space for the node
+  --   pool
+  --   reset the ╥first╙ link field in the bag header to NIL, and
+  --   reset the ╥length╙ field in the bag header to zero
+  -- otherwise
+  --   raise the undefined exception
+  -- fi
+  -- end. *)
+
+VAR   freeItem : DisposeProc; (*-- Item disposal routine, if any *)
+      theNode  : Link;        (*-- Bag node to be deallocated *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+	  freeItem := DisposeOf(dataID);
+	  WHILE (first # NullLink) DO
+	    theNode := first;
+		first   := first^.next;
+	  	freeItem(theNode^.item);
+		Deallocate(theNode, SIZE(theNode^));
+	  END (*--while*);
+  	  length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+PROCEDURE Assign        (    theBag   : Bag       (*-- in    *);
+                         VAR toBag    : Bag       (*-- inout *));
+
+(*-- Assign the items of one bag to another bag.
+  -- Algorithm:
+  --   if the source bag has been created
+  --     if the target bag has been created
+  --       destroy the target bag in its current incarnation
+  --     fi
+  --     create the target header as a duplicate of the source header
+  --     if the source bag is not empty
+  --       copy the source bag items to the target bag in the same
+  --       order that they appear in the source bag
+  --     fi
+  --   otherwise
+  --     raise the undefined exception
+  --   fi
+  -- end. *)
+
+VAR   fromIndex : Link; (*-- Loop index over source bag items *)
+	  toIndex   : Link; (*-- new item node in target bag *)
+
+BEGIN
+  bagError := noerr;
+  bagRoutine := assign;
+  IF (theBag # NullBag) THEN
+    IF Recreate(toBag, theBag^.dataID) THEN
+	  IF (theBag^.first = NullLink) THEN
+		RETURN;
+	  END (*--if*);
+	  assignItem := AssignOf(theBag^.dataID);
+
+      WITH theBag^.first^ DO
+	    toBag^.first := NewNode(item, count, NullLink);
+	  END (*--with*);
+	  IF (bagError = overflow) THEN
+        RETURN;
+	  END (*--if*);
+	  toIndex   := toBag^.first;
+	  fromIndex := theBag^.first;
+
+      WHILE (fromIndex^.next # NIL) DO
+	    fromIndex := fromIndex^.next;
+        WITH fromIndex^ DO
+	      toIndex^.next := NewNode(item, count, NullLink);
+	    END (*--with*);
+	    IF (bagError = overflow) THEN
+		  RETURN;
+        END (*--if*);
+        toIndex := toIndex^.next;
+      END (*--while*);
+      toBag^.length := theBag^.length;
+    END (*--if*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+PROCEDURE Include       (    theItem  : Item      (*-- in    *);
+       	       	         VAR inBag    : Bag       (*-- inout *));
+
+(*-- Bag Inclusion for linearly ordered list.  Algorithm is similar
+  -- to that from reference [2], pg. 118. *)
+
+VAR   current     : Link;        (*-- Loop index in search of theItem *)
+      previous    : Link;        (*-- Previous node examined *)
+	  newNode     : Link;        (*-- For new node to add *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  itemOrder   : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (inBag # NullBag) THEN
+	compareItem := CompareOf(inBag^.dataID);
+    current     := inBag^.first;
+	previous    := NullLink;
+    LOOP
+	  IF (current = NullLink) THEN
+        EXIT (*--loop*); (*-- theItem is not in the bag *)
+      END (*--if*);
+
+	  itemOrder := compareItem(current^.item, theItem);
+
+      IF (itemOrder = equal) THEN (*-- theItem is in the bag *)
+	    INC(current^.count);
+        RETURN;
+
+	  ELSIF (itemOrder = greater) THEN
+        EXIT (*--loop*); (*-- theItem is not in the bag *)
+      END (*--if*);
+
+      previous := current; (*-- Keep looking *)
+      current  := current^.next;
+    END (*--loop*);
+
+    (*-- Insert the new item *)
+
+	Allocate(newNode, SIZE(Node));
+	IF (newNode = NullLink) THEN
+	  RaiseErrIn(include, overflow);
+    ELSE
+	  WITH newNode^ DO
+	    item  := theItem;
+		count := 1;
+	  END (*--with*);
+	  IF (previous = NullLink) THEN
+	    newNode^.next := inBag^.first;
+		inBag^.first  := newNode;
+	  ELSE
+	    newNode^.next  := current;
+		previous^.next := newNode;
+      END (*--if*);
+      INC(inBag^.length);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*--------------------*)
+
+PROCEDURE Exclude       (    theItem  : Item      (*-- in    *);
+       	       	         VAR fromBag  : Bag       (*-- inout *));
+
+VAR   current     : Link;        (*-- Loop index over items *)
+      previous    : Link;        (*-- Previous node examined *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  itemOrder   : Relation;    (*-- Relation between items *)
+	  freeItem    : DisposeProc; (*-- Item disposal routine *)
+
+BEGIN
+  bagError := noerr;
+  IF (fromBag # NullBag) THEN
+	compareItem := CompareOf(fromBag^.dataID);
+    current     := fromBag^.first;
+	previous    := NullLink;
+    LOOP
+	  IF (current = NullLink) THEN
+        RETURN; (*-- theItem is not in the bag *)
+      END (*--if*);
+
+	  itemOrder := compareItem(current^.item, theItem);
+
+      IF (itemOrder = equal) THEN (*-- theItem is in the bag *)
+	    IF (current^.count > 1) THEN
+		  DEC(current^.count);
+		  RETURN;
+		ELSE
+          EXIT (*--loop*);
+		END (*--if*);
+      ELSIF (itemOrder = greater) THEN
+        RETURN;          (*-- theItem is not in the bag *)
+      END (*--if*);
+
+      previous := current;       (*-- Keep looking *)
+      current  := current^.next;
+    END (*--loop*);
+
+    (*-- ╥current╙ points to the node to be deleted. *)
+
+    IF (previous = NullLink) THEN
+	  fromBag^.first := current^.next;
+	ELSE
+	  previous^.next := current^.next;
+	END (*--if*);
+	freeItem := DisposeOf(fromBag^.dataID);
+	freeItem(current^.item);
+	Deallocate(current, SIZE(current^));
+    DEC(fromBag^.length);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*--------------------*)
+
+PROCEDURE Union         (    left     : Bag       (*-- in    *);
+       	       	             right    : Bag       (*-- in    *);
+                         VAR toBag    : Bag       (*-- inout *));
+
+(*-- Compute the bag containing all members of left and right.
+  -- x IN toBag iff (x IN left) OR (x IN right). *)
+
+VAR   leftIndex   : Link;        (*-- Loop index over left bag *)
+      rightIndex  : Link;        (*-- Loop index over right bag *)
+	  toIndex     : Link;        (*-- List of target bag nodes *)
+	  tempNode    : Link;        (*-- Temporary node *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(union, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(union, typeerror);
+	RETURN;
+  ELSIF ~Recreate(toBag, left^.dataID) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toBag^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  bagRoutine := union;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+	Allocate(tempNode, SIZE(Node));
+	IF (tempNode = NullLink) THEN
+	  RaiseErrIn(union, overflow);
+	  RETURN;
+	END (*--if*);
+	tempNode^.next := NullLink;
+
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+	INC(toBag^.length);
+
+    IF (order = less) THEN
+	  WITH tempNode^ DO
+        item  := assignItem(leftIndex^.item);
+	    count := leftIndex^.count;
+	  END (*--with*);
+      leftIndex := leftIndex^.next;
+	ELSIF (order = equal) THEN
+	  WITH tempNode^ DO
+        item  := assignItem(leftIndex^.item);
+	    count := leftIndex^.count + rightIndex^.count;
+	  END (*--with*);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    ELSE
+	  WITH tempNode^ DO
+        item  := assignItem(rightIndex^.item);
+	    count := rightIndex^.count;
+	  END (*--with*);
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+
+	TailInsert(tempNode, toBag^.first, toIndex);
+
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from either the left bag or
+    -- the right bag to the destination bag. *)
+
+  IF (leftIndex = NullLink) THEN
+    CopySubset(rightIndex, toIndex, toBag);
+  ELSIF (rightIndex = NullLink) THEN
+    CopySubset(leftIndex, toIndex, toBag);
+  END (*--if*);
+END Union;
+(*--------------------*)
+
+PROCEDURE Intersection  (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+(*-- Compute the bag containing all members in both left and right.
+  -- x IN toBag iff (x IN left) AND (x IN right).
+  -- Algorithm:
+  --   if both source bags have been created
+  --     if both source bags have the same data type
+  --       if the target bag has been created
+  --         destroy the target bag in its current incarnation
+  --       fi
+  --       create the target header as a duplicate of the source header
+  --       if creating the target bag header was successful
+  --         loop through both the left and right bags
+  --         pool
+  --       otherwise
+  --         raise the overflow exception
+  --       fi
+  --     otherwise
+  --       raise the type error exception
+  --     fi
+  --   otherwise
+  --     raise the undefined exception
+  --   fi
+  -- end. *)
+
+VAR   leftIndex   : Link;        (*-- Loop link over left bag *)
+      rightIndex  : Link;        (*-- Loop link over right bag *)
+	  toIndex     : Link;        (*-- List of target bag nodes *)
+	  tempNode    : Link;		 (*-- temporary for new node *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+	  newCount    : CARDINAL;    (*-- Smaller of left/right counts *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(intersection, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(intersection, typeerror);
+	RETURN;
+  ELSIF ~Recreate(toBag, left^.dataID) THEN
+    RETURN;
+  END (*--if*);
+  
+  WITH toBag^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+  bagRoutine := intersection;
+
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+    IF (order = equal) THEN
+
+	  IF (leftIndex^.count < rightIndex^.count) THEN
+	    newCount := leftIndex^.count;
+	  ELSE
+	    newCount := rightIndex^.count;
+	  END (*--if*);
+
+	  tempNode := NewNode(leftIndex^.item, newCount, NullLink);
+	  IF (bagError = overflow) THEN
+	    RETURN;
+	  END (*--if*);
+	  TailInsert(tempNode, toBag^.first, toIndex);
+	  INC(toBag^.length);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSIF (order = less) THEN
+      leftIndex  := leftIndex^.next;
+
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+END Intersection;
+(*--------------------*)
+
+PROCEDURE Difference    (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+(*-- Compute the bag containing all members of left that are not
+  -- members of right. x IN toBag iff (x IN left) & ┬(x IN right) *)
+
+VAR   leftIndex   : Link;        (*-- Loop index over left bag *)
+      rightIndex  : Link;        (*-- Loop index over right bag *)
+	  toIndex     : Link;        (*-- List of target bag nodes *)
+	  tempNode    : Link;        (*-- Temporary for new node *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(difference, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(difference, typeerror);
+	RETURN;
+  ELSIF ~Recreate(toBag, left^.dataID) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toBag^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+  bagRoutine := difference;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+	  IF (leftIndex^.count > rightIndex^.count) THEN
+	    tempNode := NewNode(leftIndex^.item,
+		                    leftIndex^.count - rightIndex^.count,
+							NullLink);
+	    IF (bagError = overflow) THEN
+	      RETURN;
+	    END (*--if*);
+
+	    TailInsert(tempNode, toBag^.first, toIndex);
+	    INC(toBag^.length);
+	  END (*--if*);
+
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSIF (order = less) THEN
+	  WITH leftIndex^ DO
+	    tempNode := NewNode(item, count, NullLink);
+	  END (*--with*);
+	  IF (bagError # noerr) THEN
+	    RETURN;
+	  END (*--if*);
+	  TailInsert(tempNode, toBag^.first, toIndex);
+	  INC(toBag^.length);
+
+      leftIndex  := leftIndex^.next;
+
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from the left bag to the
+    -- destination bag. *)
+
+  CopySubset(leftIndex, toIndex, toBag);
+END Difference;
+(*--------------------*)
+
+PROCEDURE SymDifference (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+(*-- Compute the bag containing all members of left or right that
+  -- are not members of both.
+  -- x IN toBag iff (x IN left) # (x IN right) *)
+
+VAR   leftIndex   : Link;        (*-- Loop index over left bag *)
+      rightIndex  : Link;        (*-- Loop index over right bag *)
+	  toIndex     : Link;        (*-- List of target bag nodes *)
+	  tempNode    : Link;        (*-- Temporary node *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+	  newItem     : Item;        (*-- Either left/right item *)
+	  newCount    : CARDINAL;    (*-- Either left/right count *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(symdifference, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(symdifference, typeerror);
+	RETURN;
+  ELSIF ~Recreate(toBag, left^.dataID) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toBag^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  bagRoutine := symdifference;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+	  IF (leftIndex^.count > rightIndex^.count) THEN
+	    WITH leftIndex^ DO
+	      tempNode := NewNode(item, count - rightIndex^.count, NullLink);
+	    END (*--with*);
+	    IF (bagError = overflow) THEN
+	      RETURN;
+	    END (*--if*);
+
+	    TailInsert(tempNode, toBag^.first, toIndex);
+	    INC(toBag^.length);
+	  END (*--if*);
+
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSE
+      IF (order = less) THEN
+	    WITH leftIndex^ DO
+	      newItem  := item;
+		  newCount := count;
+		END (*--with*);
+        leftIndex := leftIndex^.next;
+      ELSE
+	    WITH rightIndex^ DO
+	      newItem  := item;
+		  newCount := count;
+		END (*--with*);
+        rightIndex := rightIndex^.next;
+      END (*--if*);
+
+	  tempNode := NewNode(newItem, newCount, NullLink);
+      IF (tempNode = NullLink) THEN
+        RETURN;
+      END (*--if*);
+
+	  TailInsert(tempNode, toBag^.first, toIndex);
+      INC(toBag^.length);
+    END (*--if*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from either the left bag or
+    -- the right bag to the destination bag. *)
+
+  IF (leftIndex = NullLink) THEN
+    CopySubset(rightIndex, toIndex, toBag);
+  ELSIF (rightIndex = NullLink) THEN
+    CopySubset(leftIndex, toIndex, toBag);
+  END (*--if*);
+END SymDifference;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (theBag # NullBag);
+END IsDefined;
+(*--------------------*)
+
+PROCEDURE IsEmpty       (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN (theBag^.length = 0);
+  END (*--if*);
+
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*--------------------*)
+
+PROCEDURE TypeOf        (    theBag  : Bag      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.dataID;
+  END (*--if*);
+
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*--------------------*)
+
+PROCEDURE IsEqual       (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- Loop index over left bag items *)
+      rightIndex: Link; (*-- Loop index over right bag items *)
+	  compare   : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.length = right^.length) THEN
+
+        (*-- Scan both Bags looking for the first mismatch (inequality)
+          -- which indicates that the Bags are unequal.
+          -- If the WHILE loop completes then the Bags must be equal.
+		  -- Because the lengths are equal, rightIndex will be NIL
+		  -- when leftIndex is NIL. *)
+
+		compare := CompareOf(left^.dataID);
+        leftIndex := left^.first;
+		rightIndex:= right^.first;
+        WHILE (leftIndex # NullLink) DO
+          IF compare(leftIndex^.item, rightIndex^.item) # equal THEN
+            RETURN FALSE;
+          END (*--if*);
+		  leftIndex := leftIndex^.next;
+		  rightIndex:= rightIndex^.next;
+        END (*--while*);
+        RETURN TRUE;
+	  END (*--if*);
+	ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+
+  (*-- the Bags must be unequal, either by having different
+    -- lengths, mismatched types, or an undefined Bag exception. *)
+
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE NumMembers    (    theBag  : Bag         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+VAR   current    : Link;
+      totalCount : CARDINAL;
+
+BEGIN
+  bagError   := noerr;
+  totalCount := 0;
+  IF (theBag # NullBag) THEN
+    current := theBag^.first;
+    WHILE (current # NullLink) DO
+      INC(totalCount, current^.count);
+	  current := current^.next;
+    END (*--while*);
+  END (*--if*);
+
+  RaiseErrIn(nummembers, undefined);
+  RETURN totalCount;
+END NumMembers;
+(*----------------------------*)
+
+PROCEDURE UniqueMembers (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.length;
+  END (*--if*);
+
+  RaiseErrIn(uniquemembers, undefined);
+  RETURN 0;
+END UniqueMembers;
+(*----------------------------*)
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+       	       	             theBag  : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index       : Link;        (*-- Loop index over items *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+	  compareItem := CompareOf(dataID);
+	  index := first;
+	END (*--with*);
+    WHILE (index # NullLink) DO
+      IF (theItem = index^.item) THEN
+        RETURN TRUE;
+      ELSE
+	    order := compareItem(index^.item, theItem);
+        IF (order = greater) THEN
+		  RETURN FALSE;
+        END (*--if*);
+      END (*--if*);
+	  index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+PROCEDURE NumberOf      (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+VAR   index       : Link;        (*-- Loop index over items *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+	  compareItem := CompareOf(dataID);
+	  index := first;
+	END (*--with*);
+    WHILE (index # NullLink) DO
+      IF (theItem = index^.item) THEN
+        RETURN index^.count;
+      ELSE
+	    order := compareItem(index^.item, theItem);
+        IF (order = greater) THEN
+		  RETURN 0;
+        END (*--if*);
+      END (*--if*);
+	  index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(numberof, undefined);
+  END (*--if*);
+
+  RETURN 0;
+END NumberOf;
+(*----------------------------*)
+
+PROCEDURE IsSubset      (    left    : Bag         (*-- in    *);
+                             right   : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   leftIndex   : Link;    (*-- Loop index over left bag *)
+      rightIndex  : Link;    (*-- Loop index over right bag *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(issubset, undefined);
+    RETURN FALSE;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(issubset, typeerror);
+    RETURN FALSE;
+  END (*--if*);
+
+  compareItem:= CompareOf(left^.dataID);
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+    IF (order = equal) THEN
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    ELSIF (order = less) THEN
+      RETURN FALSE;
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+  RETURN (leftIndex = NullLink);
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset(    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & (left^.length < right^.length);
+END IsProperSubset;
+(*----------------------------*)
+
+
+(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
+(*~~ MODULE INITIALIZATION  ~~*)
+
+BEGIN
+  FOR bagError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[bagError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  bagError := noerr;
+END BagSUMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUUI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUUI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUUI.DEF
@@ -0,0 +1,141 @@
+DEFINITION MODULE BagSUUI;
+(*==============================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Sequential Unbounded Unmanaged Iterator
+
+    INTRODUCTION
+    This module provides the Bag ADT for generic Items. Uses an
+	ordered, linear list to implement the set of items. The TypeID
+	is necessary for its comparison routine.
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins
+      Initial implementation derived from BagSUMI.
+
+    (C) Copyright 1989 Charles A. Lins
+================================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item, Continue;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  Bag;
+CONST NullBag = Bag(NIL);
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+CONST ModuleID = 9;
+
+PROCEDURE BagError    ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        (    theType : TypeID (*-- in    *))
+                                     : Bag    (*-- out   *);
+
+PROCEDURE Destroy       (VAR theBag  : Bag    (*-- inout *));
+
+PROCEDURE Clear         (VAR theBag  : Bag    (*-- inout *));
+
+PROCEDURE Assign        (    theBag  : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+PROCEDURE Include       (    theItem : Item   (*-- in    *);
+       	       	         VAR inBag   : Bag    (*-- inout *));
+
+PROCEDURE Exclude       (    theItem : Item   (*-- in    *);
+       	       	         VAR fromBag : Bag    (*-- inout *));
+
+PROCEDURE Union         (    left    : Bag    (*-- in    *);
+       	       	             right   : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+PROCEDURE Intersection  (    left    : Bag    (*-- in    *);
+       	       	             right   : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+PROCEDURE Difference    (    left    : Bag    (*-- in    *);
+       	       	             right   : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+PROCEDURE SymDifference (    left    : Bag    (*-- in    *);
+       	       	             right   : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty       (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE TypeOf        (    theBag  : Bag      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+
+PROCEDURE NumMembers    (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE UniqueMembers (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE NumberOf      (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+
+    (*---------------------------------*)
+    (*--         ITERATORS           --*)
+
+TYPE  LoopAccessProc = PROCEDURE (Item, CARDINAL) : Continue;
+
+PROCEDURE LoopOver   (    theBag  : Bag            (*-- in    *);
+                          process : LoopAccessProc (*-- in    *));
+
+
+TYPE  AccessProc = PROCEDURE (Item, CARDINAL);
+
+PROCEDURE Traverse   (    theBag  : Bag            (*-- in    *);
+                          process : AccessProc     (*-- in    *));
+
+END BagSUUI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUUI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUUI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUUI.MOD
@@ -0,0 +1,961 @@
+IMPLEMENTATION MODULE BagSUUI;
+(*==============================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Sequential Unbounded Unmanaged Iterator
+    Code Size: R-  bytes
+
+    INTRODUCTION
+    This module provides the Bag ADT for generic Items. Uses an
+	ordered, linear list for the items.
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins
+        Initial implementation derived from BagSUMI module.
+
+    (C) Copyright 1989 Charles A. Lins
+================================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) CompareOf;
+
+    (*--------------------*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD      (*-- a bag item node *)
+        item : Item;     (*-- the item nodes' data *)
+		count: CARDINAL; (*-- number of these items *)
+		next : Link;     (*-- link to next node in list *)
+	  END (*-- Node *);
+CONST NullLink = NIL;
+
+TYPE  UnboundedBag = RECORD (*-- bag header *)
+		dataID : TypeID;    (*-- defined data type *)
+        length : CARDINAL;  (*-- current bag length, := 0 *)
+        first  : Link;      (*-- link to first Item node *)
+      END (*-- UnboundedBag *);
+
+TYPE  Bag = POINTER TO UnboundedBag;
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+VAR   bagError  : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+PROCEDURE BagError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN bagError;
+END BagError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  bagError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--       LOCAL ROUTINES        --*)
+
+VAR   bagRoutine : Operations;  (*-- Routine calling NewNode *)
+
+PROCEDURE NewNode       (    theItem : Item        (*-- in    *);
+       	       	             theCount: CARDINAL    (*-- in    *);
+       	       	             theNext : Link        (*-- in    *))
+							         : Link        (*-- out   *);
+
+VAR   newLink : Link;
+
+BEGIN
+  Allocate(newLink, SIZE(Node));
+  IF (newLink = NullLink) THEN
+    RaiseErrIn(bagRoutine, overflow);
+  ELSE
+    WITH newLink^ DO
+	  item  := theItem;
+	  count := theCount;
+	  next  := theNext;
+	END (*--with*);
+  END (*--if*);
+  RETURN newLink;
+END NewNode;
+(*--------------------*)
+
+PROCEDURE TailInsert (    theNode : Link (*--in   *);
+					  VAR first   : Link (*--inout*);
+					  VAR last    : Link (*--inout*));
+BEGIN
+  IF (first = NullLink) THEN
+	first := theNode;
+  ELSE
+	last^.next := theNode;
+  END (*--if*);
+  last := theNode;
+END TailInsert;
+(*--------------------*)
+
+PROCEDURE CopySubset (    fromIndex  : Link       (*-- in    *);
+                          toIndex    : Link       (*-- in    *);
+                      VAR toBag      : Bag        (*-- inout *));
+
+VAR   tempNode : Link;
+
+BEGIN
+  LOOP
+    IF (fromIndex = NullLink) THEN
+	  EXIT (*--loop*);
+	ELSE
+	  WITH fromIndex^ DO
+	    tempNode := NewNode(item, count, NIL);
+	  END (*--with*);
+	  IF (tempNode = NullLink) THEN
+	    EXIT (*--loop*);
+	  END (*--if*);
+	  INC(toBag^.length);
+	  TailInsert(tempNode, toBag^.first, toIndex);
+      fromIndex := fromIndex^.next;
+	END (*--if*);
+  END (*--loop*);
+END CopySubset;
+(*--------------------*)
+
+PROCEDURE Recreate (VAR theBag  : Bag       (*--inout*);
+                        theType : TypeID    (*--in   *))
+                                : BOOLEAN   (*--out  *);
+BEGIN
+  IF (theBag = NullBag) THEN
+    theBag := Create(theType);
+  ELSE
+    Clear(theBag);
+    theBag^.dataID := theType;
+  END (*--if*);
+  RETURN (bagError = noerr);
+END Recreate;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        (    theType  : TypeID    (*-- in    *))
+                                      : Bag       (*-- out   *);
+
+VAR   newBag : Bag; (*-- new bag variable being created *)
+
+BEGIN
+  bagError := noerr;
+  Allocate(newBag, SIZE(UnboundedBag));
+  IF (newBag = NullBag) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newBag^ DO
+	  dataID := theType;
+      length := 0;
+	  first  := NullLink;
+    END (*--with*);
+  END (*--if*);
+  RETURN newBag;
+END Create;
+(*--------------------*)
+
+PROCEDURE Destroy       (VAR theBag   : Bag       (*-- inout *));
+BEGIN
+  Clear(theBag);
+  IF (bagError = noerr) THEN
+    Deallocate(theBag, SIZE(UnboundedBag));
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+PROCEDURE Clear         (VAR theBag   : Bag       (*-- inout *));
+
+VAR   theNode  : Link;        (*-- Bag node to be deallocated *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+	  WHILE (first # NullLink) DO
+	    theNode := first;
+		first   := first^.next;
+		Deallocate(theNode, SIZE(theNode^));
+	  END (*--while*);
+  	  length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+PROCEDURE Assign        (    theBag   : Bag       (*-- in    *);
+                         VAR toBag    : Bag       (*-- inout *));
+
+VAR   fromIndex : Link; (*-- Loop index over source bag items *)
+	  toIndex   : Link; (*-- new item node in target bag *)
+
+BEGIN
+  bagError := noerr;
+  bagRoutine := assign;
+  IF (theBag # NullBag) THEN
+    IF Recreate(toBag, theBag^.dataID) THEN
+	  IF (theBag^.first = NullLink) THEN
+		RETURN;
+	  END (*--if*);
+
+      WITH theBag^.first^ DO
+	    toBag^.first := NewNode(item, count, NullLink);
+	  END (*--with*);
+	  IF (bagError = overflow) THEN
+        RETURN;
+	  END (*--if*);
+	  toIndex   := toBag^.first;
+	  fromIndex := theBag^.first;
+
+      WHILE (fromIndex^.next # NIL) DO
+	    fromIndex := fromIndex^.next;
+        WITH fromIndex^ DO
+	      toIndex^.next := NewNode(item, count, NullLink);
+	    END (*--with*);
+	    IF (bagError = overflow) THEN
+		  RETURN;
+        END (*--if*);
+        toIndex := toIndex^.next;
+      END (*--while*);
+      toBag^.length := theBag^.length;
+    END (*--if*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+PROCEDURE Include       (    theItem  : Item      (*-- in    *);
+       	       	         VAR inBag    : Bag       (*-- inout *));
+
+VAR   current     : Link;        (*-- Loop index in search of theItem *)
+      previous    : Link;        (*-- Previous node examined *)
+	  newNode     : Link;        (*-- For new node to add *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  itemOrder   : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (inBag # NullBag) THEN
+	compareItem := CompareOf(inBag^.dataID);
+    current     := inBag^.first;
+	previous    := NullLink;
+    LOOP
+	  IF (current = NullLink) THEN
+        EXIT (*--loop*); (*-- theItem is not in the bag *)
+      END (*--if*);
+
+	  itemOrder := compareItem(current^.item, theItem);
+
+      IF (itemOrder = equal) THEN (*-- theItem is in the bag *)
+	    INC(current^.count);
+        RETURN;
+
+	  ELSIF (itemOrder = greater) THEN
+        EXIT (*--loop*); (*-- theItem is not in the bag *)
+      END (*--if*);
+
+      previous := current; (*-- Keep looking *)
+      current  := current^.next;
+    END (*--loop*);
+
+    (*-- Insert the new item *)
+
+	Allocate(newNode, SIZE(Node));
+	IF (newNode = NullLink) THEN
+	  RaiseErrIn(include, overflow);
+    ELSE
+	  WITH newNode^ DO
+	    item  := theItem;
+		count := 1;
+	  END (*--with*);
+	  IF (previous = NullLink) THEN
+	    newNode^.next := inBag^.first;
+		inBag^.first  := newNode;
+	  ELSE
+	    newNode^.next  := current;
+		previous^.next := newNode;
+      END (*--if*);
+      INC(inBag^.length);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*--------------------*)
+
+PROCEDURE Exclude       (    theItem  : Item      (*-- in    *);
+       	       	         VAR fromBag  : Bag       (*-- inout *));
+
+VAR   current     : Link;        (*-- Loop index over items *)
+      previous    : Link;        (*-- Previous node examined *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (fromBag # NullBag) THEN
+	compareItem := CompareOf(fromBag^.dataID);
+    current     := fromBag^.first;
+	previous    := NullLink;
+    LOOP
+	  IF (current = NullLink) THEN
+        RETURN; (*-- theItem is not in the bag *)
+      END (*--if*);
+
+	  itemOrder := compareItem(current^.item, theItem);
+
+      IF (itemOrder = equal) THEN (*-- theItem is in the bag *)
+	    IF (current^.count > 1) THEN
+		  DEC(current^.count);
+		  RETURN;
+		ELSE
+          EXIT (*--loop*);
+		END (*--if*);
+      ELSIF (itemOrder = greater) THEN
+        RETURN;          (*-- theItem is not in the bag *)
+      END (*--if*);
+
+      previous := current;       (*-- Keep looking *)
+      current  := current^.next;
+    END (*--loop*);
+
+    (*-- ╥current╙ points to the node to be deleted. *)
+
+    IF (previous = NullLink) THEN
+	  fromBag^.first := current^.next;
+	ELSE
+	  previous^.next := current^.next;
+	END (*--if*);
+	Deallocate(current, SIZE(current^));
+    DEC(fromBag^.length);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*--------------------*)
+
+PROCEDURE Union         (    left     : Bag       (*-- in    *);
+       	       	             right    : Bag       (*-- in    *);
+                         VAR toBag    : Bag       (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left bag *)
+      rightIndex  : Link;        (*-- Loop index over right bag *)
+	  toIndex     : Link;        (*-- List of target bag nodes *)
+	  tempNode    : Link;        (*-- Temporary node *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(union, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(union, typeerror);
+	RETURN;
+  ELSIF ~Recreate(toBag, left^.dataID) THEN
+    RETURN;
+  END (*--if*);
+
+  compareItem := CompareOf(toBag^.dataID);
+  bagRoutine := union;
+
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+	Allocate(tempNode, SIZE(Node));
+	IF (tempNode = NullLink) THEN
+	  RaiseErrIn(union, overflow);
+	  RETURN;
+	END (*--if*);
+	tempNode^.next := NullLink;
+
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+	INC(toBag^.length);
+
+    IF (order = less) THEN
+	  WITH tempNode^ DO
+        item  := leftIndex^.item;
+	    count := leftIndex^.count;
+	  END (*--with*);
+      leftIndex := leftIndex^.next;
+	ELSIF (order = equal) THEN
+	  WITH tempNode^ DO
+        item  := leftIndex^.item;
+	    count := leftIndex^.count + rightIndex^.count;
+	  END (*--with*);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    ELSE
+	  WITH tempNode^ DO
+        item  := rightIndex^.item;
+	    count := rightIndex^.count;
+	  END (*--with*);
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+
+	TailInsert(tempNode, toBag^.first, toIndex);
+
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from either the left bag or
+    -- the right bag to the destination bag. *)
+
+  IF (leftIndex = NullLink) THEN
+    CopySubset(rightIndex, toIndex, toBag);
+  ELSIF (rightIndex = NullLink) THEN
+    CopySubset(leftIndex, toIndex, toBag);
+  END (*--if*);
+END Union;
+(*--------------------*)
+
+PROCEDURE Intersection  (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop link over left bag *)
+      rightIndex  : Link;        (*-- Loop link over right bag *)
+	  toIndex     : Link;        (*-- List of target bag nodes *)
+	  tempNode    : Link;		 (*-- temporary for new node *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+	  newCount    : CARDINAL;    (*-- Smaller of left/right counts *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(intersection, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(intersection, typeerror);
+	RETURN;
+  ELSIF ~Recreate(toBag, left^.dataID) THEN
+    RETURN;
+  END (*--if*);
+
+  compareItem := CompareOf(toBag^.dataID);
+  bagRoutine := intersection;
+
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+    IF (order = equal) THEN
+
+	  IF (leftIndex^.count < rightIndex^.count) THEN
+	    newCount := leftIndex^.count;
+	  ELSE
+	    newCount := rightIndex^.count;
+	  END (*--if*);
+
+	  tempNode := NewNode(leftIndex^.item, newCount, NullLink);
+	  IF (bagError = overflow) THEN
+	    RETURN;
+	  END (*--if*);
+	  TailInsert(tempNode, toBag^.first, toIndex);
+	  INC(toBag^.length);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSIF (order = less) THEN
+      leftIndex  := leftIndex^.next;
+
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+END Intersection;
+(*--------------------*)
+
+PROCEDURE Difference    (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left bag *)
+      rightIndex  : Link;        (*-- Loop index over right bag *)
+	  toIndex     : Link;        (*-- List of target bag nodes *)
+	  tempNode    : Link;        (*-- Temporary for new node *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(difference, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(difference, typeerror);
+	RETURN;
+  ELSIF ~Recreate(toBag, left^.dataID) THEN
+    RETURN;
+  END (*--if*);
+
+  compareItem := CompareOf(toBag^.dataID);
+  bagRoutine := difference;
+
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+	  IF (leftIndex^.count > rightIndex^.count) THEN
+	    tempNode := NewNode(leftIndex^.item,
+		                    leftIndex^.count - rightIndex^.count,
+							NullLink);
+	    IF (bagError = overflow) THEN
+	      RETURN;
+	    END (*--if*);
+
+	    TailInsert(tempNode, toBag^.first, toIndex);
+	    INC(toBag^.length);
+	  END (*--if*);
+
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSIF (order = less) THEN
+	  WITH leftIndex^ DO
+	    tempNode := NewNode(item, count, NullLink);
+	  END (*--with*);
+	  IF (bagError # noerr) THEN
+	    RETURN;
+	  END (*--if*);
+	  TailInsert(tempNode, toBag^.first, toIndex);
+	  INC(toBag^.length);
+
+      leftIndex  := leftIndex^.next;
+
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from the left bag to the
+    -- destination bag. *)
+
+  CopySubset(leftIndex, toIndex, toBag);
+END Difference;
+(*--------------------*)
+
+PROCEDURE SymDifference (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left bag *)
+      rightIndex  : Link;        (*-- Loop index over right bag *)
+	  toIndex     : Link;        (*-- List of target bag nodes *)
+	  tempNode    : Link;        (*-- Temporary node *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+	  newItem     : Item;        (*-- Either left/right item *)
+	  newCount    : CARDINAL;    (*-- Either left/right count *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(symdifference, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(symdifference, typeerror);
+	RETURN;
+  ELSIF ~Recreate(toBag, left^.dataID) THEN
+    RETURN;
+  END (*--if*);
+
+  compareItem := CompareOf(toBag^.dataID);
+
+  bagRoutine := symdifference;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+	  IF (leftIndex^.count > rightIndex^.count) THEN
+	    WITH leftIndex^ DO
+	      tempNode := NewNode(item, count - rightIndex^.count, NullLink);
+	    END (*--with*);
+	    IF (bagError = overflow) THEN
+	      RETURN;
+	    END (*--if*);
+
+	    TailInsert(tempNode, toBag^.first, toIndex);
+	    INC(toBag^.length);
+	  END (*--if*);
+
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSE
+      IF (order = less) THEN
+	    WITH leftIndex^ DO
+	      newItem  := item;
+		  newCount := count;
+		END (*--with*);
+        leftIndex := leftIndex^.next;
+      ELSE
+	    WITH rightIndex^ DO
+	      newItem  := item;
+		  newCount := count;
+		END (*--with*);
+        rightIndex := rightIndex^.next;
+      END (*--if*);
+
+	  tempNode := NewNode(newItem, newCount, NullLink);
+      IF (tempNode = NullLink) THEN
+        RETURN;
+      END (*--if*);
+
+	  TailInsert(tempNode, toBag^.first, toIndex);
+      INC(toBag^.length);
+    END (*--if*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from either the left bag or
+    -- the right bag to the destination bag. *)
+
+  IF (leftIndex = NullLink) THEN
+    CopySubset(rightIndex, toIndex, toBag);
+  ELSIF (rightIndex = NullLink) THEN
+    CopySubset(leftIndex, toIndex, toBag);
+  END (*--if*);
+END SymDifference;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (theBag # NullBag);
+END IsDefined;
+(*--------------------*)
+
+PROCEDURE IsEmpty       (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN (theBag^.length = 0);
+  END (*--if*);
+
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*--------------------*)
+
+PROCEDURE TypeOf        (    theBag  : Bag      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.dataID;
+  END (*--if*);
+
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*--------------------*)
+
+PROCEDURE IsEqual       (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- Loop index over left bag items *)
+      rightIndex: Link; (*-- Loop index over right bag items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.length = right^.length) THEN
+
+        (*-- Scan both Bags looking for the first mismatch (inequality)
+          -- which indicates that the Bags are unequal.
+          -- If the WHILE loop completes then the Bags must be equal.
+		  -- Because the lengths are equal, rightIndex will be NIL
+		  -- when leftIndex is NIL. *)
+
+        leftIndex := left^.first;
+		rightIndex:= right^.first;
+        WHILE (leftIndex # NullLink) DO
+          IF (leftIndex^.item # rightIndex^.item) THEN
+            RETURN FALSE;
+          END (*--if*);
+		  leftIndex := leftIndex^.next;
+		  rightIndex:= rightIndex^.next;
+        END (*--while*);
+        RETURN TRUE;
+	  END (*--if*);
+	ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+
+  (*-- the Bags must be unequal, either by having different
+    -- lengths, mismatched types, or an undefined Bag exception. *)
+
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE NumMembers    (    theBag  : Bag         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+VAR   current    : Link;
+      totalCount : CARDINAL;
+
+BEGIN
+  bagError   := noerr;
+  totalCount := 0;
+  IF (theBag # NullBag) THEN
+    current := theBag^.first;
+    WHILE (current # NullLink) DO
+      INC(totalCount, current^.count);
+	  current := current^.next;
+    END (*--while*);
+  END (*--if*);
+
+  RaiseErrIn(nummembers, undefined);
+  RETURN totalCount;
+END NumMembers;
+(*----------------------------*)
+
+PROCEDURE UniqueMembers (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.length;
+  END (*--if*);
+
+  RaiseErrIn(uniquemembers, undefined);
+  RETURN 0;
+END UniqueMembers;
+(*----------------------------*)
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+       	       	             theBag  : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index       : Link;        (*-- Loop index over items *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+	  compareItem := CompareOf(dataID);
+	  index := first;
+	END (*--with*);
+    WHILE (index # NullLink) DO
+      IF (theItem = index^.item) THEN
+        RETURN TRUE;
+      ELSE
+	    order := compareItem(index^.item, theItem);
+        IF (order = greater) THEN
+		  RETURN FALSE;
+        END (*--if*);
+      END (*--if*);
+	  index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+PROCEDURE NumberOf      (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+VAR   index       : Link;        (*-- Loop index over items *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+	  compareItem := CompareOf(dataID);
+	  index := first;
+	END (*--with*);
+    WHILE (index # NullLink) DO
+      IF (theItem = index^.item) THEN
+        RETURN index^.count;
+      ELSE
+	    order := compareItem(index^.item, theItem);
+        IF (order = greater) THEN
+		  RETURN 0;
+        END (*--if*);
+      END (*--if*);
+	  index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(numberof, undefined);
+  END (*--if*);
+
+  RETURN 0;
+END NumberOf;
+(*----------------------------*)
+
+PROCEDURE IsSubset      (    left    : Bag         (*-- in    *);
+                             right   : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   leftIndex   : Link;    (*-- Loop index over left bag *)
+      rightIndex  : Link;    (*-- Loop index over right bag *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(issubset, undefined);
+    RETURN FALSE;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(issubset, typeerror);
+    RETURN FALSE;
+  END (*--if*);
+
+  compareItem:= CompareOf(left^.dataID);
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+    IF (order = equal) THEN
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    ELSIF (order = less) THEN
+      RETURN FALSE;
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+  RETURN (leftIndex = NullLink);
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset(    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & (left^.length < right^.length);
+END IsProperSubset;
+(*----------------------------*)
+
+
+    (*---------------------------------*)
+    (*--         ITERATORS           --*)
+
+PROCEDURE LoopOver   (    theBag  : Bag            (*-- in    *);
+                          process : LoopAccessProc (*-- in    *));
+
+VAR   theNode : Link; (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+	theNode := theBag^.first;
+    WHILE (theNode # NullLink) DO
+	  WITH theNode^ DO
+        IF ~process(item, count) THEN
+          RETURN;
+        END (*--if*);
+	  END (*--with*);
+      theNode := theNode^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE Traverse   (    theBag  : Bag            (*-- in    *);
+                          process : AccessProc     (*-- in    *));
+
+VAR   theNode : Link; (*-- Loop index over items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+	theNode := theBag^.first;
+    WHILE (theNode # NullLink) DO
+	  WITH theNode^ DO
+        process(item, count);
+	  END (*--with*);
+      theNode := theNode^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+
+(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
+(*~~ MODULE INITIALIZATION  ~~*)
+
+BEGIN
+  FOR bagError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[bagError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  bagError := noerr;
+END BagSUUI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUUN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUUN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUUN.DEF
@@ -0,0 +1,126 @@
+DEFINITION MODULE BagSUUN;
+(*==============================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Sequential Unbounded Unmanaged Non-Iterator
+
+    INTRODUCTION
+    This module provides the Bag ADT for generic Items. Uses an
+	ordered, linear list to implement the set of items. The TypeID
+	is necessary for its comparison routine.
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins
+      Initial implementation derived from BagSUUI.
+
+    (C) Copyright 1989 Charles A. Lins
+================================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  Bag;
+CONST NullBag = Bag(NIL);
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+CONST ModuleID = 10;
+
+PROCEDURE BagError    ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        (    theType : TypeID (*-- in    *))
+                                     : Bag    (*-- out   *);
+
+PROCEDURE Destroy       (VAR theBag  : Bag    (*-- inout *));
+
+PROCEDURE Clear         (VAR theBag  : Bag    (*-- inout *));
+
+PROCEDURE Assign        (    theBag  : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+PROCEDURE Include       (    theItem : Item   (*-- in    *);
+       	       	         VAR inBag   : Bag    (*-- inout *));
+
+PROCEDURE Exclude       (    theItem : Item   (*-- in    *);
+       	       	         VAR fromBag : Bag    (*-- inout *));
+
+PROCEDURE Union         (    left    : Bag    (*-- in    *);
+       	       	             right   : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+PROCEDURE Intersection  (    left    : Bag    (*-- in    *);
+       	       	             right   : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+PROCEDURE Difference    (    left    : Bag    (*-- in    *);
+       	       	             right   : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+PROCEDURE SymDifference (    left    : Bag    (*-- in    *);
+       	       	             right   : Bag    (*-- in    *);
+                         VAR toBag   : Bag    (*-- inout *));
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty       (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE TypeOf        (    theBag  : Bag      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+
+PROCEDURE NumMembers    (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE UniqueMembers (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE NumberOf      (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Bag      (*-- in    *);
+       	       	             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+END BagSUUN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUUN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUUN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/BAGS/BAGSUUN.MOD
@@ -0,0 +1,913 @@
+IMPLEMENTATION MODULE BagSUUN;
+(*==============================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Bag
+               Sequential Unbounded Unmanaged Non-Iterator
+    Code Size: R-  bytes
+
+    INTRODUCTION
+    This module provides the Bag ADT for generic Items. Uses an
+	ordered, linear list for the items.
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins
+        Initial implementation derived from BagSUUI module.
+
+    (C) Copyright 1989 Charles A. Lins
+================================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM BagEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) CompareOf;
+
+    (*--------------------*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD      (*-- a bag item node *)
+        item : Item;     (*-- the item nodes' data *)
+		count: CARDINAL; (*-- number of these items *)
+		next : Link;     (*-- link to next node in list *)
+	  END (*-- Node *);
+CONST NullLink = NIL;
+
+TYPE  UnboundedBag = RECORD (*-- bag header *)
+		dataID : TypeID;    (*-- defined data type *)
+        length : CARDINAL;  (*-- current bag length, := 0 *)
+        first  : Link;      (*-- link to first Item node *)
+      END (*-- UnboundedBag *);
+
+TYPE  Bag = POINTER TO UnboundedBag;
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+VAR   bagError  : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+PROCEDURE BagError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN bagError;
+END BagError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  bagError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--       LOCAL ROUTINES        --*)
+
+VAR   bagRoutine : Operations;  (*-- Routine calling NewNode *)
+
+PROCEDURE NewNode       (    theItem : Item        (*-- in    *);
+       	       	             theCount: CARDINAL    (*-- in    *);
+       	       	             theNext : Link        (*-- in    *))
+							         : Link        (*-- out   *);
+
+VAR   newLink : Link;
+
+BEGIN
+  Allocate(newLink, SIZE(Node));
+  IF (newLink = NullLink) THEN
+    RaiseErrIn(bagRoutine, overflow);
+  ELSE
+    WITH newLink^ DO
+	  item  := theItem;
+	  count := theCount;
+	  next  := theNext;
+	END (*--with*);
+  END (*--if*);
+  RETURN newLink;
+END NewNode;
+(*--------------------*)
+
+PROCEDURE TailInsert (    theNode : Link (*--in   *);
+					  VAR first   : Link (*--inout*);
+					  VAR last    : Link (*--inout*));
+BEGIN
+  IF (first = NullLink) THEN
+	first := theNode;
+  ELSE
+	last^.next := theNode;
+  END (*--if*);
+  last := theNode;
+END TailInsert;
+(*--------------------*)
+
+PROCEDURE CopySubset (    fromIndex  : Link       (*-- in    *);
+                          toIndex    : Link       (*-- in    *);
+                      VAR toBag      : Bag        (*-- inout *));
+
+VAR   tempNode : Link;
+
+BEGIN
+  LOOP
+    IF (fromIndex = NullLink) THEN
+	  EXIT (*--loop*);
+	ELSE
+	  WITH fromIndex^ DO
+	    tempNode := NewNode(item, count, NIL);
+	  END (*--with*);
+	  IF (tempNode = NullLink) THEN
+	    EXIT (*--loop*);
+	  END (*--if*);
+	  INC(toBag^.length);
+	  TailInsert(tempNode, toBag^.first, toIndex);
+      fromIndex := fromIndex^.next;
+	END (*--if*);
+  END (*--loop*);
+END CopySubset;
+(*--------------------*)
+
+PROCEDURE Recreate (VAR theBag  : Bag       (*--inout*);
+                        theType : TypeID    (*--in   *))
+                                : BOOLEAN   (*--out  *);
+BEGIN
+  IF (theBag = NullBag) THEN
+    theBag := Create(theType);
+  ELSE
+    Clear(theBag);
+    theBag^.dataID := theType;
+  END (*--if*);
+  RETURN (bagError = noerr);
+END Recreate;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create        (    theType  : TypeID    (*-- in    *))
+                                      : Bag       (*-- out   *);
+
+VAR   newBag : Bag; (*-- new bag variable being created *)
+
+BEGIN
+  bagError := noerr;
+  Allocate(newBag, SIZE(UnboundedBag));
+  IF (newBag = NullBag) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newBag^ DO
+	  dataID := theType;
+      length := 0;
+	  first  := NullLink;
+    END (*--with*);
+  END (*--if*);
+  RETURN newBag;
+END Create;
+(*--------------------*)
+
+PROCEDURE Destroy       (VAR theBag   : Bag       (*-- inout *));
+BEGIN
+  Clear(theBag);
+  IF (bagError = noerr) THEN
+    Deallocate(theBag, SIZE(UnboundedBag));
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+PROCEDURE Clear         (VAR theBag   : Bag       (*-- inout *));
+
+VAR   theNode  : Link;        (*-- Bag node to be deallocated *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+	  WHILE (first # NullLink) DO
+	    theNode := first;
+		first   := first^.next;
+		Deallocate(theNode, SIZE(theNode^));
+	  END (*--while*);
+  	  length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+PROCEDURE Assign        (    theBag   : Bag       (*-- in    *);
+                         VAR toBag    : Bag       (*-- inout *));
+
+VAR   fromIndex : Link; (*-- Loop index over source bag items *)
+	  toIndex   : Link; (*-- new item node in target bag *)
+
+BEGIN
+  bagError := noerr;
+  bagRoutine := assign;
+  IF (theBag # NullBag) THEN
+    IF Recreate(toBag, theBag^.dataID) THEN
+	  IF (theBag^.first = NullLink) THEN
+		RETURN;
+	  END (*--if*);
+
+      WITH theBag^.first^ DO
+	    toBag^.first := NewNode(item, count, NullLink);
+	  END (*--with*);
+	  IF (bagError = overflow) THEN
+        RETURN;
+	  END (*--if*);
+	  toIndex   := toBag^.first;
+	  fromIndex := theBag^.first;
+
+      WHILE (fromIndex^.next # NIL) DO
+	    fromIndex := fromIndex^.next;
+        WITH fromIndex^ DO
+	      toIndex^.next := NewNode(item, count, NullLink);
+	    END (*--with*);
+	    IF (bagError = overflow) THEN
+		  RETURN;
+        END (*--if*);
+        toIndex := toIndex^.next;
+      END (*--while*);
+      toBag^.length := theBag^.length;
+    END (*--if*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+PROCEDURE Include       (    theItem  : Item      (*-- in    *);
+       	       	         VAR inBag    : Bag       (*-- inout *));
+
+VAR   current     : Link;        (*-- Loop index in search of theItem *)
+      previous    : Link;        (*-- Previous node examined *)
+	  newNode     : Link;        (*-- For new node to add *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  itemOrder   : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (inBag # NullBag) THEN
+	compareItem := CompareOf(inBag^.dataID);
+    current     := inBag^.first;
+	previous    := NullLink;
+    LOOP
+	  IF (current = NullLink) THEN
+        EXIT (*--loop*); (*-- theItem is not in the bag *)
+      END (*--if*);
+
+	  itemOrder := compareItem(current^.item, theItem);
+
+      IF (itemOrder = equal) THEN (*-- theItem is in the bag *)
+	    INC(current^.count);
+        RETURN;
+
+	  ELSIF (itemOrder = greater) THEN
+        EXIT (*--loop*); (*-- theItem is not in the bag *)
+      END (*--if*);
+
+      previous := current; (*-- Keep looking *)
+      current  := current^.next;
+    END (*--loop*);
+
+    (*-- Insert the new item *)
+
+	Allocate(newNode, SIZE(Node));
+	IF (newNode = NullLink) THEN
+	  RaiseErrIn(include, overflow);
+    ELSE
+	  WITH newNode^ DO
+	    item  := theItem;
+		count := 1;
+	  END (*--with*);
+	  IF (previous = NullLink) THEN
+	    newNode^.next := inBag^.first;
+		inBag^.first  := newNode;
+	  ELSE
+	    newNode^.next  := current;
+		previous^.next := newNode;
+      END (*--if*);
+      INC(inBag^.length);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*--------------------*)
+
+PROCEDURE Exclude       (    theItem  : Item      (*-- in    *);
+       	       	         VAR fromBag  : Bag       (*-- inout *));
+
+VAR   current     : Link;        (*-- Loop index over items *)
+      previous    : Link;        (*-- Previous node examined *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (fromBag # NullBag) THEN
+	compareItem := CompareOf(fromBag^.dataID);
+    current     := fromBag^.first;
+	previous    := NullLink;
+    LOOP
+	  IF (current = NullLink) THEN
+        RETURN; (*-- theItem is not in the bag *)
+      END (*--if*);
+
+	  itemOrder := compareItem(current^.item, theItem);
+
+      IF (itemOrder = equal) THEN (*-- theItem is in the bag *)
+	    IF (current^.count > 1) THEN
+		  DEC(current^.count);
+		  RETURN;
+		ELSE
+          EXIT (*--loop*);
+		END (*--if*);
+      ELSIF (itemOrder = greater) THEN
+        RETURN;          (*-- theItem is not in the bag *)
+      END (*--if*);
+
+      previous := current;       (*-- Keep looking *)
+      current  := current^.next;
+    END (*--loop*);
+
+    (*-- ╥current╙ points to the node to be deleted. *)
+
+    IF (previous = NullLink) THEN
+	  fromBag^.first := current^.next;
+	ELSE
+	  previous^.next := current^.next;
+	END (*--if*);
+	Deallocate(current, SIZE(current^));
+    DEC(fromBag^.length);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*--------------------*)
+
+PROCEDURE Union         (    left     : Bag       (*-- in    *);
+       	       	             right    : Bag       (*-- in    *);
+                         VAR toBag    : Bag       (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left bag *)
+      rightIndex  : Link;        (*-- Loop index over right bag *)
+	  toIndex     : Link;        (*-- List of target bag nodes *)
+	  tempNode    : Link;        (*-- Temporary node *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(union, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(union, typeerror);
+	RETURN;
+  ELSIF ~Recreate(toBag, left^.dataID) THEN
+    RETURN;
+  END (*--if*);
+
+  compareItem := CompareOf(toBag^.dataID);
+  bagRoutine := union;
+
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+	Allocate(tempNode, SIZE(Node));
+	IF (tempNode = NullLink) THEN
+	  RaiseErrIn(union, overflow);
+	  RETURN;
+	END (*--if*);
+	tempNode^.next := NullLink;
+
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+	INC(toBag^.length);
+
+    IF (order = less) THEN
+	  WITH tempNode^ DO
+        item  := leftIndex^.item;
+	    count := leftIndex^.count;
+	  END (*--with*);
+      leftIndex := leftIndex^.next;
+	ELSIF (order = equal) THEN
+	  WITH tempNode^ DO
+        item  := leftIndex^.item;
+	    count := leftIndex^.count + rightIndex^.count;
+	  END (*--with*);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    ELSE
+	  WITH tempNode^ DO
+        item  := rightIndex^.item;
+	    count := rightIndex^.count;
+	  END (*--with*);
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+
+	TailInsert(tempNode, toBag^.first, toIndex);
+
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from either the left bag or
+    -- the right bag to the destination bag. *)
+
+  IF (leftIndex = NullLink) THEN
+    CopySubset(rightIndex, toIndex, toBag);
+  ELSIF (rightIndex = NullLink) THEN
+    CopySubset(leftIndex, toIndex, toBag);
+  END (*--if*);
+END Union;
+(*--------------------*)
+
+PROCEDURE Intersection  (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop link over left bag *)
+      rightIndex  : Link;        (*-- Loop link over right bag *)
+	  toIndex     : Link;        (*-- List of target bag nodes *)
+	  tempNode    : Link;		 (*-- temporary for new node *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+	  newCount    : CARDINAL;    (*-- Smaller of left/right counts *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(intersection, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(intersection, typeerror);
+	RETURN;
+  ELSIF ~Recreate(toBag, left^.dataID) THEN
+    RETURN;
+  END (*--if*);
+  
+  compareItem := CompareOf(toBag^.dataID);
+  bagRoutine := intersection;
+
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+    IF (order = equal) THEN
+
+	  IF (leftIndex^.count < rightIndex^.count) THEN
+	    newCount := leftIndex^.count;
+	  ELSE
+	    newCount := rightIndex^.count;
+	  END (*--if*);
+
+	  tempNode := NewNode(leftIndex^.item, newCount, NullLink);
+	  IF (bagError = overflow) THEN
+	    RETURN;
+	  END (*--if*);
+	  TailInsert(tempNode, toBag^.first, toIndex);
+	  INC(toBag^.length);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSIF (order = less) THEN
+      leftIndex  := leftIndex^.next;
+
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+END Intersection;
+(*--------------------*)
+
+PROCEDURE Difference    (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left bag *)
+      rightIndex  : Link;        (*-- Loop index over right bag *)
+	  toIndex     : Link;        (*-- List of target bag nodes *)
+	  tempNode    : Link;        (*-- Temporary for new node *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(difference, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(difference, typeerror);
+	RETURN;
+  ELSIF ~Recreate(toBag, left^.dataID) THEN
+    RETURN;
+  END (*--if*);
+  
+  compareItem := CompareOf(toBag^.dataID);
+  bagRoutine := difference;
+
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+	  IF (leftIndex^.count > rightIndex^.count) THEN
+	    tempNode := NewNode(leftIndex^.item,
+		                    leftIndex^.count - rightIndex^.count,
+							NullLink);
+	    IF (bagError = overflow) THEN
+	      RETURN;
+	    END (*--if*);
+
+	    TailInsert(tempNode, toBag^.first, toIndex);
+	    INC(toBag^.length);
+	  END (*--if*);
+
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSIF (order = less) THEN
+	  WITH leftIndex^ DO
+	    tempNode := NewNode(item, count, NullLink);
+	  END (*--with*);
+	  IF (bagError # noerr) THEN
+	    RETURN;
+	  END (*--if*);
+	  TailInsert(tempNode, toBag^.first, toIndex);
+	  INC(toBag^.length);
+
+      leftIndex  := leftIndex^.next;
+
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from the left bag to the
+    -- destination bag. *)
+
+  CopySubset(leftIndex, toIndex, toBag);
+END Difference;
+(*--------------------*)
+
+PROCEDURE SymDifference (    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *);
+                         VAR toBag   : Bag         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left bag *)
+      rightIndex  : Link;        (*-- Loop index over right bag *)
+	  toIndex     : Link;        (*-- List of target bag nodes *)
+	  tempNode    : Link;        (*-- Temporary node *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+	  newItem     : Item;        (*-- Either left/right item *)
+	  newCount    : CARDINAL;    (*-- Either left/right count *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(symdifference, undefined);
+	RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(symdifference, typeerror);
+	RETURN;
+  ELSIF ~Recreate(toBag, left^.dataID) THEN
+    RETURN;
+  END (*--if*);
+  
+  compareItem := CompareOf(toBag^.dataID);
+
+  bagRoutine := symdifference;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+	  IF (leftIndex^.count > rightIndex^.count) THEN
+	    WITH leftIndex^ DO
+	      tempNode := NewNode(item, count - rightIndex^.count, NullLink);
+	    END (*--with*);
+	    IF (bagError = overflow) THEN
+	      RETURN;
+	    END (*--if*);
+
+	    TailInsert(tempNode, toBag^.first, toIndex);
+	    INC(toBag^.length);
+	  END (*--if*);
+
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSE
+      IF (order = less) THEN
+	    WITH leftIndex^ DO
+	      newItem  := item;
+		  newCount := count;
+		END (*--with*);
+        leftIndex := leftIndex^.next;
+      ELSE
+	    WITH rightIndex^ DO
+	      newItem  := item;
+		  newCount := count;
+		END (*--with*);
+        rightIndex := rightIndex^.next;
+      END (*--if*);
+
+	  tempNode := NewNode(newItem, newCount, NullLink);
+      IF (tempNode = NullLink) THEN
+        RETURN;
+      END (*--if*);
+
+	  TailInsert(tempNode, toBag^.first, toIndex);
+      INC(toBag^.length);
+    END (*--if*);
+  END (*--while*);
+
+  (*-- Copy remaining items, if any, from either the left bag or
+    -- the right bag to the destination bag. *)
+
+  IF (leftIndex = NullLink) THEN
+    CopySubset(rightIndex, toIndex, toBag);
+  ELSIF (rightIndex = NullLink) THEN
+    CopySubset(leftIndex, toIndex, toBag);
+  END (*--if*);
+END SymDifference;
+(*--------------------*)
+
+
+    (*---------------------------------*)
+    (*--         SELECTORS           --*)
+
+PROCEDURE IsDefined     (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (theBag # NullBag);
+END IsDefined;
+(*--------------------*)
+
+PROCEDURE IsEmpty       (    theBag  : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN (theBag^.length = 0);
+  END (*--if*);
+
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*--------------------*)
+
+PROCEDURE TypeOf        (    theBag  : Bag      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.dataID;
+  END (*--if*);
+
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*--------------------*)
+
+PROCEDURE IsEqual       (    left    : Bag      (*-- in    *);
+                             right   : Bag      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- Loop index over left bag items *)
+      rightIndex: Link; (*-- Loop index over right bag items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left # NullBag) & (right # NullBag) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.length = right^.length) THEN
+
+        (*-- Scan both Bags looking for the first mismatch (inequality)
+          -- which indicates that the Bags are unequal.
+          -- If the WHILE loop completes then the Bags must be equal.
+		  -- Because the lengths are equal, rightIndex will be NIL
+		  -- when leftIndex is NIL. *)
+
+        leftIndex := left^.first;
+		rightIndex:= right^.first;
+        WHILE (leftIndex # NullLink) DO
+          IF (leftIndex^.item # rightIndex^.item) THEN
+            RETURN FALSE;
+          END (*--if*);
+		  leftIndex := leftIndex^.next;
+		  rightIndex:= rightIndex^.next;
+        END (*--while*);
+        RETURN TRUE;
+	  END (*--if*);
+	ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+
+  (*-- the Bags must be unequal, either by having different
+    -- lengths, mismatched types, or an undefined Bag exception. *)
+
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE NumMembers    (    theBag  : Bag         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+VAR   current    : Link;
+      totalCount : CARDINAL;
+
+BEGIN
+  bagError   := noerr;
+  totalCount := 0;
+  IF (theBag # NullBag) THEN
+    current := theBag^.first;
+    WHILE (current # NullLink) DO
+      INC(totalCount, current^.count);
+	  current := current^.next;
+    END (*--while*);
+  END (*--if*);
+
+  RaiseErrIn(nummembers, undefined);
+  RETURN totalCount;
+END NumMembers;
+(*----------------------------*)
+
+PROCEDURE UniqueMembers (    theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    RETURN theBag^.length;
+  END (*--if*);
+
+  RaiseErrIn(uniquemembers, undefined);
+  RETURN 0;
+END UniqueMembers;
+(*----------------------------*)
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+       	       	             theBag  : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index       : Link;        (*-- Loop index over items *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+	  compareItem := CompareOf(dataID);
+	  index := first;
+	END (*--with*);
+    WHILE (index # NullLink) DO
+      IF (theItem = index^.item) THEN
+        RETURN TRUE;
+      ELSE
+	    order := compareItem(index^.item, theItem);
+        IF (order = greater) THEN
+		  RETURN FALSE;
+        END (*--if*);
+      END (*--if*);
+	  index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+PROCEDURE NumberOf      (    theItem : Item     (*-- in    *);
+       	       	             theBag  : Bag      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+VAR   index       : Link;        (*-- Loop index over items *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (theBag # NullBag) THEN
+    WITH theBag^ DO
+	  compareItem := CompareOf(dataID);
+	  index := first;
+	END (*--with*);
+    WHILE (index # NullLink) DO
+      IF (theItem = index^.item) THEN
+        RETURN index^.count;
+      ELSE
+	    order := compareItem(index^.item, theItem);
+        IF (order = greater) THEN
+		  RETURN 0;
+        END (*--if*);
+      END (*--if*);
+	  index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(numberof, undefined);
+  END (*--if*);
+
+  RETURN 0;
+END NumberOf;
+(*----------------------------*)
+
+PROCEDURE IsSubset      (    left    : Bag         (*-- in    *);
+                             right   : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   leftIndex   : Link;    (*-- Loop index over left bag *)
+      rightIndex  : Link;    (*-- Loop index over right bag *)
+	  compareItem : CompareProc; (*-- Item comparison routine *)
+	  order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  bagError := noerr;
+  IF (left = NullBag) OR (right = NullBag) THEN
+    RaiseErrIn(issubset, undefined);
+    RETURN FALSE;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(issubset, typeerror);
+    RETURN FALSE;
+  END (*--if*);
+
+  compareItem:= CompareOf(left^.dataID);
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+    IF (order = equal) THEN
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    ELSIF (order = less) THEN
+      RETURN FALSE;
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+  RETURN (leftIndex = NullLink);
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset(    left    : Bag         (*-- in    *);
+       	       	             right   : Bag         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & (left^.length < right^.length);
+END IsProperSubset;
+(*----------------------------*)
+
+
+(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
+(*~~ MODULE INITIALIZATION  ~~*)
+
+BEGIN
+  FOR bagError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[bagError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  bagError := noerr;
+END BagSUUN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/BYTEITEM.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/BYTEITEM.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/BYTEITEM.DEF
@@ -0,0 +1,50 @@
+DEFINITION MODULE ByteItems;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Generic Item Structure Utility - BYTE Items
+
+    INTRODUCTION
+    This module provides support for generic data items, restricted
+    to types compatible with BYTE.  Assignment, equality testing, and
+    relational operations are all provided by the language.
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved. 
+====================================================================*)
+
+FROM SYSTEM IMPORT
+    (*--Type*) BYTE;
+
+
+TYPE  Item	= BYTE; 	    (*-- The BYTE item data type *)
+CONST NullItem	= VAL(BYTE, 0C);    (*-- The ╘null╒ value *)
+
+
+TYPE  AssignProc  = PROCEDURE (    Item    (*-- in    *))
+				 : Item    (*-- out   *);
+
+TYPE  EqualProc   = PROCEDURE (    Item    (*-- in    *),
+				   Item    (*-- in    *))
+				 : BOOLEAN (*-- out   *);
+
+
+    (*---------------------------------*)
+    (*--	 ITERATORS	     --*)
+
+TYPE  AccessProc     = PROCEDURE (    Item     (*-- in	  *));
+TYPE  ChangeProc     = PROCEDURE (VAR Item     (*-- inout *));
+
+
+TYPE  Continue	     = BOOLEAN;
+TYPE  LoopAccessProc = PROCEDURE (    Item     (*-- in	  *))
+				    : Continue (*-- out   *);
+
+TYPE  LoopChangeProc = PROCEDURE (VAR Item     (*-- inout *))
+				    : Continue (*-- out   *);
+
+END ByteItems.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/BYTEITEM.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/BYTEITEM.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/BYTEITEM.MOD
@@ -0,0 +1,19 @@
+IMPLEMENTATION MODULE ByteItems;
+(*====================================================================
+   Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+   Compiler : JPI TopSpeed Modula-2
+   Code Size: R-  bytes
+   Component: Generic Item Structures - BYTE compatible
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    IMPLEMENTATION DESIGN NOTES
+    * The JPI compiler requires an empty implementation module.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved.
+====================================================================*)
+
+END ByteItems.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/CHARITEM.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/CHARITEM.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/CHARITEM.DEF
@@ -0,0 +1,44 @@
+DEFINITION MODULE CharItems;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Generic Item Structure Utility - Character Items
+
+    INTRODUCTION
+    This module provides support for generic data items, restricted
+    to types compatible with CHAR.  Assignment, equality testing, and
+    relational operations are all provided by the language.
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved. 
+====================================================================*)
+
+TYPE  Item	= CHAR;  (*-- The CHAR item data type *)
+CONST NullItem	= 0C;	 (*-- The ╘null╒ value *)
+
+TYPE  AssignProc  = PROCEDURE (    Item    (*-- in    *))
+				 : Item    (*-- out   *);
+
+TYPE  EqualProc   = PROCEDURE (    Item    (*-- in    *),
+				   Item    (*-- in    *))
+				 : BOOLEAN (*-- out   *);
+
+    (*---------------------------------*)
+    (*--	 ITERATORS	     --*)
+
+TYPE  AccessProc     = PROCEDURE (    Item     (*-- in	  *));
+TYPE  ChangeProc     = PROCEDURE (VAR Item     (*-- inout *));
+
+
+TYPE  Continue	     = BOOLEAN;
+TYPE  LoopAccessProc = PROCEDURE (    Item     (*-- in	  *))
+				    : Continue (*-- out   *);
+
+TYPE  LoopChangeProc = PROCEDURE (VAR Item     (*-- inout *))
+				    : Continue (*-- out   *);
+
+END CharItems.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/CHARITEM.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/CHARITEM.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/CHARITEM.MOD
@@ -0,0 +1,19 @@
+IMPLEMENTATION MODULE CharItems;
+(*====================================================================
+   Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+   Compiler : JPI TopSpeed Modula-2
+   Code Size: R-  bytes
+   Component: Generic Item Structures - CHAR compatible
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    IMPLEMENTATION DESIGN NOTES
+    * The JPI compiler requires an empty implementation module.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved.
+====================================================================*)
+
+END CharItems.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ERRORHAN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ERRORHAN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ERRORHAN.DEF
@@ -0,0 +1,68 @@
+DEFINITION MODULE ErrorHandling;
+(*====================================================================
+    Version  : 1.0  Sun, Mar 5, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Standard Error Handling Support Utility
+
+    INTRODUCTION
+    This module provides a general support mechanism for the exceptions
+    declared by the various ADT component modules.
+
+    Having a general error code for all modules allows use of general
+    exception handlers, instead of being restricted to a specific
+    group of data structure modules.  Consistent error reporting is
+    also better supported since the mechanism provided here supports
+    mapping of error values to the strings displayed for the module
+    and operation raising the exception, as well as a description of
+    the exception condition.
+
+    The facilities provided by the module cover these functional areas:
+      (1) translation between local exception enumerations to the
+	  global gneral error code, and the reverse translation;
+      (2) the standard error reporting mechanism;
+      (3) predefined error handlers; and
+      (4) standard exception handler invocation mechanism.
+
+
+    REVISION HISTORY
+    v1.0  Sun, Mar 5, 1989  C. Lins
+      Initial JPI implementation.
+
+    CONSTRUCTORS
+    * Raise in ModuleID, in Operation, in Exception, in HandlerProc
+	Requires: NOTHING
+	Modifies: NOTHING
+	Effects:  Standard exception handler activation routine
+		  1. If the HandlerProc is not ╥NullHandler╙, the
+		     handler is invoked, followed by exiting Raise.
+		     (Assuming the HandlerProc returns).
+		  2. Otherwise, if the default handler is ╥NullHandler╙,
+		     Raise is exited.
+	Signals:  NOTHING
+
+    PROPRIETARY NOTICES
+    "ErrorHandling.DEF" Copyright (C) 1989 Charles A. Lins.
+====================================================================*)
+
+FROM SYSTEM IMPORT (*--Type*) BYTE;
+
+    (*-----------------------*)
+
+TYPE  ModuleNo	  = CARDINAL;
+TYPE  Operation   = BYTE;
+TYPE  Exception   = BYTE;
+
+TYPE  HandlerProc = PROCEDURE (ModuleNo, Operation, Exception);
+CONST NullHandler = NULLPROC;
+
+PROCEDURE ExitOnError	 (    moduleID	 : ModuleNo    (*-- in	  *);
+			      operation  : Operation   (*-- in	  *);
+			      exception  : Exception   (*-- in	  *));
+
+PROCEDURE Raise 	 (    moduleID	 : ModuleNo    (*-- in	  *);
+			      operation  : Operation   (*-- in	  *);
+			      exception  : Exception   (*-- in	  *);
+			      theHandler : HandlerProc (*-- in	  *));
+
+END ErrorHandling.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ERRORHAN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ERRORHAN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ERRORHAN.MOD
@@ -0,0 +1,44 @@
+IMPLEMENTATION MODULE ErrorHandling;
+(*====================================================================
+    Version  : 1.0  Sun, Mar 5, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Code Size: R-  bytes
+    Data Size: 10 bytes
+    Component: Standard Error Handling Support Utility
+
+    INTRODUCTION
+    This module provides a general support mechanism for the exceptions
+    declared by the various ADT component modules.
+
+    REVISION HISTORY
+    v1.0  Sun, Mar 5, 1989  C. Lins
+      Initial JPI implementation.
+
+    PROPRIETARY NOTICES
+    ErrorHandling.MOD Copyright (C) 1989 Charles A. Lins.
+====================================================================*)
+
+FROM SYSTEM IMPORT
+    (*--Type*) BYTE;
+
+
+PROCEDURE ExitOnError	 (    moduleID	 : CARDINAL    (*-- in	  *);
+			      operation  : BYTE        (*-- in	  *);
+			      exception  : BYTE        (*-- in	  *));
+BEGIN
+  HALT;
+END ExitOnError;
+(*----------------------------*)
+
+PROCEDURE Raise 	 (    moduleID	 : CARDINAL    (*-- in	  *);
+			      operation  : BYTE        (*-- in	  *);
+			      exception  : BYTE        (*-- in	  *);
+			      theHandler : HandlerProc (*-- in	  *));
+BEGIN
+  IF (theHandler # NullHandler) THEN
+    theHandler(moduleID, operation, exception);
+  END (*--if*);
+END Raise;
+(*----------------------------*)
+
+END ErrorHandling.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/INTEGERI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/INTEGERI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/INTEGERI.DEF
@@ -0,0 +1,47 @@
+DEFINITION MODULE IntegerItems; 
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Utility - INTEGER Item Type Definitions
+
+    INTRODUCTION
+    This module provides operations supporting INTEGER Items.
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    INTERFACE DESIGN ISSUES
+    * The procedure type declarations representing assignment, equality,
+      and comparison operations, are not strictly necessary since these
+      operations can be accomplished using the predefined operations for
+      INTEGERs.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved.
+====================================================================*)
+
+TYPE  Item	= INTEGER;  (*-- The discrete item data type *)
+CONST NullItem	= 0;	    (*-- An ╘empty╒ INTEGER value *)
+
+
+TYPE  AssignProc  = PROCEDURE (    Item (*-- in    *))
+				 : Item (*-- out   *);
+
+TYPE  EqualProc   = PROCEDURE (    Item    (*-- in    *),
+				   Item    (*-- in    *))
+				 : BOOLEAN (*-- out   *);
+
+
+TYPE  AccessProc    = PROCEDURE (    Item     (*-- in	 *));
+TYPE  ChangeProc    = PROCEDURE (VAR Item     (*-- inout *));
+
+
+TYPE  Continue	     = BOOLEAN;
+TYPE  LoopAccessProc = PROCEDURE (    Item     (*-- in	  *))
+				    : Continue (*-- out   *);
+
+TYPE  LoopChangeProc = PROCEDURE (VAR Item     (*-- inout *))
+				    : Continue (*-- out   *);
+
+END IntegerItems.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/INTEGERI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/INTEGERI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/INTEGERI.MOD
@@ -0,0 +1,19 @@
+IMPLEMENTATION MODULE IntegerItems;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Utility - INTEGER Item Type Definitions
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    IMPLEMENTATION ISSUES
+    * An empty implementation module is required by the JPI compiler.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved.
+====================================================================*)
+
+END IntegerItems.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMCONV.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMCONV.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMCONV.DEF
@@ -0,0 +1,68 @@
+
+DEFINITION MODULE ItemConversions;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Item Conversions Utility
+
+    INTRODUCTION
+    This module provides conversion operations between generic items
+    and the basic data types.
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    PROPRIETARY NOTICES
+    "ItemConversions.DEF", by C. Lins, Copyright (C) 1989 Charles A. Lins.
+=====================================================================*)
+
+FROM SYSTEM IMPORT
+    (*--Type*) ADDRESS;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+    (*--------------------*)
+
+
+(*--
+    Basic Type -> Item Conversions
+--*)
+
+PROCEDURE AddrToItem (	  x : ADDRESS  (*-- in	  *))
+			    : Item     (*-- out   *);
+
+PROCEDURE CardToItem (	  x : CARDINAL (*-- in	  *))
+			    : Item     (*-- out   *);
+
+PROCEDURE CharToItem (	  x : CHAR     (*-- in	  *))
+			    : Item     (*-- out   *);
+
+PROCEDURE IntToItem  (	  x : INTEGER  (*-- in	  *))
+			    : Item     (*-- out   *);
+
+PROCEDURE RealToItem (	  x : REAL     (*-- in	  *))
+			    : Item     (*-- out   *);
+
+
+(*--
+    Item -> Basic Type Conversions
+--*)
+
+PROCEDURE ItemToAddr (	  x : Item	(*-- in    *))
+			    : ADDRESS	(*-- out   *);
+
+PROCEDURE ItemToCard (	  x : Item	(*-- in    *))
+			    : CARDINAL	(*-- out   *);
+
+PROCEDURE ItemToChar (	  x : Item	(*-- in    *))
+			    : CHAR	(*-- out   *);
+
+PROCEDURE ItemToInt  (	  x : Item	(*-- in    *))
+			    : INTEGER	(*-- out   *);
+
+PROCEDURE ItemToReal (	  x : Item	(*-- in    *))
+			    : REAL	(*-- out   *);
+
+END ItemConversions.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMCONV.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMCONV.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMCONV.MOD
@@ -0,0 +1,104 @@
+IMPLEMENTATION MODULE ItemConversions;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Item Conversions Utility
+
+    INTRODUCTION
+    This module provides conversion operations between generic items
+    and the basic data types.
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    PROPRIETARY NOTICES
+    ItemConversions.MOD, by C. Lins, Copyright (C) 1989 Charles A. Lins.
+=====================================================================*)
+
+FROM SYSTEM IMPORT
+    (*--Type*) ADDRESS;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+    (*--------------------*)
+
+PROCEDURE AddrToItem (	  x : ADDRESS  (*-- in	  *))
+			    : Item     (*-- out   *);
+BEGIN
+  RETURN Item(x);
+END AddrToItem;
+(*--------------------*)
+
+PROCEDURE CardToItem (	  x : CARDINAL (*-- in	  *))
+			    : Item     (*-- out   *);
+BEGIN
+  RETURN Item(x);
+END CardToItem;
+(*--------------------*)
+
+PROCEDURE CharToItem (	  x : CHAR     (*-- in	  *))
+			    : Item     (*-- out   *);
+BEGIN
+  RETURN Item(x);
+END CharToItem;
+(*--------------------*)
+
+PROCEDURE IntToItem  (	  x : INTEGER (*-- in	 *))
+			    : Item    (*-- out	 *);
+BEGIN
+  RETURN Item(x);
+END IntToItem;
+(*--------------------*)
+
+PROCEDURE RealToItem (	  x : REAL     (*-- in	  *))
+			    : Item     (*-- out   *);
+BEGIN
+  RETURN Item(x);
+END RealToItem;
+(*--------------------*)
+
+
+(*--
+    Item -> Basic Type Conversions
+--*)
+
+PROCEDURE ItemToAddr (	  x : Item	(*-- in    *))
+			    : ADDRESS	(*-- out   *);
+BEGIN
+  RETURN ADDRESS(x);
+END ItemToAddr;
+(*--------------------*)
+
+PROCEDURE ItemToCard (	  x : Item	(*-- in    *))
+			    : CARDINAL	(*-- out   *);
+BEGIN
+  RETURN CARDINAL(x);
+END ItemToCard;
+(*--------------------*)
+
+PROCEDURE ItemToChar (	  x : Item	(*-- in    *))
+			    : CHAR	(*-- out   *);
+BEGIN
+  RETURN CHAR(x);
+END ItemToChar;
+(*--------------------*)
+
+PROCEDURE ItemToInt  (	  x : Item	(*-- in    *))
+			    : INTEGER	(*-- out   *);
+BEGIN
+  RETURN INTEGER(x);
+END ItemToInt;
+(*--------------------*)
+
+PROCEDURE ItemToReal (	  x : Item	(*-- in    *))
+			    : REAL	(*-- out   *);
+BEGIN
+  RETURN REAL(x);
+END ItemToReal;
+(*--------------------*)
+
+END ItemConversions.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMOPER.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMOPER.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMOPER.DEF
@@ -0,0 +1,75 @@
+DEFINITION MODULE ItemOperations;
+(*==============================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Structure Utility - Generic Item Operations
+
+    INTRODUCTION
+    This module provides predefined routines for the standard data
+    types, (CHAR, INTEGER, etc.), compatible with the procedure types
+    exported by the ╥Items╙ module.
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved.
+==============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+
+(*--
+  --  Predefined Assignment Routine for the Standard Data Types
+  --  as Generic Items.
+--*)
+
+PROCEDURE AssignItem   (    source : Item     (*-- in	 *))
+				   : Item     (*-- out	 *);
+
+
+(*--
+  --  Predefined Equality Comparison Routine for the Standard
+  --  Data Types as Generic Items.
+--*)
+
+PROCEDURE EqualItems   (    left   : Item     (*-- in	 *);
+			    right  : Item     (*-- in	 *))
+				   : BOOLEAN  (*-- out	 *);
+
+
+(*--
+  --  Predefined Comparison Routines for the Standard Data Types
+  --  as Generic Items.
+--*)
+
+PROCEDURE CharCompare	   (	left : Item	(*-- in    *);
+				right: Item	(*-- in    *))
+				     : Relation (*-- out   *);
+
+PROCEDURE IntegerCompare   (	left : Item	(*-- in    *);
+				right: Item	(*-- in    *))
+				     : Relation (*-- out   *);
+
+PROCEDURE CardinalCompare  (	left : Item	(*-- in    *);
+				right: Item	(*-- in    *))
+				     : Relation (*-- out   *);
+
+PROCEDURE LongIntCompare   (	left : Item	(*-- in    *);
+				right: Item	(*-- in    *))
+				     : Relation (*-- out   *);
+
+PROCEDURE LongCardCompare  (	left : Item	(*-- in    *);
+				right: Item	(*-- in    *))
+				     : Relation (*-- out   *);
+
+PROCEDURE RealCompare	   (	left : Item	(*-- in    *);
+				right: Item	(*-- in    *))
+				     : Relation (*-- out   *);
+
+END ItemOperations.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMOPER.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMOPER.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMOPER.MOD
@@ -0,0 +1,195 @@
+IMPLEMENTATION MODULE ItemOperations;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Structure Utility - Generic Item Operations
+
+    INTRODUCTION
+    This module provides predefined routines for the standard data
+    types, (CHAR, INTEGER, etc.), compatible with the procedure types
+    exported by the ╥Items╙ module.
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved.
+====================================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+    (*-----------------------*)
+
+PROCEDURE AssignItem   (    source : Item     (*-- in	 *))
+				   : Item     (*-- out	 *);
+BEGIN
+  RETURN source;
+END AssignItem;
+(*----------------------------*)
+
+PROCEDURE EqualItems   (    left   : Item     (*-- in	 *);
+			    right  : Item     (*-- in	 *))
+				   : BOOLEAN  (*-- out	 *);
+BEGIN
+  RETURN left = right;
+END EqualItems;
+(*----------------------------*)
+
+PROCEDURE CharCompare	   (	left : Item	(*-- in    *);
+				right: Item	(*-- in    *))
+				     : Relation (*-- out   *);
+
+VAR   leftChar	: CHAR;
+      rightChar : CHAR;
+
+BEGIN
+  leftChar  := CHAR(left);
+  rightChar := CHAR(right);
+
+  IF (leftChar = rightChar) THEN
+     RETURN equal;
+
+  ELSIF (leftChar < rightChar) THEN
+     RETURN less;
+
+  ELSIF (leftChar > rightChar) THEN
+     RETURN greater;
+  END (*--if*);
+
+  RETURN incomparable; (*-- We should NEVER get here *)
+END CharCompare;
+(*----------------------------*)
+
+PROCEDURE IntegerCompare   (	left : Item	(*-- in    *);
+				right: Item	(*-- in    *))
+				     : Relation (*-- out   *);
+
+VAR   leftInt  : INTEGER;
+      rightInt : INTEGER;
+
+BEGIN
+  leftInt  := INTEGER(left);
+  rightInt := INTEGER(right);
+
+  IF (leftInt = rightInt) THEN
+     RETURN equal;
+
+  ELSIF (leftInt < rightInt) THEN
+     RETURN less;
+
+  ELSIF (leftInt > rightInt) THEN
+     RETURN greater;
+  END (*--if*);
+
+  RETURN incomparable; (*-- We should NEVER get here *)
+END IntegerCompare;
+(*----------------------------*)
+
+PROCEDURE CardinalCompare  (	left : Item	(*-- in    *);
+				right: Item	(*-- in    *))
+				     : Relation (*-- out   *);
+
+VAR   leftCard	: CARDINAL;
+      rightCard : CARDINAL;
+
+BEGIN
+  leftCard  := CARDINAL(left);
+  rightCard := CARDINAL(right);
+
+  IF (leftCard = rightCard) THEN
+     RETURN equal;
+
+  ELSIF (leftCard < rightCard) THEN
+     RETURN less;
+
+  ELSIF (leftCard > rightCard) THEN
+     RETURN greater;
+  END (*--if*);
+
+  RETURN incomparable; (*-- We should NEVER get here *)
+END CardinalCompare;
+(*----------------------------*)
+
+PROCEDURE LongIntCompare   (	left : Item	(*-- in    *);
+				right: Item	(*-- in    *))
+				     : Relation (*-- out   *);
+
+VAR   leftLongInt  : LONGINT;
+      rightLongInt : LONGINT;
+
+BEGIN
+  leftLongInt  := LONGINT(left);
+  rightLongInt := LONGINT(right);
+
+  IF (leftLongInt = rightLongInt) THEN
+     RETURN equal;
+
+  ELSIF (leftLongInt < rightLongInt) THEN
+     RETURN less;
+
+  ELSIF (leftLongInt > rightLongInt) THEN
+     RETURN greater;
+  END (*--if*);
+
+  RETURN incomparable; (*-- We should NEVER get here *)
+END LongIntCompare;
+(*----------------------------*)
+
+PROCEDURE LongCardCompare  (	left : Item	(*-- in    *);
+				right: Item	(*-- in    *))
+				     : Relation (*-- out   *);
+
+VAR   leftLongCard  : LONGCARD;
+      rightLongCard : LONGCARD;
+
+BEGIN
+  leftLongCard	:= LONGCARD(left);
+  rightLongCard := LONGCARD(right);
+
+  IF (leftLongCard = rightLongCard) THEN
+     RETURN equal;
+
+  ELSIF (leftLongCard < rightLongCard) THEN
+     RETURN less;
+
+  ELSIF (leftLongCard > rightLongCard) THEN
+     RETURN greater;
+  END (*--if*);
+
+  RETURN incomparable; (*-- We should NEVER get here *)
+END LongCardCompare;
+(*----------------------------*)
+
+PROCEDURE RealCompare	   (	left : Item	(*-- in    *);
+				right: Item	(*-- in    *))
+				     : Relation (*-- out   *);
+
+VAR   leftReal	: REAL;
+      rightReal : REAL;
+
+BEGIN
+  leftReal  := REAL(left);
+  rightReal := REAL(right);
+
+  IF (leftReal = rightReal) THEN
+     RETURN equal;
+
+  ELSIF (leftReal < rightReal) THEN
+     RETURN less;
+
+  ELSIF (leftReal > rightReal) THEN
+     RETURN greater;
+  END (*--if*);
+
+  RETURN incomparable; (*-- We should NEVER get here *)
+END RealCompare;
+(*----------------------------*)
+
+END ItemOperations.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMS.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMS.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMS.DEF
@@ -0,0 +1,238 @@
+DEFINITION MODULE Items;
+(*==============================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Structure - Generic Item Types
+
+    INTRODUCTION
+    This module provides the abstract data type, Item, which has the
+    operations of Assignment (:=), (In)Equality (=,#), Comparison
+    (<,<=,=,#,>=,>), Disposal, and iterator support routines.  Actual
+    routines providing these facilities must be either imported from
+    the predefined ItemOperations module (for the standard types) or
+    be provided by the programmer.
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    INTERFACE DESIGN ISSUES
+    The primary issue is to provide generic facilities.  In order to
+    represent a generic data type one must have available operations
+    equivalent to the standard operations for assignment (:=),
+    (in)equality comparison (=,#) and for ordered data types, the
+    relational operators (<,=,>).  These are the minimum operations
+    that must be available for having a functional data type.
+    The standard Modula-2 facilities for these operations on an
+    opaque type would yield semantics where one would assign and
+    compare the opaque type itself, this typically being a pointer
+    type.  Since we wish to allow non-pointer types as legitimate
+    values for an item, using the standard operators would suffice
+    for this purpose.  But we also allow wish to allow the use of
+    abstract data structures and dynamically allocated variables as
+    items. In this case the standard operators would operate on the
+    ADDRESS of or the POINTER TO the value of an item instead of the
+    value itself.  This is sufficient for (in)equality comparisons,
+    but assignment of pointer types results in sharing of the pointer,
+    not copying of the value.  Furthermore, relational comparisons of
+    < or > are meaningless since we only have the ADDRESS of the value,
+    not the value itself, and Modula-2 does not allow these operations
+    on opaque types anyway.
+
+    REFERENCES
+    [1] K. John Gough, ╥Writing Generic Utilities in Modula-2╙,
+	Journal of Pascal, Ada, and Modula-2, Vol. 5 (3),
+	May/June 1986, pp. 53-62.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved.
+==============================================================*)
+
+FROM Relations IMPORT
+    (*--Type*) Relation, RelOp;
+
+
+(*
+    This module provides support for generic data items.  This is
+    accomplished by providing an opaque type, ╥Item╙, representing an
+    arbitrary data type.  The advantage of this technique is in
+    allowing the creation of modules that can manipulate generic data
+    structures with a minimum of knowledge about the actual data being
+    manipulated.  Thus, a single module is needed to implement specific
+    forms of a data structure. Plus the module need only be concerned
+    with actual implementation issues regarding that structure.  For
+    example, there need be only one unbounded stack module, one bounded
+    stack module, etc.	If necessary, type-specific modules can be built
+    on top of the generic module.  Of course, there are constraints that
+    must be placed on the client module(s) to insure proper usage of a
+    generic item.  These are listed below:
+
+    1. The actual data type mapped to an Item must be compatible with
+       SYSTEM.ADDRESS.	Specifically, the relation SIZE(DataType) <=
+       SIZE(SYSTEM.ADDRESS) must be true.  If this condition is not met,
+       (e.g., a record or array structure), then the client module must
+       use a pointer to the actual data.
+
+    2. Modula-2 supports only a limited number of the standard operations
+       for opaque types.  These are assignment (:=) and the test for
+       (in)equality (=,#).  The relational operators <, <=, >, and >= are
+       not supported for opaque types.	This restriction means that when
+       a generic module requires relational operators, the client module
+       must provide this facility to the generic module.
+*)
+
+
+TYPE  Item;			 (*-- The generic data type *)
+CONST NullItem = Item(NIL); (*-- An empty value for an item *)
+
+
+(*--  CONSTRUCTORS
+
+  * AssignProc (in Item) out Item
+    Defines a generic function procedure type representing the equivalent
+    semantics as the standard Modula-2 assignment operator.  A generic module
+    must have a mechanism for assigning generic items to efficiently implement
+    the standard Assign operation.  For all of the simple data types (CHAR, INTEGER,
+    CARDINAL, etc.) the assignment operator suffices to accomplish this goal.  But
+    for dynamically created items, using := would result in copying pointers to the
+    actual data.  This is undesirable when the intended effect is to make a copy of
+    the data itself.  For this reason, this routine template is provided.
+
+  * DisposeProc (inout Item)
+    Disposal defines a generic procedure type (for which an actual procedure must be
+    provided) that will deallocate any and all dynamically allocated resources that
+    may be associated with a given instance of an Item.  Use of this routine will
+    prevent the creation of dangling pointers (a.k.a. garbage) for items created
+    using NEW or ALLOCATE when these items are released by a generic module.
+
+  * NoAssignProc
+    Defines a procedure ╥constant╙ representing the standard Modula-2
+    assignment operator, :=, which cannot be used as a procedure type
+    parameter.
+
+  * NoDisposeProc
+    Defines a procedure ╥constant╙ representing disposal of items
+    statically allocated on the stack.	This may be used for primitive
+    data items CHAR, INTEGER, etc.  It is more efficient to test for an
+    empty disposal routine rather than forcing the client to provide a
+    disposal routine that does nothing.
+--*)
+
+TYPE  AssignProc  = PROCEDURE (    Item      (*-- in	*))
+				   : Item    (*-- out	*);
+
+TYPE  DisposeProc = PROCEDURE (VAR Item      (*-- inout *));
+
+CONST NoDisposeProc = NULLPROC;
+CONST NoAssignProc  = NULLPROC;
+
+
+(*--  SELECTORS
+
+  * EqualProc  (in Item, in Item) out BOOLEAN
+    A generic function procedure type (for which an actual procedure
+    must be provided) that yields the equivalent semantics as the
+    standard Modula-2 relational operators for simple data types.
+
+  * NoEqualProc
+    Defines a procedure "constant" representing the standard Modula-2
+    equality operator, =, which cannot be used as a procedure type
+    parameter.
+
+--*)
+
+TYPE  EqualProc = PROCEDURE (	 Item	    (*-- in    *),
+				 Item	    (*-- in    *))
+				 : BOOLEAN  (*-- out   *);
+
+CONST NoEqualProc = NULLPROC;
+
+
+(*--
+  * CompareProc (in Item, in Item) out Relation
+    A generic function procedure type (for which an actual procedure
+    must be provided) that yields the equivalent semantics as the
+    standard Modula-2 comparison operator establishing the ordering
+    relationship for simple data types.  A routine of this type
+    attempts to answer the question "What is the ordering relation
+    between the first (or left) operand and the second (or right)
+    operand?"
+
+  * RelationProc (in Item, in Relation, in Item) out Boolean
+    A generic function procedure type (for which an actual procedure
+    must be provided) that yields the equivalent semantics as the
+    standard Modula-2 ordering relations used in comparisons to
+    evaluate the existence of a given ordering relationship between
+    (compatible) data types.  A routine of this type attempts to
+    answer the question "Does the ordering relation between the first
+    (or left) operand and the second (or right) operand match the
+    given relation?"
+
+  * RelOpProc (in Item ,in RelOp, in Item) out Boolean
+    Same as RelationProc above, except that the full set of relational
+    operators are allowed, e.g., <, <=, =, #, >, and >=.
+--*)
+
+TYPE  CompareProc  = PROCEDURE (    Item       (*-- in	  *),
+				    Item       (*-- in	  *))
+				    : Relation (*-- out   *);
+
+TYPE  RelationProc = PROCEDURE (    Item       (*-- in	  *),
+				    Relation   (*-- in	  *),
+				    Item       (*-- in	  *))
+				    : BOOLEAN  (*-- out   *);
+
+TYPE  RelOpProc    = PROCEDURE (    Item       (*-- in	  *),
+				    RelOp      (*-- in	  *),
+				    Item       (*-- in	  *))
+				    : BOOLEAN  (*-- out   *);
+
+
+(*--  ITERATORS
+
+  * AccessProc (in Item)
+    Defines a generic procedure type (for which an actual procedure
+    must be provided) that allows read-only access to a generic item
+    from within the standard iterator operation ╥Traverse╙.
+
+  * ChangeProc (inout Item)
+    Defines a generic procedure type (for which an actual procedure
+    must be provided) that allows read-write access to a generic item
+    from within the standard iterator operation ╥TravChange╙.
+
+  * LoopAccessProc (in Item) out Continue
+    Defines a generic procedure type (for which an actual procedure
+    must be provided) that allows read-only access to a generic item
+    from within the standard iterator operation ╥LoopOver╙.  The actual
+    routine matching this declaration may control continuation of the
+    iteration through the function result ╥Continue╙.
+      * TRUE continues the iteration
+      * FALSE terminates the iteration
+    These two results account for the renaming of the BOOLEAN function
+    result, clarifying the semantic meaning of the result.
+
+  * LoopChangeProc (inout Item) outContinue
+    Defines a generic procedure type (for which an actual procedure
+    must be provided) that allows read-write access to a generic item
+    from within the standard iterator operation ╥LoopChange╙.  The
+    actual routine matching this declaration may control continuation
+    of the iteration through the function result ╥Continue╙.
+      * TRUE continues the iteration
+      * FALSE terminates the iteration
+    These two results account for the renaming of the BOOLEAN function
+    result, clarifying the semantic meaning of the result.
+
+--*)
+
+
+TYPE  AccessProc     = PROCEDURE (    Item	 (*-- in    *));
+TYPE  ChangeProc     = PROCEDURE (VAR Item	 (*-- inout *));
+
+TYPE  Continue	     = BOOLEAN;
+TYPE  LoopAccessProc = PROCEDURE (    Item	 (*-- in    *))
+				      : Continue (*-- out   *);
+TYPE  LoopChangeProc = PROCEDURE (VAR Item	 (*-- inout *))
+				      : Continue (*-- out   *);
+
+END Items.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMS.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMS.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMS.MOD
@@ -0,0 +1,24 @@
+IMPLEMENTATION MODULE Items;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Structure - Generic Item Types
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    IMPLEMENTATION DESIGN NOTES
+    * The actual type for the opaque Item must be defined.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved.
+====================================================================*)
+
+FROM SYSTEM IMPORT
+    (*--Type*) ADDRESS;
+
+TYPE  Item = ADDRESS;
+
+END Items.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/RELATION.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/RELATION.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/RELATION.DEF
@@ -0,0 +1,65 @@
+DEFINITION MODULE Relations;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Tool - Relational Operators Utility
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    INTRODUCTION
+    This module provides definitions for the standard Modula-2 relations
+    and relational operators, along with routines for mapping one type to
+    the other, deriving the NOT of a relational operator, and testing for
+    a given relational operator implying that another relational operator
+    is also true.
+
+    PROPRIETARY NOTICES
+    "Relations.DEF" Copyright (C) 1989 Charles A. Lins.
+====================================================================*)
+
+(*
+    Relation defines the minimum set of relational operators from which all
+    others may be derived.  The following equivalent notations should be noted:
+	# -> NOT EqualTo
+	<= -> NOT GreaterThan
+	>= -> NOT LessThan.
+
+    RelOp defines the standard Modula-2 relational operators.
+*)
+
+TYPE  Relation = (		(*-- Ordering Relations *)
+		  less, 	(*-- <	less than	*)
+		  equal,	(*-- =	equal to	*)
+		  greater,	(*-- >	greater than	*)
+		  incomparable	(*-- ?	failure result	*)
+		 );
+
+TYPE  RelOp    = (		(*-- Relational Operators	 *)
+		  lt,		(*-- <	less than		 *)
+		  le,		(*-- <=	less than or equal to	 *)
+		  eq,		(*-- =	equal to		 *)
+		  ne,		(*-- #	not equal to		 *)
+		  gt,		(*-- >	greater than		 *)
+		  ge,		(*-- >=	greater than or equal to *)
+		  unordered	(*-- ?	failure result		 *)
+		 );
+
+
+PROCEDURE RelToRelOp (	  theRelation: Relation (*-- in    *))
+				     : RelOp	(*-- out   *);
+
+PROCEDURE RelOpToRel (	  theRelOp   : RelOp	(*-- in    *))
+				     : Relation (*-- out   *);
+
+    (*-----------------------*)
+
+PROCEDURE NotRelOpOf (	  theRelOp   : RelOp	(*-- in    *))
+				     : RelOp	(*-- out   *);
+
+PROCEDURE AImpliesB  (	  left	     : RelOp	(*-- in    *);
+			  right      : RelOp	(*-- in    *))
+				     : BOOLEAN	(*-- out   *);
+
+END Relations.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/RELATION.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/RELATION.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/RELATION.MOD
@@ -0,0 +1,126 @@
+IMPLEMENTATION MODULE Relations;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Tool - Relational Operators Utility
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    INTRODUCTION
+    This module provides definitions for the standard Modula-2 relations
+    and relational operators, along with routines for mapping one type to
+    the other, deriving the NOT of a relational operator, and testing for
+    a given relational operator implying that another relational operator
+    is also true.
+
+    LOCAL DATA TYPES
+    * RelSet	 Defines a set of relational operators.
+
+    LOCAL VARIABLES
+    * relMap
+	Mapping array of relational operators to a RelSet. It is used by the
+	relational expression routines to easily determine whether the result
+	from a comparison routine meeting the expression relation.
+
+		   Set of
+		  Relations
+	  Index    Mapping
+	  ╤╤╤╤╤   ╤╤╤╤╤╤╤╤╤
+	    <=	  {<=, <, =}
+	    <	  {<=, <, #}
+	    =	  {<=, =, >=}
+	    #	  {<, #, >}
+	    >	  {#, >, >=}
+	    >=	  {=, >, >=}
+	    ?	  {}
+
+    * NOTRelation
+	Mapping of relational operators to the opposite operator, i.e., = τ #.
+
+    INITIALIZATION ROUTINES
+    * InitRelMapping:  Initialize the mapping array relMap.
+    * InitNOTMapping:  Initialize the mapping array NOTRelation.
+
+    PROPRIETARY NOTICES
+    Relations.MOD, by C. Lins, Copyright (C) 1989 Charles A. Lins.
+====================================================================*)
+
+
+VAR   mapToRelOp : ARRAY Relation OF RelOp;
+
+PROCEDURE RelToRelOp (	  theRelation: Relation (*-- in    *))
+				     : RelOp	(*-- out   *);
+BEGIN
+  RETURN mapToRelOp [ theRelation ];
+END RelToRelOp;
+(*----------------------------*)
+
+
+VAR   mapRelation: ARRAY RelOp OF Relation;
+
+PROCEDURE RelOpToRel (	  theRelOp   : RelOp	(*-- in    *))
+				     : Relation (*-- out   *);
+BEGIN
+  RETURN mapRelation [ theRelOp ];
+END RelOpToRel;
+(*----------------------------*)
+
+
+VAR   notRelOp : ARRAY RelOp OF RelOp;
+
+PROCEDURE NotRelOpOf (	  theRelOp   : RelOp	(*-- in    *))
+				     : RelOp	(*-- out   *);
+BEGIN
+  RETURN notRelOp [ theRelOp ];
+END NotRelOpOf;
+(*----------------------------*)
+
+
+TYPE  RelSet = SET OF RelOp;
+VAR   relMap : ARRAY RelOp OF RelSet;
+
+PROCEDURE AImpliesB  (	  left	     : RelOp	(*-- in    *);
+			  right      : RelOp	(*-- in    *))
+				     : BOOLEAN	(*-- out   *);
+BEGIN
+  RETURN left IN relMap [ right ];
+END AImpliesB;
+(*----------------------------*)
+
+
+(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
+(*   MODULE INITIALIZATION    *)
+
+BEGIN
+  relMap [ lt ] := RelSet {le, lt, ne};
+  relMap [ le ] := RelSet {le, lt, eq};
+  relMap [ eq ] := RelSet {le, eq, ge};
+  relMap [ ne ] := RelSet {lt, ne, gt};
+  relMap [ gt ] := RelSet {ge, gt, ne};
+  relMap [ ge ] := RelSet {eq, ge, gt};
+  relMap [ unordered ] := RelSet {};
+
+  notRelOp [ lt ] := ge;
+  notRelOp [ le ] := gt;
+  notRelOp [ eq ] := ne;
+  notRelOp [ ne ] := eq;
+  notRelOp [ gt ] := le;
+  notRelOp [ ge ] := lt;
+  notRelOp [ unordered ] := unordered;
+
+  mapToRelOp  [ less	] := lt;
+  mapToRelOp  [ equal	] := eq;
+  mapToRelOp  [ greater ] := gt;
+  mapToRelOp  [incomparable] := unordered;
+
+  mapRelation [ lt ] := less;
+  mapRelation [ le ] := incomparable;
+  mapRelation [ eq ] := equal;
+  mapRelation [ ne ] := incomparable;
+  mapRelation [ gt ] := greater;
+  mapRelation [ ge ] := incomparable;
+  mapRelation [ unordered ] := incomparable;
+END Relations.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/TYPEMANA.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/TYPEMANA.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/TYPEMANA.DEF
@@ -0,0 +1,71 @@
+DEFINITION MODULE TypeManager;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Tool - Dynamic Type Management Utility
+
+    INTRODUCTION
+    This module provides facilities for defining generic item types
+    and associating assignment, comparison and disposal routines with
+    that type.
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved.
+====================================================================*)
+
+FROM  Items  IMPORT
+    (*--Type*) AssignProc, CompareProc, DisposeProc;
+
+    (*-----------------------*)
+
+TYPE  TypeID;
+TYPE  TypeName = ARRAY [0 .. 15] OF CHAR;
+
+CONST NullType = TypeID(NIL);
+
+
+    (*-----------------------*)
+    (*	   CONSTRUCTORS      *)
+
+CONST NoCompareProc = NULLPROC;
+
+PROCEDURE Create    (	 theName    : TypeName	  (*-- in    *);
+			 assignment : AssignProc  (*-- in    *);
+			 comparison : CompareProc (*-- in    *);
+			 deallocate : DisposeProc (*-- in    *))
+				    : TypeID	  (*-- out   *);
+
+PROCEDURE CharTypeID	 () : TypeID   (*-- out   *);
+PROCEDURE IntegerTypeID  () : TypeID   (*-- out   *);
+PROCEDURE CardinalTypeID () : TypeID   (*-- out   *);
+PROCEDURE LongIntTypeID  () : TypeID   (*-- out   *);
+PROCEDURE LongCardTypeID () : TypeID   (*-- out   *);
+PROCEDURE RealTypeID	 () : TypeID   (*-- out   *);
+
+    (*-----------------------*)
+    (*	    SELECTORS	     *)
+
+PROCEDURE NameOf    (	 theType : TypeID      (*-- in	  *);
+		     VAR theName : TypeName    (*-- out   *));
+
+PROCEDURE AssignOf  (	 theType : TypeID      (*-- in	  *))
+				 : AssignProc  (*-- out   *);
+
+PROCEDURE CompareOf (	 theType : TypeID      (*-- in	  *))
+				 : CompareProc (*-- out   *);
+
+PROCEDURE DisposeOf (	 theType : TypeID      (*-- in	  *))
+				 : DisposeProc (*-- out   *);
+
+PROCEDURE AttributesOf (    theType    : TypeID      (*-- in	*);
+			VAR theName    : TypeName    (*-- out	*);
+			VAR assignment : AssignProc  (*-- out	*);
+			VAR comparison : CompareProc (*-- out	*);
+			VAR deallocate : DisposeProc (*-- out	*));
+
+END TypeManager.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/TYPEMANA.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/TYPEMANA.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/TYPEMANA.MOD
@@ -0,0 +1,209 @@
+IMPLEMENTATION MODULE TypeManager;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Tool - Dynamic Type Management Utility
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved.
+====================================================================*)
+
+FROM SYSTEM IMPORT
+    (*--Proc*) ADR;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM ItemOperations IMPORT
+    (*--Proc*) AssignItem, CharCompare, IntegerCompare, CardinalCompare,
+	       LongIntCompare, LongCardCompare, RealCompare;
+
+    (*-----------------------*)
+
+TYPE  TypeID   = POINTER TO TypeNode;
+TYPE  TypeNode = RECORD
+	name	: TypeName;    (*-- Name for this type *)
+	assign	: AssignProc;  (*-- Assignment routine *)
+	compare : CompareProc; (*-- Comparison routine *)
+	dispose : DisposeProc; (*-- Item Disposal routine *)
+      END (*-- TypeNode *);
+
+
+    (*-----------------------*)
+
+TYPE  SimpleTypes = (chars, ints, cards, longints, longcards, reals);
+VAR   basicTypes  : ARRAY SimpleTypes OF TypeNode;
+
+
+    (*-----------------------*)
+
+PROCEDURE NullDispose (VAR theItem : Item (*-- inout *));
+BEGIN
+END NullDispose;
+(*----------------------------*)
+
+
+    (*-----------------------*)
+    (*	   CONSTRUCTORS      *)
+
+PROCEDURE Build     (	 theName    : TypeName	  (*-- in    *);
+			 assignment : AssignProc  (*-- in    *);
+			 comparison : CompareProc (*-- in    *);
+			 deallocate : DisposeProc (*-- in    *);
+		     VAR theTypeNode: TypeNode	  (*-- out   *));
+BEGIN
+  WITH theTypeNode DO
+    name    := theName;
+    assign  := assignment;
+    compare := comparison;
+    dispose := deallocate;
+  END (*--with*);
+END Build;
+(*----------------------------*)
+
+PROCEDURE Create    (	 theName    : TypeName	  (*-- in    *);
+			 assignment : AssignProc  (*-- in    *);
+			 comparison : CompareProc (*-- in    *);
+			 deallocate : DisposeProc (*-- in    *))
+				    : TypeID	  (*-- out   *);
+
+VAR   newType : TypeID;
+
+BEGIN
+  Allocate(newType, SIZE(TypeNode));
+  IF (newType # NullType) THEN
+    Build(theName, assignment, comparison, deallocate, newType^);
+  END (*--if*);
+  RETURN newType;
+END Create;
+(*----------------------------*)
+
+PROCEDURE CharTypeID	 () : TypeID   (*-- out   *);
+BEGIN
+  RETURN ADR(basicTypes[chars]);
+END CharTypeID;
+(*----------------------------*)
+
+PROCEDURE IntegerTypeID  () : TypeID   (*-- out   *);
+BEGIN
+  RETURN ADR(basicTypes[ints]);
+END IntegerTypeID;
+(*----------------------------*)
+
+PROCEDURE CardinalTypeID () : TypeID   (*-- out   *);
+BEGIN
+  RETURN ADR(basicTypes[cards]);
+END CardinalTypeID;
+(*----------------------------*)
+
+PROCEDURE LongIntTypeID  () : TypeID   (*-- out   *);
+BEGIN
+  RETURN ADR(basicTypes[longints]);
+END LongIntTypeID;
+(*----------------------------*)
+
+PROCEDURE LongCardTypeID () : TypeID   (*-- out   *);
+BEGIN
+  RETURN ADR(basicTypes[longcards]);
+END LongCardTypeID;
+(*----------------------------*)
+
+PROCEDURE RealTypeID	 () : TypeID   (*-- out   *);
+BEGIN
+  RETURN ADR(basicTypes[reals]);
+END RealTypeID;
+(*----------------------------*)
+
+
+    (*-----------------------*)
+    (*	    SELECTORS	     *)
+
+PROCEDURE NameOf    (	 theType : TypeID      (*-- in	  *);
+		     VAR theName : TypeName    (*-- out   *));
+BEGIN
+  IF (theType = NullType) THEN
+    theName := "";
+  ELSE
+    theName := theType^.name;
+  END (*--if*);
+END NameOf;
+(*----------------------------*)
+
+PROCEDURE AssignOf  (	 theType : TypeID      (*-- in	  *))
+				 : AssignProc  (*-- out   *);
+BEGIN
+  IF (theType = NullType) THEN
+    RETURN AssignItem;
+  END (*--if*);
+  RETURN theType^.assign;
+END AssignOf;
+(*----------------------------*)
+
+PROCEDURE CompareOf (	 theType : TypeID      (*-- in	  *))
+				 : CompareProc (*-- out   *);
+BEGIN
+  IF (theType = NullType) THEN
+    RETURN NoCompareProc;
+  END (*--if*);
+  RETURN theType^.compare;
+END CompareOf;
+(*----------------------------*)
+
+PROCEDURE DisposeOf (	 theType : TypeID      (*-- in	  *))
+				 : DisposeProc (*-- out   *);
+BEGIN
+  IF (theType = NullType) THEN
+    RETURN NullDispose;
+  END (*--if*);
+  RETURN theType^.dispose;
+END DisposeOf;
+(*----------------------------*)
+
+PROCEDURE AttributesOf (    theType    : TypeID      (*-- in	*);
+			VAR theName    : TypeName    (*-- out	*);
+			VAR assignment : AssignProc  (*-- out	*);
+			VAR comparison : CompareProc (*-- out	*);
+			VAR deallocate : DisposeProc (*-- out	*));
+BEGIN
+  IF (theType = NullType) THEN
+    theName    := "";
+    assignment := AssignItem;
+    comparison := NoCompareProc;
+    deallocate := NullDispose;
+  ELSE
+    WITH theType^ DO
+      theName	 := name;
+      assignment := assign;
+      comparison := compare;
+      deallocate := dispose;
+    END (*--with*);
+  END (*--if*);
+END AttributesOf;
+(*----------------------------*)
+
+
+(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
+(*~~ MODULE INITIALIZATION  ~~*)
+
+BEGIN
+  Build("CHAR",     AssignItem,  CharCompare,
+		    NullDispose, basicTypes[chars]);
+  Build("INTEGER",  AssignItem,  IntegerCompare,
+		    NullDispose, basicTypes[ints]);
+  Build("CARDINAL", AssignItem,  CardinalCompare,
+		    NullDispose, basicTypes[cards]);
+  Build("LONGINT",  AssignItem,  LongIntCompare,
+		    NullDispose, basicTypes[longints]);
+  Build("LONGCARD", AssignItem,  LongCardCompare,
+		    NullDispose, basicTypes[longcards]);
+  Build("REAL",     AssignItem,  RealCompare,
+		    NullDispose, basicTypes[reals]);
+END TypeManager.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETCSBMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETCSBMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETCSBMI.DEF
@@ -0,0 +1,233 @@
+(*
+14			The Discrete (Character) Bounded Set
+
+
+Before leaving the subject of sets let us examine a set implementation for the Modula-2
+CHAR data type.  Because we will be dealing with a scalar data type, this information can
+be used to our advantage and allow certain optimizations in the implementation that could
+not be applied otherwise with the generic form.
+
+
+
+14.1		SetCSBMI Interface
+
+
+There are three differences between the generic bounded set and the discrete form as
+presented here:
+
+* Create does not require a size parameter since this value is constant;
+* SizeOf is not necessary for the same reason; and
+* Complement can be provided since the universal set for characters is known and
+  finite.
+
+In all other respects, the definition is otherwise identical with that for the bounded set.
+*)
+
+
+DEFINITION MODULE SetCSBMI;
+(*===========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Set
+               Discrete Sequential Bounded Managed Iterator
+
+    INTRODUCTION
+    This module supports the abstract data type set for
+    discrete values of ASCII CHARs.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM CharItems IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions;
+
+    (*-----------------------*)
+
+TYPE  Set;
+TYPE  SizeRange = [1..256];
+CONST NullSet   = Set(NIL);
+
+
+(*
+14.1.1			Exceptions
+
+The ModuleID is used by the exception handling mechanism to distinguish this module
+from other modules.
+
+SetError returns the exception code from the most recent discrete set operation.  A result
+of noerr indicates successful completion of the operation.
+
+GetHandler returns the exception handler routine associated with the given exception. 
+Though the routine is a function procedure returning a procedure as its result, the
+HandlerProc may not be called from within the GetHandler call itself.  The procedure
+result must be first assigned to a procedure variable before invocation. Exception handlers
+are given an initial value of ExitOnError except for the handler for noerr which is
+initialized to the null exception handler.
+
+SetHandler associates an exception handler routine with the given exception and is the
+inverse of GetHandler. This routine may be used to override the default settings for the
+exception handlers.
+*)
+
+CONST ModuleID = 1;
+
+PROCEDURE SetError    ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+(*
+14.1.2			Constructors
+
+The Create operation attempts to generate a new, empty character set.  The TypeID is
+unnecessary since we are dealing directly with characters and incorporating such
+knowledge into the implementation.  A similar statement can be made regarding the
+maximum size of the set since characters form a small, discrete ranges of values.
+
+Create will return the new set upon successful completion of the routine.  If it is not
+possible for the set to be created, the constant NullSet  will be returned instead.
+
+Destroy takes the given set, clears it of any items, and then destroys the set itself. 
+Where Create makes a defined set, Destroy is its inverse, making the set undefined.
+
+Clear takes the given set and removes all its items, thus returning the set to the empty
+state.
+
+The Assign operation attempts to generate a duplicate of the source set (theSet) in the
+target set (toSet).  The target set is automatically created, if necessary, otherwise the
+target is cleared of its present contents before the assignment.  All character sets are given
+the same, maximum size.
+
+The Include operation adds items to the given set.  If the item is already a member of the
+set the exception condition is quietly ignored.
+
+The Exclude operation removes the specified item from the given set.  If the given set is 
+empty on entry to Exclude, or the given item is not a member of the set  the notinset 
+exception is ignored and the set remains unchanged.
+
+Union, Intersection, Difference, SymDifference (symmetric difference), and Complement
+operations all implement the standard set operations of the same name as defined in the
+set abstraction chapter (11).
+*)
+
+PROCEDURE Create        ()           : Set         (*-- out   *);
+
+PROCEDURE Destroy       (VAR theSet  : Set         (*-- inout *));
+
+PROCEDURE Clear         (VAR theSet  : Set         (*-- inout *));
+
+PROCEDURE Assign        (    theSet  : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+PROCEDURE Include       (    theItem : Item        (*-- in    *);
+                         VAR inSet   : Set         (*-- inout *));
+
+PROCEDURE Exclude       (    theItem : Item        (*-- in    *);
+                         VAR fromSet : Set         (*-- inout *));
+
+PROCEDURE Union         (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+PROCEDURE Intersection  (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+PROCEDURE Difference    (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+PROCEDURE SymDifference (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+PROCEDURE Complement    (    theSet  : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+
+(*
+14.1.3			Selectors
+
+IsDefined attempts to determine whether the given set is valid, e.g., has been created and
+not yet destroyed.  How this is accomplished may be as simple or complicated as the
+implementer desires and the requirements of the application.
+
+IsEmpty returns true if the given set contains no items; in other words, its cardinality is
+zero.  Undefined sets are always considered empty.
+
+IsEqual returns true if the left and right sets contain the same items.  Obviously, both
+must also have been created.  An undefined set is not equal to any other set, including
+itself.
+
+NumMembers returns the number of items present in the given set.  Undefined sets are
+considered to have no members.
+
+IsAMember returns true if the given item is present in the given set, and false otherwise.
+
+IsSubset and IsProperSubset both implement standard logical set operations as defined in
+the Set Abstraction (chapter 11).
+*)
+
+PROCEDURE IsDefined     (    theSet  : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEmpty       (    theSet  : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE NumMembers    (    theSet  : Set         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+                             theSet  : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+
+(*
+14.1.4			Iterators
+
+The iterator routine LoopOver provides the facility for looping over some or all items of
+a set, with read-only access to each item.  theProcess procedure parameter to this routine
+returns a BOOLEAN function result where TRUE allows the iteration to proceed to the
+next item and FALSE causes the iteration to be terminated.
+
+The Traverse iterator provides the facility for looping over all items of a set, with
+read-only access to each item.
+
+Both iterators traverse the given set from the first item towards the last item in ascending
+order.  Obviously, if given an empty set the processing procedure will not be invoked.
+*)
+
+PROCEDURE LoopOver    (    theSet  : Set            (*-- in    *);
+                           process : LoopAccessProc (*-- in    *));
+
+PROCEDURE Traverse    (    theSet  : Set            (*-- in    *);
+                           process : AccessProc     (*-- in    *));
+
+END SetCSBMI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETCSBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETCSBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETCSBMI.MOD
@@ -0,0 +1,645 @@
+(*
+14.2		SetCSBMI Implementation
+*)
+
+
+IMPLEMENTATION MODULE SetCSBMI;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structure - Set
+               Discrete Sequential Bounded Managed Iterator
+
+    INTRODUCTION
+    This module supports the abstract data type set for
+    discrete values of CHARs.
+
+    REVISION HISTORY
+    v1.00  30 Apr 19898  C. Lins:
+        Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM CharItems IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, Raise, ExitOnError;
+
+    (*-----------------------*)
+
+
+(*
+14.2.1		Internal Discrete Set Representation
+
+╟Illustration Here╚
+
+Figure 14.1
+
+For the internal representation of the discrete (character) set we use a bit vector of items,
+where an item at the appropriate index has a value of one if the item is a member of the
+set and a value of zero otherwise.  In order to save space and enable the use of the standard
+Modula-2 bitset operations, the bit vector is stored as an array of BITSETs.  So instead of
+requiring 256 words per character set only 16 words are needed.  The array of bitsets is
+indexed from zero to fifteen, inclusive, as shown in the calculation of the maximum value
+for theBitsetsPerSet subrange.  In effect, this constant expression reduces to:
+
+					(16 DIV 16) - 1 = (16 - 1) = 15.
+
+The cost for the space savings is the increased execution time used in the calculation of an
+item's bitset index and bit offset within the bitset.
+*)
+
+CONST bitsPerBitset = 16;
+CONST maxSetSize    = MAX(SizeRange);
+TYPE  BitsetsPerSet = [ 0 .. (maxSetSize DIV bitsPerBitset) - 1 ];
+TYPE  BitIndex      = [ 0 .. bitsPerBitset - 1 ];
+
+TYPE  ItemsArray = ARRAY BitsetsPerSet OF BITSET;
+TYPE  DiscreteSet = RECORD
+        items : ItemsArray;    (*-- Bit vector of items *)
+      END (*-- DiscreteSet *);
+
+TYPE  Set = POINTER TO DiscreteSet;
+
+    (*-----------------------*)
+
+VAR   theEmptySet : ItemsArray; (*-- Predefined set, initialized to ┐ *)
+
+
+(*
+14.2.2		Exceptions
+
+To support the exception handling mechanism two variables are needed.  The first,
+setError, is used to record the exception result from each operation; while handlers  is an
+array of exception handling procedures indexed by the exception result.
+
+The routines SetError, GetHandler, and SetHandler have been previously described in the
+definition module, and their operation should be readily apparent.  RaiseErrIn is a local
+routine used to set the setError variable and invoke the Raise routine of the
+ErrorHandling module.
+*)
+
+VAR   setError   : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE SetError    ()             : Exceptions (*-- out   *);
+BEGIN
+  RETURN setError;
+END SetError;
+(*----------------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  setError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+PROCEDURE Recreate   (VAR theSet : Set     (*-- inout *))
+                                 : BOOLEAN (*-- out   *);
+BEGIN
+  IF (theSet = NIL) THEN
+    theSet := Create();
+  END (*--if*);
+  RETURN (theSet # NIL);
+END Recreate;
+(*----------------------------*)
+
+
+(*
+14.2.2		Constructors
+
+Create simply allocates a new array of bitsets raising the overflow exception if unable to
+do so.  Otherwise the newly created set is cleared using array assignment of the predefined
+empty character set.
+*)
+
+PROCEDURE Create        ()           : Set         (*-- out   *);
+
+VAR   newSet : Set;
+
+BEGIN
+  setError := noerr;
+  Allocate(newSet, SIZE(DiscreteSet));
+  IF (newSet # NIL) THEN
+    newSet^.items := theEmptySet;
+    RETURN newSet;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullSet;
+END Create;
+(*----------------------------*)
+
+
+(*
+Destroy takes advantage that Clear  sets setError  to noerr and raises the undefined 
+exception.  So if Clear succeeds, Destroy releases the allocated set header.
+*)
+
+PROCEDURE Destroy       (VAR theSet    : Set         (*-- inout *));
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    Deallocate(theSet, SIZE(theSet^));
+  ELSE
+    RaiseErrIn(destroy, undefined);
+    theSet := NullSet;
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+
+(*
+Clear sets setError to noerr and checks for an undefined set raising the undefined 
+exception if necessary.  After asserting a valid set, it is sufficient to overwrite the existing
+items with the predefined empty set.
+*)
+
+PROCEDURE Clear         (VAR theSet    : Set         (*-- inout *));
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    theSet^.items := theEmptySet;
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+
+(*
+Assign creates the target set if necessary and then uses array assignment to duplicate the
+source bitset array within the target.
+*)
+
+PROCEDURE Assign        (    theSet  : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+BEGIN 
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    IF Recreate(toSet) THEN
+      toSet^.items := theSet^.items;
+    END (*--if*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+
+(*
+Include and Exclude simply calculate the bitset number and bit offset and use the
+Modula-2 set inclusion and exclusion operations.
+*)
+
+PROCEDURE Include       (    theItem : Item        (*-- in    *);
+                         VAR inSet   : Set         (*-- inout *));
+BEGIN
+  setError := noerr;
+  IF (inSet # NIL) THEN
+    INCL(inSet^.items[VAL(CARDINAL, ORD(theItem)) DIV bitsPerBitset],
+         VAL(CARDINAL, ORD(theItem)) MOD bitsPerBitset);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*----------------------------*)
+
+PROCEDURE Exclude       (    theItem : Item        (*-- in    *);
+                         VAR fromSet : Set         (*-- inout *));
+BEGIN
+  setError := noerr;
+  IF (fromSet # NIL) THEN
+    EXCL(fromSet^.items[VAL(CARDINAL, ORD(theItem)) DIV bitsPerBitset],
+         VAL(CARDINAL, ORD(theItem)) MOD bitsPerBitset);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*----------------------------*)
+
+
+(*
+Union, Intersection, Difference, and SymDifference all simply loop over the bitsets of
+the left and right sets using the Modula-2 set operators to form the target set. 
+Complement is similar except that it takes the difference of the universal set from the
+given set.
+*)
+
+PROCEDURE Union         (    left   : Set         (*-- in    *);
+                             right  : Set         (*-- in    *);
+                         VAR toSet  : Set         (*-- inout *));
+
+VAR   index : BitsetsPerSet; (*-- loop index over bitsets *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF Recreate(toSet) THEN
+      WITH toSet^ DO
+        FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+          items[index] := left^.items[index] + right^.items[index];
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(union, undefined);
+  END (*--if*);
+END Union;
+(*----------------------------*)
+
+PROCEDURE Intersection  (    left   : Set         (*-- in    *);
+                             right  : Set         (*-- in    *);
+                         VAR toSet  : Set         (*-- inout *));
+
+VAR   index : BitsetsPerSet; (*-- loop index over bitsets *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF Recreate(toSet) THEN
+      WITH toSet^ DO
+        FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+          items[index] := left^.items[index] * right^.items[index];
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(intersection, undefined);
+  END (*--if*);
+END Intersection;
+(*----------------------------*)
+
+PROCEDURE Difference    (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   index : BitsetsPerSet; (*-- loop index over bitsets *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF Recreate(toSet) THEN
+      WITH toSet^ DO
+        FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+          items[index] := left^.items[index] - right^.items[index];
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(difference, undefined);
+  END (*--if*);
+END Difference;
+(*----------------------------*)
+
+PROCEDURE SymDifference (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   index : BitsetsPerSet; (*-- loop index over bitsets *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF Recreate(toSet) THEN
+      WITH toSet^ DO
+        FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+          items[index] := left^.items[index] / right^.items[index];
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(symdifference, undefined);
+  END (*--if*);
+END SymDifference;
+(*----------------------------*)
+
+PROCEDURE Complement    (    theSet  : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   index : BitsetsPerSet; (*-- loop index over bitsets *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    IF Recreate(toSet) THEN
+      WITH theSet^ DO
+        FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+          toSet^.items[index] := BITSET{0..15} - items[index];
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(complement, undefined);
+  END (*--if*);
+END Complement;
+(*----------------------------*)
+
+
+
+(*
+14.2.3		Selectors
+
+IsDefined returns true if the given set is not NIL and false otherwise, the simple test for a
+defined set object.
+*)
+
+PROCEDURE IsDefined     (    theSet    : Set         (*-- in    *))
+                                       : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN (theSet # NIL);
+END IsDefined;
+(*----------------------------*)
+
+
+(*
+IsEmpty simply loops through the bitsets returning false if any are found non-empty. 
+Ideally, we would like to directly compare the given bitset array with the empty set array
+but Modula-2 does not support array comparison.
+*)
+
+PROCEDURE IsEmpty       (    theSet    : Set         (*-- in    *))
+                                       : BOOLEAN     (*-- out   *);
+
+VAR   index : BitsetsPerSet; (*-- loop index over bitsets *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+        IF (items[index] # BITSET{}) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(isempty, undefined);
+  END (*--if*);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+
+(*
+IsEqual loops over each of the set's bitset arrays returning false on the first inequality.  If
+the loop completes without premature exit then the two sets must be equal.
+*)
+
+PROCEDURE IsEqual       (    left      : Set         (*-- in    *);
+                             right     : Set         (*-- in    *))
+                                       : BOOLEAN     (*-- out   *);
+
+VAR   index : BitsetsPerSet;   (*-- loop index over bitsets *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    WITH left^ DO
+      FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+        IF (items[index] # right^.items[index]) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+    RETURN TRUE;
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+
+(*
+NumMembers calculates the number of member items of the set by looping over the
+individual bitsets and summing to the number of ╥on╙ bits.  As simple BITSET
+comparison with the empty bitset allows the routine to quickly skip over groups of
+empty items.  As always, undefined sets cause zero to be returned.
+*)
+
+PROCEDURE NumMembers    (    theSet    : Set         (*-- in    *))
+                                       : CARDINAL    (*-- out   *);
+
+VAR   eachWord: BitsetsPerSet; (*-- loop index over bitsets *)
+      eachBit : BitIndex;      (*-- loop index over bits  *)
+      count   : CARDINAL;      (*-- working sum of items in the set *)
+
+BEGIN
+  setError := noerr;
+  count    := 0;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      FOR eachWord := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+        IF (items[eachWord] # BITSET{}) THEN
+          FOR eachBit := MIN(BitIndex) TO MAX(BitIndex) DO
+            IF (eachBit IN items[eachWord]) THEN
+              INC(count);
+            END (*--if*);
+          END (*--for*);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(nummembers, undefined);
+  END (*--if*);
+  RETURN count;
+END NumMembers;
+(*----------------------------*)
+
+
+(*
+IsAMember calculates the bitset number and bit offset into the character set and simply
+uses Modula-2 bitset inclusion to determine if the given item is a member of the set.  As
+always, undefined sets cause false to be returned.
+*)
+
+PROCEDURE IsAMember     (    theItem   : Item        (*-- in    *);
+                             theSet    : Set         (*-- in    *))
+                                       : BOOLEAN     (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN (VAL(CARDINAL, ORD(theItem)) MOD bitsPerBitset) IN
+           theSet^.items[VAL(CARDINAL, ORD(theItem)) DIV bitsPerBitset];
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+
+(*
+IsSubset implementation takes advantage of the equivalence of A Ω B with A ∞ B = A, in
+other words A - B = ».
+*)
+
+
+PROCEDURE IsSubset      (    left      : Set         (*-- in    *);
+                             right     : Set         (*-- in    *))
+                                       : BOOLEAN     (*-- out   *);
+
+VAR   index : BitsetsPerSet; (*-- loop index over bitsets *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    WITH left^ DO
+      FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+        IF (items[index] - right^.items[index]) # BITSET{} THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+    RETURN TRUE;
+  ELSE
+    RaiseErrIn(issubset, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset (    left   : Set        (*-- in    *);
+                              right  : Set        (*-- in    *))
+                                     : BOOLEAN    (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & ~IsEqual(left, right);
+END IsProperSubset;
+(*----------------------------*)
+
+
+(*
+14.2.4		Iterators
+
+LoopOver scans each bitset within the character set passing items on to the processing
+procedure parameter.  Instead of examining every single bit, an optimization is done that
+allows the routine to skip over a bitset if it is empty.  Only bitsets with at least one
+member present are examined further to determine the individual items that are members.
+
+Traverse operates in the same manner.
+*)
+
+PROCEDURE LoopOver      (    theSet  : Set            (*-- in    *);
+                             process : LoopAccessProc (*-- in    *));
+
+VAR   eachWord : BitsetsPerSet; (*-- loop index over bitsets *)
+      eachBit  : BitIndex;      (*-- loop index over bits in bitset *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      FOR eachWord := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+        IF items[eachWord] # BITSET{} THEN
+          FOR eachBit := MIN(BitIndex) TO MAX(BitIndex) DO
+            IF (eachBit IN items[eachWord]) THEN
+              IF ~process(CHR(eachWord * bitsPerBitset + eachBit)) THEN
+                RETURN;
+              END (*--if*);
+            END (*--if*);
+          END (*--for*);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE Traverse      (    theSet  : Set         (*-- in    *);
+                             process : AccessProc  (*-- in    *));
+
+VAR   eachWord : BitsetsPerSet; (*-- loop index over bitsets *)
+      eachBit  : BitIndex;      (*-- loop index over bits in bitset *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      FOR eachWord := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+        IF items[eachWord] # BITSET{} THEN
+          FOR eachBit := MIN(BitIndex) TO MAX(BitIndex) DO
+            IF (eachBit IN items[eachWord]) THEN
+              process(CHR(eachWord * bitsPerBitset + eachBit));
+            END (*--if*);
+          END (*--for*);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+
+
+(*
+14.2.5		Module Initialization
+
+In the module initialization, the predefined discrete set for the empty set (») is filled with
+empty values and the local exception handlers array variables are set to default handlers
+(ExitOnError) except for the noerr handler which is given the null handler.  setError is
+given the value noerr avoiding an undefined state.
+*)
+
+VAR   index : BitsetsPerSet; (*-- loop index over bitsets *)
+
+BEGIN
+  FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+    theEmptySet[index] := BITSET{};
+  END (*--for*);
+
+  FOR setError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[setError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  setError := noerr;
+END SetCSBMI.
+
+
+(*
+References
+
+[1]	G. Booch, Software Components in Ada Structures, Tools and Subsystems,
+	Benjamin/Cummings, Menlo Park, CA, 1987, pp. 40-43, 250-295.
+[2]	R. Gleaves, Modula-2 for Pascal Programmers, Springer-Verlag, New York, NY, 1984,
+	PowerSets Module, pg. 60.
+[3]	R. Ford and R.S. Wiener, Modula-2: A Software Development Approach, John Wiley
+	and Sons, New York, NY, 1985.
+[4]	G.P. McKeown and V.J. Rayward-Smith, Mathematics for Computing, Halstead Press,
+	Wokingham, England, 1982, Section 1.2, Set Theory, pp. 9-18.
+[5]	Modula Corporation, Macintosh Modula-2 System Reference Manual, Version 4.1
+	Supplement, Provo, UT, 1985, LongSets Module definition module.
+[6]	N. Wirth, Programming in Modula-2, 3rd ed., Springer-Verlag, Berlin Heidelberg,
+	1985.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETCSBMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETCSBMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETCSBMN.DEF
@@ -0,0 +1,211 @@
+(*
+14	The Discrete (Character) Bounded Set (continued)
+
+
+Before leaving the subject of sets let us examine a set implementation for the Modula-2
+CHAR data type.  Because we will be dealing with a scalar data type, this information can
+be used to our advantage and allow certain optimizations in the implementation that could
+not be applied otherwise with the generic form.
+
+
+
+14.3		SetCSBMN Interface
+
+
+There are three differences between the generic bounded set and the discrete form as
+presented here:
+
+* Create does not require a size parameter since this value is constant;
+* SizeOf is not necessary for the same reason; and
+* Complement can be provided since the universal set for characters is known and
+  finite.
+
+In all other respects, the definition is otherwise identical with that for the bounded set.
+*)
+
+
+DEFINITION MODULE SetCSBMN;
+(*===========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Set
+               Discrete Sequential Bounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module supports the abstract data type set for
+    discrete values of ASCII CHARs.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+      Initial implementation for TML Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM CharItems IMPORT
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions;
+
+    (*-----------------------*)
+
+TYPE  Set;
+TYPE  SizeRange = [1..256];
+CONST NullSet   = Set(NIL);
+
+
+(*
+14.3.1			Exceptions
+
+The ModuleID is used by the exception handling mechanism to distinguish this module
+from other modules.
+
+SetError returns the exception code from the most recent discrete set operation.  A result
+of noerr indicates successful completion of the operation.
+
+GetHandler returns the exception handler routine associated with the given exception. 
+Though the routine is a function procedure returning a procedure as its result, the
+HandlerProc may not be called from within the GetHandler call itself.  The procedure
+result must be first assigned to a procedure variable before invocation. Exception handlers
+are given an initial value of ExitOnError except for the handler for noerr which is
+initialized to the null exception handler.
+
+SetHandler associates an exception handler routine with the given exception and is the
+inverse of GetHandler. This routine may be used to override the default settings for the
+exception handlers.
+*)
+
+CONST ModuleID = 2;
+
+PROCEDURE SetError    ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+(*
+14.3.2			Constructors
+
+The Create operation attempts to generate a new, empty character set.  The TypeID is
+unnecessary since we are dealing directly with characters and incorporating such
+knowledge into the implementation.  A similar statement can be made regarding the
+maximum size of the set since characters form a small, discrete ranges of values.
+
+Create will return the new set upon successful completion of the routine.  If it is not
+possible for the set to be created, the constant NullSet  will be returned instead.
+
+Destroy takes the given set, clears it of any items, and then destroys the set itself. 
+Where Create makes a defined set, Destroy is its inverse, making the set undefined.
+
+Clear takes the given set and removes all its items, thus returning the set to the empty
+state.
+
+The Assign operation attempts to generate a duplicate of the source set (theSet) in the
+target set (toSet).  The target set is automatically created, if necessary, otherwise the
+target is cleared of its present contents before the assignment.  All character sets are given
+the same, maximum size.
+
+The Include operation adds items to the given set.  If the item is already a member of the
+set the exception condition is quietly ignored.
+
+The Exclude operation removes the specified item from the given set.  If the given set is 
+empty on entry to Exclude, or the given item is not a member of the set  the notinset 
+exception is ignored and the set remains unchanged.
+
+Union, Intersection, Difference, SymDifference (symmetric difference), and Complement
+operations all implement the standard set operations of the same name as defined in the
+set abstraction chapter (11).
+*)
+
+PROCEDURE Create        ()           : Set         (*-- out   *);
+
+PROCEDURE Destroy       (VAR theSet  : Set         (*-- inout *));
+
+PROCEDURE Clear         (VAR theSet  : Set         (*-- inout *));
+
+PROCEDURE Assign        (    theSet  : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+PROCEDURE Include       (    theItem : Item        (*-- in    *);
+                         VAR inSet   : Set         (*-- inout *));
+
+PROCEDURE Exclude       (    theItem : Item        (*-- in    *);
+                         VAR fromSet : Set         (*-- inout *));
+
+PROCEDURE Union         (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+PROCEDURE Intersection  (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+PROCEDURE Difference    (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+PROCEDURE SymDifference (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+PROCEDURE Complement    (    theSet  : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+
+(*
+14.3.3			Selectors
+
+IsDefined attempts to determine whether the given set is valid, e.g., has been created and
+not yet destroyed.  How this is accomplished may be as simple or complicated as the
+implementer desires and the requirements of the application.
+
+IsEmpty returns true if the given set contains no items; in other words, its cardinality is
+zero.  Undefined sets are always considered empty.
+
+IsEqual returns true if the left and right sets contain the same items.  Obviously, both
+must also have been created.  An undefined set is not equal to any other set, including
+itself.
+
+NumMembers returns the number of items present in the given set.  Undefined sets are
+considered to have no members.
+
+IsAMember returns true if the given item is present in the given set, and false otherwise.
+
+IsSubset and IsProperSubset both implement standard logical set operations as defined in
+the Set Abstraction (chapter 11).
+*)
+
+PROCEDURE IsDefined     (    theSet  : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEmpty       (    theSet  : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE NumMembers    (    theSet  : Set         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+                             theSet  : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+END SetCSBMN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETCSBMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETCSBMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETCSBMN.MOD
@@ -0,0 +1,579 @@
+(*
+14.4	SetCSBMN Implementation
+*)
+
+
+IMPLEMENTATION MODULE SetCSBMN;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R- bytes
+    Component: Monolithic Structure - Set
+               Discrete Sequential Bounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module supports the abstract data type set for
+    discrete values of CHARs.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins:
+        Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM CharItems IMPORT
+    (*--Type*) Item;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, Raise, ExitOnError;
+
+    (*-----------------------*)
+
+
+(*
+14.4.1		Internal Discrete Set Representation
+
+╟Illustration Here╚
+
+Figure 14.1
+
+For the internal representation of the discrete (character) set we use a bit vector of items,
+where an item at the appropriate index has a value of one if the item is a member of the
+set and a value of zero otherwise.  In order to save space and enable the use of the standard
+Modula-2 bitset operations, the bit vector is stored as an array of BITSETs.  So instead of
+requiring 256 words per character set only 16 words are needed.  The array of bitsets is
+indexed from zero to fifteen, inclusive, as shown in the calculation of the maximum value
+for theBitsetsPerSet subrange.  In effect, this constant expression reduces to:
+
+					(16 DIV 16) - 1 = (16 - 1) = 15.
+
+The cost for the space savings is the increased execution time used in the calculation of an
+item's bitset index and bit offset within the bitset.
+*)
+
+CONST bitsPerBitset = 16;
+CONST maxSetSize    = MAX(SizeRange);
+TYPE  BitsetsPerSet = [ 0 .. (maxSetSize DIV bitsPerBitset) - 1 ];
+TYPE  BitIndex      = [ 0 .. bitsPerBitset - 1 ];
+
+TYPE  ItemsArray = ARRAY BitsetsPerSet OF BITSET;
+TYPE  DiscreteSet = RECORD
+        items : ItemsArray;    (*-- Bit vector of items *)
+      END (*-- DiscreteSet *);
+
+TYPE  Set = POINTER TO DiscreteSet;
+
+    (*-----------------------*)
+
+VAR   theEmptySet : ItemsArray; (*-- Predefined set, initialized to ┐ *)
+
+
+(*
+14.4.2		Exceptions
+
+To support the exception handling mechanism two variables are needed.  The first,
+setError, is used to record the exception result from each operation; while handlers  is an
+array of exception handling procedures indexed by the exception result.
+
+The routines SetError, GetHandler, and SetHandler have been previously described in the
+definition module, and their operation should be readily apparent.  RaiseErrIn is a local
+routine used to set the setError variable and invoke the Raise routine of the
+ErrorHandling module.
+*)
+
+VAR   setError   : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE SetError    ()             : Exceptions (*-- out   *);
+BEGIN
+  RETURN setError;
+END SetError;
+(*----------------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  setError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+PROCEDURE Recreate   (VAR theSet : Set     (*-- inout *))
+                                 : BOOLEAN (*-- out   *);
+BEGIN
+  IF (theSet = NIL) THEN
+    theSet := Create();
+  END (*--if*);
+  RETURN (theSet # NIL);
+END Recreate;
+(*----------------------------*)
+
+
+(*
+14.4.2		Constructors
+
+Create simply allocates a new array of bitsets raising the overflow exception if unable to
+do so.  Otherwise the newly created set is cleared using array assignment of the predefined
+empty character set.
+*)
+
+PROCEDURE Create        ()           : Set         (*-- out   *);
+
+VAR   newSet : Set;
+
+BEGIN
+  setError := noerr;
+  Allocate(newSet, SIZE(DiscreteSet));
+  IF (newSet # NIL) THEN
+    newSet^.items := theEmptySet;
+    RETURN newSet;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullSet;
+END Create;
+(*----------------------------*)
+
+
+(*
+Destroy takes advantage that Clear  sets setError  to noerr and raises the undefined 
+exception.  So if Clear succeeds, Destroy releases the allocated set header.
+*)
+
+PROCEDURE Destroy       (VAR theSet    : Set         (*-- inout *));
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    Deallocate(theSet, SIZE(DiscreteSet));
+  ELSE
+    RaiseErrIn(destroy, undefined);
+    theSet := NullSet;
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+
+(*
+Clear sets setError to noerr and checks for an undefined set raising the undefined 
+exception if necessary.  After asserting a valid set, it is sufficient to overwrite the existing
+items with the predefined empty set.
+*)
+
+PROCEDURE Clear         (VAR theSet    : Set         (*-- inout *));
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    theSet^.items := theEmptySet;
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+
+(*
+Assign creates the target set if necessary and then uses array assignment to duplicate the
+source bitset array within the target.
+*)
+
+PROCEDURE Assign        (    theSet  : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+BEGIN 
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    IF Recreate(toSet) THEN
+      toSet^.items := theSet^.items;
+    END (*--if*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+
+(*
+Include and Exclude simply calculate the bitset number and bit offset and use the
+Modula-2 set inclusion and exclusion operations.
+*)
+
+PROCEDURE Include       (    theItem : Item        (*-- in    *);
+                         VAR inSet   : Set         (*-- inout *));
+BEGIN
+  setError := noerr;
+  IF (inSet # NIL) THEN
+    INCL(inSet^.items[VAL(CARDINAL, ORD(theItem)) DIV bitsPerBitset],
+         VAL(CARDINAL, ORD(theItem)) MOD bitsPerBitset);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*----------------------------*)
+
+PROCEDURE Exclude       (    theItem : Item        (*-- in    *);
+                         VAR fromSet : Set         (*-- inout *));
+BEGIN
+  setError := noerr;
+  IF (fromSet # NIL) THEN
+    EXCL(fromSet^.items[VAL(CARDINAL, ORD(theItem)) DIV bitsPerBitset],
+         VAL(CARDINAL, ORD(theItem)) MOD bitsPerBitset);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*----------------------------*)
+
+
+(*
+Union, Intersection, Difference, and SymDifference all simply loop over the bitsets of
+the left and right sets using the Modula-2 set operators to form the target set. 
+Complement is similar except that it takes the difference of the universal set from the
+given set.
+*)
+
+PROCEDURE Union         (    left   : Set         (*-- in    *);
+                             right  : Set         (*-- in    *);
+                         VAR toSet  : Set         (*-- inout *));
+
+VAR   index : BitsetsPerSet; (*-- loop index over bitsets *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF Recreate(toSet) THEN
+      WITH toSet^ DO
+        FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+          items[index] := left^.items[index] + right^.items[index];
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(union, undefined);
+  END (*--if*);
+END Union;
+(*----------------------------*)
+
+PROCEDURE Intersection  (    left   : Set         (*-- in    *);
+                             right  : Set         (*-- in    *);
+                         VAR toSet  : Set         (*-- inout *));
+
+VAR   index : BitsetsPerSet; (*-- loop index over bitsets *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF Recreate(toSet) THEN
+      WITH toSet^ DO
+        FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+          items[index] := left^.items[index] * right^.items[index];
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(intersection, undefined);
+  END (*--if*);
+END Intersection;
+(*----------------------------*)
+
+PROCEDURE Difference    (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   index : BitsetsPerSet; (*-- loop index over bitsets *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF Recreate(toSet) THEN
+      WITH toSet^ DO
+        FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+          items[index] := left^.items[index] - right^.items[index];
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(difference, undefined);
+  END (*--if*);
+END Difference;
+(*----------------------------*)
+
+PROCEDURE SymDifference (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   index : BitsetsPerSet; (*-- loop index over bitsets *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF Recreate(toSet) THEN
+      WITH toSet^ DO
+        FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+          items[index] := left^.items[index] / right^.items[index];
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(symdifference, undefined);
+  END (*--if*);
+END SymDifference;
+(*----------------------------*)
+
+PROCEDURE Complement    (    theSet  : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   index : BitsetsPerSet; (*-- loop index over bitsets *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    IF Recreate(toSet) THEN
+      WITH theSet^ DO
+        FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+          toSet^.items[index] := BITSET{0..15} - items[index];
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(complement, undefined);
+  END (*--if*);
+END Complement;
+(*----------------------------*)
+
+
+
+(*
+14.4.3		Selectors
+
+IsDefined returns true if the given set is not NIL and false otherwise, the simple test for a
+defined set object.
+*)
+
+PROCEDURE IsDefined     (    theSet    : Set         (*-- in    *))
+                                       : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN (theSet # NIL);
+END IsDefined;
+(*----------------------------*)
+
+
+(*
+IsEmpty simply loops through the bitsets returning false if any are found non-empty.
+Ideally, we would like to directly compare the given bitset array with the empty set array
+but Modula-2 does not support array comparison.
+*)
+
+PROCEDURE IsEmpty       (    theSet    : Set         (*-- in    *))
+                                       : BOOLEAN     (*-- out   *);
+
+VAR   index : BitsetsPerSet; (*-- loop index over bitsets *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+        IF (items[index] # BITSET{}) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(isempty, undefined);
+  END (*--if*);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+
+(*
+IsEqual loops over each of the set's bitset arrays returning false on the first inequality.  If
+the loop completes without premature exit then the two sets must be equal.
+*)
+
+PROCEDURE IsEqual       (    left      : Set         (*-- in    *);
+                             right     : Set         (*-- in    *))
+                                       : BOOLEAN     (*-- out   *);
+
+VAR   index : BitsetsPerSet;   (*-- loop index over bitsets *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    WITH left^ DO
+      FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+        IF (items[index] # right^.items[index]) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+    RETURN TRUE;
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+
+(*
+NumMembers calculates the number of member items of the set by looping over the
+individual bitsets and summing to the number of ╥on╙ bits.  As simple BITSET
+comparison with the empty bitset allows the routine to quickly skip over groups of
+empty items.  As always, undefined sets cause zero to be returned.
+*)
+
+PROCEDURE NumMembers    (    theSet    : Set         (*-- in    *))
+                                       : CARDINAL    (*-- out   *);
+
+VAR   eachWord: BitsetsPerSet; (*-- loop index over bitsets *)
+      eachBit : BitIndex;      (*-- loop index over bits  *)
+      count   : CARDINAL;      (*-- working sum of items in the set *)
+
+BEGIN
+  setError := noerr;
+  count    := 0;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      FOR eachWord := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+        IF (items[eachWord] # BITSET{}) THEN
+          FOR eachBit := MIN(BitIndex) TO MAX(BitIndex) DO
+            IF (eachBit IN items[eachWord]) THEN
+              INC(count);
+            END (*--if*);
+          END (*--for*);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(nummembers, undefined);
+  END (*--if*);
+  RETURN count;
+END NumMembers;
+(*----------------------------*)
+
+
+(*
+IsAMember calculates the bitset number and bit offset into the character set and simply
+uses Modula-2 bitset inclusion to determine if the given item is a member of the set.  As
+always, undefined sets cause false to be returned.
+*)
+
+PROCEDURE IsAMember     (    theItem   : Item        (*-- in    *);
+                             theSet    : Set         (*-- in    *))
+                                       : BOOLEAN     (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN (VAL(CARDINAL, ORD(theItem)) MOD bitsPerBitset) IN
+           theSet^.items[VAL(CARDINAL, ORD(theItem)) DIV bitsPerBitset];
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+
+(*
+IsSubset implementation takes advantage of the equivalence of A Ω B with A ∞ B = A, in
+other words A - B = ».
+*)
+
+
+PROCEDURE IsSubset      (    left      : Set         (*-- in    *);
+                             right     : Set         (*-- in    *))
+                                       : BOOLEAN     (*-- out   *);
+
+VAR   index : BitsetsPerSet; (*-- loop index over bitsets *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    WITH left^ DO
+      FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+        IF (items[index] - right^.items[index]) # BITSET{} THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+    RETURN TRUE;
+  ELSE
+    RaiseErrIn(issubset, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset (    left   : Set        (*-- in    *);
+                              right  : Set        (*-- in    *))
+                                     : BOOLEAN    (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & ~IsEqual(left, right);
+END IsProperSubset;
+(*----------------------------*)
+
+
+
+(*
+14.4.5		Module Initialization
+
+In the module initialization, the predefined discrete set for the empty set (») is filled with
+empty values and the local exception handlers array variables are set to default handlers
+(ExitOnError) except for the noerr handler which is given the null handler.  setError is
+given the value noerr avoiding an undefined state.
+*)
+
+VAR   index : BitsetsPerSet; (*-- loop index over bitsets *)
+
+BEGIN
+  FOR index := MIN(BitsetsPerSet) TO MAX(BitsetsPerSet) DO
+    theEmptySet[index] := BITSET{};
+  END (*--for*);
+
+  FOR setError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[setError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  setError := noerr;
+END SetCSBMN.
+
+
+(*
+References
+
+[1]	G. Booch, Software Components in Ada Structures, Tools and Subsystems,
+	Benjamin/Cummings, Menlo Park, CA, 1987, pp. 40-43, 250-295.
+[2]	R. Gleaves, Modula-2 for Pascal Programmers, Springer-Verlag, New York, NY, 1984,
+	PowerSets Module, pg. 60.
+[3]	R. Ford and R.S. Wiener, Modula-2: A Software Development Approach, John Wiley
+	and Sons, New York, NY, 1985.
+[4]	G.P. McKeown and V.J. Rayward-Smith, Mathematics for Computing, Halstead Press,
+	Wokingham, England, 1982, Section 1.2, Set Theory, pp. 9-18.
+[5]	Modula Corporation, Macintosh Modula-2 System Reference Manual, Version 4.1
+	Supplement, Provo, UT, 1985, LongSets Module definition module.
+[6]	N. Wirth, Programming in Modula-2, 3rd ed., Springer-Verlag, Berlin Heidelberg,
+	1985.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETENUM.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETENUM.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETENUM.DEF
@@ -0,0 +1,151 @@
+DEFINITION MODULE SetEnum;
+
+(*==============================================================
+
+    Version  : 1.00  30 Apr 1989  C. Lins
+
+    Compiler : TopSpeed Modula-2
+
+    Component: Set Enumerations Utility
+
+
+
+    THE ABSTRACTION
+
+    This module provides definitions of the standard set exceptions
+
+    and operations.
+
+
+
+    REVISION HISTORY
+
+    v1.00  30 Apr 1989  C. Lins:
+
+        Initial JPI Modula-2 implementation.
+
+
+
+    (C) Copyright 1989 Charles A. Lins
+
+==============================================================*)
+
+
+
+CONST ComponentID = 768;	(*-- must be a multiple of 256 *)
+
+
+
+    (*---------------------------------*)
+
+    (*--        SET OPERATIONS       --*)
+
+
+
+TYPE  Operations = (
+
+                    (*-- Module Initialization *)
+
+                    modinit,
+
+
+
+                    (*-- Constructors *)
+
+                    create, destroy, clear, assign, include, exclude,
+
+                    inclrange, exclrange, union, intersection,
+
+                    difference, symdifference, merge, complement,
+
+                    construct,
+
+
+
+                    (*-- Selectors *)
+
+                    isdefined, isempty, isequal, sizeof, typeof,
+
+                    nummembers, ismember, issubset, ispropersubset,
+
+					universeof, inuniverse, minmember, maxmember,
+
+
+
+                    (*-- Iterators *)
+
+                    loopover, traverse,
+
+
+
+                    (*-- Guarded Concurrent Operations *)
+
+                    seize, release
+
+                   );
+
+
+
+TYPE  Constructors = Operations [ create    .. construct ];
+
+TYPE  Selectors    = Operations [ isdefined .. maxmember ];
+
+TYPE  Iterators    = Operations [ loopover  .. traverse ];
+
+TYPE  GuardedOps   = Operations [ seize     .. release ];
+
+
+
+
+
+    (*---------------------------------*)
+
+    (*--       SET EXCEPTIONS        --*)
+
+
+
+TYPE  Exceptions = (noerr,      (*-- Nothing went wrong, all's well. *)
+
+                    initfailed, (*-- Module initialization failure. *)
+
+
+
+                    domainerr,  (*-- Item outside the Universe, or
+
+                                  -- Set Universes mismatched, or
+
+                                  -- Invalid Universe definition *) 
+
+
+
+                    iteminset,  (*-- Item already exists in set *)
+
+
+
+                    notinset,   (*-- Item does not exist in set *)
+
+
+
+                    overflow,   (*-- Set cannot grow big enough for
+
+                                  -- the requested operation. *)
+
+
+
+                    typeerror,  (*-- TypeID mismatch between sets *)
+
+
+
+                    undefined   (*-- Set has not been Created, or
+
+                                  -- set has been Destroyed. *)
+
+                   );
+
+
+
+TYPE  ExceptionSet = SET OF Exceptions;
+
+
+
+END SetEnum.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETENUM.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETENUM.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETENUM.MOD
@@ -0,0 +1,45 @@
+IMPLEMENTATION MODULE SetEnum; 
+
+(*====================================================================
+
+    Version  : 1.00  22 Dec 1987  C. Lins
+
+    Compiler : TML Modula-2 Compiler for the Apple Macintosh
+
+    Code Size: R+ 32 bytes, R- 32 bytes
+
+    Component: Structure 
+
+
+
+    THE ABSTRACTION
+
+    This module provides definitions of the standard set exceptions
+
+    and operations.  TML requires an empty implementation module.
+
+
+
+    REVISION HISTORY
+
+    v1.00  22 Dec 1987  C. Lins:
+
+        Initial TML Modula-2 implementation
+
+
+
+    PROPRIETARY NOTICES
+
+    "SetEnum.IMP", by C. Lins, Copyright ⌐ 1987 Chuck Lins Software.
+
+    5063 Clairemont Mesa Blvd. # 6, San Diego, Calif., USA  92117.
+
+    Apple is a registered trademark of Apple Computer, Inc.
+
+    Macintosh is a trademark of Apple Computer, Inc.
+
+====================================================================*)
+
+
+
+END SetEnum.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETHANDL.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETHANDL.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETHANDL.DEF
@@ -0,0 +1,34 @@
+(*
+This module provides a simple exception handler for the
+various Set abstractions. Given an error code, it reports
+the exception to standard output in the following format:
+### Error "<error text>" raised in Routine "<routine name>" in Module <module #>
+
+The system beep is made before issuing the message and a WriteLn
+follows the message display.
+
+The module does NOT made use of Macintosh resources (it should).
+*)
+
+DEFINITION MODULE SetHandlers;
+(*==============================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Set Exception Handlers Utility
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins:
+        Initial implementation
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM SetEnum IMPORT
+	(*--type*) Exceptions, Operations;
+
+
+PROCEDURE WriteHandler (    theModule  : CARDINAL   (*--in   *);
+                            theRoutine : Operations (*--in   *);
+                            theError   : Exceptions (*--in   *));
+
+END SetHandlers.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETHANDL.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETHANDL.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETHANDL.MOD
@@ -0,0 +1,78 @@
+IMPLEMENTATION MODULE SetHandlers;
+(*==============================================================
+    Version  : 1.00  02 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Set Exception Handlers Utility
+
+    REVISION HISTORY
+    v1.00  02 May 1989  C. Lins:
+        Initial TopSpeed Modula-2 implementation
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM SetEnum IMPORT
+	(*--type*) Exceptions, Operations;
+
+FROM IO IMPORT
+	(*--proc*) WrStr, WrLn, WrCard;
+
+
+PROCEDURE WriteHandler (    theModule 	: CARDINAL;
+	  	                    theOperation: Operations;
+	  	                    theException: Exceptions);
+
+BEGIN
+  WrStr('### Error "');
+
+  CASE theException OF
+  	noerr     : WrStr('No Error');
+  |	domainerr : WrStr('Domain Error');
+  | iteminset : WrStr('Item in Set');
+  | notinset  : WrStr('Item not in Set');
+  | overflow  : WrStr('Overflow');
+  | typeerror : WrStr('Type mismatch between sets');
+  | undefined : WrStr('Undefined Set');
+  END (*--case*);
+
+  WrStr('" raised in Routine "');
+
+  CASE theOperation OF
+  	assign        : WrStr('Assign');
+  | create        : WrStr('Create');
+  | destroy       : WrStr('Destroy');
+  | clear         : WrStr('Clear');
+  | include       : WrStr('Include');
+  | exclude       : WrStr('Exclude');
+  | inclrange     : WrStr('Include Range');
+  | exclrange     : WrStr('Exclude Range');
+  | union         : WrStr('Union');
+  | intersection  : WrStr('Intersection');
+  | difference    : WrStr('Difference');
+  | symdifference : WrStr('Symmetric Difference');
+  | complement    : WrStr('Complement');
+  | construct     : WrStr('Construct');
+
+  | isempty       : WrStr('IsEmpty');
+  | isequal       : WrStr('IsEqual');
+  | typeof        : WrStr('TypeOf');
+  | sizeof        : WrStr('SizeOf');
+  | nummembers    : WrStr('NumMembers');
+  | ismember      : WrStr('IsMember');
+  | issubset      : WrStr('IsSubset');
+  | ispropersubset: WrStr('IsProperSubset');
+  | universeof    : WrStr('UniverseOf');
+	
+  | loopover      : WrStr('LoopOver');
+  | traverse      : WrStr('Traverse');
+
+  ELSE
+    WrStr('?????');
+  END (*--case*);
+
+  WrStr('" in Module ');
+  WrCard(theModule, 1);
+  WrLn;
+END WriteHandler;
+
+END SetHandlers.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBMI.DEF
@@ -0,0 +1,267 @@
+(*
+12	The Bounded Set
+
+
+The first of three implementations for the set abstraction described in the previous chapter 
+is presented here.  This particular form has the properties: Sequential, Bounded, Managed,
+and Iterator, describing specific aspects of the implementation as follows:
+
+Sequential:	Can only be used in a non-tasking environment, or by only one task.
+Bounded:	The maximum size of a set is given when the set is created.
+Managed:	Memory space for items and objects is returned to the system when no
+			longer needed.
+Iterator:	Routines for looping over each of a set's items are provided.
+
+As has been the convention for all other abstractions, the interface to the module defining
+set operations and exceptions is included here as well in Section 12.1.  The bounded set
+interface follows in Section 12.2 while the actual implementation appears in Section
+12.3.
+
+
+12.2	SetSBMI Interface
+*)
+
+
+DEFINITION MODULE SetSBMI;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Component: Monolithic Structures - Set
+               Sequential Bounded Managed Iterator
+
+    INTRODUCTION
+    This module provides the interface to the bounded
+    implementation Set abstraction for generic Items.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  Set;
+TYPE  SizeRange = [ 1 .. 8000 ];
+CONST NullSet   = Set(NIL);
+
+
+
+(*
+12.2.1			Exceptions
+
+The ModuleID is used by the exception handling mechanism to distinguish this module
+from other modules.
+
+SetError returns the exception code from the most recent set operation.  A result of noerr 
+indicates successful completion of the operation.
+
+GetHandler returns the exception handler routine associated with the given exception. 
+Though the routine is a function procedure returning a procedure as its result, the
+HandlerProc may not be called from within the GetHandler call itself.  The procedure
+result must be first assigned to a procedure variable before invocation.  Exception handlers
+are given an initial value of ExitOnError except for the handler for noerr which is
+initialized to the null exception handler.
+
+SetHandler associates an exception handler routine with the given exception and is the
+inverse of GetHandler.  This routine may be used to override the default settings for the
+exception handlers.
+*)
+
+CONST ModuleID = 3;
+
+PROCEDURE SetError    ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    theError   : Exceptions  (*-- in    *))
+                                      : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    theError   : Exceptions  (*-- in    *);
+                           theHandler : HandlerProc (*-- in    *));
+
+
+(*
+12.2.2			Constructors
+
+The Create operation attempts to generate a new, empty set of the given maximum size
+(theSize) and Item operations associated with the given data type identifier (theType).
+
+For the bounded form of set, it is necessary to define the maximum number of items
+desired.  This is done with theSize parameter.
+
+The TypeID is the method by which Items of any data type are supported.  Using the
+TypeID, the component can assign one item to another and release any dynamically
+allocated resources associated with an Item without knowledge of the Item's internal
+composition.  In this way, one may create a set whose items consist of other
+(dynamically allocated) structures, as well as sets consisting of the basic data types.
+
+Create will return the new set upon successful completion of the routine.  If it not
+possible for the set to be created, the constant NullSet  will be returned instead.
+
+Destroy takes the given set, clears it of any items, and then destroys the set itself. 
+Where Create makes a defined set, Destroy is its inverse, making the set undefined.
+
+Clear takes the given set and removes all of its items.  theType attribute of the set 
+(assigned when the set was created) is used to retrieve the item deallocation routine for the
+items of the set.  Clearing the set returns it to the empty state.
+
+The Assign operation attempts to generate a duplicate of the source set (theSet) in the
+target set (toSet).  The target set is automatically created using the size and data type
+attributes of the source set, if necessary.  If this step is unnecessary, (the target set has
+already been previously created), the target is cleared of its present contents, its data type
+is set to that of the source set but the size is left unchanged.
+
+There is no guarantee that the client module would desire the target set to be defined with
+the same size as the source.  The minimum requirement for the target set size is that it
+must be capable of storing all of the items present in the source set.  It may be desirable
+that the target set size be greater than the source set size.  Such a situation could occur
+during error recovery of a bounded set overflow caused by the set's cardinality
+encountering the set size, and the client module may effectively attempt to increase the
+the set size using the assignment mechanism.
+
+In order to allow Items of any data type, a method must be provided to assign the contents
+of one item to another item.  This is accomplished, as above for Create, through the
+TypeID of the source set.
+
+The Include operation adds items to the given set.  If the cardinality of the set is already
+at its maximum size the overflow exception will be raised and the set remains unchanged.
+
+The Exclude operation removes the specified item from the given set.  If the given set is 
+empty on entry to Exclude, or the given item is not a member of the set  the notinset 
+exception may be raised and the set remains unchanged.
+
+Union, Intersection, Difference, and SymDifference  (symmetric difference) operations all
+implement the standard set operations of the same name.
+*)
+
+PROCEDURE Create        (    theSize  : SizeRange (*-- in    *);
+                             theType  : TypeID    (*-- in    *))
+                                      : Set       (*-- out   *);
+
+PROCEDURE Destroy       (VAR theSet   : Set       (*-- inout *));
+
+PROCEDURE Clear         (VAR theSet   : Set       (*-- inout *));
+
+PROCEDURE Assign        (    theSet   : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+PROCEDURE Include       (    theItem  : Item      (*-- in    *);
+                         VAR inSet    : Set       (*-- inout *));
+
+PROCEDURE Exclude       (    theItem  : Item      (*-- in    *);
+                         VAR fromSet  : Set       (*-- inout *));
+
+PROCEDURE Union         (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+PROCEDURE Intersection  (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+PROCEDURE Difference    (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+PROCEDURE SymDifference (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+
+(*
+12.2.3			Selectors
+
+IsDefined attempts to determine whether the given set is valid, e.g., has been created and
+not yet destroyed.  How this is accomplished may be as simple or complicated as the
+implementer desires and the requirements of the application.
+
+IsEmpty returns true if the given set contains no items; in other words, its cardinality is
+zero.  Undefined sets are always considered to be empty.
+
+IsEqual returns true if the left and right sets contain the same items.  Obviously, both
+must also have the same data type and have been created.  An undefined set is not equal to
+any other set, including itself.
+
+The routines SizeOf and TypeOf return the values given the set when it was created, and
+both are provided so the user of the module need not maintain separate variables recording
+this information.
+
+NumMembers returns the number of items present on the given set.  Undefined sets are
+considered to have a cardinality of zero.
+
+IsAMember returns true if the given item is present in the given set, and false otherwise.
+
+IsSubset and IsProperSubset both implement standard logical set operations as defined in
+the Set Abstraction (chapter 11).
+*)
+
+PROCEDURE IsDefined     (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty       (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE SizeOf        (    theSet  : Set      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf        (    theSet  : Set      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+
+PROCEDURE NumMembers    (    theSet  : Set      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+                             theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+
+(*
+12.2.4			Iterators
+
+The iterator routine LoopOver provides the facility for looping over some or all items of
+a set, with read-only access to each item.  theProcess procedure parameter to this routine
+returns a BOOLEAN function result where TRUE allows the iteration to proceed to the
+next item and FALSE causes the iteration to be terminated.
+
+The Traverse iterator provides the facility for looping over all items of a set, with
+read-only access to each item.
+
+Both iterators traverse the given set from the first item towards the last item in ascending
+order.  Obviously, if given an empty set the processing procedure will not be invoked.
+
+Iterators allowing changes to an item's value are not provided as this would violate our
+abstraction (and increase the complexity of the implementation).
+*)
+
+PROCEDURE LoopOver (    theSet  : Set            (*-- in    *);
+                        process : LoopAccessProc (*-- in    *));
+
+PROCEDURE Traverse (    theSet  : Set            (*-- in    *);
+                        process : AccessProc     (*-- in    *));
+
+END SetSBMI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBMI.MOD
@@ -0,0 +1,1048 @@
+(*
+12.3	SetSBMI Implementation
+*)
+
+
+IMPLEMENTATION MODULE SetSBMI;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Set
+               Sequential Bounded Managed Iterator
+
+    INTRODUCTION
+    This module provides the implementation of the bounded
+    Set abstraction for generic Items using an ordered array.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+        Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, AssignProc, CompareProc, DisposeProc,
+               AccessProc, LoopAccessProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, CompareOf, DisposeOf;
+
+    (*--------------------*)
+
+
+(*
+12.3.1	Internal Bounded Set Representation
+
+╟Illustration Here╚
+
+Figure 12.1
+
+Like the internal representations for the bounded stack and string, a bounded set is
+represented as a pointer to a record containing an array of items of a variable size.  In
+addition, the data type ID, physical array size (maximum number of items), and the
+current length (number of items currently present in the array).  The representation
+invariants that must be enforced by the module are:
+
+1.	MIN(SizeRange) <= size <= MAX(SizeRange)
+2.	MIN(SizeRange) <= length <= size
+3.	items[x] < items[x+1], for all x such that x < length
+
+The third invariant states that elements of the items array must be linearly ordered in
+ascending sequence.
+*)
+
+TYPE  ItemsArray = ARRAY SizeRange OF Item;
+TYPE  BoundedSet = RECORD
+        dataID : TypeID;     (*-- defined data type *)
+        size   : SizeRange;  (*-- defined Set size *)
+        length : CARDINAL;   (*-- current Set length, := 0 *)
+        items  : ItemsArray; (*-- ordered array [1..size] of Item *)
+      END (*-- BoundedSet *);
+
+TYPE  Set = POINTER TO BoundedSet;
+
+
+(*
+12.2.2	Exceptions
+
+To support the exception handling mechanism two variables are needed.  The first,
+setError, is used to record the exception result from each operation; while handlers  is an
+array of exception handling procedures indexed by the exception result.
+
+The routines SetError, GetHandler, and SetHandler have been previously described in the
+definition module, and their operation should be readily apparent.  RaiseErrIn  is a local
+routine used to set the setError variable and invoke the Raise  routine of the
+ErrorHandling module.
+*)
+
+VAR   setError  : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+PROCEDURE SetError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN setError;
+END SetError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  setError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+
+(*
+12.3.3	Local Routines
+
+
+12.3.3.1	CopySubset
+
+Several of the set algorithms require the ability to copy the all remaining items from a
+given set to a partially created target set.  CopySubset  performs this operation by
+looping through the fromSet starting from the given index to the end of the fromSet,
+copying each item to the target set along the way.  If during the copying process the
+target set size is insufficient for all of the items from the source set, the overflow
+exception is raised and the operation is aborted.  (A more efficient implementation for
+checking overflow would be to calculate the number of items to copy from the source
+(length - fromIndex + 1) and compare this to the number of available positions remaining
+in the target (size - length) and if the result is greater then invoke overflow).
+
+
+12.3.3.2	Recreate
+
+All routines that accept a target set as an inout parameter need to either (1) clear the
+existing set of its contents if the set already exists, or (2) create a new, empty set to be
+target of the operation.  The Recreate  routine provides such a capability, returning true if
+successful.  It should be noted that failure only occurs as a result when the set must be
+created.
+*)
+
+PROCEDURE CopySubset (    routine : Operations (*-- in    *);
+                          fromSet : Set        (*-- in    *);
+                          index   : SizeRange  (*-- in    *);
+                      VAR toSet   : Set        (*-- inout *));
+
+VAR   assignItem : AssignProc; (*-- Item assignment routine, if any *)
+
+BEGIN
+  assignItem := AssignOf(fromSet^.dataID);
+  WITH toSet^ DO
+    WHILE (index <= fromSet^.length) DO
+      IF (length < size) THEN
+        INC(length);
+        items[length] := assignItem(fromSet^.items[index]);
+        INC(index);
+      ELSE
+        RaiseErrIn(routine, overflow);
+        RETURN;
+      END (*--if*);
+    END (*--while*);
+  END (*--with*);
+END CopySubset;
+(*--------------------*)
+
+PROCEDURE Recreate (    theType : TypeID    (*-- in    *);
+                        theSize : SizeRange (*-- in    *);
+                    VAR theSet  : Set       (*-- inout *))
+                                : BOOLEAN   (*-- out   *);
+BEGIN
+  IF (theSet # NIL) THEN
+    Clear(theSet);
+    theSet^.dataID := theType;
+  ELSE
+    theSet := Create(theSize, theType);
+  END (*--if*);
+  RETURN (setError = noerr);
+END Recreate;
+(*--------------------*)
+
+
+(*
+12.3.4	Constructors
+
+Create begins by clearing the setError field under the assumption of a successful result.
+
+The header for the set must then be allocated in a local variable since the function result
+cannot be manipulated but only returned.  The key to this allocation step is the
+calculation of the number of bytes necessary based on the size of an individual item and
+the number of items requested.  We must not forget the space for storing theSize, the
+Type, and the set length.  The constant staticSize  accomplishes this regardless of the
+number and size of these ╥static╙ fields.  The calculation is unaffected by changes in the
+number or size of these fields that may come about due to future maintenance.  If the
+bounded set could not be allocated, the overflow exception must be raised, and the NullSet
+returned.
+
+At this point, all possibility of failure has been avoided and the bounded set header can be
+initialized to its empty state, and the size limit and data type ID  can be stored for this
+bounded set.  Lastly, the new set can be returned to the caller.
+*)
+
+PROCEDURE Create        (    theSize  : SizeRange (*-- in    *);
+                             theType  : TypeID    (*-- in    *))
+                                      : Set       (*-- out   *);
+
+CONST staticSize = SIZE(BoundedSet) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newSet : Set;
+
+BEGIN
+  setError := noerr;
+  Allocate(newSet, staticSize + itemSize * theSize);
+  IF (newSet # NIL) THEN
+    WITH newSet^ DO
+      size   := theSize;
+      dataID := theType;
+      length := 0;
+    END (*--with*);
+    RETURN newSet;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullSet;
+END Create;
+(*--------------------*)
+
+
+(*
+Destroy takes advantage that Clear sets setError to noerr and raises the undefined set
+exception.  So if Clear succeeds, Destroy simply releases the allocated set header.
+*)
+
+PROCEDURE Destroy       (VAR theSet   : Set       (*-- inout *));
+
+CONST staticSize = SIZE(BoundedSet) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theSet);
+  IF (setError = noerr) THEN
+    Deallocate(theSet, staticSize + itemSize * theSet^.size);
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+
+(*
+Clear sets setError to noerr and checks for an undefined set raising the undefined set
+exception if necessary.  After asserting a valid set, the item disposal routine is retrieved
+for the set, followed by the deallocation of every item in the set.  Once this has been
+taken care of, the set length is adjusted to the empty state.
+*)
+
+PROCEDURE Clear         (VAR theSet   : Set       (*-- inout *));
+
+VAR   freeItem : DisposeProc; (*-- Item disposal routine, if any *)
+      index    : CARDINAL;    (*-- Loop index over items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      freeItem := DisposeOf(dataID);
+      FOR index := MIN(SizeRange) TO length DO
+        freeItem(items[index]);
+      END (*--for*);
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+
+(*
+Assignment for bounded objects is simpler to implement than their unbounded
+counterparts since the opportunity for overflow is restricted to when the target object is
+being (re-)created.
+
+If the target object exists and is capable of holding all of the source object's items the
+target can be safely cleared and its data type updated appropriately.  Otherwise, the
+overflow exception is raised and the assignment operation aborted.  When the target object
+is initially undefined it must be created using the data type and size attributes of the
+source object.  If overflow does not occur, the actual assignment can commence,
+otherwise its suffices to exit as Create has already raised the exception.
+
+The assignment operator cannot be used to copy the whole items array as only a slice of
+the array's index range was actually allocated and who knows what other dynamically
+allocated objects follow it in memory.  Nor can assignment be used to copy individual
+items as the data type of those items is unknown; using assignment for dynamically
+allocated items would cause structural sharing of items, which is not desired.
+*)
+
+PROCEDURE Assign        (    theSet   : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+VAR   assignItem : AssignProc; (*-- Item assignment routine, if any *)
+      index      : CARDINAL;   (*-- Loop index over items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      IF Recreate(dataID, size, toSet) THEN
+        IF (length <= toSet^.size) THEN
+          assignItem := AssignOf(dataID);
+          FOR index := MIN(SizeRange) TO length DO
+            toSet^.items[index] := assignItem(items[index]);
+          END (*--for*);
+          toSet^.length := length;
+        ELSE
+          RaiseErrIn(assign, overflow);
+        END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+
+(*
+Include must add the given item to the set if it is not already a member or to simply exit
+if the item is already a member (these semantics are compatible with Modula-2's INCL
+operation).  We could use the IsAMember selector except the index where the item is not
+found is necessary to insert the item in its appropriate position within the ordered array.
+Once we have this position, we make room for the new item by shifting all items above
+the index position up by one index position in the array.  Of course, there must be room
+for the new item in the set.  Then the new item is inserted into its proper place.
+*)
+
+PROCEDURE Include       (    theItem  : Item      (*-- in    *);
+                         VAR inSet    : Set       (*-- inout *));
+
+VAR   index       : CARDINAL;    (*-- Loop index in search for theItem *)
+      jndex       : CARDINAL;    (*-- Loop index in shifting items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (inSet # NIL) THEN
+    WITH inSet^ DO
+      compareItem := CompareOf(dataID);
+      index := MIN(SizeRange);
+      LOOP
+        IF (index > length) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+        itemOrder := compareItem(items[index], theItem);
+        IF (itemOrder = equal) THEN
+          RETURN;
+        ELSIF (itemOrder = greater) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+        INC(index);
+      END (*--loop*);
+
+      IF (length < size) THEN
+
+        FOR jndex := length TO index BY -1 DO
+          items[jndex + 1] := items[jndex];
+        END (*--for*);
+
+        INC(length);
+        items[index] := theItem;
+
+      ELSE
+        RaiseErrIn(include, overflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*--------------------*)
+
+
+(*
+Exclude undoes what Include did to add an item to the set; if the item is found then all
+items above it in the array are shifted downward one position and the set length is updated
+to reflect removal of the item.  If the item is not found the routine simply exits to be
+compatible with Modula-2's EXCL operation.
+*)
+
+PROCEDURE Exclude       (    theItem  : Item      (*-- in    *);
+                         VAR fromSet  : Set       (*-- inout *));
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (fromSet # NIL) THEN
+    WITH fromSet^ DO
+      compareItem := CompareOf(dataID);
+      index := MIN(SizeRange);
+      LOOP
+        IF (index > length) THEN
+          RETURN;
+        END (*--if*);
+
+        itemOrder := compareItem(items[index], theItem);
+        IF (itemOrder = equal) THEN
+          EXIT (*--loop*);
+        ELSIF (itemOrder = greater) THEN
+          RETURN;
+        END (*--if*);
+
+        INC(index);
+      END (*--loop*);
+
+      WHILE (index < length) DO
+        INC(index);
+        items[index - 1] := items[index];
+      END (*--while*);
+      DEC(length);
+
+    END (*--with*);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*--------------------*)
+
+
+(*
+Union computes the set containing all members of left and right, e.g.,
+
+x IN toSet iff (x IN left) OR (x IN right).
+
+The algorithm used is a variation on the array merge from Augenstein and Tanenbaum [2,
+pg. 414] and the set intersection algorithm presented in Aho, Hopcroft, and Ullman [1,
+pg. 117].
+
+The algorithm loops over the items of the left and right sets until the end of either is
+reached.  On each iteration, the items are compared for the ordering relation between them.
+This is used to determine from which set an item is copied to the target set, and which
+indexes to advance.  In this manner, all items are processed only once and duplicate items
+in the target set are avoided. The toSet length is used as the running index for adding the
+resulting items of the union.
+
+The last step is to copy the remaining items, if any, from either the left set or the right
+set to the destination set.
+*)
+
+PROCEDURE Union         (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+      assignItem  : AssignProc;  (*-- Item assignment routine *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(union, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(union, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, left^.size, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    WITH toSet^ DO
+      IF (length < size) THEN
+        INC(length);
+      ELSE
+        RaiseErrIn(union, overflow);
+        RETURN;
+      END (*--if*);
+      IF (order = less) THEN
+        items[length] := assignItem(left^.items[leftIndex]);
+        INC(leftIndex);
+      ELSIF (order = equal) THEN
+        items[length] := assignItem(left^.items[leftIndex]);
+        INC(leftIndex);
+        INC(rightIndex);
+      ELSE
+        items[length] := assignItem(right^.items[rightIndex]);
+        INC(rightIndex);
+      END (*--if*);
+    END (*--with*);
+  END (*--while*);
+
+  IF (leftIndex > left^.length) THEN
+    CopySubset(union, right, rightIndex, toSet);
+  ELSIF (rightIndex > right^.length) THEN
+    CopySubset(union, left, leftIndex, toSet);
+  END (*--if*);
+END Union;
+(*--------------------*)
+
+
+(*
+Intersection computes the set containing all members in both left and right sets, e.g.,
+
+x IN toSet iff (x IN left) AND (x IN right).
+
+The algorithm, similar to the set intersection algorithm given in Aho, Hopcroft, and
+Ullman [1, pg. 117] for ordered lists, loops over the items of the left and right sets until
+the end of either is reached.  On each iteration, the items are compared for the ordering
+relation between them.  Equal items are copied to the target set and both indexes are
+advanced, otherwise the index to the smaller item is advanced.  In this manner, all items
+are processed only once and duplicate items in the target set are avoided.  The toSet length
+is used as the running index for adding the resulting items of the intersection.
+*)
+
+PROCEDURE Intersection  (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+      assignItem  : AssignProc;  (*-- Item assignment routine *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(intersection, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(intersection, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, left^.size, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex  <= left^.length) & (rightIndex < right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    IF (order = equal) THEN
+      WITH toSet^ DO
+        IF (length < size) THEN
+          INC(length);
+          items[length] := assignItem(left^.items[leftIndex]);
+        ELSE
+          RaiseErrIn(intersection, overflow);
+          RETURN;
+        END (*--if*);
+      END (*--with*);
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      INC(leftIndex);
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+END Intersection;
+(*--------------------*)
+
+
+(*
+Difference computes the set containing all members of the left set that are not members
+of the right set, e.g.,
+
+x IN toSet iff (x IN left) & ┬(x IN right)
+
+The algorithm, similar to the above algorithm for intersection, loops over the items of
+the left and right sets until the end of either is reached.  On each iteration, the items are
+compared for the ordering relation between them.  Equal items are skipped and both
+indexes advanced, otherwise the index to the smaller item is advanced.  When the item
+from the left set is less than that of the right set we know that it is not present in the
+right set and can copy that item over to the target set.  The toSet length is used as the
+running index for adding the resulting items of the difference.  The last step is to copy the
+remaining items, if any, from the left set to the destination set.
+*)
+
+PROCEDURE Difference    (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+      assignItem  : AssignProc;  (*-- Item assignment routine *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(difference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(difference, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, left^.size, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    IF (order = equal) THEN
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      WITH toSet^ DO
+        IF (length < size) THEN
+          INC(length);
+          items[length] := assignItem(left^.items[leftIndex]);
+        ELSE
+          RaiseErrIn(difference, overflow);
+          RETURN;
+        END (*--if*);
+      END (*--with*);
+      INC(leftIndex);
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+
+  CopySubset(difference, left, leftIndex, toSet);
+END Difference;
+(*--------------------*)
+
+
+(*
+SymDifference computes the set containing all members of the left or right set that are
+not members of both sets, e.g.,
+
+x IN toSet iff (x IN left) ¡ (x IN right)
+
+The algorithm, similar to that given above for union and difference, loops over the items
+of the left and right sets until the end of either is reached.  On each iteration, the items are
+compared for the ordering relation between them.  Equal items are skipped and both
+indexes advanced, otherwise the index to the smaller item is advanced.  When the items
+between the two sets are unequal we can then copy the smaller of the two items over to
+the target set.  The toSet length is used as the running index for adding the resulting
+items of the symmetric difference.  The last step is to copy the remaining items, if any,
+from either the left or right set, whichever has items remaining, to the target set.
+*)
+
+PROCEDURE SymDifference (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+      assignItem  : AssignProc;  (*-- Item assignment routine *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(symdifference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(symdifference, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, left^.size, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    IF (order = equal) THEN
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSE
+      WITH toSet^ DO
+        IF (length < size) THEN
+          INC(length);
+        ELSE
+          RaiseErrIn(symdifference, overflow);
+          RETURN;
+        END (*--if*);
+        IF (order = less) THEN
+          items[length] := assignItem(left^.items[leftIndex]);
+          INC(leftIndex);
+        ELSE
+          items[length] := assignItem(right^.items[rightIndex]);
+          INC(rightIndex);
+        END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--while*);
+
+  IF (leftIndex > left^.length) THEN
+    CopySubset(symdifference, right, rightIndex, toSet);
+  ELSIF (rightIndex > right^.length) THEN
+    CopySubset(symdifference, left, leftIndex, toSet);
+  END (*--if*);
+END SymDifference;
+(*--------------------*)
+
+
+
+(*
+12.3.4		Selectors
+
+IsDefined returns true if the given set is non-NIL, which is the simplest test for a defined
+set object.
+*)
+
+PROCEDURE IsDefined     (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (theSet # NIL);
+END IsDefined;
+(*--------------------*)
+
+
+(*
+IsEmpty (as always) returns the logical condition as to the state of the set's length,
+which if zero indicates an empty set.
+*)
+
+PROCEDURE IsEmpty       (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN (theSet^.length = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*--------------------*)
+
+
+(*
+Sizeof simply returns the defined size for the given set or a default value for an undefined
+set.  TypeOf is similar except that it deals with the set's data type ID.
+*)
+
+PROCEDURE SizeOf        (    theSet  : Set      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*--------------------*)
+
+PROCEDURE TypeOf        (    theSet  : Set      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*--------------------*)
+
+
+(*
+IsEqual must return true if the two given sets each contain the same items.  After
+enforcing the required preconditions, the lengths of the sets are compared in a simple test
+for inequality.  If the lengths are equal it is possible for the sets to be equal so we loop
+over each item of both sets returning false upon encountering the first inequality between
+two items.  True is returned if the loop completes without finding any mismatched items.
+*)
+
+PROCEDURE IsEqual       (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- Loop index over items *)
+      compare : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.length = right^.length) THEN
+	compare := CompareOf(left^.dataID);
+        FOR index := MIN(SizeRange) TO left^.length DO
+          IF compare(left^.items[index], right^.items[index]) # equal THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--for*);
+        RETURN TRUE;
+      END (*--if*);
+    ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+
+(*
+NumMembers needs to simply return the current set length or for an undefined set return
+zero as it is impossible to have any members in such a set.
+*)
+
+PROCEDURE NumMembers    (    theSet  : Set         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.length;
+  END (*--if*);
+  RaiseErrIn(nummembers, undefined);
+  RETURN 0;
+END NumMembers;
+(*----------------------------*)
+
+
+(*
+IsAMember seeks to determine whether the given item is a member of the given set by
+scanning each of the items in the set in turn.  There are two conditions that could cause
+the loop to terminate prior to reaching the last item: (1) the item and a set item match
+indicating that the item is a member of the set, and (2) the item is greater than a set item
+indicating non-membership since the set items are linearly ordered.  If the end of the loop
+is reached and we have not exited with a match then by implication the item is not
+present.
+*)
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+                             theSet  : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      compareItem := CompareOf(dataID);
+      FOR index := MIN(SizeRange) TO length DO
+        IF (theItem = items[index]) THEN
+          RETURN TRUE;
+        ELSE
+          order := compareItem(items[index], theItem);
+          IF (order = greater) THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+
+(*
+IsSubset after ensuring that the required preconditions are met, proceeds to loop through
+the items of the left and right sets attempting to determine if every member of the left set
+is also a member of the right set.  Because the items of the array are linearly ordered in
+ascending sequence inequality can be determined quicker than with a completely unordered
+set implementation.  When an item of the left set is less than its counterpart in the right
+set we can immediately return false knowing that that item is not present in the right set.
+If the left item is greater then we know that we must advance the index into the right set
+since the item may yet be found further into the array.  When the items are equal both
+indexes are advanced.  When the end of the loop has been reached without premature exit,
+the left set can only be a subset of the right if we have examined beyond the end of the
+left set.
+*)
+
+PROCEDURE IsSubset      (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(issubset, undefined);
+    RETURN FALSE;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(issubset, typeerror);
+    RETURN FALSE;
+  END (*--if*);
+
+  compareItem:= CompareOf(left^.dataID);
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    IF (order = equal) THEN
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      RETURN FALSE;
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+  RETURN (leftIndex > left^.length);
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset(    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & (left^.length < right^.length);
+END IsProperSubset;
+(*----------------------------*)
+
+
+
+(*
+12.3.6		Iterators
+
+Both iterators are simply loops over each of the items in the given set.  LoopOver may
+be terminated before reaching the last item in the set if the access procedure returns false.
+*)
+
+PROCEDURE LoopOver   (    theSet  : Set            (*-- in    *);
+                          process : LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- Loop index over items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      FOR index := MIN(SizeRange) TO length DO
+        IF ~process(items[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE Traverse   (    theSet  : Set            (*-- in    *);
+                          process : AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- Loop index over items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      FOR index := MIN(SizeRange) TO length DO
+        process(items[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+
+
+(*
+12.2.7	Module Initialization
+
+In the module initialization the local exception handlers array variables are set to default
+handlers (ExitOnError) except for the noerr handler which is given the null handler. 
+setError is given the value noerr avoiding an undefined state.
+*)
+
+BEGIN
+  FOR setError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[setError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  setError := noerr;
+END SetSBMI.
+
+
+
+(*
+References
+
+[1]	A. Aho, J. Hopcroft and J. Ullman, Data Structures and Algorithms, Addison-Wesley,
+	Reading, MA 1983.
+[2]	A.M. Tenenbaum and M.J. Augenstein, Data Structures Using Pascal, Prentice-Hall,
+	Englewood Cliffs, NJ 1981.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBMN.DEF
@@ -0,0 +1,239 @@
+(*
+12	The Bounded Set (continued)
+
+
+The particular implementation described here has the properties: Sequential, Bounded,
+Managed, and Non-Iterator, describing specific aspects of the implementation as follows:
+
+Sequential:	Can only be used in a non-tasking environment, or by only one task.
+Bounded:	The maximum size of a set is given when the set is created.
+Managed:	Memory space for items and objects is returned to the system when no
+		longer needed.
+Non-Iterator:	Routines for looping over each of a set's items are not provided.
+
+The bounded non-iterator set interface follows below in Section 12.4 while the actual
+implementation appears in Section 12.5.
+
+
+12.4	SetSBMN Interface
+*)
+
+
+DEFINITION MODULE SetSBMN;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Component: Monolithic Structures - Set
+               Sequential Bounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module provides the interface to the bounded
+    implementation Set abstraction for generic Items.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  Set;
+TYPE  SizeRange = [ 1 .. 8000 ];
+CONST NullSet   = Set(NIL);
+
+
+
+(*
+12.4.1			Exceptions
+
+The ModuleID is used by the exception handling mechanism to distinguish this module
+from other modules.
+
+SetError returns the exception code from the most recent set operation.  A result of noerr 
+indicates successful completion of the operation.
+
+GetHandler returns the exception handler routine associated with the given exception. 
+Though the routine is a function procedure returning a procedure as its result, the
+HandlerProc may not be called from within the GetHandler call itself.  The procedure
+result must be first assigned to a procedure variable before invocation.  Exception handlers
+are given an initial value of ExitOnError except for the handler for noerr which is
+initialized to the null exception handler.
+
+SetHandler associates an exception handler routine with the given exception and is the
+inverse of GetHandler.  This routine may be used to override the default settings for the
+exception handlers.
+*)
+
+CONST ModuleID = 4;
+
+PROCEDURE SetError    ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    theError   : Exceptions  (*-- in    *))
+                                      : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    theError   : Exceptions  (*-- in    *);
+                           theHandler : HandlerProc (*-- in    *));
+
+
+(*
+12.4.2			Constructors
+
+The Create operation attempts to generate a new, empty set of the given maximum size
+(theSize) and Item operations associated with the given data type identifier (theType).
+
+For the bounded form of set, it is necessary to define the maximum number of items
+desired.  This is done with theSize parameter.
+
+The TypeID is the method by which Items of any data type are supported.  Using the
+TypeID, the component can assign one item to another and release any dynamically
+allocated resources associated with an Item without knowledge of the Item's internal
+composition.  In this way, one may create a set whose items consist of other
+(dynamically allocated) structures, as well as sets consisting of the basic data types.
+
+Create will return the new set upon successful completion of the routine.  If it not
+possible for the set to be created, the constant NullSet  will be returned instead.
+
+Destroy takes the given set, clears it of any items, and then destroys the set itself. 
+Where Create makes a defined set, Destroy is its inverse, making the set undefined.
+
+Clear takes the given set and removes all of its items.  theType attribute of the set 
+(assigned when the set was created) is used to retrieve the item deallocation routine for the
+items of the set.  Clearing the set returns it to the empty state.
+
+The Assign operation attempts to generate a duplicate of the source set (theSet) in the
+target set (toSet).  The target set is automatically created using the size and data type
+attributes of the source set, if necessary.  If this step is unnecessary, (the target set has
+already been previously created), the target is cleared of its present contents, its data type
+is set to that of the source set but the size is left unchanged.
+
+There is no guarantee that the client module would desire the target set to be defined with
+the same size as the source.  The minimum requirement for the target set size is that it
+must be capable of storing all of the items present in the source set.  It may be desirable
+that the target set size be greater than the source set size.  Such a situation could occur
+during error recovery of a bounded set overflow caused by the set's cardinality
+encountering the set size, and the client module may effectively attempt to increase the
+the set size using the assignment mechanism.
+
+In order to allow Items of any data type, a method must be provided to assign the contents
+of one item to another item.  This is accomplished, as above for Create, through the
+TypeID of the source set.
+
+The Include operation adds items to the given set.  If the cardinality of the set is already
+at its maximum size the overflow exception will be raised and the set remains unchanged.
+
+The Exclude operation removes the specified item from the given set.  If the given set is 
+empty on entry to Exclude, or the given item is not a member of the set  the notinset 
+exception may be raised and the set remains unchanged.
+
+Union, Intersection, Difference, and SymDifference  (symmetric difference) operations all
+implement the standard set operations of the same name.
+*)
+
+PROCEDURE Create        (    theSize  : SizeRange (*-- in    *);
+                             theType  : TypeID    (*-- in    *))
+                                      : Set       (*-- out   *);
+
+PROCEDURE Destroy       (VAR theSet   : Set       (*-- inout *));
+
+PROCEDURE Clear         (VAR theSet   : Set       (*-- inout *));
+
+PROCEDURE Assign        (    theSet   : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+PROCEDURE Include       (    theItem  : Item      (*-- in    *);
+                         VAR inSet    : Set       (*-- inout *));
+
+PROCEDURE Exclude       (    theItem  : Item      (*-- in    *);
+                         VAR fromSet  : Set       (*-- inout *));
+
+PROCEDURE Union         (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+PROCEDURE Intersection  (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+PROCEDURE Difference    (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+PROCEDURE SymDifference (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+
+(*
+12.4.3			Selectors
+
+IsDefined attempts to determine whether the given set is valid, e.g., has been created and
+not yet destroyed.  How this is accomplished may be as simple or complicated as the
+implementer desires and the requirements of the application.
+
+IsEmpty returns true if the given set contains no items; in other words, its cardinality is
+zero.  Undefined sets are always considered to be empty.
+
+IsEqual returns true if the left and right sets contain the same items.  Obviously, both
+must also have the same data type and have been created.  An undefined set is not equal to
+any other set, including itself.
+
+The routines SizeOf and TypeOf return the values given the set when it was created, and
+both are provided so the user of the module need not maintain separate variables recording
+this information.
+
+NumMembers returns the number of items present on the given set.  Undefined sets are
+considered to have a cardinality of zero.
+
+IsAMember returns true if the given item is present in the given set, and false otherwise.
+
+IsSubset and IsProperSubset both implement standard logical set operations as defined in
+the Set Abstraction (chapter 11).
+*)
+
+PROCEDURE IsDefined     (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty       (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE SizeOf        (    theSet  : Set      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf        (    theSet  : Set      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+
+PROCEDURE NumMembers    (    theSet  : Set      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+                             theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+END SetSBMN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBMN.MOD
@@ -0,0 +1,997 @@
+(*
+12.5	SetSBMN Implementation
+*)
+
+
+IMPLEMENTATION MODULE SetSBMN;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Set
+               Sequential Bounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module provides the implementation of the bounded
+    Set abstraction for generic Items using an ordered array.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+        Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, CompareOf, DisposeOf;
+
+    (*--------------------*)
+
+
+(*
+12.5.1		Internal Bounded Set Representation
+
+╟Illustration Here╚
+
+Figure 12.1
+
+Like the internal representations for the bounded stack and string, a bounded set is
+represented as a pointer to a record containing an array of items of a variable size.  In
+addition, the data type ID, physical array size (maximum number of items), and the
+current length (number of items currently present in the array).  The representation
+invariants that must be enforced by the module are:
+
+1.	MIN(SizeRange) <= size <= MAX(SizeRange)
+2.	MIN(SizeRange) <= length <= size
+3.	items[x] < items[x+1], for all x such that x < length
+
+The third invariant states that elements of the items array must be linearly ordered in
+ascending sequence.
+*)
+
+TYPE  ItemsArray = ARRAY SizeRange OF Item;
+TYPE  BoundedSet = RECORD
+        dataID : TypeID;     (*-- defined data type *)
+        size   : SizeRange;  (*-- defined Set size *)
+        length : CARDINAL;   (*-- current Set length, := 0 *)
+        items  : ItemsArray; (*-- ordered array [1..size] of Item *)
+      END (*-- BoundedSet *);
+
+TYPE  Set = POINTER TO BoundedSet;
+
+
+(*
+12.5.2	Exceptions
+
+To support the exception handling mechanism two variables are needed.  The first,
+setError, is used to record the exception result from each operation; while handlers  is an
+array of exception handling procedures indexed by the exception result.
+
+The routines SetError, GetHandler, and SetHandler have been previously described in the
+definition module, and their operation should be readily apparent.  RaiseErrIn  is a local
+routine used to set the setError variable and invoke the Raise  routine of the
+ErrorHandling module.
+*)
+
+VAR   setError  : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+PROCEDURE SetError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN setError;
+END SetError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  setError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+
+(*
+12.5.3	Local Routines
+
+
+12.5.3.1	CopySubset
+
+Several of the set algorithms require the ability to copy the all remaining items from a
+given set to a partially created target set.  CopySubset  performs this operation by
+looping through the fromSet starting from the given index to the end of the fromSet,
+copying each item to the target set along the way.  If during the copying process the
+target set size is insufficient for all of the items from the source set, the overflow
+exception is raised and the operation is aborted.  (A more efficient implementation for
+checking overflow would be to calculate the number of items to copy from the source
+(length - fromIndex + 1) and compare this to the number of available positions remaining
+in the target (size - length) and if the result is greater then invoke overflow).
+
+
+12.5.3.2	Recreate
+
+All routines that accept a target set as an inout parameter need to either (1) clear the
+existing set of its contents if the set already exists, or (2) create a new, empty set to be
+target of the operation.  The Recreate  routine provides such a capability, returning true if
+successful.  It should be noted that failure only occurs as a result when the set must be
+created.
+*)
+
+PROCEDURE CopySubset (    routine : Operations (*-- in    *);
+                          fromSet : Set        (*-- in    *);
+                          index   : SizeRange  (*-- in    *);
+                      VAR toSet   : Set        (*-- inout *));
+
+VAR   assignItem : AssignProc; (*-- Item assignment routine, if any *)
+
+BEGIN
+  assignItem := AssignOf(fromSet^.dataID);
+  WITH toSet^ DO
+    WHILE (index <= fromSet^.length) DO
+      IF (length < size) THEN
+        INC(length);
+        items[length] := assignItem(fromSet^.items[index]);
+        INC(index);
+      ELSE
+        RaiseErrIn(routine, overflow);
+        RETURN;
+      END (*--if*);
+    END (*--while*);
+  END (*--with*);
+END CopySubset;
+(*--------------------*)
+
+PROCEDURE Recreate (    theType : TypeID    (*-- in    *);
+                        theSize : SizeRange (*-- in    *);
+                    VAR theSet  : Set       (*-- inout *))
+                                : BOOLEAN   (*-- out   *);
+BEGIN
+  IF (theSet # NIL) THEN
+    Clear(theSet);
+    theSet^.dataID := theType;
+  ELSE
+    theSet := Create(theSize, theType);
+  END (*--if*);
+  RETURN (setError = noerr);
+END Recreate;
+(*--------------------*)
+
+
+(*
+12.5.4	Constructors
+
+Create begins by clearing the setError field under the assumption of a successful result.
+
+The header for the set must then be allocated in a local variable since the function result
+cannot be manipulated but only returned.  The key to this allocation step is the
+calculation of the number of bytes necessary based on the size of an individual item and
+the number of items requested.  We must not forget the space for storing theSize, the
+Type, and the set length.  The constant staticSize  accomplishes this regardless of the
+number and size of these ╥static╙ fields.  The calculation is unaffected by changes in the
+number or size of these fields that may come about due to future maintenance.  If the
+bounded set could not be allocated, the overflow exception must be raised, and the NullSet
+returned.
+
+At this point, all possibility of failure has been avoided and the bounded set header can be
+initialized to its empty state, and the size limit and data type ID  can be stored for this
+bounded set.  Lastly, the new set can be returned to the caller.
+*)
+
+PROCEDURE Create        (    theSize  : SizeRange (*-- in    *);
+                             theType  : TypeID    (*-- in    *))
+                                      : Set       (*-- out   *);
+
+CONST staticSize = SIZE(BoundedSet) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newSet : Set;
+
+BEGIN
+  setError := noerr;
+  Allocate(newSet, staticSize + itemSize * theSize);
+  IF (newSet # NIL) THEN
+    WITH newSet^ DO
+      size   := theSize;
+      dataID := theType;
+      length := 0;
+    END (*--with*);
+    RETURN newSet;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullSet;
+END Create;
+(*--------------------*)
+
+
+(*
+Destroy takes advantage that Clear sets setError to noerr and raises the undefined set
+exception.  So if Clear succeeds, Destroy simply releases the allocated set header.
+*)
+
+PROCEDURE Destroy       (VAR theSet   : Set       (*-- inout *));
+
+CONST staticSize = SIZE(BoundedSet) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theSet);
+  IF (setError = noerr) THEN
+    Deallocate(theSet, staticSize + itemSize * theSet^.size);
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+
+(*
+Clear sets setError to noerr and checks for an undefined set raising the undefined set
+exception if necessary.  After asserting a valid set, the item disposal routine is retrieved
+for the set, followed by the deallocation of every item in the set.  Once this has been
+taken care of, the set length is adjusted to the empty state.
+*)
+
+PROCEDURE Clear         (VAR theSet   : Set       (*-- inout *));
+
+VAR   freeItem : DisposeProc; (*-- Item disposal routine, if any *)
+      index    : CARDINAL;    (*-- Loop index over items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      freeItem := DisposeOf(dataID);
+      FOR index := MIN(SizeRange) TO length DO
+        freeItem(items[index]);
+      END (*--for*);
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+
+(*
+Assignment for bounded objects is simpler to implement than their unbounded
+counterparts since the opportunity for overflow is restricted to when the target object is
+being (re-)created.
+
+If the target object exists and is capable of holding all of the source object's items the
+target can be safely cleared and its data type updated appropriately.  Otherwise, the
+overflow exception is raised and the assignment operation aborted.  When the target object
+is initially undefined it must be created using the data type and size attributes of the
+source object.  If overflow does not occur, the actual assignment can commence,
+otherwise its suffices to exit as Create has already raised the exception.
+
+The assignment operator cannot be used to copy the whole items array as only a slice of
+the array's index range was actually allocated and who knows what other dynamically
+allocated objects follow it in memory.  Nor can assignment be used to copy individual
+items as the data type of those items is unknown; using assignment for dynamically
+allocated items would cause structural sharing of items, which is not desired.
+*)
+
+PROCEDURE Assign        (    theSet   : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+VAR   assignItem : AssignProc; (*-- Item assignment routine, if any *)
+      index      : CARDINAL;   (*-- Loop index over items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      IF Recreate(dataID, size, toSet) THEN
+        IF (length <= toSet^.size) THEN
+          assignItem := AssignOf(dataID);
+          FOR index := MIN(SizeRange) TO length DO
+            toSet^.items[index] := assignItem(items[index]);
+          END (*--for*);
+          toSet^.length := length;
+        ELSE
+          RaiseErrIn(assign, overflow);
+        END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+
+(*
+Include must add the given item to the set if it is not already a member or to simply exit
+if the item is already a member (these semantics are compatible with Modula-2's INCL
+operation).  We could use the IsAMember selector except the index where the item is not
+found is necessary to insert the item in its appropriate position within the ordered array. 
+Once we have this position, we make room for the new item by shifting all items above
+the index position up by one index position in the array.  Of course, there must be room
+for the new item in the set.  Then the new item is inserted into its proper place.
+*)
+
+PROCEDURE Include       (    theItem  : Item      (*-- in    *);
+                         VAR inSet    : Set       (*-- inout *));
+
+VAR   index       : CARDINAL;    (*-- Loop index in search for theItem *)
+      jndex       : CARDINAL;    (*-- Loop index in shifting items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (inSet # NIL) THEN
+    WITH inSet^ DO
+      compareItem := CompareOf(dataID);
+      index := MIN(SizeRange);
+      LOOP
+        IF (index > length) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+        itemOrder := compareItem(items[index], theItem);
+        IF (itemOrder = equal) THEN
+          RETURN;
+        ELSIF (itemOrder = greater) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+        INC(index);
+      END (*--loop*);
+
+      IF (length < size) THEN
+
+        FOR jndex := length TO index BY -1 DO
+          items[jndex + 1] := items[jndex];
+        END (*--for*);
+
+        INC(length);
+        items[index] := theItem;
+
+      ELSE
+        RaiseErrIn(include, overflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*--------------------*)
+
+
+(*
+Exclude undoes what Include did to add an item to the set; if the item is found then all
+items above it in the array are shifted downward one position and the set length is updated
+to reflect removal of the item.  If the item is not found the routine simply exits to be
+compatible with Modula-2's EXCL operation.
+*)
+
+PROCEDURE Exclude       (    theItem  : Item      (*-- in    *);
+                         VAR fromSet  : Set       (*-- inout *));
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (fromSet # NIL) THEN
+    WITH fromSet^ DO
+      compareItem := CompareOf(dataID);
+      index := MIN(SizeRange);
+      LOOP
+        IF (index > length) THEN
+          RETURN;
+        END (*--if*);
+
+        itemOrder := compareItem(items[index], theItem);
+        IF (itemOrder = equal) THEN
+          EXIT (*--loop*);
+        ELSIF (itemOrder = greater) THEN
+          RETURN;
+        END (*--if*);
+
+        INC(index);
+      END (*--loop*);
+
+      WHILE (index < length) DO
+        INC(index);
+        items[index - 1] := items[index];
+      END (*--while*);
+      DEC(length);
+
+    END (*--with*);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*--------------------*)
+
+
+(*
+Union computes the set containing all members of left and right, e.g.,
+
+x IN toSet iff (x IN left) OR (x IN right).
+
+The algorithm used is a variation on the array merge from Augenstein and Tanenbaum [2,
+pg. 414] and the set intersection algorithm presented in Aho, Hopcroft, and Ullman [1,
+pg. 117].
+
+The algorithm loops over the items of the left and right sets until the end of either is
+reached.  On each iteration, the items are compared for the ordering relation between them. 
+This is used to determine from which set an item is copied to the target set, and which
+indexes to advance.  In this manner, all items are processed only once and duplicate items
+in the target set are avoided. The toSet length is used as the running index for adding the
+resulting items of the union.
+
+The last step is to copy the remaining items, if any, from either the left set or the right
+set to the destination set.
+*)
+
+PROCEDURE Union         (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+      assignItem  : AssignProc;  (*-- Item assignment routine *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(union, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(union, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, left^.size, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    WITH toSet^ DO
+      IF (length < size) THEN
+        INC(length);
+      ELSE
+        RaiseErrIn(union, overflow);
+        RETURN;
+      END (*--if*);
+      IF (order = less) THEN
+        items[length] := assignItem(left^.items[leftIndex]);
+        INC(leftIndex);
+      ELSIF (order = equal) THEN
+        items[length] := assignItem(left^.items[leftIndex]);
+        INC(leftIndex);
+        INC(rightIndex);
+      ELSE
+        items[length] := assignItem(right^.items[rightIndex]);
+        INC(rightIndex);
+      END (*--if*);
+    END (*--with*);
+  END (*--while*);
+
+  IF (leftIndex > left^.length) THEN
+    CopySubset(union, right, rightIndex, toSet);
+  ELSIF (rightIndex > right^.length) THEN
+    CopySubset(union, left, leftIndex, toSet);
+  END (*--if*);
+END Union;
+(*--------------------*)
+
+
+(*
+Intersection computes the set containing all members in both left and right sets, e.g.,
+
+x IN toSet iff (x IN left) AND (x IN right).
+
+The algorithm, similar to the set intersection algorithm given in Aho, Hopcroft, and
+Ullman [1, pg. 117] for ordered lists, loops over the items of the left and right sets until
+the end of either is reached.  On each iteration, the items are compared for the ordering
+relation between them.  Equal items are copied to the target set and both indexes are
+advanced, otherwise the index to the smaller item is advanced.  In this manner, all items
+are processed only once and duplicate items in the target set are avoided.  The toSet length
+is used as the running index for adding the resulting items of the intersection.
+*)
+
+PROCEDURE Intersection  (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+      assignItem  : AssignProc;  (*-- Item assignment routine *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(intersection, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(intersection, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, left^.size, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    IF (order = equal) THEN
+      WITH toSet^ DO
+        IF (length < size) THEN
+          INC(length);
+          items[length] := assignItem(left^.items[leftIndex]);
+        ELSE
+          RaiseErrIn(intersection, overflow);
+          RETURN;
+        END (*--if*);
+      END (*--with*);
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      INC(leftIndex);
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+END Intersection;
+(*--------------------*)
+
+
+(*
+Difference computes the set containing all members of the left set that are not members
+of the right set, e.g.,
+
+x IN toSet iff (x IN left) & ┬(x IN right)
+
+The algorithm, similar to the above algorithm for intersection, loops over the items of
+the left and right sets until the end of either is reached.  On each iteration, the items are
+compared for the ordering relation between them.  Equal items are skipped and both
+indexes advanced, otherwise the index to the smaller item is advanced.  When the item
+from the left set is less than that of the right set we know that it is not present in the
+right set and can copy that item over to the target set.  The toSet length is used as the
+running index for adding the resulting items of the difference.  The last step is to copy the
+remaining items, if any, from the left set to the destination set.
+*)
+
+PROCEDURE Difference    (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+      assignItem  : AssignProc;  (*-- Item assignment routine *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(difference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(difference, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, left^.size, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    IF (order = equal) THEN
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      WITH toSet^ DO
+        IF (length < size) THEN
+          INC(length);
+          items[length] := assignItem(left^.items[leftIndex]);
+        ELSE
+          RaiseErrIn(difference, overflow);
+          RETURN;
+        END (*--if*);
+      END (*--with*);
+      INC(leftIndex);
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+
+  CopySubset(difference, left, leftIndex, toSet);
+END Difference;
+(*--------------------*)
+
+
+(*
+SymDifference computes the set containing all members of the left or right set that are
+not members of both sets, e.g.,
+
+x IN toSet iff (x IN left) ¡ (x IN right)
+
+The algorithm, similar to that given above for union and difference, loops over the items
+of the left and right sets until the end of either is reached.  On each iteration, the items are
+compared for the ordering relation between them.  Equal items are skipped and both
+indexes advanced, otherwise the index to the smaller item is advanced.  When the items
+between the two sets are unequal we can then copy the smaller of the two items over to
+the target set.  The toSet length is used as the running index for adding the resulting
+items of the symmetric difference.  The last step is to copy the remaining items, if any,
+from either the left or right set, whichever has items remaining, to the target set.
+*)
+
+PROCEDURE SymDifference (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+      assignItem  : AssignProc;  (*-- Item assignment routine *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(symdifference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(symdifference, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, left^.size, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    IF (order = equal) THEN
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSE
+      WITH toSet^ DO
+        IF (length < size) THEN
+          INC(length);
+        ELSE
+          RaiseErrIn(symdifference, overflow);
+          RETURN;
+        END (*--if*);
+        IF (order = less) THEN
+          items[length] := assignItem(left^.items[leftIndex]);
+          INC(leftIndex);
+        ELSE
+          items[length] := assignItem(right^.items[rightIndex]);
+          INC(rightIndex);
+        END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--while*);
+
+  IF (leftIndex > left^.length) THEN
+    CopySubset(symdifference, right, rightIndex, toSet);
+  ELSIF (rightIndex > right^.length) THEN
+    CopySubset(symdifference, left, leftIndex, toSet);
+  END (*--if*);
+END SymDifference;
+(*--------------------*)
+
+
+
+(*
+12.5.5		Selectors
+
+IsDefined returns true if the given set is non-NIL, which is the simplest test for a defined
+set object.
+*)
+
+PROCEDURE IsDefined     (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (theSet # NIL);
+END IsDefined;
+(*--------------------*)
+
+
+(*
+IsEmpty (as always) returns the logical condition as to the state of the set's length,
+which if zero indicates an empty set.
+*)
+
+PROCEDURE IsEmpty       (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN (theSet^.length = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*--------------------*)
+
+
+(*
+Sizeof simply returns the defined size for the given set or a default value for an undefined
+set.  TypeOf is similar except that it deals with the set's data type ID.
+*)
+
+PROCEDURE SizeOf        (    theSet  : Set      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*--------------------*)
+
+PROCEDURE TypeOf        (    theSet  : Set      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*--------------------*)
+
+
+(*
+IsEqual must return true if the two given sets each contain the same items.  After
+enforcing the required preconditions, the lengths of the sets are compared in a simple test
+for inequality.  If the lengths are equal it is possible for the sets to be equal so we loop
+over each item of both sets returning false upon encountering the first inequality between
+two items.  True is returned if the loop completes without finding any mismatched items.
+*)
+
+PROCEDURE IsEqual       (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   index   : CARDINAL;		(*-- Loop index over items *)
+      compare : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.length = right^.length) THEN
+	compare := CompareOf(left^.dataID);
+        FOR index := MIN(SizeRange) TO left^.length DO
+          IF compare(left^.items[index], right^.items[index]) # equal THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--for*);
+        RETURN TRUE;
+      END (*--if*);
+    ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+
+(*
+NumMembers needs to simply return the current set length or for an undefined set return
+zero as it is impossible to have any members in such a set.
+*)
+
+PROCEDURE NumMembers    (    theSet  : Set         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.length;
+  END (*--if*);
+  RaiseErrIn(nummembers, undefined);
+  RETURN 0;
+END NumMembers;
+(*----------------------------*)
+
+
+(*
+IsAMember seeks to determine whether the given item is a member of the given set by
+scanning each of the items in the set in turn.  There are two conditions that could cause
+the loop to terminate prior to reaching the last item: (1) the item and a set item match
+indicating that the item is a member of the set, and (2) the item is greater than a set item
+indicating non-membership since the set items are linearly ordered.  If the end of the loop
+is reached and we have not exited with a match then by implication the item is not
+present.
+*)
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+                             theSet  : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      compareItem := CompareOf(dataID);
+      FOR index := MIN(SizeRange) TO length DO
+        IF (theItem = items[index]) THEN
+          RETURN TRUE;
+        ELSE
+          order := compareItem(items[index], theItem);
+          IF (order = greater) THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+
+(*
+IsSubset after ensuring that the required preconditions are met, proceeds to loop through
+the items of the left and right sets attempting to determine if every member of the left set
+is also a member of the right set.  Because the items of the array are linearly ordered in
+ascending sequence inequality can be determined quicker than with a completely unordered
+set implementation.  When an item of the left set is less than its counterpart in the right
+set we can immediately return false knowing that that item is not present in the right set. 
+If the left item is greater then we know that we must advance the index into the right set
+since the item may yet be found further into the array.  When the items are equal both
+indexes are advanced.  When the end of the loop has been reached without premature exit,
+the left set can only be a subset of the right if we have examined beyond the end of the
+left set.
+*)
+
+PROCEDURE IsSubset      (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(issubset, undefined);
+    RETURN FALSE;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(issubset, typeerror);
+    RETURN FALSE;
+  END (*--if*);
+
+  compareItem:= CompareOf(left^.dataID);
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    IF (order = equal) THEN
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      RETURN FALSE;
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+  RETURN (leftIndex > left^.length);
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset(    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & (left^.length < right^.length);
+END IsProperSubset;
+(*----------------------------*)
+
+
+(*
+12.5.6		Module Initialization
+
+In the module initialization the local exception handlers array variables are set to default
+handlers (ExitOnError) except for the noerr handler which is given the null handler. 
+setError is given the value noerr avoiding an undefined state.
+*)
+
+BEGIN
+  FOR setError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[setError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  setError := noerr;
+END SetSBMN.
+
+
+
+(*
+References
+
+[1]	A. Aho, J. Hopcroft and J. Ullman, Data Structures and Algorithms, Addison-Wesley,
+	Reading, MA 1983.
+[2]	A.M. Tenenbaum and M.J. Augenstein, Data Structures Using Pascal, Prentice-Hall,
+	Englewood Cliffs, NJ 1981.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBUI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBUI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBUI.DEF
@@ -0,0 +1,123 @@
+DEFINITION MODULE SetSBUI;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Set
+               Sequential Bounded Unmanaged Iterator
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+      Initial implementation. Derived from SetSBMI module.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  Set;
+TYPE  SizeRange = [ 1 .. 8000 ];
+CONST NullSet   = Set(NIL);
+
+
+    (*-----------------------*)
+
+CONST ModuleID = 5;
+
+PROCEDURE SetError    ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    theError   : Exceptions  (*-- in    *))
+                                      : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    theError   : Exceptions  (*-- in    *);
+                           theHandler : HandlerProc (*-- in    *));
+
+    (*-----------------------*)
+
+PROCEDURE Create        (    theSize  : SizeRange (*-- in    *);
+                             theType  : TypeID    (*-- in    *))
+                                      : Set       (*-- out   *);
+
+PROCEDURE Destroy       (VAR theSet   : Set       (*-- inout *));
+
+PROCEDURE Clear         (VAR theSet   : Set       (*-- inout *));
+
+PROCEDURE Assign        (    theSet   : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+PROCEDURE Include       (    theItem  : Item      (*-- in    *);
+                         VAR inSet    : Set       (*-- inout *));
+
+PROCEDURE Exclude       (    theItem  : Item      (*-- in    *);
+                         VAR fromSet  : Set       (*-- inout *));
+
+PROCEDURE Union         (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+PROCEDURE Intersection  (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+PROCEDURE Difference    (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+PROCEDURE SymDifference (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+    (*-----------------------*)
+
+PROCEDURE IsDefined     (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty       (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE SizeOf        (    theSet  : Set      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf        (    theSet  : Set      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+
+PROCEDURE NumMembers    (    theSet  : Set      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+                             theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+    (*-----------------------*)
+
+PROCEDURE LoopOver (    theSet  : Set            (*-- in    *);
+                        process : LoopAccessProc (*-- in    *));
+
+PROCEDURE Traverse (    theSet  : Set            (*-- in    *);
+                        process : AccessProc     (*-- in    *));
+
+END SetSBUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBUI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBUI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBUI.MOD
@@ -0,0 +1,723 @@
+IMPLEMENTATION MODULE SetSBUI;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Set
+               Sequential Bounded Unmanaged Iterator
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+        Initial implementation. Derived from SetSBMI module.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc, AccessProc, LoopAccessProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) CompareOf;
+
+    (*--------------------*)
+
+
+TYPE  ItemsArray = ARRAY SizeRange OF Item;
+TYPE  BoundedSet = RECORD
+        dataID : TypeID;     (*-- defined data type *)
+        size   : SizeRange;  (*-- defined Set size *)
+        length : CARDINAL;   (*-- current Set length, := 0 *)
+        items  : ItemsArray; (*-- ordered array [1..size] of Item *)
+      END (*-- BoundedSet *);
+
+TYPE  Set = POINTER TO BoundedSet;
+
+    (*--------------------*)
+
+VAR   setError  : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+PROCEDURE SetError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN setError;
+END SetError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  setError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+PROCEDURE CopySubset (    routine : Operations (*-- in    *);
+                          fromSet : Set        (*-- in    *);
+                          index   : SizeRange  (*-- in    *);
+                      VAR toSet   : Set        (*-- inout *));
+BEGIN
+  WITH toSet^ DO
+    WHILE (index <= fromSet^.length) DO
+      IF (length < size) THEN
+        INC(length);
+        items[length] := fromSet^.items[index];
+        INC(index);
+      ELSE
+        RaiseErrIn(routine, overflow);
+        RETURN;
+      END (*--if*);
+    END (*--while*);
+  END (*--with*);
+END CopySubset;
+(*--------------------*)
+
+PROCEDURE Recreate (    theType : TypeID    (*-- in    *);
+                        theSize : SizeRange (*-- in    *);
+                    VAR theSet  : Set       (*-- inout *))
+                                : BOOLEAN   (*-- out   *);
+BEGIN
+  IF (theSet # NIL) THEN
+    Clear(theSet);
+    theSet^.dataID := theType;
+  ELSE
+    theSet := Create(theSize, theType);
+  END (*--if*);
+  RETURN (setError = noerr);
+END Recreate;
+(*--------------------*)
+
+
+PROCEDURE Create        (    theSize  : SizeRange (*-- in    *);
+                             theType  : TypeID    (*-- in    *))
+                                      : Set       (*-- out   *);
+
+CONST staticSize = SIZE(BoundedSet) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newSet : Set;
+
+BEGIN
+  setError := noerr;
+  Allocate(newSet, staticSize + itemSize * theSize);
+  IF (newSet # NIL) THEN
+    WITH newSet^ DO
+      size   := theSize;
+      dataID := theType;
+      length := 0;
+    END (*--with*);
+    RETURN newSet;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullSet;
+END Create;
+(*--------------------*)
+
+PROCEDURE Destroy       (VAR theSet   : Set       (*-- inout *));
+
+CONST staticSize = SIZE(BoundedSet) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theSet);
+  IF (setError = noerr) THEN
+    Deallocate(theSet, staticSize + itemSize * theSet^.size);
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+PROCEDURE Clear         (VAR theSet   : Set       (*-- inout *));
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+PROCEDURE Assign        (    theSet   : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+VAR   index : CARDINAL;   (*-- Loop index over items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      IF Recreate(dataID, size, toSet) THEN
+        IF (length <= toSet^.size) THEN
+          FOR index := MIN(SizeRange) TO length DO
+            toSet^.items[index] := items[index];
+          END (*--for*);
+          toSet^.length := length;
+        ELSE
+          RaiseErrIn(assign, overflow);
+        END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+PROCEDURE Include       (    theItem  : Item      (*-- in    *);
+                         VAR inSet    : Set       (*-- inout *));
+
+VAR   index       : CARDINAL;    (*-- Loop index in search for theItem *)
+      jndex       : CARDINAL;    (*-- Loop index in shifting items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (inSet # NIL) THEN
+    WITH inSet^ DO
+      compareItem := CompareOf(dataID);
+      index := MIN(SizeRange);
+      LOOP
+        IF (index > length) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+        itemOrder := compareItem(items[index], theItem);
+        IF (itemOrder = equal) THEN
+          RETURN;
+        ELSIF (itemOrder = greater) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+        INC(index);
+      END (*--loop*);
+
+      IF (length < size) THEN
+
+        FOR jndex := length TO index BY -1 DO
+          items[jndex + 1] := items[jndex];
+        END (*--for*);
+
+        INC(length);
+        items[index] := theItem;
+
+      ELSE
+        RaiseErrIn(include, overflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*--------------------*)
+
+PROCEDURE Exclude       (    theItem  : Item      (*-- in    *);
+                         VAR fromSet  : Set       (*-- inout *));
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (fromSet # NIL) THEN
+    WITH fromSet^ DO
+      compareItem := CompareOf(dataID);
+      index := MIN(SizeRange);
+      LOOP
+        IF (index > length) THEN
+          RETURN;
+        END (*--if*);
+
+        itemOrder := compareItem(items[index], theItem);
+        IF (itemOrder = equal) THEN
+          EXIT (*--loop*);
+        ELSIF (itemOrder = greater) THEN
+          RETURN;
+        END (*--if*);
+
+        INC(index);
+      END (*--loop*);
+
+      WHILE (index < length) DO
+        INC(index);
+        items[index - 1] := items[index];
+      END (*--while*);
+      DEC(length);
+
+    END (*--with*);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*--------------------*)
+
+PROCEDURE Union         (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(union, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(union, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, left^.size, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    WITH toSet^ DO
+      IF (length < size) THEN
+        INC(length);
+      ELSE
+        RaiseErrIn(union, overflow);
+        RETURN;
+      END (*--if*);
+      IF (order = less) THEN
+        items[length] := left^.items[leftIndex];
+        INC(leftIndex);
+      ELSIF (order = equal) THEN
+        items[length] := left^.items[leftIndex];
+        INC(leftIndex);
+        INC(rightIndex);
+      ELSE
+        items[length] := right^.items[rightIndex];
+        INC(rightIndex);
+      END (*--if*);
+    END (*--with*);
+  END (*--while*);
+
+  IF (leftIndex > left^.length) THEN
+    CopySubset(union, right, rightIndex, toSet);
+  ELSIF (rightIndex > right^.length) THEN
+    CopySubset(union, left, leftIndex, toSet);
+  END (*--if*);
+END Union;
+(*--------------------*)
+
+PROCEDURE Intersection  (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(intersection, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(intersection, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, left^.size, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    IF (order = equal) THEN
+      WITH toSet^ DO
+        IF (length < size) THEN
+          INC(length);
+          items[length] := left^.items[leftIndex];
+        ELSE
+          RaiseErrIn(intersection, overflow);
+          RETURN;
+        END (*--if*);
+      END (*--with*);
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      INC(leftIndex);
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+END Intersection;
+(*--------------------*)
+
+PROCEDURE Difference    (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(difference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(difference, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, left^.size, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    IF (order = equal) THEN
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      WITH toSet^ DO
+        IF (length < size) THEN
+          INC(length);
+          items[length] := left^.items[leftIndex];
+        ELSE
+          RaiseErrIn(difference, overflow);
+          RETURN;
+        END (*--if*);
+      END (*--with*);
+      INC(leftIndex);
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+
+  CopySubset(difference, left, leftIndex, toSet);
+END Difference;
+(*--------------------*)
+
+PROCEDURE SymDifference (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(symdifference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(symdifference, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, left^.size, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    IF (order = equal) THEN
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSE
+      WITH toSet^ DO
+        IF (length < size) THEN
+          INC(length);
+        ELSE
+          RaiseErrIn(symdifference, overflow);
+          RETURN;
+        END (*--if*);
+        IF (order = less) THEN
+          items[length] := left^.items[leftIndex];
+          INC(leftIndex);
+        ELSE
+          items[length] := right^.items[rightIndex];
+          INC(rightIndex);
+        END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--while*);
+
+  IF (leftIndex > left^.length) THEN
+    CopySubset(symdifference, right, rightIndex, toSet);
+  ELSIF (rightIndex > right^.length) THEN
+    CopySubset(symdifference, left, leftIndex, toSet);
+  END (*--if*);
+END SymDifference;
+(*--------------------*)
+
+
+PROCEDURE IsDefined     (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (theSet # NIL);
+END IsDefined;
+(*--------------------*)
+
+PROCEDURE IsEmpty       (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN (theSet^.length = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*--------------------*)
+
+PROCEDURE SizeOf        (    theSet  : Set      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*--------------------*)
+
+PROCEDURE TypeOf        (    theSet  : Set      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*--------------------*)
+
+PROCEDURE IsEqual       (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- Loop index over items *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.length = right^.length) THEN
+        FOR index := MIN(SizeRange) TO left^.length DO
+          IF (left^.items[index] # right^.items[index]) THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--for*);
+        RETURN TRUE;
+      END (*--if*);
+    ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE NumMembers    (    theSet  : Set         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.length;
+  END (*--if*);
+  RaiseErrIn(nummembers, undefined);
+  RETURN 0;
+END NumMembers;
+(*----------------------------*)
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+                             theSet  : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      compareItem := CompareOf(dataID);
+      FOR index := MIN(SizeRange) TO length DO
+        IF (theItem = items[index]) THEN
+          RETURN TRUE;
+        ELSE
+          order := compareItem(items[index], theItem);
+          IF (order = greater) THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+PROCEDURE IsSubset      (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(issubset, undefined);
+    RETURN FALSE;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(issubset, typeerror);
+    RETURN FALSE;
+  END (*--if*);
+
+  compareItem:= CompareOf(left^.dataID);
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <= left^.length) & (rightIndex <= right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    IF (order = equal) THEN
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      RETURN FALSE;
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+  RETURN (leftIndex > left^.length);
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset(    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & (left^.length < right^.length);
+END IsProperSubset;
+(*----------------------------*)
+
+
+PROCEDURE LoopOver   (    theSet  : Set            (*-- in    *);
+                          process : LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- Loop index over items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      FOR index := MIN(SizeRange) TO length DO
+        IF ~process(items[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE Traverse   (    theSet  : Set            (*-- in    *);
+                          process : AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- Loop index over items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      FOR index := MIN(SizeRange) TO length DO
+        process(items[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+
+BEGIN
+  FOR setError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[setError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  setError := noerr;
+END SetSBUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBUN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBUN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBUN.DEF
@@ -0,0 +1,114 @@
+DEFINITION MODULE SetSBUN;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Set
+               Sequential Bounded Unmanaged Non-Iterator
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+      Initial implementation. Derived from SetSBUI module.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  Set;
+TYPE  SizeRange = [ 1 .. 8000 ];
+CONST NullSet   = Set(NIL);
+
+
+    (*-----------------------*)
+
+CONST ModuleID = 6;
+
+PROCEDURE SetError    ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    theError   : Exceptions  (*-- in    *))
+                                      : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    theError   : Exceptions  (*-- in    *);
+                           theHandler : HandlerProc (*-- in    *));
+
+    (*-----------------------*)
+
+PROCEDURE Create        (    theSize  : SizeRange (*-- in    *);
+                             theType  : TypeID    (*-- in    *))
+                                      : Set       (*-- out   *);
+
+PROCEDURE Destroy       (VAR theSet   : Set       (*-- inout *));
+
+PROCEDURE Clear         (VAR theSet   : Set       (*-- inout *));
+
+PROCEDURE Assign        (    theSet   : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+PROCEDURE Include       (    theItem  : Item      (*-- in    *);
+                         VAR inSet    : Set       (*-- inout *));
+
+PROCEDURE Exclude       (    theItem  : Item      (*-- in    *);
+                         VAR fromSet  : Set       (*-- inout *));
+
+PROCEDURE Union         (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+PROCEDURE Intersection  (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+PROCEDURE Difference    (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+PROCEDURE SymDifference (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+    (*-----------------------*)
+
+PROCEDURE IsDefined     (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty       (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE SizeOf        (    theSet  : Set      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf        (    theSet  : Set      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+
+PROCEDURE NumMembers    (    theSet  : Set      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+                             theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+END SetSBUN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBUN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBUN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSBUN.MOD
@@ -0,0 +1,682 @@
+IMPLEMENTATION MODULE SetSBUN;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Set
+               Sequential Bounded Unmanaged Non-Iterator
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+        Initial implementation. Derived from SetSBUI module.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) CompareOf;
+
+    (*--------------------*)
+
+
+TYPE  ItemsArray = ARRAY SizeRange OF Item;
+TYPE  BoundedSet = RECORD
+        dataID : TypeID;     (*-- defined data type *)
+        size   : SizeRange;  (*-- defined Set size *)
+        length : CARDINAL;   (*-- current Set length, := 0 *)
+        items  : ItemsArray; (*-- ordered array [1..size] of Item *)
+      END (*-- BoundedSet *);
+
+TYPE  Set = POINTER TO BoundedSet;
+
+    (*--------------------*)
+
+VAR   setError  : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+PROCEDURE SetError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN setError;
+END SetError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  setError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+PROCEDURE CopySubset (    routine : Operations (*-- in    *);
+                          fromSet : Set        (*-- in    *);
+                          index   : SizeRange  (*-- in    *);
+                      VAR toSet   : Set        (*-- inout *));
+BEGIN
+  WITH toSet^ DO
+    WHILE (index <= fromSet^.length) DO
+      IF (length < size) THEN
+        INC(length);
+        items[length] := fromSet^.items[index];
+        INC(index);
+      ELSE
+        RaiseErrIn(routine, overflow);
+        RETURN;
+      END (*--if*);
+    END (*--while*);
+  END (*--with*);
+END CopySubset;
+(*--------------------*)
+
+PROCEDURE Recreate (    theType : TypeID    (*-- in    *);
+                        theSize : SizeRange (*-- in    *);
+                    VAR theSet  : Set       (*-- inout *))
+                                : BOOLEAN   (*-- out   *);
+BEGIN
+  IF (theSet # NIL) THEN
+    Clear(theSet);
+    theSet^.dataID := theType;
+  ELSE
+    theSet := Create(theSize, theType);
+  END (*--if*);
+  RETURN (setError = noerr);
+END Recreate;
+(*--------------------*)
+
+
+PROCEDURE Create        (    theSize  : SizeRange (*-- in    *);
+                             theType  : TypeID    (*-- in    *))
+                                      : Set       (*-- out   *);
+
+CONST staticSize = SIZE(BoundedSet) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newSet : Set;
+
+BEGIN
+  setError := noerr;
+  Allocate(newSet, staticSize + itemSize * theSize);
+  IF (newSet # NIL) THEN
+    WITH newSet^ DO
+      size   := theSize;
+      dataID := theType;
+      length := 0;
+    END (*--with*);
+    RETURN newSet;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullSet;
+END Create;
+(*--------------------*)
+
+PROCEDURE Destroy       (VAR theSet   : Set       (*-- inout *));
+
+CONST staticSize = SIZE(BoundedSet) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theSet);
+  IF (setError = noerr) THEN
+    Deallocate(theSet, staticSize + itemSize * theSet^.size);
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+PROCEDURE Clear         (VAR theSet   : Set       (*-- inout *));
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+PROCEDURE Assign        (    theSet   : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+VAR   index : CARDINAL;   (*-- Loop index over items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      IF Recreate(dataID, size, toSet) THEN
+        IF (length <= toSet^.size) THEN
+          FOR index := MIN(SizeRange) TO length DO
+            toSet^.items[index] := items[index];
+          END (*--for*);
+          toSet^.length := length;
+        ELSE
+          RaiseErrIn(assign, overflow);
+        END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+PROCEDURE Include       (    theItem  : Item      (*-- in    *);
+                         VAR inSet    : Set       (*-- inout *));
+
+VAR   index       : CARDINAL;    (*-- Loop index in search for theItem *)
+      jndex       : CARDINAL;    (*-- Loop index in shifting items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (inSet # NIL) THEN
+    WITH inSet^ DO
+      compareItem := CompareOf(dataID);
+      index := MIN(SizeRange);
+      LOOP
+        IF (index > length) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+        itemOrder := compareItem(items[index], theItem);
+        IF (itemOrder = equal) THEN
+          RETURN;
+        ELSIF (itemOrder = greater) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+        INC(index);
+      END (*--loop*);
+
+      IF (length < size) THEN
+
+        FOR jndex := length TO index BY -1 DO
+          items[jndex + 1] := items[jndex];
+        END (*--for*);
+
+        INC(length);
+        items[index] := theItem;
+
+      ELSE
+        RaiseErrIn(include, overflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*--------------------*)
+
+PROCEDURE Exclude       (    theItem  : Item      (*-- in    *);
+                         VAR fromSet  : Set       (*-- inout *));
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (fromSet # NIL) THEN
+    WITH fromSet^ DO
+      compareItem := CompareOf(dataID);
+      index := MIN(SizeRange);
+      LOOP
+        IF (index > length) THEN
+          RETURN;
+        END (*--if*);
+
+        itemOrder := compareItem(items[index], theItem);
+        IF (itemOrder = equal) THEN
+          EXIT (*--loop*);
+        ELSIF (itemOrder = greater) THEN
+          RETURN;
+        END (*--if*);
+
+        INC(index);
+      END (*--loop*);
+
+      WHILE (index < length) DO
+        INC(index);
+        items[index - 1] := items[index];
+      END (*--while*);
+      DEC(length);
+
+    END (*--with*);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*--------------------*)
+
+PROCEDURE Union         (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(union, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(union, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, left^.size, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <=left^.length) & (rightIndex <=right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    WITH toSet^ DO
+      IF (length < size) THEN
+        INC(length);
+      ELSE
+        RaiseErrIn(union, overflow);
+        RETURN;
+      END (*--if*);
+      IF (order = less) THEN
+        items[length] := left^.items[leftIndex];
+        INC(leftIndex);
+      ELSIF (order = equal) THEN
+        items[length] := left^.items[leftIndex];
+        INC(leftIndex);
+        INC(rightIndex);
+      ELSE
+        items[length] := right^.items[rightIndex];
+        INC(rightIndex);
+      END (*--if*);
+    END (*--with*);
+  END (*--while*);
+
+  IF (leftIndex > left^.length) THEN
+    CopySubset(union, right, rightIndex, toSet);
+  ELSIF (rightIndex > right^.length) THEN
+    CopySubset(union, left, leftIndex, toSet);
+  END (*--if*);
+END Union;
+(*--------------------*)
+
+PROCEDURE Intersection  (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(intersection, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(intersection, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, left^.size, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <= left^.length) & (rightIndex <=right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    IF (order = equal) THEN
+      WITH toSet^ DO
+        IF (length < size) THEN
+          INC(length);
+          items[length] := left^.items[leftIndex];
+        ELSE
+          RaiseErrIn(intersection, overflow);
+          RETURN;
+        END (*--if*);
+      END (*--with*);
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      INC(leftIndex);
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+END Intersection;
+(*--------------------*)
+
+PROCEDURE Difference    (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(difference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(difference, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, left^.size, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <=left^.length) & (rightIndex <=right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    IF (order = equal) THEN
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      WITH toSet^ DO
+        IF (length < size) THEN
+          INC(length);
+          items[length] := left^.items[leftIndex];
+        ELSE
+          RaiseErrIn(difference, overflow);
+          RETURN;
+        END (*--if*);
+      END (*--with*);
+      INC(leftIndex);
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+
+  CopySubset(difference, left, leftIndex, toSet);
+END Difference;
+(*--------------------*)
+
+PROCEDURE SymDifference (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(symdifference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(symdifference, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, left^.size, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+  END (*--with*);
+
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <=left^.length) & (rightIndex <=right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    IF (order = equal) THEN
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSE
+      WITH toSet^ DO
+        IF (length < size) THEN
+          INC(length);
+        ELSE
+          RaiseErrIn(symdifference, overflow);
+          RETURN;
+        END (*--if*);
+        IF (order = less) THEN
+          items[length] := left^.items[leftIndex];
+          INC(leftIndex);
+        ELSE
+          items[length] := right^.items[rightIndex];
+          INC(rightIndex);
+        END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--while*);
+
+  IF (leftIndex > left^.length) THEN
+    CopySubset(symdifference, right, rightIndex, toSet);
+  ELSIF (rightIndex > right^.length) THEN
+    CopySubset(symdifference, left, leftIndex, toSet);
+  END (*--if*);
+END SymDifference;
+(*--------------------*)
+
+
+PROCEDURE IsDefined     (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (theSet # NIL);
+END IsDefined;
+(*--------------------*)
+
+PROCEDURE IsEmpty       (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN (theSet^.length = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*--------------------*)
+
+PROCEDURE SizeOf        (    theSet  : Set      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*--------------------*)
+
+PROCEDURE TypeOf        (    theSet  : Set      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*--------------------*)
+
+PROCEDURE IsEqual       (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- Loop index over items *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.length = right^.length) THEN
+        FOR index := MIN(SizeRange) TO left^.length DO
+          IF (left^.items[index] # right^.items[index]) THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--for*);
+        RETURN TRUE;
+      END (*--if*);
+    ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE NumMembers    (    theSet  : Set         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.length;
+  END (*--if*);
+  RaiseErrIn(nummembers, undefined);
+  RETURN 0;
+END NumMembers;
+(*----------------------------*)
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+                             theSet  : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index       : CARDINAL;    (*-- Loop index over items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      compareItem := CompareOf(dataID);
+      FOR index := MIN(SizeRange) TO length DO
+        IF (theItem = items[index]) THEN
+          RETURN TRUE;
+        ELSE
+          order := compareItem(items[index], theItem);
+          IF (order = greater) THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+PROCEDURE IsSubset      (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   leftIndex   : CARDINAL;    (*-- Loop index over left set *)
+      rightIndex  : CARDINAL;    (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(issubset, undefined);
+    RETURN FALSE;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(issubset, typeerror);
+    RETURN FALSE;
+  END (*--if*);
+
+  compareItem:= CompareOf(left^.dataID);
+  leftIndex  := MIN(SizeRange);
+  rightIndex := MIN(SizeRange);
+  WHILE (leftIndex <=left^.length) & (rightIndex <=right^.length) DO
+    order := compareItem(left^.items[leftIndex],
+                         right^.items[rightIndex]);
+    IF (order = equal) THEN
+      INC(leftIndex);
+      INC(rightIndex);
+    ELSIF (order = less) THEN
+      RETURN FALSE;
+    ELSE
+      INC(rightIndex);
+    END (*--if*);
+  END (*--while*);
+  RETURN (leftIndex > left^.length);
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset(    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & (left^.length < right^.length);
+END IsProperSubset;
+(*----------------------------*)
+
+
+BEGIN
+  FOR setError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[setError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  setError := noerr;
+END SetSBUN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUMI.DEF
@@ -0,0 +1,240 @@
+(*
+13			The Unbounded Set
+
+This chapter presents the unbounded implementation of the set abstraction described in
+Chapter 11.  As with the other unbounded modules, given previously, the size of the set
+structure will vary dynamically as items are added and removed.  This particular form has
+the properties: Sequential, Unbounded, Managed, and Iterator.  These describe specific
+aspects of the implementation as follows:
+
+Sequential:	Can only be used in a non-tasking environment, or by only one task.
+Unbounded:	The size of a set varies dynamically as items are added and removed from
+		the set.
+Managed:	Memory space for items and objects is returned to the system when no
+		longer needed.
+Iterator:	Routines for looping over each of the set items are provided.
+
+The unbounded set interface follows in Section 13.1 while the actual implementation
+appears in Section 13.2.
+
+
+
+13.1	SetSUMI Interface
+*)
+
+
+DEFINITION MODULE SetSUMI;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Set
+               Sequential Unbounded Managed Iterator
+
+    INTRODUCTION
+    This module provides the interface for the unbounded Set
+    abstraction for generic Items.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+    (*-----------------------*)
+
+TYPE  Set;
+CONST NullSet = Set(NIL);
+
+
+(*
+13.2.1			Exceptions
+
+The ModuleID is used by the exception handling mechanism to distinguish this module
+from other modules.
+
+SetError returns the exception code from the most recent set operation.  A result of noerr 
+indicates successful completion of the operation.
+
+GetHandler returns the exception handler routine associated with the given exception. 
+Though the routine is a function procedure returning a procedure as its result, the
+HandlerProc may not be called from within the GetHandler call itself.  The procedure
+result must be first assigned to a procedure variable before invocation.  Exception handlers
+are given an initial value of ExitOnError except for the handler for noerr which is
+initialized to the null exception handler.
+
+SetHandler associates an exception handler routine with the given exception and is the
+inverse of GetHandler.  This routine may be used to override the default settings for the
+exception handlers.
+*)
+
+CONST ModuleID = 7;
+
+PROCEDURE SetError    ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+(*
+13.1.2			Constructors
+
+Create attempts to define a new, empty unbounded set of the given type, raising the
+undefined exception if it is unable to successfully complete the set.
+
+Destroy takes the given set, clears it of any items, and then destroys the set itself. 
+Where Create makes a defined set, Destroy is its inverse, making the set undefined.
+
+Clear takes the given set and removes all of its items.  theType attribute of the set 
+(assigned when the set was created) is used to retrieve the item deallocation routine for the
+items of the set.  Clearing the set returns it to the empty state.
+
+The Assign operation attempts to generate a duplicate of the source set (theSet) in the
+target set (toSet).  The target set is automatically created using the data type attribute of
+the source set, if necessary.  If this step is unnecessary, (the target set has been previously
+created), the target is cleared of its present contents, and its data type is changed to that of
+the source set.
+
+The Include operation adds items to the given set.  If the routine is unable to expand the
+set for the new item the overflow exception will be raised and the set remains unchanged. 
+If the item is already a member of the set the iteminset  exception is quietly ignored.
+
+The Exclude operation removes the specified item from the given set.  If the given set is 
+empty on entry to Exclude, or the given item is not a member of the set  the notinset 
+exception is silently ignored and the set remains unchanged.
+
+Union, Intersection, Difference, and SymDifference (symmetric difference) operations all
+implement the standard set operations of the same name as defined in the set abstraction
+chapter (11).
+*)
+
+PROCEDURE Create        (    theType : TypeID (*-- in    *))
+                                     : Set    (*-- out   *);
+
+PROCEDURE Destroy       (VAR theSet  : Set    (*-- inout *));
+
+PROCEDURE Clear         (VAR theSet  : Set    (*-- inout *));
+
+PROCEDURE Assign        (    theSet  : Set    (*-- in    *);
+                         VAR toSet   : Set    (*-- inout *));
+
+PROCEDURE Include       (    theItem : Item   (*-- in    *);
+                         VAR inSet   : Set    (*-- inout *));
+
+PROCEDURE Exclude       (    theItem : Item   (*-- in    *);
+                         VAR fromSet : Set    (*-- inout *));
+
+PROCEDURE Union         (    left    : Set    (*-- in    *);
+                             right   : Set    (*-- in    *);
+                         VAR toSet   : Set    (*-- inout *));
+
+PROCEDURE Intersection  (    left    : Set    (*-- in    *);
+                             right   : Set    (*-- in    *);
+                         VAR toSet   : Set    (*-- inout *));
+
+PROCEDURE Difference    (    left    : Set    (*-- in    *);
+                             right   : Set    (*-- in    *);
+                         VAR toSet   : Set    (*-- inout *));
+
+PROCEDURE SymDifference (    left    : Set    (*-- in    *);
+                             right   : Set    (*-- in    *);
+                         VAR toSet   : Set    (*-- inout *));
+
+
+
+(*
+13.1.3			Selectors
+
+IsDefined attempts to determine whether the given set is valid, e.g., has been created and
+not yet destroyed.  How this is accomplished may be as simple or complicated as the
+implementer desires and the requirements of the application.
+
+IsEmpty returns true if the given set contains no items; in other words, its cardinality is
+zero.  Undefined sets are always considered empty.
+
+IsEqual returns true if the left and right sets contain the same items.  Obviously, both
+must also have the same data type and have been created.  An undefined set is not equal to
+any other set, including itself.
+
+The TypeOf routine returns the current TypeID value given the set when it was created or
+assigned, and is provided so the user of the module need not maintain a separate variable
+recording this information.
+
+NumMembers returns the number of items present on the given set.  Undefined sets are
+considered to have no members.
+
+IsAMember returns true if the given item is present in the given set, and false otherwise.
+
+IsSubset and IsProperSubset both implement standard logical set operations as defined in
+the Set Abstraction (chapter 11).
+*)
+
+PROCEDURE IsDefined     (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty       (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE TypeOf        (    theSet  : Set      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+
+PROCEDURE NumMembers    (    theSet  : Set      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+                             theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+
+
+(*
+13.1.4			Iterators
+
+The iterator routine LoopOver provides the facility for looping over some or all items of
+a set, with read-only access to each item.  theProcess procedure parameter to this routine
+returns a BOOLEAN function result where TRUE allows the iteration to proceed to the
+next item and FALSE causes the iteration to be terminated.
+
+The Traverse iterator provides the facility for looping over all items of a set, with
+read-only access to each item.
+
+Both iterators traverse the given set from the first item towards the last item in ascending
+order.  Obviously, if given an empty set the processing procedure will not be invoked.
+*)
+
+PROCEDURE LoopOver   (    theSet  : Set            (*-- in    *);
+                          process : LoopAccessProc (*-- in    *));
+
+PROCEDURE Traverse   (    theSet  : Set            (*-- in    *);
+                          process : AccessProc     (*-- in    *));
+
+END SetSUMI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUMI.MOD
@@ -0,0 +1,1101 @@
+(*
+13.2	SetSUMI Implementation
+*)
+
+IMPLEMENTATION MODULE SetSUMI;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989 1988  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Set
+               Sequential Unbounded Managed Iterator
+
+    INTRODUCTION
+    This module implements the unbounded Set abstraction for
+    generic Items using a linearly ordered list.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1988  C. Lins
+        Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+=============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, AssignProc, CompareProc, DisposeProc,
+	           AccessProc, LoopAccessProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, CompareOf, DisposeOf;
+
+    (*--------------------*)
+
+
+(*
+13.2.1	Internal Unbounded Set Representation
+
+╟Illustration Here╚
+
+Figure 13.1
+
+For the internal representation of an unbounded set, a linear linked list is used as shown
+above in Figure 13.1.  Each item of the set is stored in a node  which is linked to its
+immediate successor.  The unbounded set header maintains the data type ID of the set, its
+current length, and the link to the first node of the list of set member items.
+
+Representation Invariants
+1. when length = 0, first = NIL
+2. when length > 0, first ¡ NIL
+3. the each item node is linked to its successor and the last item node has a next of NIL
+4. first^.item < first^.next^.item and item < item^.next^.item
+5. length contains the number of nodes in the list
+*)
+
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD  (*-- a set item node *)
+        item : Item; (*-- the item nodes' data *)
+        next : Link; (*-- link to next node in list *)
+	  END (*-- Node *);
+
+TYPE  UnboundedSet = RECORD (*-- set header *)
+        dataID : TypeID;    (*-- defined data type *)
+        length : CARDINAL;  (*-- current set length, := 0 *)
+        first  : Link;      (*-- link to first Item node *)
+      END (*-- UnboundedSet *);
+
+TYPE  Set = POINTER TO UnboundedSet;
+
+
+
+(*
+13.2.2		Exceptions
+
+To support the exception handling mechanism two variables are needed.  The first,
+setError, is used to record the exception code from each operation; while handlers  is an
+array of exception handling procedures indexed by the exception code.
+
+The routines SetError, GetHandler, and SetHandler have been previously described in the
+definition module, and their operation should be readily apparent.  RaiseErrIn  is a local
+routine used to set the setError variable and invoke the Raise  routine of the
+ErrorHandling module.
+*)
+
+VAR   setError  : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+PROCEDURE SetError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN setError;
+END SetError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  setError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+(*
+13.2.3	Local Routines
+
+Many set routines need to create new item nodes and NewNode  performs this; setting the
+item and link fields to the new node which is returned.  There are two ╥state╙ variables
+used by NewNode: (1) setRoutine, and (2) assignItem, which are used when raising the
+overflow exception, and when copying items values, respectively.  A routine, such as
+Union, may call NewNode many times throughout its execution and it would be quite
+inefficient to repeatedly pass these as parameters.
+
+Several set algorithms require the ability to copy the all remaining items from a given set
+to a partially created target set.  CopySubset  performs this operation by looping through
+the fromSet starting from the given index to the end of the set copying each item to the
+target set along the way.
+
+All routines that accept a target set as an inout parameter need to either (1) clear the set of
+its present contents if the set already exists, or (2) create a new, empty set to be target of
+the operation.  The Recreate  routine provides such a capability, returning true if
+successful.  It should be noted that failure only occurs as a result when the set must be
+created.
+*)
+
+VAR   setRoutine : Operations;  (*-- Routine calling NewNode *)
+VAR   assignItem : AssignProc;  (*-- Item assignment routine *)
+
+PROCEDURE NewNode       (    theItem : Item        (*-- in    *);
+       	       	             theNext : Link        (*-- in    *))
+       	       	                     : Link        (*-- out   *);
+
+VAR   newLink : Link;
+
+BEGIN
+  Allocate(newLink, SIZE(Node));
+  IF (newLink = NIL) THEN
+    RaiseErrIn(setRoutine, overflow);
+  ELSE
+    WITH newLink^ DO
+      item := assignItem(theItem);
+      next := theNext;
+    END (*--with*);
+  END (*--if*);
+  RETURN newLink;
+END NewNode;
+(*--------------------*)
+
+PROCEDURE CopySubset (    fromIndex  : Link       (*-- in    *);
+                          toIndex    : Link       (*-- in    *);
+                      VAR toSet      : Set        (*-- inout *));
+
+VAR   tempNode : Link;
+
+BEGIN
+  LOOP
+    IF (fromIndex = NIL) THEN
+      EXIT (*--loop*);
+    ELSE
+      tempNode := NewNode(fromIndex^.item, NIL);
+      IF (tempNode = NIL) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+      INC(toSet^.length);
+      IF (toSet^.first = NIL) THEN
+        toSet^.first := tempNode;
+      ELSE
+        toIndex^.next := tempNode;
+      END (*--if*);
+      toIndex   := tempNode;
+      fromIndex := fromIndex^.next;
+    END (*--if*);
+  END (*--loop*);
+END CopySubset;
+(*--------------------*)
+
+PROCEDURE Recreate (    theType : TypeID    (*-- in    *);
+                    VAR theSet  : Set       (*-- inout *))
+                                : BOOLEAN   (*-- out   *);
+BEGIN
+  IF (theSet # NIL) THEN
+    Clear(theSet);
+    theSet^.dataID := theType;
+  ELSE
+    theSet := Create(theType);
+  END (*--if*);
+  RETURN (setError = noerr);
+END Recreate;
+(*--------------------*)
+
+
+
+(*
+13.2.4		Constructors
+
+Create attempts to allocate a new, empty unbounded set header, which if successful allows
+the set to be initialized to an empty state with the given data type ID, a length of zero and
+a pointer to the first item node of NIL.  If unable to allocate the header the overflow
+exception is raised and the NullSet is returned.
+*)
+
+PROCEDURE Create        (    theType  : TypeID    (*-- in    *))
+                                      : Set       (*-- out   *);
+
+VAR   newSet : Set; (*-- new set variable being created *)
+
+BEGIN
+  setError := noerr;
+  Allocate(newSet, SIZE(UnboundedSet));
+  IF (newSet # NIL) THEN
+    WITH newSet^ DO
+      dataID := theType;
+      length := 0;
+      first  := NIL;
+    END (*--with*);
+    RETURN newSet;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullSet;
+END Create;
+(*--------------------*)
+
+
+(*
+Destroy takes advantage that Clear  sets setError  to noerr and raises the undefined  set
+exception.  So if Clear succeeds, Destroy releases the allocated set header.
+*)
+
+PROCEDURE Destroy       (VAR theSet   : Set       (*-- inout *));
+BEGIN
+  Clear(theSet);
+  IF (setError = noerr) THEN
+    Deallocate(theSet, SIZE(theSet^));
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+
+(*
+Clear  sets setError  to noerr then ensures a valid set object, raising the undefined 
+exception, if necessary.  Then the set nodes are traversed, in order, deallocating each item
+and then its node.  The representation invariants state that when length is zero, first must
+be NIL, and so we repeatedly adjust first since our last step will be to set length to zero. 
+The loop is guaranteed to terminate as the last item node must have a next of NIL.
+*)
+
+PROCEDURE Clear         (VAR theSet   : Set       (*-- inout *));
+
+VAR   freeItem : DisposeProc; (*-- Item disposal routine, if any *)
+      theNode  : Link;        (*-- Set node to be deallocated *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      freeItem := DisposeOf(dataID);
+      WHILE (first # NIL) DO
+        theNode := first;
+        first   := first^.next;
+        freeItem(theNode^.item);
+        Deallocate(theNode, SIZE(theNode^));
+      END (*--while*);
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+
+(*
+Assign attempts to duplicate the items of the source set in the target set, avoiding the
+useless operation of assigning a set to itself and recreating the target set if necessary.  To
+simplify the assignment, the routine initially copies the first node from the source to the
+target and then proceeds to loop through any remaining item nodes.  This is done to
+maintain the elements of the target in the same order as they appeared in the source.
+*)
+
+PROCEDURE Assign        (    theSet   : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+VAR   fromIndex : Link; (*-- Loop index over source set items *)
+      toIndex   : Link; (*-- Loop index over target set items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+
+    IF (toSet = theSet) OR ~Recreate(theSet^.dataID, toSet) THEN
+      RETURN;
+    END (*--if*);
+
+    WITH theSet^ DO
+      IF (first = NIL) THEN
+        RETURN;
+      END (*--if*);
+      assignItem := AssignOf(dataID);
+    END (*--with*);
+
+    setRoutine := assign;
+    WITH toSet^ DO
+      first := NewNode(theSet^.first^.item, NIL);
+      IF (setError = overflow) THEN
+        RETURN;
+      END (*--if*);
+      toIndex     := first;
+      fromIndex   := theSet^.first;
+    END (*--with*);
+
+    WHILE (fromIndex^.next # NIL) DO
+      fromIndex     := fromIndex^.next;
+      toIndex^.next := NewNode(fromIndex^.item, NIL);
+      IF (setError = overflow) THEN
+        RETURN;
+      END (*--if*);
+      toIndex := toIndex^.next;
+    END (*--while*);
+    toSet^.length := theSet^.length;
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+
+(*
+Include  must add the given item to the set if it is not already a member or to simply exit
+if the item is already a member (these semantics are compatible with Modula-2's INCL
+operation).  We could use the IsAMember selector except the index where the item is not
+found is necessary to insert the item in its appropriate position within the ordered list. 
+Once we have this position, we make add the new item using the standard ordered linked
+list insertion algorithm.
+*)
+
+PROCEDURE Include       (    theItem  : Item      (*-- in    *);
+                         VAR inSet    : Set       (*-- inout *));
+
+VAR   current     : Link;        (*-- Loop index in search of theItem *)
+      previous    : Link;        (*-- Previous node examined *)
+      newNode     : Link;        (*-- For new node to add *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (inSet # NIL) THEN
+    compareItem := CompareOf(inSet^.dataID);
+    current     := inSet^.first;
+    previous    := NIL;
+    LOOP
+      IF (current = NIL) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+
+      itemOrder := compareItem(current^.item, theItem);
+
+      IF (itemOrder = equal) THEN
+        RETURN;
+
+      ELSIF (itemOrder = greater) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+
+      previous := current;
+      current  := current^.next;
+    END (*--loop*);
+
+    (*-- Insert the new item *)
+
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(include, overflow);
+    ELSE
+      newNode^.item := theItem;
+      IF (previous = NIL) THEN
+        newNode^.next := inSet^.first;
+        inSet^.first  := newNode;
+      ELSE
+        newNode^.next  := current;
+        previous^.next := newNode;
+      END (*--if*);
+      INC(inSet^.length);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*--------------------*)
+
+
+(*
+Exclude undoes what Include did to add an item to the set. The first step is to determine if
+the given item is present in the set.  If the item is not found the routine simply exits to
+be compatible with Modula-2's EXCL operation.  If the item is found the list is updated
+by relinking nodes using the standard ordered linked list node deletion algorithm, the
+removed node and its item are both deallocated, and the set length is updated to reflect the
+removal of the item. 
+*)
+
+PROCEDURE Exclude       (    theItem  : Item      (*-- in    *);
+                         VAR fromSet  : Set       (*-- inout *));
+
+VAR   current     : Link;        (*-- Loop index over items *)
+      previous    : Link;        (*-- Previous node examined *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Relation between items *)
+      freeItem    : DisposeProc; (*-- Item disposal routine *)
+
+BEGIN
+  setError := noerr;
+  IF (fromSet # NIL) THEN
+    compareItem := CompareOf(fromSet^.dataID);
+    current     := fromSet^.first;
+    previous    := NIL;
+    LOOP
+      IF (current = NIL) THEN
+        RETURN;
+      END (*--if*);
+
+      itemOrder := compareItem(current^.item, theItem);
+
+      IF (itemOrder = equal) THEN
+        EXIT (*--loop*);
+      ELSIF (itemOrder = greater) THEN
+        RETURN;
+      END (*--if*);
+
+      previous := current;
+      current  := current^.next;
+    END (*--loop*);
+
+    (*-- ╥current╙ points to the node to be deleted. *)
+
+    IF (previous = NIL) THEN
+      fromSet^.first := current^.next;
+    ELSE
+      previous^.next := current^.next;
+    END (*--if*);
+    freeItem := DisposeOf(fromSet^.dataID);
+    freeItem(current^.item);
+    Deallocate(current, SIZE(current^));
+    DEC(fromSet^.length);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*--------------------*)
+
+
+(*
+Union computes the set containing all members of left and right, e.g.,
+
+x IN toSet iff (x IN left) OR (x IN right).
+
+The algorithm used is a variation on the array merge from reference [2], pg. 414 and the
+ordered list set intersection algorithm presented in Aho, Hopcroft, and Ullman [1, pg.
+117].  It is essentially the same algorithm used in the previous chapter on the bounded set
+converted to work with ordered linear linked lists.
+
+The algorithm loops over the items of the left and right sets until the end of either is
+reached.  On each iteration, the items are compared for the ordering relation between them. 
+This is used to determine from which set an item is copied to the target set, and which
+indexes to advance.  In this manner, all items are processed only once and duplicate items
+in the target set are avoided.
+
+The last step is to copy the remaining items, if any, from either the left set or the right
+set to the destination set.
+*)
+
+PROCEDURE Union         (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left set *)
+      rightIndex  : Link;        (*-- Loop index over right set *)
+      toIndex     : Link;        (*-- List of target set nodes *)
+      tempNode    : Link;        (*-- Temporary node *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(union, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(union, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  setRoutine := union;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+    Allocate(tempNode, SIZE(Node));
+    IF (tempNode = NIL) THEN
+      RaiseErrIn(union, overflow);
+      RETURN;
+    END (*--if*);
+    tempNode^.next := NIL;
+    INC(toSet^.length);
+
+    IF (order = less) THEN
+      tempNode^.item := assignItem(leftIndex^.item);
+      leftIndex := leftIndex^.next;
+
+    ELSIF (order = equal) THEN
+      tempNode^.item := assignItem(leftIndex^.item);
+      leftIndex := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSE
+      tempNode^.item := assignItem(rightIndex^.item);
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+
+    (*-- Update the linked list *)
+
+    IF (toSet^.first = NIL) THEN
+      toSet^.first := tempNode;
+    ELSE
+      toIndex^.next := tempNode;
+    END (*--if*);
+    toIndex := tempNode;
+  END (*--while*);
+
+  IF (leftIndex = NIL) THEN
+    CopySubset(rightIndex, toIndex, toSet);
+  ELSIF (rightIndex = NIL) THEN
+    CopySubset(leftIndex, toIndex, toSet);
+  END (*--if*);
+END Union;
+(*--------------------*)
+
+
+(*
+Intersection computes the set containing all members in both left and right sets, e.g.,
+
+x IN toSet iff (x IN left) AND (x IN right).
+
+The algorithm, from that given by Aho, Hopcroft, and Ullman, in [1, pg. 117], loops
+over the items of the left and right sets until the end of either is reached.  On each
+iteration, the items are compared for the ordering relation between them.  Equal items are
+copied to the target set and both indexes are advanced, otherwise the index to the smaller
+item is advanced.  In this manner, all items are processed only once and duplicate items in
+the target set are avoided.
+*)
+
+PROCEDURE Intersection  (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop link over left set *)
+      rightIndex  : Link;        (*-- Loop link over right set *)
+      toIndex     : Link;        (*-- List of target set nodes *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(intersection, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(intersection, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+ 
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  setRoutine := intersection;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+      IF (toSet^.first = NIL) THEN
+        toSet^.first := NewNode(leftIndex^.item, NIL);
+        toIndex := toSet^.first;
+      ELSE
+        toIndex^.next := NewNode(leftIndex^.item, NIL);
+        toIndex := toIndex^.next;
+      END (*--if*);
+      IF (setError = overflow) THEN
+        RETURN;
+      END (*--if*);
+      INC(toSet^.length);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSIF (order = less) THEN
+      leftIndex  := leftIndex^.next;
+
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+END Intersection;
+(*--------------------*)
+
+
+(*
+Difference computes the set containing all members of the left set that are not members
+of the right set, e.g.,
+
+x IN toSet iff (x IN left) & ┬(x IN right)
+
+The algorithm, similar to that given above for union and intersection, loops over the
+items of the left and right sets until the end of either is reached.  On each iteration, the
+items are compared for the ordering relation between them.  Equal items are skipped and
+both indexes advanced, otherwise the index to the smaller item is advanced.  When the
+item from the left set is less than that of the right set we know that it is not present in
+the right set and can then copy that item over to the target set.  The last step is to copy
+the remaining items, if any, from the left set to the destination set.
+*)
+
+PROCEDURE Difference    (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left set *)
+      rightIndex  : Link;        (*-- Loop index over right set *)
+      toIndex     : Link;        (*-- List of target set nodes *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(difference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(difference, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  setRoutine := difference;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSIF (order = less) THEN
+      IF (toSet^.first = NIL) THEN
+        toSet^.first := NewNode(leftIndex^.item, NIL);
+        toIndex := toSet^.first;
+      ELSE
+        toIndex^.next := NewNode(leftIndex^.item, NIL);
+        toIndex := toIndex^.next;
+      END (*--if*);
+
+      IF (setError = overflow) THEN
+        RETURN;
+      END (*--if*);
+
+      INC(toSet^.length);
+      leftIndex  := leftIndex^.next;
+
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+
+  CopySubset(leftIndex, toIndex, toSet);
+END Difference;
+(*--------------------*)
+
+
+(*
+SymDifference computes the set containing all members of the left or right set that are
+not members of the both sets, e.g.,
+
+x IN toSet iff (x IN left) ¡ (x IN right)
+
+The algorithm, similar to that given above for union and difference, loops over the items
+of the left and right sets until the end of either is reached.  On each iteration, the items are
+compared for the ordering relation between them.  Equal items are skipped and both
+indexes advanced, otherwise the index to the smaller item is advanced.  When the items
+between the two sets are unequal we can then copy the smaller of the two items over to
+the target set.  The last step is to copy the remaining items, if any, from either the left or
+right set, whichever has items remaining, to the target set.
+*)
+
+PROCEDURE SymDifference (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left set *)
+      rightIndex  : Link;        (*-- Loop index over right set *)
+      toIndex     : Link;        (*-- List of target set nodes *)
+      tempNode    : Link;        (*-- Temporary node *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(symdifference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(symdifference, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  setRoutine := symdifference;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSE
+      Allocate(tempNode, SIZE(Node));
+      IF (tempNode = NIL) THEN
+        RaiseErrIn(symdifference, overflow);
+        RETURN;
+      END (*--if*);
+      INC(toSet^.length);
+      IF (order = less) THEN
+        tempNode^.item := assignItem(leftIndex^.item);
+        leftIndex  := leftIndex^.next;
+      ELSE
+        tempNode^.item := assignItem(rightIndex^.item);
+        rightIndex := rightIndex^.next;
+      END (*--if*);
+
+      IF (toSet^.first = NIL) THEN
+        toSet^.first := tempNode;
+      ELSE
+        toIndex^.next := tempNode;
+      END (*--if*);
+
+      toIndex := tempNode;
+    END (*--if*);
+  END (*--while*);
+
+  IF (leftIndex = NIL) THEN
+    CopySubset(rightIndex, toIndex, toSet);
+  ELSIF (rightIndex = NIL) THEN
+    CopySubset(leftIndex, toIndex, toSet);
+  END (*--if*);
+END SymDifference;
+(*--------------------*)
+
+
+
+(*
+13.2.5		Selectors
+
+IsDefined returns true if the given set is not NIL and false otherwise, which is the simple
+test for a defined set object.
+*)
+
+PROCEDURE IsDefined     (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (theSet # NIL);
+END IsDefined;
+(*--------------------*)
+
+
+(*
+IsEmpty (as always) returns the logical condition as to the state of the set's length,
+which if zero indicates an empty set.
+*)
+
+PROCEDURE IsEmpty       (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN (theSet^.length = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*--------------------*)
+
+
+PROCEDURE TypeOf        (    theSet  : Set      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*--------------------*)
+
+
+(*
+IsEqual must return true if the two given sets each contain the same items.  After
+enforcing the required preconditions, the lengths of the sets are compared in a simple test
+for inequality.  If the lengths are equal it is possible for the sets to be equal so we loop
+over each item of both sets returning false upon encountering a mismatch between two
+items.  True is returned if the loop completes without finding any mismatched items. 
+Note that because the lengths are equal, both indexes will reach the end of their respective
+set simultaneously.
+*)
+
+PROCEDURE IsEqual       (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- Loop index over left set items *)
+      rightIndex: Link; (*-- Loop index over right set items *)
+	  compare   : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.length = right^.length) THEN
+
+		compare   := CompareOf(left^.dataID);
+        leftIndex := left^.first;
+        rightIndex:= right^.first;
+        WHILE (leftIndex # NIL) DO
+          IF compare(leftIndex^.item, rightIndex^.item) # equal THEN
+            RETURN FALSE;
+          END (*--if*);
+          leftIndex := leftIndex^.next;
+          rightIndex:= rightIndex^.next;
+        END (*--while*);
+        RETURN TRUE;
+      END (*--if*);
+
+    ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+
+(*
+NumMembers needs to simply return the current set length or for an undefined set return
+zero as it is impossible to have any members in such a set.
+*)
+
+PROCEDURE NumMembers    (    theSet  : Set         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.length;
+  END (*--if*);
+  RaiseErrIn(nummembers, undefined);
+  RETURN 0;
+END NumMembers;
+(*----------------------------*)
+
+
+(*
+IsAMember seeks to determine whether the given item is a member of the given set by
+scanning each of the items in the set in turn.  There are two conditions that could cause
+the loop to terminate prior to reaching the last item: (1) the item and a set item match
+indicating that the item is a member of the set, and (2) the item is greater than a set item
+indicating non-membership since the set items are linearly ordered.  If the end of the loop
+is reached and we have not exited with a match then by implication the item is not
+present.
+*)
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+                             theSet  : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index       : Link;        (*-- Loop index over items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      compareItem := CompareOf(dataID);
+      index := first;
+    END (*--with*);
+    WHILE (index # NIL) DO
+      IF (theItem = index^.item) THEN
+        RETURN TRUE;
+      ELSIF (compareItem(index^.item, theItem) = greater) THEN
+        RETURN FALSE;
+      END (*--if*);
+      index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+
+(*
+IsSubset after ensuring that the required preconditions are met, proceeds to loop through
+the items of the left and right sets attempting to determine if every member of the left set
+is also a member of the right set.  Because the items of the list are linearly ordered in
+ascending sequence, inequality can be determined more quickly than with a completely
+unordered set implementation.  When an item of the left set is less than its counterpart in
+the right set we can immediately return false knowing that that item is not present in the
+right set.  If the left item is greater we know that we must advance the index into the
+right set since the item may yet be found further into the list.  When the items are equal
+both indexes are advanced.  When the end of the loop has been reached without premature
+exit, the left set can only be a subset of the right if we have examined beyond the end of
+the left set.
+*)
+
+PROCEDURE IsSubset      (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   leftIndex   : Link;        (*-- Loop index over left set *)
+      rightIndex  : Link;        (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(issubset, undefined);
+    RETURN FALSE;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(issubset, typeerror);
+    RETURN FALSE;
+  END (*--if*);
+
+  compareItem:= CompareOf(left^.dataID);
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+    IF (order = equal) THEN
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    ELSIF (order = less) THEN
+      RETURN FALSE;
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+  RETURN (leftIndex = NIL);
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset(    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & (left^.length < right^.length);
+END IsProperSubset;
+(*----------------------------*)
+
+
+
+(*
+13.2.6  Iterators
+
+Both LoopOver and Traverse simply loop through the given set's list of items from the
+first to the end of the list passing the item to the given processing procedure parameter.
+*)
+
+PROCEDURE LoopOver   (    theSet  : Set            (*-- in    *);
+                          process : LoopAccessProc (*-- in    *));
+
+VAR   theNode : Link; (*-- Loop index over items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    theNode := theSet^.first;
+    WHILE (theNode # NIL) & process(theNode^.item) DO
+      theNode := theNode^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE Traverse   (    theSet  : Set            (*-- in    *);
+                          process : AccessProc     (*-- in    *));
+
+VAR   theNode : Link; (*-- Loop index over items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    theNode := theSet^.first;
+    WHILE (theNode # NIL) DO
+      process(theNode^.item);
+      theNode := theNode^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+
+
+(*
+13.2.7		Module Initialization
+
+In the module initialization the local exception handlers array variables are set to default
+handlers (ExitOnError) except for the noerr handler which is given the null handler. 
+setError is given the value noerr avoiding an undefined state.
+*)
+
+BEGIN
+  FOR setError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[setError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  setError := noerr;
+END SetSUMI.
+
+
+(*
+References
+
+[1]	A.V. Aho, J.E. Hopcroft, and J.D. Ullman, Data Structures and Algorithms,
+	Addison-Wesley, Reading, MA, 1983, pg. 118.
+[2]	A.M. Tenenbaum and M.J. Augenstein, Data Structures Using Pascal, Prentice-Hall,
+	Englewood Cliffs, NJ 1981.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUMN.DEF
@@ -0,0 +1,217 @@
+(*
+13		The Unbounded Set (continued)
+
+This chapter presents the unbounded implementation of the set abstraction described in
+Chapter 11.  As with the other unbounded modules, given previously, the size of the set
+structure will vary dynamically as items are added and removed.  This particular form has
+the properties: Sequential, Unbounded, Managed, and Non-Iterator.  These describe specific
+aspects of the implementation as follows:
+
+Sequential:	Can only be used in a non-tasking environment, or by only one task.
+Unbounded:	The size of a set varies dynamically as items are added and removed from
+		the set.
+Managed:	Memory space for items and objects is returned to the system when no
+		longer needed.
+Non-Iterator:	Routines for looping over each of the set items are not provided.
+
+The unbounded set interface follows in Section 13.3 while the actual implementation
+appears in Section 13.4.
+
+
+
+13.3		SetSUMN Interface
+*)
+
+
+DEFINITION MODULE SetSUMN;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Set
+               Sequential Unbounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module provides the interface for the unbounded Set
+    abstraction for generic Items.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+    (*-----------------------*)
+
+TYPE  Set;
+CONST NullSet = Set(NIL);
+
+
+(*
+13.4.1			Exceptions
+
+The ModuleID is used by the exception handling mechanism to distinguish this module
+from other modules.
+
+SetError returns the exception code from the most recent set operation.  A result of noerr 
+indicates successful completion of the operation.
+
+GetHandler returns the exception handler routine associated with the given exception. 
+Though the routine is a function procedure returning a procedure as its result, the
+HandlerProc may not be called from within the GetHandler call itself.  The procedure
+result must be first assigned to a procedure variable before invocation.  Exception handlers
+are given an initial value of ExitOnError except for the handler for noerr which is
+initialized to the null exception handler.
+
+SetHandler associates an exception handler routine with the given exception and is the
+inverse of GetHandler.  This routine may be used to override the default settings for the
+exception handlers.
+*)
+
+CONST ModuleID = 8;
+
+PROCEDURE SetError    ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+(*
+13.3.2			Constructors
+
+Create attempts to define a new, empty unbounded set of the given type, raising the
+undefined exception if it is unable to successfully complete the set.
+
+Destroy takes the given set, clears it of any items, and then destroys the set itself. 
+Where Create makes a defined set, Destroy is its inverse, making the set undefined.
+
+Clear takes the given set and removes all of its items.  theType attribute of the set 
+(assigned when the set was created) is used to retrieve the item deallocation routine for the
+items of the set.  Clearing the set returns it to the empty state.
+
+The Assign operation attempts to generate a duplicate of the source set (theSet) in the
+target set (toSet).  The target set is automatically created using the data type attribute of
+the source set, if necessary.  If this step is unnecessary, (the target set has been previously
+created), the target is cleared of its present contents, and its data type is changed to that of
+the source set.
+
+The Include operation adds items to the given set.  If the routine is unable to expand the
+set for the new item the overflow exception will be raised and the set remains unchanged. 
+If the item is already a member of the set the iteminset  exception is quietly ignored.
+
+The Exclude operation removes the specified item from the given set.  If the given set is 
+empty on entry to Exclude, or the given item is not a member of the set  the notinset 
+exception is silently ignored and the set remains unchanged.
+
+Union, Intersection, Difference, and SymDifference (symmetric difference) operations all
+implement the standard set operations of the same name as defined in the set abstraction
+chapter (11).
+*)
+
+PROCEDURE Create        (    theType : TypeID (*-- in    *))
+                                     : Set    (*-- out   *);
+
+PROCEDURE Destroy       (VAR theSet  : Set    (*-- inout *));
+
+PROCEDURE Clear         (VAR theSet  : Set    (*-- inout *));
+
+PROCEDURE Assign        (    theSet  : Set    (*-- in    *);
+                         VAR toSet   : Set    (*-- inout *));
+
+PROCEDURE Include       (    theItem : Item   (*-- in    *);
+                         VAR inSet   : Set    (*-- inout *));
+
+PROCEDURE Exclude       (    theItem : Item   (*-- in    *);
+                         VAR fromSet : Set    (*-- inout *));
+
+PROCEDURE Union         (    left    : Set    (*-- in    *);
+                             right   : Set    (*-- in    *);
+                         VAR toSet   : Set    (*-- inout *));
+
+PROCEDURE Intersection  (    left    : Set    (*-- in    *);
+                             right   : Set    (*-- in    *);
+                         VAR toSet   : Set    (*-- inout *));
+
+PROCEDURE Difference    (    left    : Set    (*-- in    *);
+                             right   : Set    (*-- in    *);
+                         VAR toSet   : Set    (*-- inout *));
+
+PROCEDURE SymDifference (    left    : Set    (*-- in    *);
+                             right   : Set    (*-- in    *);
+                         VAR toSet   : Set    (*-- inout *));
+
+
+
+(*
+13.3.3			Selectors
+
+IsDefined attempts to determine whether the given set is valid, e.g., has been created and
+not yet destroyed.  How this is accomplished may be as simple or complicated as the
+implementer desires and the requirements of the application.
+
+IsEmpty returns true if the given set contains no items; in other words, its cardinality is
+zero.  Undefined sets are always considered empty.
+
+IsEqual returns true if the left and right sets contain the same items.  Obviously, both
+must also have the same data type and have been created.  An undefined set is not equal to
+any other set, including itself.
+
+The TypeOf routine returns the current TypeID value given the set when it was created or
+assigned, and is provided so the user of the module need not maintain a separate variable
+recording this information.
+
+NumMembers returns the number of items present on the given set.  Undefined sets are
+considered to have no members.
+
+IsAMember returns true if the given item is present in the given set, and false otherwise.
+
+IsSubset and IsProperSubset both implement standard logical set operations as defined in
+the Set Abstraction (chapter 11).
+*)
+
+PROCEDURE IsDefined     (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty       (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE TypeOf        (    theSet  : Set      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+
+PROCEDURE NumMembers    (    theSet  : Set      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+                             theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+END SetSUMN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUMN.MOD
@@ -0,0 +1,1053 @@
+(*
+13.4	SetSUMN Implementation
+*)
+
+IMPLEMENTATION MODULE SetSUMN;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Set
+               Sequential Unbounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module implements the unbounded Set abstraction for
+    generic Items using a linearly ordered list.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+        Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, CompareOf, DisposeOf;
+
+    (*--------------------*)
+
+
+(*
+13.4.1		Internal Unbounded Set Representation
+
+╟Illustration Here╚
+
+Figure 13.1
+
+For the internal representation of an unbounded set, a linear linked list is used as shown
+above in Figure 13.1.  Each item of the set is stored in a node  which is linked to its
+immediate successor.  The unbounded set header maintains the data type ID of the set, its
+current length, and the link to the first node of the list of set member items.
+
+Representation Invariants
+1. when length = 0, first = NIL
+2. when length > 0, first # NIL
+3. the each item node is linked to its successor and the last item node has a next of NIL
+4. first^.item < first^.next^.item and item < item^.next^.item
+5. length contains the number of nodes in the list
+*)
+
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD  (*-- a set item node *)
+        item : Item; (*-- the item nodes' data *)
+        next : Link; (*-- link to next node in list *)
+      END (*-- Node *);
+
+TYPE  UnboundedSet = RECORD (*-- set header *)
+        dataID : TypeID;    (*-- defined data type *)
+        length : CARDINAL;  (*-- current set length, := 0 *)
+        first  : Link;      (*-- link to first Item node *)
+      END (*-- UnboundedSet *);
+
+TYPE  Set = POINTER TO UnboundedSet;
+
+
+
+(*
+13.4.2		Exceptions
+
+To support the exception handling mechanism two variables are needed.  The first,
+setError, is used to record the exception code from each operation; while handlers  is an
+array of exception handling procedures indexed by the exception code.
+
+The routines SetError, GetHandler, and SetHandler have been previously described in the
+definition module, and their operation should be readily apparent.  RaiseErrIn  is a local
+routine used to set the setError variable and invoke the Raise  routine of the
+ErrorHandling module.
+*)
+
+VAR   setError  : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+PROCEDURE SetError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN setError;
+END SetError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  setError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+(*
+13.4.3		Local Routines
+
+Many set routines need to create new item nodes and NewNode  performs this; setting the
+item and link fields to the new node which is returned.  There are two ╥state╙ variables
+used by NewNode: (1) setRoutine, and (2) assignItem, which are used when raising the
+overflow exception, and when copying items values, respectively.  A routine, such as
+Union, may call NewNode many times throughout its execution and it would be quite
+inefficient to repeatedly pass these as parameters.
+
+Several set algorithms require the ability to copy the all remaining items from a given set
+to a partially created target set.  CopySubset  performs this operation by looping through
+the fromSet starting from the given index to the end of the set copying each item to the
+target set along the way.
+
+All routines that accept a target set as an inout parameter need to either (1) clear the set of
+its present contents if the set already exists, or (2) create a new, empty set to be target of
+the operation.  The Recreate  routine provides such a capability, returning true if
+successful.  It should be noted that failure only occurs as a result when the set must be
+created.
+*)
+
+VAR   setRoutine : Operations;  (*-- Routine calling NewNode *)
+VAR   assignItem : AssignProc;  (*-- Item assignment routine *)
+
+PROCEDURE NewNode       (    theItem : Item        (*-- in    *);
+       	       	             theNext : Link        (*-- in    *))
+       	       	                     : Link        (*-- out   *);
+
+VAR   newLink : Link;
+
+BEGIN
+  Allocate(newLink, SIZE(Node));
+  IF (newLink = NIL) THEN
+    RaiseErrIn(setRoutine, overflow);
+  ELSE
+    WITH newLink^ DO
+      item := assignItem(theItem);
+      next := theNext;
+    END (*--with*);
+  END (*--if*);
+  RETURN newLink;
+END NewNode;
+(*--------------------*)
+
+PROCEDURE CopySubset (    fromIndex  : Link       (*-- in    *);
+                          toIndex    : Link       (*-- in    *);
+                      VAR toSet      : Set        (*-- inout *));
+
+VAR   tempNode : Link;
+
+BEGIN
+  LOOP
+    IF (fromIndex = NIL) THEN
+      EXIT (*--loop*);
+    ELSE
+      tempNode := NewNode(fromIndex^.item, NIL);
+      IF (tempNode = NIL) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+      INC(toSet^.length);
+      IF (toSet^.first = NIL) THEN
+        toSet^.first := tempNode;
+      ELSE
+        toIndex^.next := tempNode;
+      END (*--if*);
+      toIndex   := tempNode;
+      fromIndex := fromIndex^.next;
+    END (*--if*);
+  END (*--loop*);
+END CopySubset;
+(*--------------------*)
+
+PROCEDURE Recreate (    theType : TypeID    (*-- in    *);
+                    VAR theSet  : Set       (*-- inout *))
+                                : BOOLEAN   (*-- out   *);
+BEGIN
+  IF (theSet # NIL) THEN
+    Clear(theSet);
+    theSet^.dataID := theType;
+  ELSE
+    theSet := Create(theType);
+  END (*--if*);
+  RETURN (setError = noerr);
+END Recreate;
+(*--------------------*)
+
+
+
+(*
+13.4.4		Constructors
+
+Create attempts to allocate a new, empty unbounded set header, which if successful allows
+the set to be initialized to an empty state with the given data type ID, a length of zero and
+a pointer to the first item node of NIL.  If unable to allocate the header the overflow
+exception is raised and the NullSet is returned.
+*)
+
+PROCEDURE Create        (    theType  : TypeID    (*-- in    *))
+                                      : Set       (*-- out   *);
+
+VAR   newSet : Set; (*-- new set variable being created *)
+
+BEGIN
+  setError := noerr;
+  Allocate(newSet, SIZE(UnboundedSet));
+  IF (newSet # NIL) THEN
+    WITH newSet^ DO
+      dataID := theType;
+      length := 0;
+      first  := NIL;
+    END (*--with*);
+    RETURN newSet;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullSet;
+END Create;
+(*--------------------*)
+
+
+(*
+Destroy takes advantage that Clear  sets setError  to noerr and raises the undefined  set
+exception.  So if Clear succeeds, Destroy releases the allocated set header.
+*)
+
+PROCEDURE Destroy       (VAR theSet   : Set       (*-- inout *));
+BEGIN
+  Clear(theSet);
+  IF (setError = noerr) THEN
+    Deallocate(theSet, SIZE(theSet^));
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+
+(*
+Clear  sets setError  to noerr then ensures a valid set object, raising the undefined 
+exception, if necessary.  Then the set nodes are traversed, in order, deallocating each item
+and then its node.  The representation invariants state that when length is zero, first must
+be NIL, and so we repeatedly adjust first since our last step will be to set length to zero. 
+The loop is guaranteed to terminate as the last item node must have a next of NIL.
+*)
+
+PROCEDURE Clear         (VAR theSet   : Set       (*-- inout *));
+
+VAR   freeItem : DisposeProc; (*-- Item disposal routine, if any *)
+      theNode  : Link;        (*-- Set node to be deallocated *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      freeItem := DisposeOf(dataID);
+      WHILE (first # NIL) DO
+        theNode := first;
+        first   := first^.next;
+        freeItem(theNode^.item);
+        Deallocate(theNode, SIZE(theNode^));
+      END (*--while*);
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+
+(*
+Assign attempts to duplicate the items of the source set in the target set, avoiding the
+useless operation of assigning a set to itself and recreating the target set if necessary.  To
+simplify the assignment, the routine initially copies the first node from the source to the
+target and then proceeds to loop through any remaining item nodes.  This is done to
+maintain the elements of the target in the same order as they appeared in the source.
+*)
+
+PROCEDURE Assign        (    theSet   : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+VAR   fromIndex : Link; (*-- Loop index over source set items *)
+      toIndex   : Link; (*-- Loop index over target set items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+
+    IF (toSet = theSet) OR ~Recreate(theSet^.dataID, toSet) THEN
+      RETURN;
+    END (*--if*);
+
+    WITH theSet^ DO
+      IF (first = NIL) THEN
+        RETURN;
+      END (*--if*);
+      assignItem := AssignOf(dataID);
+    END (*--with*);
+
+    setRoutine := assign;
+    WITH toSet^ DO
+      first := NewNode(theSet^.first^.item, NIL);
+      IF (setError = overflow) THEN
+        RETURN;
+      END (*--if*);
+      toIndex     := first;
+      fromIndex   := theSet^.first;
+    END (*--with*);
+
+    WHILE (fromIndex^.next # NIL) DO
+      fromIndex     := fromIndex^.next;
+      toIndex^.next := NewNode(fromIndex^.item, NIL);
+      IF (setError = overflow) THEN
+        RETURN;
+      END (*--if*);
+      toIndex := toIndex^.next;
+    END (*--while*);
+    toSet^.length := theSet^.length;
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+
+(*
+Include  must add the given item to the set if it is not already a member or to simply exit
+if the item is already a member (these semantics are compatible with Modula-2's INCL
+operation).  We could use the IsAMember selector except the index where the item is not
+found is necessary to insert the item in its appropriate position within the ordered list. 
+Once we have this position, we make add the new item using the standard ordered linked
+list insertion algorithm.
+*)
+
+PROCEDURE Include       (    theItem  : Item      (*-- in    *);
+                         VAR inSet    : Set       (*-- inout *));
+
+VAR   current     : Link;        (*-- Loop index in search of theItem *)
+      previous    : Link;        (*-- Previous node examined *)
+      newNode     : Link;        (*-- For new node to add *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (inSet # NIL) THEN
+    compareItem := CompareOf(inSet^.dataID);
+    current     := inSet^.first;
+    previous    := NIL;
+    LOOP
+      IF (current = NIL) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+
+      itemOrder := compareItem(current^.item, theItem);
+
+      IF (itemOrder = equal) THEN
+        RETURN;
+
+      ELSIF (itemOrder = greater) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+
+      previous := current;
+      current  := current^.next;
+    END (*--loop*);
+
+    (*-- Insert the new item *)
+
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(include, overflow);
+    ELSE
+      newNode^.item := theItem;
+      IF (previous = NIL) THEN
+        newNode^.next := inSet^.first;
+        inSet^.first  := newNode;
+      ELSE
+        newNode^.next  := current;
+        previous^.next := newNode;
+      END (*--if*);
+      INC(inSet^.length);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*--------------------*)
+
+
+(*
+Exclude undoes what Include did to add an item to the set. The first step is to determine if
+the given item is present in the set.  If the item is not found the routine simply exits to
+be compatible with Modula-2's EXCL operation.  If the item is found the list is updated
+by relinking nodes using the standard ordered linked list node deletion algorithm, the
+removed node and its item are both deallocated, and the set length is updated to reflect the
+removal of the item. 
+*)
+
+PROCEDURE Exclude       (    theItem  : Item      (*-- in    *);
+                         VAR fromSet  : Set       (*-- inout *));
+
+VAR   current     : Link;        (*-- Loop index over items *)
+      previous    : Link;        (*-- Previous node examined *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Relation between items *)
+      freeItem    : DisposeProc; (*-- Item disposal routine *)
+
+BEGIN
+  setError := noerr;
+  IF (fromSet # NIL) THEN
+    compareItem := CompareOf(fromSet^.dataID);
+    current     := fromSet^.first;
+    previous    := NIL;
+    LOOP
+      IF (current = NIL) THEN
+        RETURN;
+      END (*--if*);
+
+      itemOrder := compareItem(current^.item, theItem);
+
+      IF (itemOrder = equal) THEN
+        EXIT (*--loop*);
+      ELSIF (itemOrder = greater) THEN
+        RETURN;
+      END (*--if*);
+
+      previous := current;
+      current  := current^.next;
+    END (*--loop*);
+
+    (*-- ╥current╙ points to the node to be deleted. *)
+
+    IF (previous = NIL) THEN
+      fromSet^.first := current^.next;
+    ELSE
+      previous^.next := current^.next;
+    END (*--if*);
+    freeItem := DisposeOf(fromSet^.dataID);
+    freeItem(current^.item);
+    Deallocate(current, SIZE(current^));
+    DEC(fromSet^.length);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*--------------------*)
+
+
+(*
+Union computes the set containing all members of left and right, e.g.,
+
+x IN toSet iff (x IN left) OR (x IN right).
+
+The algorithm used is a variation on the array merge from reference [2], pg. 414 and the
+ordered list set intersection algorithm presented in Aho, Hopcroft, and Ullman [1, pg.
+117].  It is essentially the same algorithm used in the previous chapter on the bounded set
+converted to work with ordered linear linked lists.
+
+The algorithm loops over the items of the left and right sets until the end of either is
+reached.  On each iteration, the items are compared for the ordering relation between them. 
+This is used to determine from which set an item is copied to the target set, and which
+indexes to advance.  In this manner, all items are processed only once and duplicate items
+in the target set are avoided.
+
+The last step is to copy the remaining items, if any, from either the left set or the right
+set to the destination set.
+*)
+
+PROCEDURE Union         (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left set *)
+      rightIndex  : Link;        (*-- Loop index over right set *)
+      toIndex     : Link;        (*-- List of target set nodes *)
+      tempNode    : Link;        (*-- Temporary node *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(union, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(union, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  setRoutine := union;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+    Allocate(tempNode, SIZE(Node));
+    IF (tempNode = NIL) THEN
+      RaiseErrIn(union, overflow);
+      RETURN;
+    END (*--if*);
+    tempNode^.next := NIL;
+    INC(toSet^.length);
+
+    IF (order = less) THEN
+      tempNode^.item := assignItem(leftIndex^.item);
+      leftIndex := leftIndex^.next;
+
+    ELSIF (order = equal) THEN
+      tempNode^.item := assignItem(leftIndex^.item);
+      leftIndex := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSE
+      tempNode^.item := assignItem(rightIndex^.item);
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+
+    (*-- Update the linked list *)
+
+    IF (toSet^.first = NIL) THEN
+      toSet^.first := tempNode;
+    ELSE
+      toIndex^.next := tempNode;
+    END (*--if*);
+    toIndex := tempNode;
+  END (*--while*);
+
+  IF (leftIndex = NIL) THEN
+    CopySubset(rightIndex, toIndex, toSet);
+  ELSIF (rightIndex = NIL) THEN
+    CopySubset(leftIndex, toIndex, toSet);
+  END (*--if*);
+END Union;
+(*--------------------*)
+
+
+(*
+Intersection computes the set containing all members in both left and right sets, e.g.,
+
+x IN toSet iff (x IN left) AND (x IN right).
+
+The algorithm, from that given by Aho, Hopcroft, and Ullman, in [1, pg. 117], loops
+over the items of the left and right sets until the end of either is reached.  On each
+iteration, the items are compared for the ordering relation between them.  Equal items are
+copied to the target set and both indexes are advanced, otherwise the index to the smaller
+item is advanced.  In this manner, all items are processed only once and duplicate items in
+the target set are avoided.
+*)
+
+PROCEDURE Intersection  (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop link over left set *)
+      rightIndex  : Link;        (*-- Loop link over right set *)
+      toIndex     : Link;        (*-- List of target set nodes *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(intersection, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(intersection, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  setRoutine := intersection;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+      IF (toSet^.first = NIL) THEN
+        toSet^.first := NewNode(leftIndex^.item, NIL);
+        toIndex := toSet^.first;
+      ELSE
+        toIndex^.next := NewNode(leftIndex^.item, NIL);
+        toIndex := toIndex^.next;
+      END (*--if*);
+      IF (setError = overflow) THEN
+        RETURN;
+      END (*--if*);
+      INC(toSet^.length);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSIF (order = less) THEN
+      leftIndex  := leftIndex^.next;
+
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+END Intersection;
+(*--------------------*)
+
+
+(*
+Difference computes the set containing all members of the left set that are not members
+of the right set, e.g.,
+
+x IN toSet iff (x IN left) & ┬(x IN right)
+
+The algorithm, similar to that given above for union and intersection, loops over the
+items of the left and right sets until the end of either is reached.  On each iteration, the
+items are compared for the ordering relation between them.  Equal items are skipped and
+both indexes advanced, otherwise the index to the smaller item is advanced.  When the
+item from the left set is less than that of the right set we know that it is not present in
+the right set and can then copy that item over to the target set.  The last step is to copy
+the remaining items, if any, from the left set to the destination set.
+*)
+
+PROCEDURE Difference    (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left set *)
+      rightIndex  : Link;        (*-- Loop index over right set *)
+      toIndex     : Link;        (*-- List of target set nodes *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(difference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(difference, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  setRoutine := difference;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSIF (order = less) THEN
+      IF (toSet^.first = NIL) THEN
+        toSet^.first := NewNode(leftIndex^.item, NIL);
+        toIndex := toSet^.first;
+      ELSE
+        toIndex^.next := NewNode(leftIndex^.item, NIL);
+        toIndex := toIndex^.next;
+      END (*--if*);
+
+      IF (setError = overflow) THEN
+        RETURN;
+      END (*--if*);
+
+      INC(toSet^.length);
+      leftIndex  := leftIndex^.next;
+
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+
+  CopySubset(leftIndex, toIndex, toSet);
+END Difference;
+(*--------------------*)
+
+
+(*
+SymDifference computes the set containing all members of the left or right set that are
+not members of the both sets, e.g.,
+
+x IN toSet iff (x IN left) ¡ (x IN right)
+
+The algorithm, similar to that given above for union and difference, loops over the items
+of the left and right sets until the end of either is reached.  On each iteration, the items are
+compared for the ordering relation between them.  Equal items are skipped and both
+indexes advanced, otherwise the index to the smaller item is advanced.  When the items
+between the two sets are unequal we can then copy the smaller of the two items over to
+the target set.  The last step is to copy the remaining items, if any, from either the left or
+right set, whichever has items remaining, to the target set.
+*)
+
+PROCEDURE SymDifference (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left set *)
+      rightIndex  : Link;        (*-- Loop index over right set *)
+      toIndex     : Link;        (*-- List of target set nodes *)
+      tempNode    : Link;        (*-- Temporary node *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(symdifference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(symdifference, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+    assignItem  := AssignOf(dataID);
+  END (*--with*);
+
+  setRoutine := symdifference;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSE
+      Allocate(tempNode, SIZE(Node));
+      IF (tempNode = NIL) THEN
+        RaiseErrIn(symdifference, overflow);
+        RETURN;
+      END (*--if*);
+      INC(toSet^.length);
+      IF (order = less) THEN
+        tempNode^.item := assignItem(leftIndex^.item);
+        leftIndex  := leftIndex^.next;
+      ELSE
+        tempNode^.item := assignItem(rightIndex^.item);
+        rightIndex := rightIndex^.next;
+      END (*--if*);
+
+      IF (toSet^.first = NIL) THEN
+        toSet^.first := tempNode;
+      ELSE
+        toIndex^.next := tempNode;
+      END (*--if*);
+
+      toIndex := tempNode;
+    END (*--if*);
+  END (*--while*);
+
+  IF (leftIndex = NIL) THEN
+    CopySubset(rightIndex, toIndex, toSet);
+  ELSIF (rightIndex = NIL) THEN
+    CopySubset(leftIndex, toIndex, toSet);
+  END (*--if*);
+END SymDifference;
+(*--------------------*)
+
+
+
+(*
+13.4.5		Selectors
+
+IsDefined returns true if the given set is not NIL and false otherwise, which is the simple
+test for a defined set object.
+*)
+
+PROCEDURE IsDefined     (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (theSet # NIL);
+END IsDefined;
+(*--------------------*)
+
+
+(*
+IsEmpty (as always) returns the logical condition as to the state of the set's length,
+which if zero indicates an empty set.
+*)
+
+PROCEDURE IsEmpty       (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN (theSet^.length = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*--------------------*)
+
+
+PROCEDURE TypeOf        (    theSet  : Set      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*--------------------*)
+
+
+(*
+IsEqual must return true if the two given sets each contain the same items.  After
+enforcing the required preconditions, the lengths of the sets are compared in a simple test
+for inequality.  If the lengths are equal it is possible for the sets to be equal so we loop
+over each item of both sets returning false upon encountering a mismatch between two
+items.  True is returned if the loop completes without finding any mismatched items. 
+Note that because the lengths are equal, both indexes will reach the end of their respective
+set simultaneously.
+*)
+
+PROCEDURE IsEqual       (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- Loop index over left set items *)
+      rightIndex: Link; (*-- Loop index over right set items *)
+      compare   : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.length = right^.length) THEN
+
+	compare   := CompareOf(left^.dataID);
+        leftIndex := left^.first;
+        rightIndex:= right^.first;
+        WHILE (leftIndex # NIL) DO
+          IF compare(leftIndex^.item, rightIndex^.item) # equal THEN
+            RETURN FALSE;
+          END (*--if*);
+          leftIndex := leftIndex^.next;
+          rightIndex:= rightIndex^.next;
+        END (*--while*);
+        RETURN TRUE;
+      END (*--if*);
+
+    ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+
+(*
+NumMembers needs to simply return the current set length or for an undefined set return
+zero as it is impossible to have any members in such a set.
+*)
+
+PROCEDURE NumMembers    (    theSet  : Set         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.length;
+  END (*--if*);
+  RaiseErrIn(nummembers, undefined);
+  RETURN 0;
+END NumMembers;
+(*----------------------------*)
+
+
+(*
+IsAMember seeks to determine whether the given item is a member of the given set by
+scanning each of the items in the set in turn.  There are two conditions that could cause
+the loop to terminate prior to reaching the last item: (1) the item and a set item match
+indicating that the item is a member of the set, and (2) the item is greater than a set item
+indicating non-membership since the set items are linearly ordered.  If the end of the loop
+is reached and we have not exited with a match then by implication the item is not
+present.
+*)
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+                             theSet  : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index       : Link;        (*-- Loop index over items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      compareItem := CompareOf(dataID);
+      index := first;
+    END (*--with*);
+    WHILE (index # NIL) DO
+      IF (theItem = index^.item) THEN
+        RETURN TRUE;
+      ELSIF (compareItem(index^.item, theItem) = greater) THEN
+        RETURN FALSE;
+      END (*--if*);
+      index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+
+(*
+IsSubset after ensuring that the required preconditions are met, proceeds to loop through
+the items of the left and right sets attempting to determine if every member of the left set
+is also a member of the right set.  Because the items of the list are linearly ordered in
+ascending sequence, inequality can be determined more quickly than with a completely
+unordered set implementation.  When an item of the left set is less than its counterpart in
+the right set we can immediately return false knowing that that item is not present in the
+right set.  If the left item is greater we know that we must advance the index into the
+right set since the item may yet be found further into the list.  When the items are equal
+both indexes are advanced.  When the end of the loop has been reached without premature
+exit, the left set can only be a subset of the right if we have examined beyond the end of
+the left set.
+*)
+
+PROCEDURE IsSubset      (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   leftIndex   : Link;        (*-- Loop index over left set *)
+      rightIndex  : Link;        (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(issubset, undefined);
+    RETURN FALSE;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(issubset, typeerror);
+    RETURN FALSE;
+  END (*--if*);
+
+  compareItem:= CompareOf(left^.dataID);
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+    IF (order = equal) THEN
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    ELSIF (order = less) THEN
+      RETURN FALSE;
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+  RETURN (leftIndex = NIL);
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset(    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & (left^.length < right^.length);
+END IsProperSubset;
+(*----------------------------*)
+
+
+(*
+13.4.6		Module Initialization
+
+In the module initialization the local exception handlers array variables are set to default
+handlers (ExitOnError) except for the noerr handler which is given the null handler.
+setError is given the value noerr avoiding an undefined state.
+*)
+
+BEGIN
+  FOR setError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[setError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  setError := noerr;
+END SetSUMN.
+
+
+(*
+References
+
+[1]	A.V. Aho, J.E. Hopcroft, and J.D. Ullman, Data Structures and Algorithms,
+	Addison-Wesley, Reading, MA, 1983, pg. 118.
+[2]	A.M. Tenenbaum and M.J. Augenstein, Data Structures Using Pascal, Prentice-Hall,
+	Englewood Cliffs, NJ 1981.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUUI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUUI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUUI.DEF
@@ -0,0 +1,154 @@
+(*
+13	The Unbounded Set (continued)
+
+This chapter presents the unbounded implementation of the set abstraction described in
+Chapter 11.  As with the other unbounded modules, given previously, the size of the set
+structure will vary dynamically as items are added and removed.  This particular form has
+the properties: Sequential, Unbounded, Unmanaged, and Iterator.  These describe specific
+aspects of the implementation as follows:
+
+Sequential:	Can only be used in a non-tasking environment, or by only one task.
+Unbounded:	The size of a set varies dynamically as items are added and removed from
+		the set.
+Unmanaged:	Memory space for objects is returned to the system when no longer needed.
+Iterator:	Routines for looping over each of the set items are provided.
+
+The unbounded set interface follows in Section 13.7 while the actual implementation
+appears in Section 13.8.
+
+
+
+13.7	SetSUUI Interface
+*)
+
+
+DEFINITION MODULE SetSUUI;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Set
+               Sequential Unbounded Unmanaged Iterator
+
+    INTRODUCTION
+    This module provides the interface for the unbounded Set
+    abstraction for generic Items.
+
+    REVISION HISTORY
+    v1.00  30 Jan 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2. Derived from
+	  SetSUMI module.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  Set;
+CONST NullSet = Set(NIL);
+
+(*
+13.7.1			Exceptions
+*)
+
+CONST ModuleID = 9;
+
+PROCEDURE SetError    ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+(*
+13.7.2			Constructors
+*)
+
+PROCEDURE Create        (    theType : TypeID (*-- in    *))
+                                     : Set    (*-- out   *);
+
+PROCEDURE Destroy       (VAR theSet  : Set    (*-- inout *));
+
+PROCEDURE Clear         (VAR theSet  : Set    (*-- inout *));
+
+PROCEDURE Assign        (    theSet  : Set    (*-- in    *);
+                         VAR toSet   : Set    (*-- inout *));
+
+PROCEDURE Include       (    theItem : Item   (*-- in    *);
+                         VAR inSet   : Set    (*-- inout *));
+
+PROCEDURE Exclude       (    theItem : Item   (*-- in    *);
+                         VAR fromSet : Set    (*-- inout *));
+
+PROCEDURE Union         (    left    : Set    (*-- in    *);
+                             right   : Set    (*-- in    *);
+                         VAR toSet   : Set    (*-- inout *));
+
+PROCEDURE Intersection  (    left    : Set    (*-- in    *);
+                             right   : Set    (*-- in    *);
+                         VAR toSet   : Set    (*-- inout *));
+
+PROCEDURE Difference    (    left    : Set    (*-- in    *);
+                             right   : Set    (*-- in    *);
+                         VAR toSet   : Set    (*-- inout *));
+
+PROCEDURE SymDifference (    left    : Set    (*-- in    *);
+                             right   : Set    (*-- in    *);
+                         VAR toSet   : Set    (*-- inout *));
+
+(*
+13.7.3			Selectors
+*)
+
+PROCEDURE IsDefined     (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty       (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual       (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE TypeOf        (    theSet  : Set      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+
+PROCEDURE NumMembers    (    theSet  : Set      (*-- in    *))
+                                     : CARDINAL (*-- out   *);
+
+PROCEDURE IsAMember     (    theItem : Item     (*-- in    *);
+                             theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsSubset      (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsProperSubset(    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+(*
+13.7.4			Iterators
+*)
+
+PROCEDURE LoopOver   (    theSet  : Set            (*-- in    *);
+                          process : LoopAccessProc (*-- in    *));
+
+PROCEDURE Traverse   (    theSet  : Set            (*-- in    *);
+                          process : AccessProc     (*-- in    *));
+
+END SetSUUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUUI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUUI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUUI.MOD
@@ -0,0 +1,846 @@
+(*
+13.8		SetSUUI Implementation
+*)
+
+IMPLEMENTATION MODULE SetSUUI;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Set
+               Sequential Unbounded Unmanaged Iterator
+
+    INTRODUCTION
+    This module implements the unbounded Set abstraction for
+    generic Items using a linearly ordered list.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+        Initial implementation for TopSpeed Modula-2. Derived from
+	SetSUMI module.
+
+    (C) Copyright 1989 Charles A. Lins
+=============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc, AccessProc, LoopAccessProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) CompareOf;
+
+    (*--------------------*)
+
+(*
+13.8.1		Internal Unbounded Set Representation
+*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD  (*-- a set item node *)
+        item : Item; (*-- the item nodes' data *)
+        next : Link; (*-- link to next node in list *)
+	  END (*-- Node *);
+
+TYPE  UnboundedSet = RECORD (*-- set header *)
+        dataID : TypeID;    (*-- defined data type *)
+        length : CARDINAL;  (*-- current set length, := 0 *)
+        first  : Link;      (*-- link to first Item node *)
+      END (*-- UnboundedSet *);
+
+TYPE  Set = POINTER TO UnboundedSet;
+
+(*
+13.8.2		Exceptions
+*)
+
+VAR   setError  : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE SetError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN setError;
+END SetError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  setError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+(*
+13.8.3		Local Routines
+*)
+
+VAR   setRoutine : Operations;  (*-- Routine calling NewNode *)
+
+PROCEDURE NewNode       (    theItem : Item        (*-- in    *);
+       	       	             theNext : Link        (*-- in    *))
+       	       	                     : Link        (*-- out   *);
+
+VAR   newLink : Link;
+
+BEGIN
+  Allocate(newLink, SIZE(Node));
+  IF (newLink = NIL) THEN
+    RaiseErrIn(setRoutine, overflow);
+  ELSE
+    WITH newLink^ DO
+      item := theItem;
+      next := theNext;
+    END (*--with*);
+  END (*--if*);
+  RETURN newLink;
+END NewNode;
+(*--------------------*)
+
+PROCEDURE CopySubset (    fromIndex  : Link       (*-- in    *);
+                          toIndex    : Link       (*-- in    *);
+                      VAR toSet      : Set        (*-- inout *));
+
+VAR   tempNode : Link;
+
+BEGIN
+  LOOP
+    IF (fromIndex = NIL) THEN
+      EXIT (*--loop*);
+    ELSE
+      tempNode := NewNode(fromIndex^.item, NIL);
+      IF (tempNode = NIL) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+      INC(toSet^.length);
+      IF (toSet^.first = NIL) THEN
+        toSet^.first := tempNode;
+      ELSE
+        toIndex^.next := tempNode;
+      END (*--if*);
+      toIndex   := tempNode;
+      fromIndex := fromIndex^.next;
+    END (*--if*);
+  END (*--loop*);
+END CopySubset;
+(*--------------------*)
+
+PROCEDURE Recreate (    theType : TypeID    (*-- in    *);
+                    VAR theSet  : Set       (*-- inout *))
+                                : BOOLEAN   (*-- out   *);
+BEGIN
+  IF (theSet # NIL) THEN
+    Clear(theSet);
+    theSet^.dataID := theType;
+  ELSE
+    theSet := Create(theType);
+  END (*--if*);
+  RETURN (setError = noerr);
+END Recreate;
+(*--------------------*)
+
+(*
+13.8.4		Constructors
+*)
+
+PROCEDURE Create        (    theType  : TypeID    (*-- in    *))
+                                      : Set       (*-- out   *);
+
+VAR   newSet : Set; (*-- new set variable being created *)
+
+BEGIN
+  setError := noerr;
+  Allocate(newSet, SIZE(UnboundedSet));
+  IF (newSet # NIL) THEN
+    WITH newSet^ DO
+      dataID := theType;
+      length := 0;
+      first  := NIL;
+    END (*--with*);
+    RETURN newSet;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullSet;
+END Create;
+(*--------------------*)
+
+PROCEDURE Destroy       (VAR theSet   : Set       (*-- inout *));
+BEGIN
+  Clear(theSet);
+  IF (setError = noerr) THEN
+    Deallocate(theSet, SIZE(theSet^));
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+PROCEDURE Clear         (VAR theSet   : Set       (*-- inout *));
+
+VAR   theNode  : Link;        (*-- Set node to be deallocated *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      WHILE (first # NIL) DO
+        theNode := first;
+        first   := first^.next;
+        Deallocate(theNode, SIZE(theNode^));
+      END (*--while*);
+  	  length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+PROCEDURE Assign        (    theSet   : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+VAR   fromIndex : Link; (*-- Loop index over source set items *)
+      toIndex   : Link; (*-- Loop index over target set items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+
+    IF (toSet = theSet) OR ~Recreate(theSet^.dataID, toSet) THEN
+      RETURN;
+    END (*--if*);
+
+    WITH theSet^ DO
+      IF (first = NIL) THEN
+        RETURN;
+      END (*--if*);
+    END (*--with*);
+
+    setRoutine := assign;
+    WITH toSet^ DO
+      first := NewNode(theSet^.first^.item, NIL);
+      IF (setError = overflow) THEN
+        RETURN;
+      END (*--if*);
+      toIndex     := first;
+      fromIndex   := theSet^.first;
+    END (*--with*);
+
+    WHILE (fromIndex^.next # NIL) DO
+      fromIndex     := fromIndex^.next;
+      toIndex^.next := NewNode(fromIndex^.item, NIL);
+      IF (setError = overflow) THEN
+        RETURN;
+      END (*--if*);
+      toIndex := toIndex^.next;
+    END (*--while*);
+    toSet^.length := theSet^.length;
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+PROCEDURE Include       (    theItem  : Item      (*-- in    *);
+                         VAR inSet    : Set       (*-- inout *));
+
+VAR   current     : Link;        (*-- Loop index in search of theItem *)
+      previous    : Link;        (*-- Previous node examined *)
+      newNode     : Link;        (*-- For new node to add *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (inSet # NIL) THEN
+    compareItem := CompareOf(inSet^.dataID);
+    current     := inSet^.first;
+    previous    := NIL;
+    LOOP
+      IF (current = NIL) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+
+      itemOrder := compareItem(current^.item, theItem);
+
+      IF (itemOrder = equal) THEN
+        RETURN;
+
+      ELSIF (itemOrder = greater) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+
+      previous := current;
+      current  := current^.next;
+    END (*--loop*);
+
+    (*-- Insert the new item *)
+
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(include, overflow);
+    ELSE
+      newNode^.item := theItem;
+      IF (previous = NIL) THEN
+        newNode^.next := inSet^.first;
+        inSet^.first  := newNode;
+      ELSE
+        newNode^.next  := current;
+        previous^.next := newNode;
+      END (*--if*);
+      INC(inSet^.length);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*--------------------*)
+
+PROCEDURE Exclude       (    theItem  : Item      (*-- in    *);
+                         VAR fromSet  : Set       (*-- inout *));
+
+VAR   current     : Link;        (*-- Loop index over items *)
+      previous    : Link;        (*-- Previous node examined *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (fromSet # NIL) THEN
+    compareItem := CompareOf(fromSet^.dataID);
+    current     := fromSet^.first;
+    previous    := NIL;
+    LOOP
+      IF (current = NIL) THEN
+        RETURN;
+      END (*--if*);
+
+      itemOrder := compareItem(current^.item, theItem);
+
+      IF (itemOrder = equal) THEN
+        EXIT (*--loop*);
+      ELSIF (itemOrder = greater) THEN
+        RETURN;
+      END (*--if*);
+
+      previous := current;
+      current  := current^.next;
+    END (*--loop*);
+
+    (*-- ╥current╙ points to the node to be deleted. *)
+
+    IF (previous = NIL) THEN
+      fromSet^.first := current^.next;
+    ELSE
+      previous^.next := current^.next;
+    END (*--if*);
+    Deallocate(current, SIZE(current^));
+    DEC(fromSet^.length);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*--------------------*)
+
+PROCEDURE Union         (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left set *)
+      rightIndex  : Link;        (*-- Loop index over right set *)
+      toIndex     : Link;        (*-- List of target set nodes *)
+      tempNode    : Link;        (*-- Temporary node *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(union, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(union, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+  END (*--with*);
+
+  setRoutine := union;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+    Allocate(tempNode, SIZE(Node));
+    IF (tempNode = NIL) THEN
+      RaiseErrIn(union, overflow);
+      RETURN;
+    END (*--if*);
+    tempNode^.next := NIL;
+    INC(toSet^.length);
+
+    IF (order = less) THEN
+      tempNode^.item := leftIndex^.item;
+      leftIndex := leftIndex^.next;
+
+    ELSIF (order = equal) THEN
+      tempNode^.item := leftIndex^.item;
+      leftIndex := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSE
+      tempNode^.item := rightIndex^.item;
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+
+    (*-- Update the linked list *)
+
+    IF (toSet^.first = NIL) THEN
+      toSet^.first := tempNode;
+    ELSE
+      toIndex^.next := tempNode;
+    END (*--if*);
+    toIndex := tempNode;
+  END (*--while*);
+
+  IF (leftIndex = NIL) THEN
+    CopySubset(rightIndex, toIndex, toSet);
+  ELSIF (rightIndex = NIL) THEN
+    CopySubset(leftIndex, toIndex, toSet);
+  END (*--if*);
+END Union;
+(*--------------------*)
+
+PROCEDURE Intersection  (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop link over left set *)
+      rightIndex  : Link;        (*-- Loop link over right set *)
+      toIndex     : Link;        (*-- List of target set nodes *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(intersection, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(intersection, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+  END (*--with*);
+
+  setRoutine := intersection;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+      IF (toSet^.first = NIL) THEN
+        toSet^.first := NewNode(leftIndex^.item, NIL);
+        toIndex := toSet^.first;
+      ELSE
+        toIndex^.next := NewNode(leftIndex^.item, NIL);
+        toIndex := toIndex^.next;
+      END (*--if*);
+      IF (setError = overflow) THEN
+        RETURN;
+      END (*--if*);
+      INC(toSet^.length);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSIF (order = less) THEN
+      leftIndex  := leftIndex^.next;
+
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+END Intersection;
+(*--------------------*)
+
+PROCEDURE Difference    (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left set *)
+      rightIndex  : Link;        (*-- Loop index over right set *)
+      toIndex     : Link;        (*-- List of target set nodes *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(difference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(difference, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+  END (*--with*);
+
+  setRoutine := difference;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSIF (order = less) THEN
+      IF (toSet^.first = NIL) THEN
+        toSet^.first := NewNode(leftIndex^.item, NIL);
+        toIndex := toSet^.first;
+      ELSE
+        toIndex^.next := NewNode(leftIndex^.item, NIL);
+        toIndex := toIndex^.next;
+      END (*--if*);
+
+      IF (setError = overflow) THEN
+        RETURN;
+      END (*--if*);
+
+      INC(toSet^.length);
+      leftIndex  := leftIndex^.next;
+
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+
+  CopySubset(leftIndex, toIndex, toSet);
+END Difference;
+(*--------------------*)
+
+PROCEDURE SymDifference (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left set *)
+      rightIndex  : Link;        (*-- Loop index over right set *)
+      toIndex     : Link;        (*-- List of target set nodes *)
+      tempNode    : Link;        (*-- Temporary node *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(symdifference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(symdifference, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+  END (*--with*);
+
+  setRoutine := symdifference;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSE
+      Allocate(tempNode, SIZE(Node));
+      IF (tempNode = NIL) THEN
+        RaiseErrIn(symdifference, overflow);
+        RETURN;
+      END (*--if*);
+      INC(toSet^.length);
+      IF (order = less) THEN
+        tempNode^.item := leftIndex^.item;
+        leftIndex  := leftIndex^.next;
+      ELSE
+        tempNode^.item := rightIndex^.item;
+        rightIndex := rightIndex^.next;
+      END (*--if*);
+
+      IF (toSet^.first = NIL) THEN
+        toSet^.first := tempNode;
+      ELSE
+        toIndex^.next := tempNode;
+      END (*--if*);
+
+      toIndex := tempNode;
+    END (*--if*);
+  END (*--while*);
+
+  IF (leftIndex = NIL) THEN
+    CopySubset(rightIndex, toIndex, toSet);
+  ELSIF (rightIndex = NIL) THEN
+    CopySubset(leftIndex, toIndex, toSet);
+  END (*--if*);
+END SymDifference;
+(*--------------------*)
+
+(*
+13.8.5		Selectors
+*)
+
+PROCEDURE IsDefined     (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (theSet # NIL);
+END IsDefined;
+(*--------------------*)
+
+PROCEDURE IsEmpty       (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN (theSet^.length = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*--------------------*)
+
+PROCEDURE TypeOf        (    theSet  : Set      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*--------------------*)
+
+PROCEDURE IsEqual       (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- Loop index over left set items *)
+      rightIndex: Link; (*-- Loop index over right set items *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.length = right^.length) THEN
+
+        leftIndex := left^.first;
+        rightIndex:= right^.first;
+        WHILE (leftIndex # NIL) DO
+          IF (leftIndex^.item # rightIndex^.item) THEN
+            RETURN FALSE;
+          END (*--if*);
+          leftIndex := leftIndex^.next;
+          rightIndex:= rightIndex^.next;
+        END (*--while*);
+        RETURN TRUE;
+      END (*--if*);
+
+    ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE NumMembers    (    theSet  : Set         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.length;
+  END (*--if*);
+  RaiseErrIn(nummembers, undefined);
+  RETURN 0;
+END NumMembers;
+(*----------------------------*)
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+                             theSet  : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index       : Link;        (*-- Loop index over items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      compareItem := CompareOf(dataID);
+      index := first;
+    END (*--with*);
+    WHILE (index # NIL) DO
+      IF (theItem = index^.item) THEN
+        RETURN TRUE;
+      ELSIF (compareItem(index^.item, theItem) = greater) THEN
+        RETURN FALSE;
+      END (*--if*);
+      index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+PROCEDURE IsSubset      (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   leftIndex   : Link;        (*-- Loop index over left set *)
+      rightIndex  : Link;        (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(issubset, undefined);
+    RETURN FALSE;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(issubset, typeerror);
+    RETURN FALSE;
+  END (*--if*);
+
+  compareItem:= CompareOf(left^.dataID);
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+    IF (order = equal) THEN
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    ELSIF (order = less) THEN
+      RETURN FALSE;
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+  RETURN (leftIndex = NIL);
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset(    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & (left^.length < right^.length);
+END IsProperSubset;
+(*----------------------------*)
+
+(*
+13.8.6		Iterators
+*)
+
+PROCEDURE LoopOver   (    theSet  : Set            (*-- in    *);
+                          process : LoopAccessProc (*-- in    *));
+
+VAR   theNode : Link; (*-- Loop index over items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    theNode := theSet^.first;
+    WHILE (theNode # NIL) & process(theNode^.item) DO
+      theNode := theNode^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE Traverse   (    theSet  : Set            (*-- in    *);
+                          process : AccessProc     (*-- in    *));
+
+VAR   theNode : Link; (*-- Loop index over items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    theNode := theSet^.first;
+    WHILE (theNode # NIL) DO
+      process(theNode^.item);
+      theNode := theNode^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+(*
+13.8.7		Module Initialization
+*)
+
+BEGIN
+  FOR setError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[setError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  setError := noerr;
+END SetSUUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUUN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUUN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUUN.DEF
@@ -0,0 +1,152 @@
+(*
+13			The Unbounded Set (continued)
+
+This chapter presents the unbounded, unmanaged implementation of the set abstraction described in
+Chapter 11.  As with the other unbounded modules, given previously, the size of the set
+structure varies dynamically as items are added and removed.  This particular form has
+the properties: Sequential, Unbounded, Unmanaged, and Non-Iterator.  These describe specific
+aspects of the implementation as follows:
+
+Sequential:	Can only be used in a non-tasking environment, or by only one task.
+Unbounded:	The size of a set varies dynamically as items are added and removed from
+		the set.
+Unmanaged:	Memory space for objects is returned to the system when no longer needed.
+		Note that Items are not managed.
+Non-Iterator:	Routines for looping over each of the set items are not provided.
+
+The unbounded set interface follows in Section 13.5 while the actual implementation
+appears in Section 13.6.
+
+The TypeManager module is needed for the implementation which uses an ordered list. So
+comparison is needed but assignment and disposal are not.
+
+
+
+13.5		SetSUUN Interface
+*)
+
+
+DEFINITION MODULE SetSUUN;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Set
+               Sequential Unbounded Unmanaged Non-Iterator
+
+    INTRODUCTION
+    This module provides the interface for the unbounded Set
+    abstraction for generic Items.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2. Derived from
+	  SetSUMN module.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Proc*) HandlerProc;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  Set;
+CONST NullSet = Set(NIL);
+
+
+(*
+13.5.1			Exceptions
+*)
+
+CONST ModuleID = 10;
+
+PROCEDURE SetError    ()             : Exceptions  (*--out  *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*--in   *);
+                           toHandler : HandlerProc (*--in   *));
+
+
+(*
+13.5.2			Constructors
+*)
+
+PROCEDURE Create        (    theType : TypeID (*--in   *))
+                                     : Set    (*--out  *);
+
+PROCEDURE Destroy       (VAR theSet  : Set    (*--inout*));
+
+PROCEDURE Clear         (VAR theSet  : Set    (*--inout*));
+
+PROCEDURE Assign        (    theSet  : Set    (*--in   *);
+                         VAR toSet   : Set    (*--inout*));
+
+PROCEDURE Include       (    theItem : Item   (*--in   *);
+                         VAR inSet   : Set    (*--inout*));
+
+PROCEDURE Exclude       (    theItem : Item   (*--in   *);
+                         VAR fromSet : Set    (*--inout*));
+
+PROCEDURE Union         (    left    : Set    (*--in   *);
+                             right   : Set    (*--in   *);
+                         VAR toSet   : Set    (*--inout*));
+
+PROCEDURE Intersection  (    left    : Set    (*--in   *);
+                             right   : Set    (*--in   *);
+                         VAR toSet   : Set    (*--inout*));
+
+PROCEDURE Difference    (    left    : Set    (*--in   *);
+                             right   : Set    (*--in   *);
+                         VAR toSet   : Set    (*--inout*));
+
+PROCEDURE SymDifference (    left    : Set    (*--in   *);
+                             right   : Set    (*--in   *);
+                         VAR toSet   : Set    (*--inout*));
+
+
+
+(*
+13.5.3			Selectors
+*)
+
+PROCEDURE IsDefined     (    theSet  : Set      (*--in   *))
+                                     : BOOLEAN  (*--out  *);
+
+PROCEDURE IsEmpty       (    theSet  : Set      (*--in   *))
+                                     : BOOLEAN  (*--out  *);
+
+PROCEDURE TypeOf        (    theSet  : Set      (*--in   *))
+                                     : TypeID   (*--out  *);
+
+PROCEDURE IsEqual       (    left    : Set      (*--in   *);
+                             right   : Set      (*--in   *))
+                                     : BOOLEAN  (*--out  *);
+
+PROCEDURE NumMembers    (    theSet  : Set      (*--in   *))
+                                     : CARDINAL (*--out  *);
+
+PROCEDURE IsAMember     (    theItem : Item     (*--in   *);
+                             theSet  : Set      (*--in   *))
+                                     : BOOLEAN  (*--out  *);
+
+PROCEDURE IsSubset      (    left    : Set      (*--in   *);
+                             right   : Set      (*--in   *))
+                                     : BOOLEAN  (*--out  *);
+
+PROCEDURE IsProperSubset(    left    : Set      (*--in   *);
+                             right   : Set      (*--in   *))
+                                     : BOOLEAN  (*--out  *);
+
+END SetSUUN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUUN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUUN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/SETS/SETSUUN.MOD
@@ -0,0 +1,806 @@
+(*
+13.4		SetSUUN Implementation
+*)
+
+IMPLEMENTATION MODULE SetSUUN;
+(*==========================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Set
+               Sequential Unbounded Unmanaged Non-Iterator
+
+    INTRODUCTION
+    This module implements the unbounded Set abstraction for
+    generic Items using a linearly ordered list.
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2. Derived from
+	  SetSUMN module.
+
+    (C) Copyright 1989 Charles A. Lins
+=============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM SetEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) CompareOf;
+
+    (*--------------------*)
+
+(*
+13.6.1		Internal Unbounded Set Representation
+*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD  (*-- a set item node *)
+        item : Item; (*-- the item nodes' data *)
+        next : Link; (*-- link to next node in list *)
+	  END (*-- Node *);
+
+TYPE  UnboundedSet = RECORD (*-- set header *)
+        dataID : TypeID;    (*-- defined data type *)
+        length : CARDINAL;  (*-- current set length, := 0 *)
+        first  : Link;      (*-- link to first Item node *)
+      END (*-- UnboundedSet *);
+
+TYPE  Set = POINTER TO UnboundedSet;
+
+
+(*
+13.6.2		Exceptions
+*)
+
+VAR   setError  : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE SetError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN setError;
+END SetError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := toHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  setError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+(*
+13.6.3		Local Routines
+*)
+
+VAR   setRoutine : Operations;  (*-- Routine calling NewNode *)
+
+PROCEDURE NewNode       (    theItem : Item        (*-- in    *);
+       	       	             theNext : Link        (*-- in    *))
+       	       	                     : Link        (*-- out   *);
+
+VAR   newLink : Link;
+
+BEGIN
+  Allocate(newLink, SIZE(Node));
+  IF (newLink = NIL) THEN
+    RaiseErrIn(setRoutine, overflow);
+  ELSE
+    WITH newLink^ DO
+      item := theItem;
+      next := theNext;
+    END (*--with*);
+  END (*--if*);
+  RETURN newLink;
+END NewNode;
+(*--------------------*)
+
+PROCEDURE CopySubset (    fromIndex  : Link       (*-- in    *);
+                          toIndex    : Link       (*-- in    *);
+                      VAR toSet      : Set        (*-- inout *));
+
+VAR   tempNode : Link;
+
+BEGIN
+  LOOP
+    IF (fromIndex = NIL) THEN
+      EXIT (*--loop*);
+    ELSE
+      tempNode := NewNode(fromIndex^.item, NIL);
+      IF (tempNode = NIL) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+      INC(toSet^.length);
+      IF (toSet^.first = NIL) THEN
+        toSet^.first := tempNode;
+      ELSE
+        toIndex^.next := tempNode;
+      END (*--if*);
+      toIndex   := tempNode;
+      fromIndex := fromIndex^.next;
+    END (*--if*);
+  END (*--loop*);
+END CopySubset;
+(*--------------------*)
+
+PROCEDURE Recreate (    theType : TypeID    (*-- in    *);
+                    VAR theSet  : Set       (*-- inout *))
+                                : BOOLEAN   (*-- out   *);
+BEGIN
+  IF (theSet # NIL) THEN
+    Clear(theSet);
+    theSet^.dataID := theType;
+  ELSE
+    theSet := Create(theType);
+  END (*--if*);
+  RETURN (setError = noerr);
+END Recreate;
+(*--------------------*)
+
+(*
+13.6.4		Constructors
+*)
+
+PROCEDURE Create        (    theType  : TypeID    (*-- in    *))
+                                      : Set       (*-- out   *);
+
+VAR   newSet : Set; (*-- new set variable being created *)
+
+BEGIN
+  setError := noerr;
+  Allocate(newSet, SIZE(UnboundedSet));
+  IF (newSet # NIL) THEN
+    WITH newSet^ DO
+      dataID := theType;
+      length := 0;
+      first  := NIL;
+    END (*--with*);
+    RETURN newSet;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullSet;
+END Create;
+(*--------------------*)
+
+PROCEDURE Destroy       (VAR theSet   : Set       (*-- inout *));
+BEGIN
+  Clear(theSet);
+  IF (setError = noerr) THEN
+    Deallocate(theSet, SIZE(theSet^));
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+PROCEDURE Clear         (VAR theSet   : Set       (*-- inout *));
+
+VAR   theNode  : Link;        (*-- Set node to be deallocated *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      WHILE (first # NIL) DO
+        theNode := first;
+        first   := first^.next;
+        Deallocate(theNode, SIZE(theNode^));
+      END (*--while*);
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+PROCEDURE Assign        (    theSet   : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+VAR   fromIndex : Link; (*-- Loop index over source set items *)
+      toIndex   : Link; (*-- Loop index over target set items *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+
+    IF (toSet = theSet) OR ~Recreate(theSet^.dataID, toSet) THEN
+      RETURN;
+    END (*--if*);
+
+    WITH theSet^ DO
+      IF (first = NIL) THEN
+        RETURN;
+      END (*--if*);
+    END (*--with*);
+
+    setRoutine := assign;
+    WITH toSet^ DO
+      first := NewNode(theSet^.first^.item, NIL);
+      IF (setError = overflow) THEN
+        RETURN;
+      END (*--if*);
+      toIndex     := first;
+      fromIndex   := theSet^.first;
+    END (*--with*);
+
+    WHILE (fromIndex^.next # NIL) DO
+      fromIndex     := fromIndex^.next;
+      toIndex^.next := NewNode(fromIndex^.item, NIL);
+      IF (setError = overflow) THEN
+        RETURN;
+      END (*--if*);
+      toIndex := toIndex^.next;
+    END (*--while*);
+    toSet^.length := theSet^.length;
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+PROCEDURE Include       (    theItem  : Item      (*-- in    *);
+                         VAR inSet    : Set       (*-- inout *));
+
+VAR   current     : Link;        (*-- Loop index in search of theItem *)
+      previous    : Link;        (*-- Previous node examined *)
+      newNode     : Link;        (*-- For new node to add *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (inSet # NIL) THEN
+    compareItem := CompareOf(inSet^.dataID);
+    current     := inSet^.first;
+    previous    := NIL;
+    LOOP
+      IF (current = NIL) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+
+      itemOrder := compareItem(current^.item, theItem);
+
+      IF (itemOrder = equal) THEN
+        RETURN;
+
+      ELSIF (itemOrder = greater) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+
+      previous := current;
+      current  := current^.next;
+    END (*--loop*);
+
+    (*-- Insert the new item *)
+
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(include, overflow);
+    ELSE
+      newNode^.item := theItem;
+      IF (previous = NIL) THEN
+        newNode^.next := inSet^.first;
+        inSet^.first  := newNode;
+      ELSE
+        newNode^.next  := current;
+        previous^.next := newNode;
+      END (*--if*);
+      INC(inSet^.length);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(include, undefined);
+  END (*--if*);
+END Include;
+(*--------------------*)
+
+PROCEDURE Exclude       (    theItem  : Item      (*-- in    *);
+                         VAR fromSet  : Set       (*-- inout *));
+
+VAR   current     : Link;        (*-- Loop index over items *)
+      previous    : Link;        (*-- Previous node examined *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      itemOrder   : Relation;    (*-- Relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (fromSet # NIL) THEN
+    compareItem := CompareOf(fromSet^.dataID);
+    current     := fromSet^.first;
+    previous    := NIL;
+    LOOP
+      IF (current = NIL) THEN
+        RETURN;
+      END (*--if*);
+
+      itemOrder := compareItem(current^.item, theItem);
+
+      IF (itemOrder = equal) THEN
+        EXIT (*--loop*);
+      ELSIF (itemOrder = greater) THEN
+        RETURN;
+      END (*--if*);
+
+      previous := current;
+      current  := current^.next;
+    END (*--loop*);
+
+    (*-- ╥current╙ points to the node to be deleted. *)
+
+    IF (previous = NIL) THEN
+      fromSet^.first := current^.next;
+    ELSE
+      previous^.next := current^.next;
+    END (*--if*);
+    Deallocate(current, SIZE(current^));
+    DEC(fromSet^.length);
+  ELSE
+    RaiseErrIn(exclude, undefined);
+  END (*--if*);
+END Exclude;
+(*--------------------*)
+
+PROCEDURE Union         (    left     : Set       (*-- in    *);
+                             right    : Set       (*-- in    *);
+                         VAR toSet    : Set       (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left set *)
+      rightIndex  : Link;        (*-- Loop index over right set *)
+      toIndex     : Link;        (*-- List of target set nodes *)
+      tempNode    : Link;        (*-- Temporary node *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(union, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(union, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, toSet) THEN
+	  RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+  END (*--with*);
+
+  setRoutine := union;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+    Allocate(tempNode, SIZE(Node));
+    IF (tempNode = NIL) THEN
+      RaiseErrIn(union, overflow);
+      RETURN;
+    END (*--if*);
+    tempNode^.next := NIL;
+    INC(toSet^.length);
+
+    IF (order = less) THEN
+      tempNode^.item := leftIndex^.item;
+      leftIndex := leftIndex^.next;
+
+    ELSIF (order = equal) THEN
+      tempNode^.item := leftIndex^.item;
+      leftIndex := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSE
+      tempNode^.item := rightIndex^.item;
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+
+    (*-- Update the linked list *)
+
+    IF (toSet^.first = NIL) THEN
+      toSet^.first := tempNode;
+    ELSE
+      toIndex^.next := tempNode;
+    END (*--if*);
+    toIndex := tempNode;
+  END (*--while*);
+
+  IF (leftIndex = NIL) THEN
+    CopySubset(rightIndex, toIndex, toSet);
+  ELSIF (rightIndex = NIL) THEN
+    CopySubset(leftIndex, toIndex, toSet);
+  END (*--if*);
+END Union;
+(*--------------------*)
+
+PROCEDURE Intersection  (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop link over left set *)
+      rightIndex  : Link;        (*-- Loop link over right set *)
+      toIndex     : Link;        (*-- List of target set nodes *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(intersection, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(intersection, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+ 
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+  END (*--with*);
+
+  setRoutine := intersection;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+      IF (toSet^.first = NIL) THEN
+        toSet^.first := NewNode(leftIndex^.item, NIL);
+        toIndex := toSet^.first;
+      ELSE
+        toIndex^.next := NewNode(leftIndex^.item, NIL);
+        toIndex := toIndex^.next;
+      END (*--if*);
+      IF (setError = overflow) THEN
+        RETURN;
+      END (*--if*);
+      INC(toSet^.length);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSIF (order = less) THEN
+      leftIndex  := leftIndex^.next;
+
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+END Intersection;
+(*--------------------*)
+
+PROCEDURE Difference    (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left set *)
+      rightIndex  : Link;        (*-- Loop index over right set *)
+      toIndex     : Link;        (*-- List of target set nodes *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(difference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(difference, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+  END (*--with*);
+
+  setRoutine := difference;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSIF (order = less) THEN
+      IF (toSet^.first = NIL) THEN
+        toSet^.first := NewNode(leftIndex^.item, NIL);
+        toIndex := toSet^.first;
+      ELSE
+        toIndex^.next := NewNode(leftIndex^.item, NIL);
+        toIndex := toIndex^.next;
+      END (*--if*);
+
+      IF (setError = overflow) THEN
+        RETURN;
+      END (*--if*);
+
+      INC(toSet^.length);
+      leftIndex  := leftIndex^.next;
+
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+
+  CopySubset(leftIndex, toIndex, toSet);
+END Difference;
+(*--------------------*)
+
+PROCEDURE SymDifference (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *);
+                         VAR toSet   : Set         (*-- inout *));
+
+VAR   leftIndex   : Link;        (*-- Loop index over left set *)
+      rightIndex  : Link;        (*-- Loop index over right set *)
+      toIndex     : Link;        (*-- List of target set nodes *)
+      tempNode    : Link;        (*-- Temporary node *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(symdifference, undefined);
+    RETURN;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(symdifference, typeerror);
+    RETURN;
+  ELSIF ~Recreate(left^.dataID, toSet) THEN
+    RETURN;
+  END (*--if*);
+
+  WITH toSet^ DO
+    compareItem := CompareOf(dataID);
+  END (*--with*);
+
+  setRoutine := symdifference;
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+
+    IF (order = equal) THEN
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+
+    ELSE
+      Allocate(tempNode, SIZE(Node));
+      IF (tempNode = NIL) THEN
+        RaiseErrIn(symdifference, overflow);
+        RETURN;
+      END (*--if*);
+      INC(toSet^.length);
+      IF (order = less) THEN
+        tempNode^.item := leftIndex^.item;
+        leftIndex  := leftIndex^.next;
+      ELSE
+        tempNode^.item := rightIndex^.item;
+        rightIndex := rightIndex^.next;
+      END (*--if*);
+
+      IF (toSet^.first = NIL) THEN
+        toSet^.first := tempNode;
+      ELSE
+        toIndex^.next := tempNode;
+      END (*--if*);
+
+      toIndex := tempNode;
+    END (*--if*);
+  END (*--while*);
+
+  IF (leftIndex = NIL) THEN
+    CopySubset(rightIndex, toIndex, toSet);
+  ELSIF (rightIndex = NIL) THEN
+    CopySubset(leftIndex, toIndex, toSet);
+  END (*--if*);
+END SymDifference;
+(*--------------------*)
+
+(*
+13.6.5		Selectors
+*)
+
+PROCEDURE IsDefined     (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (theSet # NIL);
+END IsDefined;
+(*--------------------*)
+
+PROCEDURE IsEmpty       (    theSet  : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN (theSet^.length = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*--------------------*)
+
+PROCEDURE TypeOf        (    theSet  : Set      (*-- in    *))
+                                     : TypeID   (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*--------------------*)
+
+PROCEDURE IsEqual       (    left    : Set      (*-- in    *);
+                             right   : Set      (*-- in    *))
+                                     : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- Loop index over left set items *)
+      rightIndex: Link; (*-- Loop index over right set items *)
+
+BEGIN
+  setError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.length = right^.length) THEN
+
+        leftIndex := left^.first;
+        rightIndex:= right^.first;
+        WHILE (leftIndex # NIL) DO
+          IF (leftIndex^.item # rightIndex^.item) THEN
+            RETURN FALSE;
+          END (*--if*);
+          leftIndex := leftIndex^.next;
+          rightIndex:= rightIndex^.next;
+        END (*--while*);
+        RETURN TRUE;
+      END (*--if*);
+
+    ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE NumMembers    (    theSet  : Set         (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    RETURN theSet^.length;
+  END (*--if*);
+  RaiseErrIn(nummembers, undefined);
+  RETURN 0;
+END NumMembers;
+(*----------------------------*)
+
+PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
+                             theSet  : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index       : Link;        (*-- Loop index over items *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+
+BEGIN
+  setError := noerr;
+  IF (theSet # NIL) THEN
+    WITH theSet^ DO
+      compareItem := CompareOf(dataID);
+      index := first;
+    END (*--with*);
+    WHILE (index # NIL) DO
+      IF (theItem = index^.item) THEN
+        RETURN TRUE;
+      ELSIF (compareItem(index^.item, theItem) = greater) THEN
+        RETURN FALSE;
+      END (*--if*);
+      index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(ismember, undefined);
+  END (*--if*);
+
+  RETURN FALSE;
+END IsAMember;
+(*----------------------------*)
+
+PROCEDURE IsSubset      (    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   leftIndex   : Link;        (*-- Loop index over left set *)
+      rightIndex  : Link;        (*-- Loop index over right set *)
+      compareItem : CompareProc; (*-- Item comparison routine *)
+      order       : Relation;    (*-- Ordering relation between items *)
+
+BEGIN
+  setError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(issubset, undefined);
+    RETURN FALSE;
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(issubset, typeerror);
+    RETURN FALSE;
+  END (*--if*);
+
+  compareItem:= CompareOf(left^.dataID);
+  leftIndex  := left^.first;
+  rightIndex := right^.first;
+
+  WHILE (leftIndex # NIL) & (rightIndex # NIL) DO
+    order := compareItem(leftIndex^.item, rightIndex^.item);
+    IF (order = equal) THEN
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    ELSIF (order = less) THEN
+      RETURN FALSE;
+    ELSE
+      rightIndex := rightIndex^.next;
+    END (*--if*);
+  END (*--while*);
+  RETURN (leftIndex = NIL);
+END IsSubset;
+(*----------------------------*)
+
+PROCEDURE IsProperSubset(    left    : Set         (*-- in    *);
+                             right   : Set         (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN IsSubset(left, right) & (left^.length < right^.length);
+END IsProperSubset;
+(*----------------------------*)
+
+
+(*
+13.6.6		Module Initialization
+*)
+
+BEGIN
+  FOR setError := MIN(Exceptions) TO MAX(Exceptions) DO
+    handlers[setError] := ExitOnError;
+  END (*--for*);
+  handlers[noerr] := NullHandler;
+  setError := noerr;
+END SetSUUN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STACKENU.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STACKENU.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STACKENU.DEF
@@ -0,0 +1,62 @@
+DEFINITION MODULE StackEnum; 
+(*==============================================================
+    Version  : 1.05  16 Apr 1989  C. Lins
+    Compiler : Bob Campbell's MPW Modula-2 Compiler
+    Component: Stack Structure Utility - Standard Enumerations
+
+    THE ABSTRACTION
+    This module provides centralized definitions of the operations
+    and exceptions for all stack modules.
+
+    REVISION HISTORY
+    v1.04  07 Jan 1988  C. Lins:
+        Initial TML Modula-2 implementation
+    v1.05  16 Apr 1989  C. Lins:
+        Added ComponentID constant.
+==============================================================*)
+
+CONST ComponentID = 256;
+
+    (*---------------------------------*)
+    (*--       STACK OPERATIONS      --*)
+
+TYPE  Operations = (
+                    (*-- Module Initialization *)
+                    modinit,
+
+                    (*-- Constructors *)
+                    create, destroy, clear, assign, push, pop, poptopof,
+
+                    (*-- Selectors *)
+                    isdefined, isempty, isequal, sizeof, typeof,
+                    topof, depthof,
+
+                    (*-- Iterators *)
+                    loopover, loopchange, traverse, travchange,
+
+                    (*-- Guarded Concurrent Operations *)
+                    seize, release
+                   );
+
+TYPE  Constructors = Operations [ create    .. poptopof   ];
+TYPE  Selectors    = Operations [ isdefined .. depthof    ];
+TYPE  Iterators    = Operations [ loopover  .. travchange ];
+TYPE  GuardedOps   = Operations [ seize     .. release    ];
+
+
+    (*---------------------------------*)
+    (*--      STACK EXCEPTIONS       --*)
+
+TYPE  Exceptions = (noerr,      (*-- Nothing went wrong, all's well. *)
+                    initfailed, (*-- Module initialization failure. *)
+                    overflow,   (*-- Stack cannot grow big enough for
+                                  -- the requested operation. *)
+                    typeerror,  (*-- Type mismatch between stacks *)
+                    undefined,  (*-- Stack has not been Created. Or
+                                  -- the stack has been Destroyed. *)
+                    underflow   (*-- Stack is already empty. *)
+                   );
+
+TYPE  ExceptionSet = SET OF Exceptions;
+
+END StackEnum.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STACKENU.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STACKENU.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STACKENU.MOD
@@ -0,0 +1,19 @@
+IMPLEMENTATION MODULE StackEnum; 
+(*====================================================================
+    Version  : 1.04  07 Jan 1988  C. Lins
+    Compiler : TML Modula-2 Compiler for the Apple Macintosh
+    Code Size: R+ 32 bytes, R- 32 bytes
+    Component: Stack Structure Utility - Standard Enumerations
+
+    THE ABSTRACTION
+    This module provides centralized definitions of the operations
+    and exceptions for all stack modules.
+
+    REVISION HISTORY
+    v1.00  17 Dec 1987  C. Lins:
+        Initial TML Modula-2 implementation
+    v1.04  07 Jan 1988  C. Lins:
+        Recompiled due to changes in DEF module.
+====================================================================*)
+
+END StackEnum.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKHANDL.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKHANDL.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKHANDL.DEF
@@ -0,0 +1,30 @@
+(*
+This module provides a simple exception handler for the
+various Stack abstractions. Given an error code, it reports
+the exception to standard output in the following format:
+### Error "<error text>" raised in Routine "<routine name>" in Module <module #>
+
+The system beep is made before issuing the message and a WriteLn
+follows the message display.
+
+*)
+
+DEFINITION MODULE StkHandlers;
+(*==============================================================
+    Version  : 1.00  28 Apr 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Stack Exception Handlers Utility
+
+    REVISION HISTORY
+    v1.00  28 Apr 1989  C. Lins:
+        Initial implementation
+==============================================================*)
+
+FROM StackEnum IMPORT
+  (*--type*) Operations, Exceptions;
+
+PROCEDURE WriteHandler (    theModule : CARDINAL  (*--in   *);
+                            theOperation : Operations (*--in   *);
+                            theException : Exceptions (*--in   *));
+
+END StkHandlers.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKHANDL.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKHANDL.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKHANDL.MOD
@@ -0,0 +1,68 @@
+IMPLEMENTATION MODULE StkHandlers;
+(*==============================================================
+    Version  : 1.00  28 Apr 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Stack Exception Handlers Utility
+
+    REVISION HISTORY
+    v1.00  28 Apr 1989  C. Lins:
+        Initial implementation
+==============================================================*)
+
+FROM StackEnum IMPORT
+	(*--type*) Exceptions, Operations;
+
+
+FROM IO IMPORT
+	(*--proc*) WrStr, WrLn, WrCard;
+
+
+PROCEDURE WriteHandler (    theModule 	: CARDINAL;
+	  	theOperation: Operations;
+	  	theException: Exceptions);
+
+BEGIN
+  WrStr('### Error "');
+
+  CASE theException OF
+    noerr     : WrStr('No Error');
+  | initfailed: WrStr('Initialization failure');
+  | typeerror : WrStr('Type mismatch between Stacks');
+  | overflow  : WrStr('Stack Overflow');
+  | underflow : WrStr('Stack Underflow');
+  | undefined : WrStr('Undefined Stack');
+  END (*--case*);
+
+  WrStr('" raised in Routine "');
+
+  CASE theOperation OF
+    assign   : WrStr('Assign');
+  | create   : WrStr('Create');
+  | destroy  : WrStr('Destroy');
+  | clear    : WrStr('Clear');
+  | push     : WrStr('Push');
+  | pop      : WrStr('Pop');
+  | poptopof : WrStr('PopTopOf');
+
+  | isempty    : WrStr('IsEmpty');
+  | isequal    : WrStr('IsEqual');
+  | typeof     : WrStr('TypeOf');
+  | sizeof     : WrStr('SizeOf');
+  | topof      : WrStr('TopOf');
+  | depthof    : WrStr('DepthOf');
+	
+  | loopover   : WrStr('LoopOver');
+  | loopchange : WrStr('LoopChange');
+  | traverse   : WrStr('Traverse');
+  | travchange : WrStr('TravChange');
+	
+  ELSE
+    WrStr('?????');
+  END (*--case*);
+
+  WrStr('" in Module ');
+  WrCard(theModule, 1);
+  WrLn;
+END WriteHandler;
+
+END StkHandlers.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBMI.DEF
@@ -0,0 +1,236 @@
+(*
+6.2	StackSBMI Interface
+
+The interface to the bounded stack is presented below.  The purpose and implementation
+specifics of each routine is briefly described along with mention of the complexity
+measure of the actual implementation.
+*)
+
+
+DEFINITION MODULE StkSBMI;
+
+(*==========================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Stack (Opaque version)
+               Sequential Bounded Managed Iterator
+
+    INTRODUCTION
+    This module provides the definition of the bounded stack
+    composed of generic Items.
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+      Initial implementation
+==========================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc, ChangeProc,
+               LoopChangeProc;
+
+FROM StackEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+    (*-----------------------*)
+
+TYPE  Stack;
+TYPE  SizeRange  = [1..8100];
+
+CONST NullStack  = Stack(NIL);
+
+
+(*
+6.2.1	Exceptions
+
+The ModuleID  is used by the exception handling mechanism to distinguish this module
+from other modules.
+
+StackError  returns the exception code from the most recent stack operation.  A result of
+noerr indicates successful completion of the operation. O(1).
+
+GetHandler returns the exception handler routine associated with the given exception.
+Though the routine is a function procedure returning a procedure as its result, the
+HandlerProc may not be called from within the GetHandler call itself. The procedure
+result must be first assigned to a procedure variable before invocation. Exception handlers
+are given an initial value of ExitOnError except for the handler for noerr which is
+initialized to the null exception handler. O(1).
+
+SetHandler associates an exception handler routine with the given exception and is the
+inverse of GetHandler.  This routine may be used to override the default settings for the
+exception handlers. O(1).
+*)
+
+CONST ModuleID = 1;
+
+PROCEDURE StackError ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+
+(*
+6.2.2	Constructors
+
+The Create operation attempts to generate a new, empty stack of the given maximum
+size (theSize) and Item operations associated with the given data type identifier (theType).
+
+For the bounded form of stack, it is necessary to define the maximum depth desired and
+this is done using theSize parameter.  The TypeID is the method by which Items of any
+data type are supported.  Using theType, the component can assign one item to another
+and release any dynamically allocated resources associated with an Item without
+knowledge of the Item's internal composition.  In this way, one may create a stack whose
+items consist of other (dynamically allocated) structures, as well as stacks consisting of
+the basic data types.  Create returns the new stack upon successful completion of the
+routine.  If it is not possible for the stack to be created, the exception overflow is raised
+and the constant NullStack  is returned. O(1).
+
+Destroy  takes the given stack, clears it of any items, and then destroys the stack itself.
+Where Create makes a defined stack, Destroy is its inverse, making the stack undefined.
+O(1).
+
+Clear  takes the given stack and removes all of its items.  theType attribute of the stack
+(assigned when the stack was created) is used to retrieve the item deallocation routine for
+the items of the stack.  Clearing the stack returns it to the empty state. O(n).
+
+The Assign  operation attempts to generate a duplicate of the source stack (theStack) in
+the target stack (toStack).  The target stack is automatically created using the size and data
+type attributes of the source stack, if necessary.  If this step is unnecessary, (the target
+stack has already been previously created), the target is cleared of its present contents, its
+data type is set to that of the source stack but the size is left unchanged. O(n).
+
+There is no guarantee that the client module would desire the target stack to be defined
+with the same size as the source.  The minimum requirement for the target stack size is
+that it must be capable of storing all of the items present in the source stack.  It may be
+desirable that the target stack size be greater than the source stack size.  Such a situation
+could occur during error recovery of a bounded stack overflow caused by the stack depth
+encountering the stack size, and the client module may effectively attempt to increase the
+the stack size using the assignment mechanism.
+
+In order to allow Items of any data type, a method must be provided to assign the contents
+of one item to another item.  This is accomplished, as above for Create, through the
+TypeID of the source stack.
+
+The Push  operation adds items to the given stack.  The given item is placed on the stack
+top.  If the depth is already at its maximum size for the given stack the overflow
+exception will be raised and the stack remains unchanged. O(1).
+
+The Pop  operation removes the topmost item from the given stack.  If the given stack is
+empty on entry to Pop  the underflow  exception will be raised and the stack remains
+unchanged. O(1).
+
+PopTopOf  is a convenience routine combining the semantics of the constructor Pop and
+the selector TopOf.  The only difference from Pop is that the item's value is not disposed
+of, but is returned instead. O(1).
+*)
+
+
+PROCEDURE Create    (    theSize   : SizeRange (*-- in    *);
+                         theType   : TypeID    (*-- in    *))
+                                   : Stack     (*-- out   *);
+
+PROCEDURE Destroy   (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE Clear     (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE Assign    (    theStack  : Stack     (*-- in    *);
+                     VAR toStack   : Stack     (*-- inout *));
+
+PROCEDURE Push      (VAR toStack   : Stack     (*-- inout *);
+                         theItem   : Item      (*-- in    *));
+
+PROCEDURE Pop       (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE PopTopOf  (VAR theStack  : Stack     (*-- inout *))
+                                   : Item      (*-- out   *);
+
+
+(*
+6.2.3	Selectors
+
+IsDefined  attempts to determine whether the given stack is valid, e.g., has been created
+and not yet destroyed.  How this is accomplished may be as simple or complicated as the
+implementor desires and the requirements of the application. O(1).
+
+IsEmpty  returns true if the given stack contains no items; in other words, its depth is
+zero.  Undefined stacks are always considered empty. O(1).
+
+IsEqual  returns true if the left and right stacks contain the same items.  Obviously, both
+must also have the same data type and have been created.  An undefined stack is not equal
+to any other stack, including itself. O(n).
+
+The routines SizeOf  and TypeOf  return the values given the stack when it was created,
+and both are provided so the user of the module need not maintain separate variables
+recording this information. O(1).
+
+DepthOf  returns the number of items present on the given stack.  Undefined stacks are
+considered to have a depth of zero. O(1).
+
+TopOf  returns the item at the current stack top.  If the stack is empty a stack underflow
+occurs and the NullItem is returned (since some Item must be).  Undefined stacks also
+cause the NullItem to be returned. O(1).
+*)
+
+PROCEDURE IsDefined (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE IsEmpty   (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE IsEqual   (    left      : Stack     (*-- in    *);
+                         right     : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE SizeOf    (    theStack  : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+
+PROCEDURE TypeOf    (    theStack  : Stack     (*-- in    *))
+                                   : TypeID    (*-- out   *);
+
+PROCEDURE DepthOf   (    theStack  : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+
+PROCEDURE TopOf     (    theStack  : Stack     (*-- in    *))
+                                   : Item      (*-- out   *);
+
+
+(*
+6.2.4	Iterators
+
+The iterator routines LoopOver and LoopChange provide facilities for looping over some
+or all items of a stack, with read-only and read-write access to each item, respectively.
+theProcess  procedure parameter to these routines return a BOOLEAN function result
+where TRUE allows the iteration to proceed to the next item and FALSE causes the
+iteration to be terminated. O(n).
+
+Traverse  and TravChange iterators provide facilities for looping over all items of a stack,
+with read-only and read-write access to each item, respectively. O(n).
+
+All four iterators traverse the given stack from the topmost item towards the bottom of
+the stack.  Obviously, if given an empty stack the processing procedure will not be
+invoked.
+*)
+
+PROCEDURE LoopOver   (    theStack  : Stack          (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE LoopChange (    theStack  : Stack          (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+PROCEDURE Traverse   (    theStack  : Stack          (*-- in    *);
+                          theProcess: AccessProc     (*-- in    *));
+
+PROCEDURE TravChange (    theStack  : Stack          (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+END StkSBMI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBMI.MOD
@@ -0,0 +1,631 @@
+(*
+6.3	StackSBMI Implementation
+*)
+
+
+IMPLEMENTATION MODULE StkSBMI;
+(*==========================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Code Size: R- 2356 bytes
+    Component: Monolithic Structures - Stack (Opaque)
+               Sequential Bounded Managed Iterator
+
+    INTRODUCTION
+    This module provides the implementation of the bounded stack
+    composed of generic Items.
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins
+        Initial implementation for TML Modula-2.
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem, NoDisposeProc,
+    (*--Type*) Item, AssignProc, DisposeProc, AccessProc,
+               ChangeProc, LoopAccessProc, LoopChangeProc,
+			   CompareProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StackEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+
+(*
+6.3.1	Internal Representation
+
+Figure 6.1
+
+For the internal representation of a bounded stack a record is dynamically allocated on the
+heap.  This record will be made just large enough to hold the declared maximum size of
+the stack.  Though the items array type declaration covers the maximum allowed size
+range of a bounded stack, only size entries are actually allocated.  This technique allows
+great savings in the amount of space actually used for each bounded stack.
+
+top is initialized to zero when a stack is created, and this value is used to represent an
+empty stack.  Furthermore, top may never exceed the value of size. Encountering this
+condition is an indication of stack overflow.
+*)
+
+
+TYPE  ItemsArray   = ARRAY SizeRange OF Item;
+
+TYPE  BoundedStack = RECORD
+        dataID: TypeID;     (*-- Defined data type for this stack*)
+        size  : SizeRange;  (*-- Maximum # of items on this stack *)
+        top   : CARDINAL;   (*-- Current stack top := 0 *)
+        items : ItemsArray; (*-- Dynamic array [1..size] of item  *)
+      END (*-- BoundedStack *);
+
+TYPE  Stack = POINTER TO BoundedStack;
+
+
+(*
+6.3.2	Exceptions
+
+To support the exception handling mechanism two variables are needed.  The first,
+stackError, is used to record the exception code from each operation; while handlers  is an
+array of exception handling procedures indexed by the exception code.
+
+The routines StackError, GetHandler, and SetHandler  have been previously described in
+the definition module, and their operation should be readily apparent.
+
+RaiseErrIn  is a local routine used to set the stackError variable and invoke the Raise
+routine of the ErrorHandling module.
+*)
+
+VAR   stackError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE StackError ()              : Exceptions    (*-- out   *);
+BEGIN
+  RETURN stackError;
+END StackError;
+(*----------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions    (*-- in    *))
+                                     : HandlerProc   (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions    (*-- in    *);
+                          theHandler : HandlerProc   (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  stackError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+
+(*
+6.3.3	Constructors
+
+Create begins by clearing the stackError  field under the assumption of a successful result.
+
+The header for the stack must then be allocated in a local variable since the function result
+cannot be manipulated but only returned.  The key to this allocation step is the
+calculation of the number of bytes necessary based on the size of an individual item and
+the number of items requested.  We must not forget the space for storing theSize, the
+Type, and the stack top.  The constant minStackSize  accomplishes this regardless of the
+number and size of these ╥static╙ fields.  The calculation is unaffected by changes in the
+number or size of these fields that may come about due to future maintenance.  If the
+bounded stack could not be allocated, the overflow exception must be raised, and the
+NullStack returned.
+
+At this point, all possibility of failure has been avoided and the bounded stack header can
+be initialized to its empty state (top set to zero), and the size limit and data type ID  can
+be stored for this bounded stack.  Lastly, the new stack can be returned to the caller.
+Complexity O(1).
+*)
+
+PROCEDURE Create    (    theSize   : SizeRange (*-- in    *);
+                         theType   : TypeID    (*-- in    *))
+                                   : Stack     (*-- out   *);
+
+CONST minStackSize = SIZE(BoundedStack) - SIZE(ItemsArray);
+
+VAR   newStack : Stack;
+
+BEGIN
+  stackError := noerr;
+  Allocate(newStack, minStackSize + SIZE(Item) * theSize);
+  IF (newStack # NIL) THEN
+    WITH newStack^ DO
+      dataID := theType;
+      size   := theSize;
+      top    := 0;
+    END (*--with*);
+    RETURN newStack;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullStack;
+END Create;
+(*----------------------------*)
+
+
+(*
+Destroy  takes advantage that Clear  sets stackError  to noerr and raises the undefined
+stack exception.  So if Clear succeeds, Destroy simply releases the allocated stack header.
+Complexity O(n).
+*)
+
+PROCEDURE Destroy   (VAR theStack  : Stack     (*-- inout *));
+BEGIN
+  Clear(theStack);
+  IF (stackError = noerr) THEN
+    Deallocate(theStack, (SIZE(BoundedStack) - SIZE(ItemsArray)) +
+                          SIZE(Item) * theStack^.size);
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+
+(*
+After initializing stackError and verifying that the given stack is a valid object, Clear
+retrieves the item disposal routine associated with the stack's data type from the
+TypeManager module.  Though that module ensures that the disposal routine is not a NIL
+procedure, it would be inefficient to repeatedly invoke a procedure that did nothing (most
+compilers are not smart enough to avoid calling a NIL procedure nor one that does not
+contain any executable statements).  So to clear the stack of items it may be necessary to
+dispose of the individual items followed by setting top to zero. Complexity O(n).
+*)
+
+PROCEDURE Clear     (VAR theStack  : Stack     (*-- inout *));
+
+VAR   itemIndex : CARDINAL;    (*-- loop index over items *)
+      freeItem  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      freeItem := DisposeOf(dataID);
+      IF (freeItem # NoDisposeProc) THEN
+        FOR itemIndex := MIN(SizeRange) TO top DO
+          freeItem(items[itemIndex]);
+        END (*--for*);
+      END (*--if*);
+      top := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+
+(*
+Assignment for bounded objects is simpler to implement than their unbounded
+counterparts since the opportunity for overflow is restricted to when the target object is
+(re-)created.  If the target object exists and is capable of holding all of the source object's
+items the target can be safely cleared and its data type updated appropriately.  Otherwise,
+the overflow exception is raised and the assignment operation is aborted.  When the target
+object is undefined it must be created using the data type and size attributes of the source
+object.  If overflow does not occur, the actual assignment can commence, otherwise its
+suffices to exit (Create has already raised the exception).
+
+The assignment operator cannot be used to copy the whole items array as only a slice of
+the array's index range was actually allocated and who knows what other dynamically
+allocated objects follow it in memory.  Nor can assignment be used to copy individual
+items as the data type of those items is unknown; using assignment for dynamically
+allocated items would cause structural sharing of items, which is not desired.
+Complexity O(n).
+*)
+
+PROCEDURE Assign    (    theStack  : Stack     (*-- in    *);
+                     VAR toStack   : Stack     (*-- inout *));
+
+VAR   itemIndex : CARDINAL;   (*-- loop index over items *)
+      assignItem: AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+
+    IF (toStack # NIL) THEN
+      IF (theStack^.top <= toStack^.size) THEN
+        Clear(toStack);
+        toStack^.dataID := theStack^.dataID;
+      ELSE
+        RaiseErrIn(assign, overflow);
+      END (*--if*);
+    ELSE
+      WITH theStack^ DO
+        toStack := Create(size, dataID);
+      END (*--with*);
+    END (*--if*);
+    IF (stackError # noerr) THEN
+      RETURN;
+    END (*--if*);
+
+    WITH theStack^ DO
+      assignItem := AssignOf(dataID);
+      FOR itemIndex := MIN(SizeRange) TO top DO
+        toStack^.items[itemIndex] := assignItem(items[itemIndex]);
+      END (*--for*);
+      toStack^.top := top;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+
+(*
+Push  is quite simple to implement: if the stack is not already full, the array index to the
+stack top is advanced and theItem is stored there; otherwise the overflow exception is
+raised. Of course, the undefined exception is raised if the source stack is NIL.
+Complexity O(1).
+*)
+
+PROCEDURE Push      (VAR toStack   : Stack     (*-- inout *);
+                         theItem   : Item      (*-- in    *));
+BEGIN
+  stackError := noerr;
+  IF (toStack # NIL) THEN
+    WITH toStack^ DO
+      IF (top < size) THEN
+        INC(top);
+        items[top] := theItem;
+      ELSE
+        RaiseErrIn(push, overflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(push, undefined);
+  END (*--if*);
+END Push;
+(*----------------------------*)
+
+
+(*
+Pop  is the inverse of Push, requiring a test for stack underflow, deallocation of the item,
+and decrementing the stack top. Complexity O(1).
+
+PopTopOf  is similar to Pop except the item is not deallocated, but instead is returned to
+the caller. Complexity O(1).
+*)
+
+PROCEDURE Pop       (VAR theStack  : Stack     (*-- inout *));
+
+VAR   freeItem : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # 0) THEN
+        freeItem := DisposeOf(dataID);
+        freeItem(items[top]);
+        DEC(top);
+      ELSE
+        RaiseErrIn(pop, underflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(pop, undefined);
+  END (*--if*);
+END Pop;
+(*----------------------------*)
+
+PROCEDURE PopTopOf  (VAR theStack  : Stack     (*-- inout *))
+                                   : Item      (*-- out   *);
+
+VAR   theItem : Item; (*-- item to be returned *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # 0) THEN
+        theItem := items[top];
+        DEC(top);
+        RETURN theItem;
+      END (*--if*);
+    END (*--with*);
+
+    RaiseErrIn(poptopof, underflow);
+  ELSE
+    RaiseErrIn(poptopof, undefined);
+  END (*--if*);
+
+  (*-- Return the empty item if an exception occurred. *)
+
+  RETURN NullItem;
+
+END PopTopOf;
+(*----------------------------*)
+
+
+(*
+6.3.4	Selectors
+
+IsDefined checks that the given stack object has been bound to a dynamic entity by
+testing for a non-NIL pointer. Complexity O(1).
+*)
+
+PROCEDURE IsDefined (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+BEGIN
+  RETURN (theStack # NIL);
+END IsDefined;
+(*----------------------------*)
+
+
+(*
+IsEmpty simply tests the index to the stack top being equal to zero, returning the
+appropriate logical value.  As mentioned in the interface, an undefined stack is considered
+empty. Complexity O(1).
+*)
+
+PROCEDURE IsEmpty   (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.top = 0;
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+
+(*
+IsEqual essentially scans both stacks looking for the first mismatch (inequality) which
+indicates the stacks are unequal, otherwise if the FOR loop completes the stacks must be
+equal.  This assumes that: (1) the stacks have been defined, (2) have been given the same
+data type ID, and (3) have the same depth.  The first two of these assumptions, if
+unfounded, raise the exceptions undefined and typeerror, respectively.  If the stacks do not
+have the same depth then at least one item differs between them, and therefore they are
+unequal. Complexity O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left      : Stack     (*-- in    *);
+                         right     : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      compare : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  stackError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.top = right^.top) THEN
+
+	compare := CompareOf(left^.dataID);
+        FOR index := MIN(SizeRange) TO left^.top DO
+          IF (compare(left^.items[index], right^.items[index]) # equal) THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--for*);
+        RETURN TRUE;
+
+      END (*--if*);
+    ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+
+(*
+Both SizeOf  and TypeOf  return the current values of size and dataID, respectively, for
+the given stack.  Undefined stacks raise an exception and return so-called ╥null╙ values.
+Complexity O(1).
+*)
+
+PROCEDURE SizeOf   (    theStack   : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*----------------------------*)
+
+PROCEDURE TypeOf    (    theStack  : Stack     (*-- in    *))
+                                   : TypeID    (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*----------------------------*)
+
+PROCEDURE DepthOf   (    theStack  : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.top;
+  END (*--if*);
+  RaiseErrIn(depthof, undefined);
+  RETURN 0;
+END DepthOf;
+(*----------------------------*)
+
+PROCEDURE TopOf     (    theStack  : Stack     (*-- in    *))
+                                   : Item      (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # 0) THEN
+        RETURN items[top];
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(topof, underflow);
+  ELSE
+    RaiseErrIn(topof, undefined);
+  END (*--if*);
+
+  (*-- Return the empty item if an exception occurred *)
+
+  RETURN NullItem;
+END TopOf;
+(*----------------------------*)
+
+
+(*
+6.3.5	Iterators
+
+The two ╥looping╙ iterator routines, LoopOver and LoopChange, utilize the same
+algorithm; the essential difference is the type of procedure parameter that is invoked for
+each item processed.  A similar statement can be made about the two traversal routines,
+Traverse and TravChange.  In all cases, the iteration begins with the top stack item and
+ends with the bottom stack item.
+*)
+
+PROCEDURE LoopOver   (    theStack  : Stack          (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      FOR index := top TO MIN(SizeRange) BY -1 DO
+        IF ~theProcess(items[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE LoopChange (    theStack  : Stack          (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      FOR index := top TO MIN(SizeRange) BY -1 DO
+        IF ~theProcess(items[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopchange, undefined);
+  END (*--if*);
+END LoopChange;
+(*----------------------------*)
+
+PROCEDURE Traverse   (    theStack  : Stack          (*-- in    *);
+                          theProcess: AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      FOR index := top TO MIN(SizeRange) BY -1 DO
+        theProcess(items[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+PROCEDURE TravChange (    theStack  : Stack          (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      FOR index := top TO MIN(SizeRange) BY -1 DO
+        theProcess(items[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END TravChange;
+(*----------------------------*)
+
+
+(*
+6.3.6	Module Initialization
+
+In the module initialization the local exception handlers array variables are set to default
+handlers (ExitOnError) except for the noerr handler which is given the NullHandler.
+stackError is given the value noerr avoiding an undefined state.
+*)
+
+BEGIN
+  FOR stackError := initfailed TO MAX(Exceptions) DO
+    SetHandler(stackError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  stackError := noerr;
+END StkSBMI.
+
+
+(*
+References
+
+[1]	A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms, Addison-Wesley,
+	Reading, MA 1983, pp. 37-53.
+[2]	G. Booch, Software Components With Ada Structures, Tools, and Subsystems,
+	Benjamin/Cummings, Menlo Park, CA 1987.
+[3]	D. Knuth, The Art of Computer Programming, Vol. 1, Fundamental Algorithms,
+	Addison-Wesley, Reading, MA 1973.
+[4]	R. Wiener and R. Sincovec, Data Structures Using Modula-2, John Wiley & Sons, New
+	York, NY 1986.
+[5]	N. Wirth, Algorithms and Data Structures, Prentice-Hall, Englewood Cliffs, NJ 1986,
+	pp. 180-195.
+[6]	N. Wirth, Algorithms + Data Structures = Programs, Prentice-Hall, Englewood Cliffs,
+	NJ 1976.
+[7]	N. Wirth, Programming in Modula-2, Springer-Verlag, New York, NY 1983.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBMN.DEF
@@ -0,0 +1,205 @@
+(*
+6.4	StackSBMN Interface
+
+The interface to the bounded stack is presented below.  The purpose and implementation
+specifics of each routine is briefly described along with mention of the complexity
+measure of the actual implementation.
+*)
+
+
+DEFINITION MODULE StkSBMN;
+
+(*==========================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Stack (Opaque version)
+               Sequential Bounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module provides the definition of the bounded stack
+    composed of generic Items.
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+      Initial implementation
+==========================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM StackEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+    (*-----------------------*)
+
+TYPE  Stack;
+TYPE  SizeRange  = [1..8100];
+
+CONST NullStack  = Stack(NIL);
+
+
+(*
+6.4.1	Exceptions
+
+The ModuleID  is used by the exception handling mechanism to distinguish this module
+from other modules.
+
+StackError  returns the exception code from the most recent stack operation.  A result of
+noerr indicates successful completion of the operation. O(1).
+
+GetHandler returns the exception handler routine associated with the given exception.
+Though the routine is a function procedure returning a procedure as its result, the
+HandlerProc may not be called from within the GetHandler call itself. The procedure
+result must be first assigned to a procedure variable before invocation. Exception handlers
+are given an initial value of ExitOnError except for the handler for noerr which is
+initialized to the null exception handler. O(1).
+
+SetHandler associates an exception handler routine with the given exception and is the
+inverse of GetHandler.  This routine may be used to override the default settings for the
+exception handlers. O(1).
+*)
+
+CONST ModuleID = 3;
+
+PROCEDURE StackError ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+
+(*
+6.4.2	Constructors
+
+The Create operation attempts to generate a new, empty stack of the given maximum
+size (theSize) and Item operations associated with the given data type identifier (theType).
+
+For the bounded form of stack, it is necessary to define the maximum depth desired and
+this is done using theSize parameter.  The TypeID is the method by which Items of any
+data type are supported.  Using theType, the component can assign one item to another
+and release any dynamically allocated resources associated with an Item without
+knowledge of the Item's internal composition.  In this way, one may create a stack whose
+items consist of other (dynamically allocated) structures, as well as stacks consisting of
+the basic data types.  Create returns the new stack upon successful completion of the
+routine.  If it is not possible for the stack to be created, the exception overflow is raised
+and the constant NullStack  is returned. O(1).
+
+Destroy  takes the given stack, clears it of any items, and then destroys the stack itself.
+Where Create makes a defined stack, Destroy is its inverse, making the stack undefined.
+O(1).
+
+Clear  takes the given stack and removes all of its items.  theType attribute of the stack
+(assigned when the stack was created) is used to retrieve the item deallocation routine for
+the items of the stack.  Clearing the stack returns it to the empty state. O(n).
+
+The Assign  operation attempts to generate a duplicate of the source stack (theStack) in
+the target stack (toStack).  The target stack is automatically created using the size and data
+type attributes of the source stack, if necessary.  If this step is unnecessary, (the target
+stack has already been previously created), the target is cleared of its present contents, its
+data type is set to that of the source stack but the size is left unchanged. O(n).
+
+There is no guarantee that the client module would desire the target stack to be defined
+with the same size as the source.  The minimum requirement for the target stack size is
+that it must be capable of storing all of the items present in the source stack.  It may be
+desirable that the target stack size be greater than the source stack size.  Such a situation
+could occur during error recovery of a bounded stack overflow caused by the stack depth
+encountering the stack size, and the client module may effectively attempt to increase the
+the stack size using the assignment mechanism.
+
+In order to allow Items of any data type, a method must be provided to assign the contents
+of one item to another item.  This is accomplished, as above for Create, through the
+TypeID of the source stack.
+
+The Push  operation adds items to the given stack.  The given item is placed on the stack
+top.  If the depth is already at its maximum size for the given stack the overflow
+exception will be raised and the stack remains unchanged. O(1).
+
+The Pop  operation removes the topmost item from the given stack.  If the given stack is 
+empty on entry to Pop  the underflow  exception will be raised and the stack remains
+unchanged. O(1).
+
+PopTopOf  is a convenience routine combining the semantics of the constructor Pop and
+the selector TopOf.  The only difference from Pop is that the item's value is not disposed
+of, but is returned instead. O(1).
+*)
+
+
+PROCEDURE Create    (    theSize   : SizeRange (*-- in    *);
+                         theType   : TypeID    (*-- in    *))
+                                   : Stack     (*-- out   *);
+
+PROCEDURE Destroy   (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE Clear     (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE Assign    (    theStack  : Stack     (*-- in    *);
+                     VAR toStack   : Stack     (*-- inout *));
+
+PROCEDURE Push      (VAR toStack   : Stack     (*-- inout *);
+                         theItem   : Item      (*-- in    *));
+
+PROCEDURE Pop       (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE PopTopOf  (VAR theStack  : Stack     (*-- inout *))
+                                   : Item      (*-- out   *);
+
+
+(*
+6.4.3	Selectors
+
+IsDefined  attempts to determine whether the given stack is valid, e.g., has been created
+and not yet destroyed.  How this is accomplished may be as simple or complicated as the
+implementor desires and the requirements of the application. O(1).
+
+IsEmpty  returns true if the given stack contains no items; in other words, its depth is
+zero.  Undefined stacks are always considered empty. O(1).
+
+IsEqual  returns true if the left and right stacks contain the same items.  Obviously, both
+must also have the same data type and have been created.  An undefined stack is not equal
+to any other stack, including itself. O(n).
+
+The routines SizeOf  and TypeOf  return the values given the stack when it was created,
+and both are provided so the user of the module need not maintain separate variables
+recording this information. O(1).
+
+DepthOf  returns the number of items present on the given stack.  Undefined stacks are
+considered to have a depth of zero. O(1).
+
+TopOf  returns the item at the current stack top.  If the stack is empty a stack underflow
+occurs and the NullItem is returned (since some Item must be).  Undefined stacks also
+cause the NullItem to be returned. O(1).
+*)
+
+PROCEDURE IsDefined (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE IsEmpty   (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE IsEqual   (    left      : Stack     (*-- in    *);
+                         right     : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE SizeOf    (    theStack  : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+
+PROCEDURE TypeOf    (    theStack  : Stack     (*-- in    *))
+                                   : TypeID    (*-- out   *);
+
+PROCEDURE DepthOf   (    theStack  : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+
+PROCEDURE TopOf     (    theStack  : Stack     (*-- in    *))
+                                   : Item      (*-- out   *);
+
+END StkSBMN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBMN.MOD
@@ -0,0 +1,540 @@
+(*
+6.5	StackSBMN Implementation
+*)
+
+
+IMPLEMENTATION MODULE StkSBMN;
+(*==========================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Stack (Opaque)
+               Sequential Bounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module provides the implementation of the bounded stack
+    composed of generic Items.
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins
+        Initial implementation
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem, NoDisposeProc,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM StackEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+
+(*
+6.5.1	Internal Representation
+
+Figure 6.1
+
+For the internal representation of a bounded stack a record is dynamically allocated on the
+heap.  This record will be made just large enough to hold the declared maximum size of
+the stack.  Though the items array type declaration covers the maximum allowed size
+range of a bounded stack, only size entries are actually allocated.  This technique allows
+great savings in the amount of space actually used for each bounded stack.
+
+top is initialized to zero when a stack is created, and this value is used to represent an
+empty stack.  Furthermore, top may never exceed the value of size. Encountering this
+condition is an indication of stack overflow.
+*)
+
+
+TYPE  ItemsArray   = ARRAY SizeRange OF Item;
+
+TYPE  BoundedStack = RECORD
+        dataID: TypeID;     (*-- Defined data type for this stack*)
+        size  : SizeRange;  (*-- Maximum # of items on this stack *)
+        top   : CARDINAL;   (*-- Current stack top := 0 *)
+        items : ItemsArray; (*-- Dynamic array [1..size] of item  *)
+      END (*-- BoundedStack *);
+
+TYPE  Stack = POINTER TO BoundedStack;
+
+
+(*
+6.5.2	Exceptions
+
+To support the exception handling mechanism two variables are needed.  The first,
+stackError, is used to record the exception code from each operation; while handlers  is an
+array of exception handling procedures indexed by the exception code.
+
+The routines StackError, GetHandler, and SetHandler  have been previously described in
+the definition module, and their operation should be readily apparent.
+
+RaiseErrIn  is a local routine used to set the stackError variable and invoke the Raise
+routine of the ErrorHandling module.
+*)
+
+VAR   stackError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE StackError ()              : Exceptions    (*-- out   *);
+BEGIN
+  RETURN stackError;
+END StackError;
+(*----------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions    (*-- in    *))
+                                     : HandlerProc   (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions    (*-- in    *);
+                          theHandler : HandlerProc   (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  stackError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+
+(*
+6.5.3	Constructors
+
+Create begins by clearing the stackError  field under the assumption of a successful result.
+
+The header for the stack must then be allocated in a local variable since the function result
+cannot be manipulated but only returned.  The key to this allocation step is the
+calculation of the number of bytes necessary based on the size of an individual item and
+the number of items requested.  We must not forget the space for storing theSize, the
+Type, and the stack top.  The constant minStackSize  accomplishes this regardless of the
+number and size of these ╥static╙ fields.  The calculation is unaffected by changes in the
+number or size of these fields that may come about due to future maintenance.  If the
+bounded stack could not be allocated, the overflow exception must be raised, and the
+NullStack returned.
+
+At this point, all possibility of failure has been avoided and the bounded stack header can
+be initialized to its empty state (top set to zero), and the size limit and data type ID  can
+be stored for this bounded stack.  Lastly, the new stack can be returned to the caller.
+Complexity O(1).
+*)
+
+PROCEDURE Create    (    theSize   : SizeRange (*-- in    *);
+                         theType   : TypeID    (*-- in    *))
+                                   : Stack     (*-- out   *);
+
+CONST minStackSize = SIZE(BoundedStack) - SIZE(ItemsArray);
+
+VAR   newStack : Stack;
+
+BEGIN
+  stackError := noerr;
+  Allocate(newStack, minStackSize + SIZE(Item) * theSize);
+  IF (newStack # NIL) THEN
+    WITH newStack^ DO
+      dataID := theType;
+      size   := theSize;
+      top    := 0;
+    END (*--with*);
+    RETURN newStack;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullStack;
+END Create;
+(*----------------------------*)
+
+
+(*
+Destroy  takes advantage that Clear  sets stackError  to noerr and raises the undefined
+stack exception.  So if Clear succeeds, Destroy simply releases the allocated stack header.
+Complexity O(n).
+*)
+
+PROCEDURE Destroy   (VAR theStack  : Stack     (*-- inout *));
+
+CONST minStackSize = SIZE(BoundedStack) - SIZE(ItemsArray);
+
+BEGIN
+  Clear(theStack);
+  IF (stackError = noerr) THEN
+    Deallocate(theStack, minStackSize + SIZE(Item) * theStack^.size);
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+
+(*
+After initializing stackError and verifying that the given stack is a valid object, Clear
+retrieves the item disposal routine associated with the stack's data type from the
+TypeManager module.  Though that module ensures that the disposal routine is not a NIL
+procedure, it would be inefficient to repeatedly invoke a procedure that did nothing (most
+compilers are not smart enough to avoid calling a NIL procedure nor one that does not
+contain any executable statements).  So to clear the stack of items it may be necessary to
+dispose of the individual items followed by setting top to zero. Complexity O(n).
+*)
+
+PROCEDURE Clear     (VAR theStack  : Stack     (*-- inout *));
+
+VAR   itemIndex : CARDINAL;    (*-- loop index over items *)
+      freeItem  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      freeItem := DisposeOf(dataID);
+      IF (freeItem # NoDisposeProc) THEN
+        FOR itemIndex := MIN(SizeRange) TO top DO
+          freeItem(items[itemIndex]);
+        END (*--for*);
+      END (*--if*);
+      top := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+
+(*
+Assignment for bounded objects is simpler to implement than their unbounded
+counterparts since the opportunity for overflow is restricted to when the target object is
+(re-)created.  If the target object exists and is capable of holding all of the source object's
+items the target can be safely cleared and its data type updated appropriately.  Otherwise,
+the overflow exception is raised and the assignment operation is aborted.  When the target
+object is undefined it must be created using the data type and size attributes of the source
+object.  If overflow does not occur, the actual assignment can commence, otherwise its
+suffices to exit (Create has already raised the exception).
+
+The assignment operator cannot be used to copy the whole items array as only a slice of
+the array's index range was actually allocated and who knows what other dynamically
+allocated objects follow it in memory.  Nor can assignment be used to copy individual
+items as the data type of those items is unknown; using assignment for dynamically
+allocated items would cause structural sharing of items, which is not desired.
+Complexity O(n).
+*)
+
+PROCEDURE Assign    (    theStack  : Stack     (*-- in    *);
+                     VAR toStack   : Stack     (*-- inout *));
+
+VAR   itemIndex : CARDINAL;   (*-- loop index over items *)
+      assignItem: AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+
+    IF (toStack # NIL) THEN
+      IF (theStack^.top <= toStack^.size) THEN
+        Clear(toStack);
+        toStack^.dataID := theStack^.dataID;
+      ELSE
+        RaiseErrIn(assign, overflow);
+      END (*--if*);
+    ELSE
+      WITH theStack^ DO
+        toStack := Create(size, dataID);
+      END (*--with*);
+    END (*--if*);
+    IF (stackError # noerr) THEN
+      RETURN;
+    END (*--if*);
+
+    WITH theStack^ DO
+      assignItem := AssignOf(dataID);
+      FOR itemIndex := MIN(SizeRange) TO top DO
+        toStack^.items[itemIndex] := assignItem(items[itemIndex]);
+      END (*--for*);
+      toStack^.top := top;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+
+(*
+Push  is quite simple to implement: if the stack is not already full, the array index to the
+stack top is advanced and theItem is stored there; otherwise the overflow exception is
+raised. Of course, the undefined exception is raised if the source stack is NIL.
+Complexity O(1).
+*)
+
+PROCEDURE Push      (VAR toStack   : Stack     (*-- inout *);
+                         theItem   : Item      (*-- in    *));
+BEGIN
+  stackError := noerr;
+  IF (toStack # NIL) THEN
+    WITH toStack^ DO
+      IF (top < size) THEN
+        INC(top);
+        items[top] := theItem;
+      ELSE
+        RaiseErrIn(push, overflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(push, undefined);
+  END (*--if*);
+END Push;
+(*----------------------------*)
+
+
+(*
+Pop  is the inverse of Push, requiring a test for stack underflow, deallocation of the item,
+and decrementing the stack top. Complexity O(1).
+
+PopTopOf  is similar to Pop except the item is not deallocated, but instead is returned to
+the caller. Complexity O(1).
+*)
+
+PROCEDURE Pop       (VAR theStack  : Stack     (*-- inout *));
+
+VAR   freeItem : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # 0) THEN
+        freeItem := DisposeOf(dataID);
+        freeItem(items[top]);
+        DEC(top);
+      ELSE
+        RaiseErrIn(pop, underflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(pop, undefined);
+  END (*--if*);
+END Pop;
+(*----------------------------*)
+
+PROCEDURE PopTopOf  (VAR theStack  : Stack     (*-- inout *))
+                                   : Item      (*-- out   *);
+
+VAR   theItem : Item; (*-- item to be returned *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # 0) THEN
+        theItem := items[top];
+        DEC(top);
+        RETURN theItem;
+      END (*--if*);
+    END (*--with*);
+
+    RaiseErrIn(poptopof, underflow);
+  ELSE
+    RaiseErrIn(poptopof, undefined);
+  END (*--if*);
+
+  (*-- Return the empty item if an exception occurred. *)
+
+  RETURN NullItem;
+
+END PopTopOf;
+(*----------------------------*)
+
+
+(*
+6.5.4	Selectors
+
+IsDefined checks that the given stack object has been bound to a dynamic entity by
+testing for a non-NIL pointer. Complexity O(1).
+*)
+
+PROCEDURE IsDefined (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+BEGIN
+  RETURN (theStack # NIL);
+END IsDefined;
+(*----------------------------*)
+
+
+(*
+IsEmpty simply tests the index to the stack top being equal to zero, returning the
+appropriate logical value.  As mentioned in the interface, an undefined stack is considered
+empty. Complexity O(1).
+*)
+
+PROCEDURE IsEmpty   (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.top = 0;
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+
+(*
+IsEqual essentially scans both stacks looking for the first mismatch (inequality) which
+indicates the stacks are unequal, otherwise if the FOR loop completes the stacks must be
+equal.  This assumes that: (1) the stacks have been defined, (2) have been given the same
+data type ID, and (3) have the same depth.  The first two of these assumptions, if
+unfounded, raise the exceptions undefined and typeerror, respectively.  If the stacks do not
+have the same depth then at least one item differs between them, and therefore they are
+unequal. Complexity O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left      : Stack     (*-- in    *);
+                         right     : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      compare : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  stackError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.top = right^.top) THEN
+
+	compare := CompareOf(left^.dataID);
+        FOR index := MIN(SizeRange) TO left^.top DO
+          IF compare(left^.items[index], right^.items[index]) # equal THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--for*);
+        RETURN TRUE;
+
+      END (*--if*);
+    ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+
+(*
+Both SizeOf  and TypeOf  return the current values of size and dataID, respectively, for
+the given stack.  Undefined stacks raise an exception and return so-called ╥null╙ values.
+Complexity O(1).
+*)
+
+PROCEDURE SizeOf   (    theStack   : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*----------------------------*)
+
+PROCEDURE TypeOf    (    theStack  : Stack     (*-- in    *))
+                                   : TypeID    (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*----------------------------*)
+
+PROCEDURE DepthOf   (    theStack  : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.top;
+  END (*--if*);
+  RaiseErrIn(depthof, undefined);
+  RETURN 0;
+END DepthOf;
+(*----------------------------*)
+
+PROCEDURE TopOf     (    theStack  : Stack     (*-- in    *))
+                                   : Item      (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # 0) THEN
+        RETURN items[top];
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(topof, underflow);
+  ELSE
+    RaiseErrIn(topof, undefined);
+  END (*--if*);
+
+  (*-- Return the empty item if an exception occurred *)
+
+  RETURN NullItem;
+END TopOf;
+(*----------------------------*)
+
+
+(*
+6.5.5	Module Initialization
+
+In the module initialization the local exception handlers array variables are set to default
+handlers (ExitOnError) except for the noerr handler which is given the NullHandler.
+stackError is given the value noerr avoiding an undefined state.
+*)
+
+BEGIN
+  FOR stackError := initfailed TO MAX(Exceptions) DO
+    SetHandler(stackError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  stackError := noerr;
+END StkSBMN.
+
+
+(*
+References
+
+[1]	A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms, Addison-Wesley,
+	Reading, MA 1983, pp. 37-53.
+[2]	G. Booch, Software Components With Ada Structures, Tools, and Subsystems,
+	Benjamin/Cummings, Menlo Park, CA 1987.
+[3]	D. Knuth, The Art of Computer Programming, Vol. 1, Fundamental Algorithms,
+	Addison-Wesley, Reading, MA 1973.
+[4]	R. Wiener and R. Sincovec, Data Structures Using Modula-2, John Wiley & Sons, New
+	York, NY 1986.
+[5]	N. Wirth, Algorithms and Data Structures, Prentice-Hall, Englewood Cliffs, NJ 1986,
+	pp. 180-195.
+[6]	N. Wirth, Algorithms + Data Structures = Programs, Prentice-Hall, Englewood Cliffs,
+	NJ 1976.
+[7]	N. Wirth, Programming in Modula-2, Springer-Verlag, New York, NY 1983.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBUI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBUI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBUI.DEF
@@ -0,0 +1,98 @@
+DEFINITION MODULE StkSBUI;
+(*==========================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Stack (Opaque version)
+               Sequential Bounded Unmanaged Iterator
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+      Initial implementation from StackSBMI module.
+==========================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc, ChangeProc,
+               LoopChangeProc;
+
+FROM StackEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+    (*-----------------------*)
+
+TYPE  Stack;
+TYPE  SizeRange  = [1..8100];
+
+CONST NullStack  = Stack(NIL);
+
+    (*-----------------------*)
+
+CONST ModuleID = 5;
+
+PROCEDURE StackError ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+    (*-----------------------*)
+
+PROCEDURE Create    (    theSize   : SizeRange (*-- in    *))
+                                   : Stack     (*-- out   *);
+
+PROCEDURE Destroy   (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE Clear     (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE Assign    (    theStack  : Stack     (*-- in    *);
+                     VAR toStack   : Stack     (*-- inout *));
+
+PROCEDURE Push      (VAR toStack   : Stack     (*-- inout *);
+                         theItem   : Item      (*-- in    *));
+
+PROCEDURE Pop       (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE PopTopOf  (VAR theStack  : Stack     (*-- inout *))
+                                   : Item      (*-- out   *);
+
+    (*-----------------------*)
+
+PROCEDURE IsDefined (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE IsEmpty   (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE IsEqual   (    left      : Stack     (*-- in    *);
+                         right     : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE SizeOf    (    theStack  : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+
+PROCEDURE DepthOf   (    theStack  : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+
+PROCEDURE TopOf     (    theStack  : Stack     (*-- in    *))
+                                   : Item      (*-- out   *);
+
+    (*-----------------------*)
+
+PROCEDURE LoopOver   (    theStack  : Stack          (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE LoopChange (    theStack  : Stack          (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+PROCEDURE Traverse   (    theStack  : Stack          (*-- in    *);
+                          theProcess: AccessProc     (*-- in    *));
+
+PROCEDURE TravChange (    theStack  : Stack          (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+END StkSBUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBUI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBUI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBUI.MOD
@@ -0,0 +1,408 @@
+IMPLEMENTATION MODULE StkSBUI;
+(*==========================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Stack (Opaque)
+               Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins
+        Initial implementation from StackSBMI module.
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AccessProc, ChangeProc,
+               LoopAccessProc, LoopChangeProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM StackEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+    (*-----------------------*)
+
+
+TYPE  ItemsArray   = ARRAY SizeRange OF Item;
+
+TYPE  BoundedStack = RECORD
+        size  : SizeRange;  (*-- Maximum # of items on this stack *)
+        top   : CARDINAL;   (*-- Current stack top := 0 *)
+        items : ItemsArray; (*-- Dynamic array [1..size] of item  *)
+      END (*-- BoundedStack *);
+
+TYPE  Stack = POINTER TO BoundedStack;
+
+    (*-----------------------*)
+
+VAR   stackError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE StackError ()              : Exceptions    (*-- out   *);
+BEGIN
+  RETURN stackError;
+END StackError;
+(*----------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions    (*-- in    *))
+                                     : HandlerProc   (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions    (*-- in    *);
+                          theHandler : HandlerProc   (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  stackError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+    (*-----------------------*)
+
+PROCEDURE Create    (    theSize   : SizeRange (*-- in    *))
+                                   : Stack     (*-- out   *);
+
+CONST minStackSize = SIZE(BoundedStack) - SIZE(ItemsArray);
+
+VAR   newStack : Stack;
+
+BEGIN
+  stackError := noerr;
+  Allocate(newStack, minStackSize + SIZE(Item) * theSize);
+  IF (newStack # NIL) THEN
+    WITH newStack^ DO
+      size   := theSize;
+      top    := 0;
+    END (*--with*);
+    RETURN newStack;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullStack;
+END Create;
+(*----------------------------*)
+
+PROCEDURE Destroy   (VAR theStack  : Stack     (*-- inout *));
+
+CONST minStackSize = SIZE(BoundedStack) - SIZE(ItemsArray);
+
+BEGIN
+  Clear(theStack);
+  IF (stackError = noerr) THEN
+    Deallocate(theStack, minStackSize + SIZE(Item) * theStack^.size);
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+PROCEDURE Clear     (VAR theStack  : Stack     (*-- inout *));
+
+VAR   itemIndex : CARDINAL;    (*-- loop index over items *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      top := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+PROCEDURE Assign    (    theStack  : Stack     (*-- in    *);
+                     VAR toStack   : Stack     (*-- inout *));
+
+VAR   itemIndex : CARDINAL;   (*-- loop index over items *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+
+    IF (toStack # NIL) THEN
+      IF (theStack^.top <= toStack^.size) THEN
+        Clear(toStack);
+      ELSE
+        RaiseErrIn(assign, overflow);
+      END (*--if*);
+    ELSE
+      WITH theStack^ DO
+        toStack := Create(size);
+      END (*--with*);
+    END (*--if*);
+    IF (stackError # noerr) THEN
+      RETURN;
+    END (*--if*);
+
+    WITH theStack^ DO
+      FOR itemIndex := MIN(SizeRange) TO top DO
+        toStack^.items[itemIndex] := items[itemIndex];
+      END (*--for*);
+      toStack^.top := top;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+
+PROCEDURE Push      (VAR toStack   : Stack     (*-- inout *);
+                         theItem   : Item      (*-- in    *));
+BEGIN
+  stackError := noerr;
+  IF (toStack # NIL) THEN
+    WITH toStack^ DO
+      IF (top < size) THEN
+        INC(top);
+        items[top] := theItem;
+      ELSE
+        RaiseErrIn(push, overflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(push, undefined);
+  END (*--if*);
+END Push;
+(*----------------------------*)
+
+PROCEDURE Pop       (VAR theStack  : Stack     (*-- inout *));
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # 0) THEN
+        DEC(top);
+      ELSE
+        RaiseErrIn(pop, underflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(pop, undefined);
+  END (*--if*);
+END Pop;
+(*----------------------------*)
+
+PROCEDURE PopTopOf  (VAR theStack  : Stack     (*-- inout *))
+                                   : Item      (*-- out   *);
+
+VAR   theItem : Item; (*-- item to be returned *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # 0) THEN
+        theItem := items[top];
+        DEC(top);
+        RETURN theItem;
+      END (*--if*);
+    END (*--with*);
+
+    RaiseErrIn(poptopof, underflow);
+  ELSE
+    RaiseErrIn(poptopof, undefined);
+  END (*--if*);
+
+  (*-- Return the empty item if an exception occurred. *)
+
+  RETURN NullItem;
+
+END PopTopOf;
+(*----------------------------*)
+
+
+PROCEDURE IsDefined (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+BEGIN
+  RETURN (theStack # NIL);
+END IsDefined;
+(*----------------------------*)
+
+PROCEDURE IsEmpty   (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.top = 0;
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+PROCEDURE IsEqual   (    left      : Stack     (*-- in    *);
+                         right     : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stackError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF (left^.top = right^.top) THEN
+
+      FOR index := MIN(SizeRange) TO left^.top DO
+        IF (left^.items[index] # right^.items[index]) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE SizeOf   (    theStack   : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*----------------------------*)
+
+PROCEDURE DepthOf   (    theStack  : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.top;
+  END (*--if*);
+  RaiseErrIn(depthof, undefined);
+  RETURN 0;
+END DepthOf;
+(*----------------------------*)
+
+PROCEDURE TopOf     (    theStack  : Stack     (*-- in    *))
+                                   : Item      (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # 0) THEN
+        RETURN items[top];
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(topof, underflow);
+  ELSE
+    RaiseErrIn(topof, undefined);
+  END (*--if*);
+
+  (*-- Return the empty item if an exception occurred *)
+
+  RETURN NullItem;
+END TopOf;
+(*----------------------------*)
+
+PROCEDURE LoopOver   (    theStack  : Stack          (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      FOR index := top TO MIN(SizeRange) BY -1 DO
+        IF ~theProcess(items[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE LoopChange (    theStack  : Stack          (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      FOR index := top TO MIN(SizeRange) BY -1 DO
+        IF ~theProcess(items[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopchange, undefined);
+  END (*--if*);
+END LoopChange;
+(*----------------------------*)
+
+PROCEDURE Traverse   (    theStack  : Stack          (*-- in    *);
+                          theProcess: AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      FOR index := top TO MIN(SizeRange) BY -1 DO
+        theProcess(items[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+PROCEDURE TravChange (    theStack  : Stack          (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      FOR index := top TO MIN(SizeRange) BY -1 DO
+        theProcess(items[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END TravChange;
+(*----------------------------*)
+
+BEGIN
+  FOR stackError := initfailed TO MAX(Exceptions) DO
+    SetHandler(stackError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  stackError := noerr;
+END StkSBUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBUN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBUN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBUN.DEF
@@ -0,0 +1,83 @@
+DEFINITION MODULE StkSBUN;
+(*==========================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Stack (Opaque version)
+               Sequential Bounded Unmanaged Non-Iterator
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+      Initial implementation from StackSBUI module.
+==========================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM StackEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+    (*-----------------------*)
+
+TYPE  Stack;
+TYPE  SizeRange  = [1..8100];
+
+CONST NullStack  = Stack(NIL);
+
+    (*-----------------------*)
+
+CONST ModuleID = 8;
+
+PROCEDURE StackError ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+    (*-----------------------*)
+
+PROCEDURE Create    (    theSize   : SizeRange (*-- in    *))
+                                   : Stack     (*-- out   *);
+
+PROCEDURE Destroy   (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE Clear     (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE Assign    (    theStack  : Stack     (*-- in    *);
+                     VAR toStack   : Stack     (*-- inout *));
+
+PROCEDURE Push      (VAR toStack   : Stack     (*-- inout *);
+                         theItem   : Item      (*-- in    *));
+
+PROCEDURE Pop       (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE PopTopOf  (VAR theStack  : Stack     (*-- inout *))
+                                   : Item      (*-- out   *);
+
+    (*-----------------------*)
+
+PROCEDURE IsDefined (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE IsEmpty   (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE IsEqual   (    left      : Stack     (*-- in    *);
+                         right     : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE SizeOf    (    theStack  : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+
+PROCEDURE DepthOf   (    theStack  : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+
+PROCEDURE TopOf     (    theStack  : Stack     (*-- in    *))
+                                   : Item      (*-- out   *);
+
+END StkSBUN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBUN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBUN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBUN.MOD
@@ -0,0 +1,327 @@
+IMPLEMENTATION MODULE StkSBUN;
+(*==========================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Stack (Opaque)
+               Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins
+        Initial implementation from StackSBUI module.
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM StackEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+    (*-----------------------*)
+
+
+TYPE  ItemsArray   = ARRAY SizeRange OF Item;
+
+TYPE  BoundedStack = RECORD
+        size  : SizeRange;  (*-- Maximum # of items on this stack *)
+        top   : CARDINAL;   (*-- Current stack top := 0 *)
+        items : ItemsArray; (*-- Dynamic array [1..size] of item  *)
+      END (*-- BoundedStack *);
+
+TYPE  Stack = POINTER TO BoundedStack;
+
+    (*-----------------------*)
+
+VAR   stackError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE StackError ()              : Exceptions    (*-- out   *);
+BEGIN
+  RETURN stackError;
+END StackError;
+(*----------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions    (*-- in    *))
+                                     : HandlerProc   (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions    (*-- in    *);
+                          theHandler : HandlerProc   (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
+                          theError   : Exceptions    (*-- in    *));
+BEGIN
+  stackError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+    (*-----------------------*)
+
+PROCEDURE Create    (    theSize   : SizeRange (*-- in    *))
+                                   : Stack     (*-- out   *);
+
+CONST minStackSize = SIZE(BoundedStack) - SIZE(ItemsArray);
+
+VAR   newStack : Stack;
+
+BEGIN
+  stackError := noerr;
+  Allocate(newStack, minStackSize + SIZE(Item) * theSize);
+  IF (newStack # NIL) THEN
+    WITH newStack^ DO
+      size   := theSize;
+      top    := 0;
+    END (*--with*);
+    RETURN newStack;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullStack;
+END Create;
+(*----------------------------*)
+
+PROCEDURE Destroy   (VAR theStack  : Stack     (*-- inout *));
+
+CONST minStackSize = SIZE(BoundedStack) - SIZE(ItemsArray);
+
+BEGIN
+  Clear(theStack);
+  IF (stackError = noerr) THEN
+    Deallocate(theStack, minStackSize + SIZE(Item) * theStack^.size);
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+PROCEDURE Clear     (VAR theStack  : Stack     (*-- inout *));
+
+VAR   itemIndex : CARDINAL;    (*-- loop index over items *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      top := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+PROCEDURE Assign    (    theStack  : Stack     (*-- in    *);
+                     VAR toStack   : Stack     (*-- inout *));
+
+VAR   itemIndex : CARDINAL;   (*-- loop index over items *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+
+    IF (toStack # NIL) THEN
+      IF (theStack^.top <= toStack^.size) THEN
+        Clear(toStack);
+      ELSE
+        RaiseErrIn(assign, overflow);
+      END (*--if*);
+    ELSE
+      WITH theStack^ DO
+        toStack := Create(size);
+      END (*--with*);
+    END (*--if*);
+    IF (stackError # noerr) THEN
+      RETURN;
+    END (*--if*);
+
+    WITH theStack^ DO
+      FOR itemIndex := MIN(SizeRange) TO top DO
+        toStack^.items[itemIndex] := items[itemIndex];
+      END (*--for*);
+      toStack^.top := top;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+
+PROCEDURE Push      (VAR toStack   : Stack     (*-- inout *);
+                         theItem   : Item      (*-- in    *));
+BEGIN
+  stackError := noerr;
+  IF (toStack # NIL) THEN
+    WITH toStack^ DO
+      IF (top < size) THEN
+        INC(top);
+        items[top] := theItem;
+      ELSE
+        RaiseErrIn(push, overflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(push, undefined);
+  END (*--if*);
+END Push;
+(*----------------------------*)
+
+PROCEDURE Pop       (VAR theStack  : Stack     (*-- inout *));
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # 0) THEN
+        DEC(top);
+      ELSE
+        RaiseErrIn(pop, underflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(pop, undefined);
+  END (*--if*);
+END Pop;
+(*----------------------------*)
+
+PROCEDURE PopTopOf  (VAR theStack  : Stack     (*-- inout *))
+                                   : Item      (*-- out   *);
+
+VAR   theItem : Item; (*-- item to be returned *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # 0) THEN
+        theItem := items[top];
+        DEC(top);
+        RETURN theItem;
+      END (*--if*);
+    END (*--with*);
+
+    RaiseErrIn(poptopof, underflow);
+  ELSE
+    RaiseErrIn(poptopof, undefined);
+  END (*--if*);
+
+  (*-- Return the empty item if an exception occurred. *)
+
+  RETURN NullItem;
+
+END PopTopOf;
+(*----------------------------*)
+
+
+PROCEDURE IsDefined (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+BEGIN
+  RETURN (theStack # NIL);
+END IsDefined;
+(*----------------------------*)
+
+PROCEDURE IsEmpty   (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.top = 0;
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+PROCEDURE IsEqual   (    left      : Stack     (*-- in    *);
+                         right     : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stackError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF (left^.top = right^.top) THEN
+
+      FOR index := MIN(SizeRange) TO left^.top DO
+        IF (left^.items[index] # right^.items[index]) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE SizeOf   (    theStack   : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*----------------------------*)
+
+PROCEDURE DepthOf   (    theStack  : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.top;
+  END (*--if*);
+  RaiseErrIn(depthof, undefined);
+  RETURN 0;
+END DepthOf;
+(*----------------------------*)
+
+PROCEDURE TopOf     (    theStack  : Stack     (*-- in    *))
+                                   : Item      (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # 0) THEN
+        RETURN items[top];
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(topof, underflow);
+  ELSE
+    RaiseErrIn(topof, undefined);
+  END (*--if*);
+
+  (*-- Return the empty item if an exception occurred *)
+
+  RETURN NullItem;
+END TopOf;
+(*----------------------------*)
+
+BEGIN
+  FOR stackError := initfailed TO MAX(Exceptions) DO
+    SetHandler(stackError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  stackError := noerr;
+END StkSBUN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUMI.DEF
@@ -0,0 +1,236 @@
+(*
+7	The Unbounded Stack
+
+An implementation of the stack abstraction, described in chapter 8, is presented here.
+This particular form has the properties: Sequential, Unbounded, Managed, and Iterator.
+These describe specific aspects of the implementation as follows:
+
+Sequential:	Can only be used in a non-tasking environment, or by only one task.
+Unbounded:	The size of a stack varies dynamically as items are added and removed.
+Managed:	Memory space for items and objects is returned to the system when no
+			longer needed.
+Iterator:	Routines for looping over each of the stack items are provided.
+
+
+Section 7.1 contains the interface to the Unbounded Stack module followed by its
+implementation in Section 7.2.
+
+
+7.1		StackSUMI Interface
+
+The interface to the unbounded stack is presented below.  The purpose and
+implementation specifics of each routine is briefly described along with mention of the
+complexity measure of the actual implementation.
+*)
+
+
+DEFINITION MODULE StkSUMI;
+(*============================================================
+    Version  : 1.00  28 Apr 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2 Compiler
+    Component: Monolithic Structures - Stack (Opaque version)
+               Sequential Unbounded Managed Iterator
+
+    INTRODUCTION
+    This module provides the stack ADT composed of generic Items.
+
+    REVISION HISTORY
+    v1.00  28 Apr 1989  C. Lins:
+      Initial implementation.
+============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc, ChangeProc,
+               LoopChangeProc;
+
+FROM StackEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+
+TYPE  Stack;
+CONST NullStack  = Stack(NIL);
+
+
+(*
+7.1.1	Exceptions
+
+The ModuleID  is used by the exception handling mechanism to distinguish this module
+from other modules.
+
+StackError  returns the exception code from the most recent stack operation.  A result of
+noerr  indicates successful completion of the operation. O(1).
+
+GetHandler  returns the exception handler routine associated with the given exception. 
+Though the routine is a function procedure returning a procedure as its result, the
+HandlerProc  may not be called from within the GetHandler  call itself.  The procedure
+result must be first assigned to a procedure variable before invocation.  Exception handlers
+are given an initial value of ExitOnError  except for the handler for noerr  which is
+initialized to the null exception handler. O(1).
+
+SetHandler  associates an exception handler routine with the given exception and is the
+inverse of GetHandler.  This routine may be used to override the default settings for the
+exception handlers. O(1).
+*)
+
+CONST ModuleID = 2;
+
+PROCEDURE StackError ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+
+(*
+7.1.2	Constructors
+
+The Create operation attempts to generate a new, empty stack associated with the given
+data type identifier (theType) and Item operations.  The TypeID is the method by which
+Items of any data type are supported.  Using theType, the component can assign one item
+to another and release any dynamically allocated resources associated with an Item without
+knowledge of the Item's internal composition.  In this way, one may create a stack whose
+items consist of other (dynamically allocated) structures, as well as stacks consisting of
+the basic data types.  Create returns the new stack upon successful completion of the
+routine.  If it is not possible for the stack to be created, the overflow exception is raised
+and the constant NullStack  will be returned. O(1).
+
+Destroy  takes the given stack, clears it of any items, and then destroys the stack itself. 
+Where Create makes a defined stack, Destroy is its inverse, making the stack undefined.
+O(1).
+
+Clear  takes the given stack and removes all of its items.  theType attribute of the stack 
+(assigned when the stack was created) is used to retrieve the item deallocation routine for
+the items of the stack.  Clearing the stack returns it to the empty state. O(n).
+
+The Assign  operation attempts to generate a duplicate of the source stack (theStack) in
+the target stack (toStack).  The target stack is automatically created using the data type
+attribute of the source stack, if necessary.  If this step is unnecessary, (the target stack has
+been previously created), the target is cleared of its present contents, and its data type is
+set to that of the source stack.  O(n).
+
+In order to allow Items of any data type, a method must be provided to assign the contents
+of one item to another item.  This is accomplished, as above for Create, through the
+TypeID of the source stack.
+
+The Push  operation adds items to the given stack.  The given item is placed on the stack
+top.  If the stack cannot be expanded for theItem the overflow  exception is raised and the
+stack remains unchanged. O(1).
+
+The Pop  operation removes the topmost item from the given stack.  If the given stack is 
+empty on entry to Pop  the underflow  exception is raised and the stack remains
+unchanged. O(1).
+
+PopTopOf  is a convenience routine combining the semantics of the constructor Pop and
+the selector TopOf.  The only difference from Pop is that the item's value is not disposed
+of, but is returned instead. O(1).
+*)
+
+
+PROCEDURE Create    (    theType   : TypeID    (*-- in    *))
+                                   : Stack     (*-- out   *);
+
+PROCEDURE Destroy   (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE Clear     (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE Assign    (    theStack  : Stack     (*-- in    *);
+                     VAR toStack   : Stack     (*-- inout *));
+
+PROCEDURE Push      (VAR toStack   : Stack     (*-- inout *);
+                         theItem   : Item      (*-- in    *));
+
+PROCEDURE Pop       (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE PopTopOf  (VAR theStack  : Stack     (*-- inout *))
+                                   : Item      (*-- out   *);
+
+
+(*
+7.1.3	Selectors
+
+IsDefined  attempts to determine whether the given stack is valid, e.g., has been created
+and not yet destroyed.  How this is accomplished may be as simple or complicated as the
+implementor desires and the requirements of the application. O(1).
+
+IsEmpty  returns true if the given stack contains no items; in other words, its depth is
+zero.  Undefined stacks are always considered to be empty. O(1).
+
+IsEqual  returns true if the left and right stacks contain the same items.  Obviously, both
+must also have the same data type and have been created.  An undefined stack is not equal
+to any other stack, including itself. O(n).
+
+The routine TypeOf  returns the type ID value given  to the stack when it was created or
+used as the target of an assignment operation, and is provided so that the user of the
+module need not maintain a separate variable recording this information. O(1).
+
+DepthOf  returns the number of items present on the given stack.  Undefined stacks are
+considered to have a depth of zero. O(1).
+
+TopOf  returns the item currently at the top of the stack.  If the stack is empty a stack
+underflow occurs and the NullItem is returned (since some Item must be).  Undefined
+stacks also cause the NullItem to be returned. O(1).
+*)
+
+
+PROCEDURE IsDefined (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE IsEmpty   (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE IsEqual   (    left      : Stack     (*-- in    *);
+                         right     : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE TypeOf    (    theStack  : Stack     (*-- in    *))
+                                   : TypeID    (*-- out   *);
+
+PROCEDURE DepthOf   (    theStack  : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+
+PROCEDURE TopOf     (    theStack  : Stack     (*-- in    *))
+                                   : Item      (*-- out   *);
+
+
+(*
+7.1.4	Iterators
+
+The iterator routines LoopOver and LoopChange provide facilities for looping over some
+or all items of a stack, with read-only and read-write access to each item, respectively. 
+theProcess  procedure parameter to these routines return a BOOLEAN function result
+where TRUE allows the iteration to proceed to the next item and FALSE causes the
+iteration to be terminated. O(n).
+
+Traverse  and TravChange iterators provide facilities for looping over all items of a stack,
+with read-only and read-write access to each item, respectively. O(n).
+
+All four iterators traverse the given stack from the topmost item towards the bottom of
+the stack.  Obviously, if given an empty stack the processing procedure will not be
+invoked.
+*)
+
+
+PROCEDURE LoopOver   (    theStack  : Stack          (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE LoopChange (    theStack  : Stack          (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+PROCEDURE Traverse   (    theStack  : Stack          (*-- in    *);
+                          theProcess: AccessProc     (*-- in    *));
+
+PROCEDURE TravChange (    theStack  : Stack          (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+END StkSUMI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUMI.MOD
@@ -0,0 +1,743 @@
+
+(*
+7.2	StackSUMI Implementation
+*)
+
+
+IMPLEMENTATION MODULE StkSUMI;
+(*===========================================================
+    Version  : 1.00  28 Apr 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2 Compiler
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Stack (Opaque)
+               Sequential Unbounded Managed Iterator
+
+    INTRODUCTION
+    This module provides the implementation for the operations
+    of the unbounded stack abstract data type.
+
+    REVISION HISTORY
+    v1.00  28 Apr 1989 C. Lins:
+      Initial implementation for JPI Modula-2.
+===========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem, NoDisposeProc,
+    (*--Type*) Item, AssignProc, DisposeProc, AccessProc, ChangeProc,
+               LoopAccessProc, LoopChangeProc, CompareProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM StackEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+
+    (*--------------------*)
+
+(*
+7.2.1	Internal Unbounded Stack Representation
+
+Figure 7.1
+
+7.2.1.1	Stack Header
+
+For the internal representation of an unbounded stack we will use a singly linked list of
+nodes, with a header node, called UnboundedStack.  This header contains a pointer to the
+topmost node on the stack, a count of the current stack depth, and the data type ID of the
+stack.  An empty stack is represented by a UnboundedStack with a Top pointer of NIL
+and a Depth of zero.  Where possible, a NIL value for the Stack will be accepted as a legal
+value for an empty stack when this will not disrupt the semantics of the invoked
+operation.
+
+
+7.2.1.2	Node
+
+Each node in the list of stack items contains the Item stored on the stack, and a link to
+the node immediately beneath it.  The link for the bottommost node on the stack will
+contain a value of NIL to represent the end of the stack.
+
+
+7.2.1.3	Management of Free Stack Nodes
+
+A separate list of free nodes is kept global for all items popped from the stack.  The
+FreeList is effectively a FreeStack due to the LIFO management scheme employed.  This
+technique is used in order to minimize calls to Allocate and Deallocate system routines,
+since both (though especially Allocate) involve a rather large overhead compared to the
+bounded form.
+
+
+7.2.1.4	Stack ╨ Representation of Depth
+
+The cost to maintain the depth of each stack is relatively small, consisting of a field to
+store the depth (a CARDINAL) and the execution cost to maintain this field whenever an
+item is pushed or popped from the stack. The alternative would be to iterate over every
+item in the stack to calculate the depth whenever this operation was requested.  The
+implementation used  yields an algorithm of O(1) time complexity for determination of
+the stack's depth as opposed to an O(n) algorithm at the expense of a small increase in
+space complexity, and a small increase in the proportionality constants for the time
+complexity of Push and Pop.
+
+
+7.2.1.5	Stack ╨ Representation of an Empty Stack
+
+The representation of an opaque type is restricted to POINTER types [Wirth85, pg. 169].
+An alternative representation for an empty stack would be to use a value of NIL for the
+Stack.  Though this would simplify testing for an empty stack, it would complicate
+primitive operations such as Pop and Clear, which would then require the Free operation
+as a parameter.
+
+
+7.2.2	Efficiency of Operations
+
+Within the implementation of a component, we allow ourselves to violate the abstraction
+by examining the internal components of the data structure.  Repetitive invocations of
+procedures supporting the abstraction may be replaced with the ╥inline╙ equivalent of the
+operation.  This is most commonly done when testing for the empty stack condition and
+in copying items.
+*)
+
+TYPE  NodePtr = POINTER TO Node;
+TYPE  Node    = RECORD   (*-- a stack node *)
+        item  : Item;    (*-- generic data item *)
+        next  : NodePtr; (*-- next node beneath this one, if any *)
+      END (*-- Node *);
+
+TYPE  UnboundedStack = RECORD
+        dataID: TypeID;   (*-- Defined data type for this stack*)
+        depth : CARDINAL; (*-- current stack depth, := 0   *)
+        top   : NodePtr;  (*-- current stack top    := NIL *)
+      END (*-- UnboundedStack *);
+
+TYPE  Stack = POINTER TO UnboundedStack;
+
+    (*-----------------------*)
+
+
+(*
+7.2.3	Exceptions
+
+To support the exception handling mechanism two variables are needed.  The first,
+stackError, is used to record the exception code from each operation; while handlers  is an
+array of exception handling procedures indexed by the exception code.
+
+The routines StackError, GetHandler, and SetHandler  have been previously described in
+the definition module, and their operation should be readily apparent.  RaiseErrIn  is a
+local routine used to set stackError and invoke the Raise  routine of the ErrorHandling
+module.
+*)
+
+VAR   stackError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+
+PROCEDURE StackError ()              : Exceptions  (*-- out   *);
+BEGIN
+  RETURN stackError;
+END StackError;
+(*----------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*-- in    *);
+                          theError   : Exceptions  (*-- in    *));
+BEGIN
+  stackError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+
+(* ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤
+    µ  Local  µ  Local  µ  Local  µ  Local  µ  Local  µ  Local  µ
+   ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤ *)
+
+    MODULE FreeListMgr;
+
+    (*-- This local module controls access to the Available node list.
+      -- Version 1.00  07 Jun. 1987  C. Lins *)
+
+    IMPORT Node, NodePtr, Allocate, Deallocate;
+    EXPORT FreeNode, GetNode;
+
+    VAR   FreeList : NodePtr; (*-- Free list of available stack nodes *)
+
+    (*----------------------------*)
+
+(*
+FreeNode adds the given node to the front of the free list.  theNode's  next field is linked
+to the front of the free list and the node becomes the new front of the free list.
+*)
+
+    PROCEDURE FreeNode (VAR theNode: NodePtr);
+    BEGIN
+      theNode^.next := FreeList;
+      FreeList      := theNode;
+    END FreeNode;
+    (*----------------------------*)
+
+
+(*
+GetNode attempts to generate a new stack node.  If the free list is empty, attempt to
+allocate a brand new node.  If the allocation attempt fails, return False and exit, otherwise
+return the brand new node, a function result of True and exit.  If the free list is not empty,
+remove the first available node from the free list and return the used node to the caller
+along with a function result of True.
+*)
+
+    PROCEDURE GetNode (VAR theNode: NodePtr (*-- out *)): BOOLEAN;
+    BEGIN
+      IF (FreeList = NIL) THEN
+        Allocate(theNode, SIZE(Node));
+        IF (theNode = NIL) THEN
+          RETURN FALSE;
+        END (*--if*);
+      ELSE
+        theNode  := FreeList;
+        FreeList := FreeList^.next;
+      END (*--if*);
+      RETURN TRUE;
+    END GetNode;
+    (*----------------------------*)
+
+    (* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ *)
+    (* ~~~~~  Local Module Initialization  ~~~~~ *)
+
+    BEGIN
+      FreeList := NIL; (*-- Initialize the free list to empty. *)
+    END FreeListMgr;
+
+
+(* ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤
+    á  Local  á  Local  á  Local  á  Local  á  Local  á  Local  á
+   ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤ *)
+
+
+(*
+7.3.4	Constructors
+
+Create begins by clearing the stackError  field under the assumption of a successful result.
+
+The stack header is then allocated in a local variable since the function result cannot be
+manipulated but only returned.  If the unbounded stack could not be allocated, the
+overflow exception must be raised, and the NullStack returned.
+
+At this point, all possibility of failure has been avoided and the unbounded stack header
+can be initialized to its empty state (top is set to NIL, depth set to zero), and the data type
+ID  can be stored for this unbounded stack.  Lastly, the new stack is returned to the caller.
+Complexity: O(1).
+*)
+
+PROCEDURE Create    (    theType   : TypeID    (*-- in    *))
+                                   : Stack     (*-- out   *);
+
+VAR   newStack : Stack;
+
+BEGIN
+  stackError := noerr;
+  Allocate(newStack, SIZE(UnboundedStack));
+  IF (newStack # NIL) THEN
+    WITH newStack^ DO
+      dataID := theType;
+      depth  := 0;
+      top    := NIL;
+    END (*--with*);
+    RETURN newStack;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullStack;
+END Create;
+(*----------------------------*)
+
+
+(*
+Destroy  takes advantage that Clear  sets stackError  to noerr and raises the undefined 
+stack exception.  So if Clear succeeds, Destroy simply releases the allocated stack header.
+Complexity: O(n).
+*)
+
+PROCEDURE Destroy  (VAR theStack  : Stack     (*-- inout *));
+BEGIN
+  Clear(theStack);
+  IF (stackError = noerr) THEN
+    Deallocate(theStack, SIZE(theStack^));
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+
+(*
+After initializing stackError and verifying that the given stack is a valid object, Clear
+retrieves the item disposal routine associated with the stack's data type from the
+TypeManager module.  Then each item on the stack is deallocated followed by its stack
+node.  To do this safely a local variable, nodeToFree, is used to hold each node.  The loop
+invariant takes advantage of the fact that the bottommost stack node contains a next field
+of NIL, and this will automatically cause top to contain that value once all stack nodes
+have been cleared.  The last step is to reset depth to zero.
+Complexity O(n).
+*)
+
+PROCEDURE Clear    (VAR theStack  : Stack     (*-- inout *));
+
+VAR   nodeToFree : NodePtr;
+      freeItem   : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      freeItem := DisposeOf(dataID);
+      WHILE (top # NIL) DO
+        nodeToFree := top;
+        top := top^.next;
+        freeItem(nodeToFree^.item);
+        FreeNode(nodeToFree);
+      END (*--while*);
+      depth := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+
+(*
+Assignment for unbounded objects has the complication that overflow may occur while
+adding individual stack nodes.  When the target object is undefined, it must be created
+using the data type attribute of the source object.  If overflow does not occur, the actual
+assignment can commence, otherwise its suffices to exit (Create has already raised the
+exception).  When the target object is defined on entry to the Assign operation, it is
+sufficient to Clear the existing contents and update the data type with that of the source
+stack.  If the source stack is empty, the routine may simply exit.  Otherwise, the top
+node is copied from the source to the target, followed by a loop over the remaining items,
+if any.
+
+In order to properly copy the source stack, two node pointers are necessary: one, to loop
+through each of the source nodes, and the second to keep track of the last node added to the
+target stack.
+
+The assignment operator cannot be used to copy individual items as the data type of those
+items is unknown; using assignment for dynamically allocated items would cause
+structural sharing of items, which is not desired.
+Complexity O(mn).
+*)
+
+PROCEDURE Assign   (    theStack  : Stack     (*-- in    *);
+                    VAR toStack   : Stack     (*-- inout *));
+
+VAR   fromIndex : NodePtr;    (*-- node to add from source stack *)
+      toIndex   : NodePtr;    (*-- last node added to target stack *)
+      assignItem: AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  IF (theStack # NIL) THEN
+    IF (toStack # NIL) THEN
+      Clear(toStack);
+      toStack^.dataID := theStack^.dataID;
+    ELSE
+      toStack := Create(theStack^.dataID);
+    END (*--if*);
+
+    IF (stackError # noerr) OR (theStack^.top = NIL) THEN
+      RETURN;
+    END (*--if*);
+
+    assignItem := AssignOf(theStack^.dataID);
+    IF GetNode(toStack^.top) THEN
+      WITH toStack^.top^ DO
+        item := assignItem(theStack^.top^.item);
+        next := NIL;
+      END (*--with*);
+      fromIndex := theStack^.top;
+      toIndex   := toStack^.top;
+      INC(toStack^.depth);
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+
+
+    WHILE (stackError = noerr) & (fromIndex^.next # NIL) DO
+      fromIndex := fromIndex^.next;
+      IF GetNode(toIndex^.next) THEN
+        toIndex := toIndex^.next;
+        WITH toIndex^ DO
+          item := assignItem(fromIndex^.item);
+          next := NIL;
+        END (*--with*);
+        INC(toStack^.depth);
+      ELSE
+        RaiseErrIn(assign, overflow);
+      END (*--if*);
+    END (*--while*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+
+(*
+Push  attempts retrieval of a stack node for the new item, which if successful allows us to
+store the data for new stack top and a link to the current stack top. Then the stack top can
+be updated to point to the new node and the depth can be updated. If a stack node could not
+be allocated the overflow exception is raised and the stack is left unchanged.
+Complexity O(1)
+*)
+
+PROCEDURE Push     (VAR toStack   : Stack     (*-- inout *);
+                        theItem   : Item      (*-- in    *));
+
+VAR   newNode: NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (toStack # NIL) THEN
+    IF GetNode(newNode) THEN
+      WITH toStack^ DO
+        newNode^.item := theItem;
+        newNode^.next := top;
+        top := newNode;
+        INC(depth);
+      END (*--with*);
+    ELSE
+      RaiseErrIn(push, overflow);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(push, undefined);
+  END (*--if*);
+END Push;
+(*----------------------------*)
+
+
+(*
+Pop  is the inverse of Push, requiring a test for stack underflow, before effectively
+undoing what was done in order to place a node on the stack.
+
+PopTopOf  is similar to Pop except the item is not deallocated, but instead is returned to
+the caller.
+*)
+
+PROCEDURE Pop       (VAR theStack  : Stack     (*-- inout *));
+
+VAR   nodeToPop: NodePtr;
+      freeItem : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # NIL) THEN       (*-- Check for stack underflow *)
+        nodeToPop := top;       (*-- Remember current top of stack *)
+        top       := top^.next; (*-- Update the top of stack *)
+        DEC(depth);             (*-- Maintain a correct depth count *)
+        freeItem := DisposeOf(dataID);
+        freeItem(nodeToPop^.item); (*-- Safely recover the item space *)
+        FreeNode(nodeToPop);    (*-- Recover the node space *)
+      ELSE
+        RaiseErrIn(pop, underflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(pop, undefined);
+  END (*--if*);
+END Pop;
+(*----------------------------*)
+
+PROCEDURE PopTopOf (VAR theStack  : Stack     (*-- inout *))
+                                  : Item      (*-- out   *);
+
+VAR   oldTop    : NodePtr;
+      topItem   : Item;
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # NIL) THEN    (*-- Check for stack underflow *)
+        oldTop := top;       (*-- Remember current top of stack *)
+        topItem:= top^.item; (*-- Remember current item at stack top *)
+        top    := top^.next; (*-- Update the stack top *)
+        DEC(depth);          (*-- Maintain a correct depth count *)
+        FreeNode(oldTop);    (*-- Recover the node space *)
+        RETURN topItem;      (*-- Return the data item *)
+      END (*--if*);
+    END (*--with*);
+
+    RaiseErrIn(poptopof, underflow);
+  ELSE
+    RaiseErrIn(poptopof, undefined);
+  END (*--if*);
+  RETURN NullItem;
+END PopTopOf;
+(*----------------------------*)
+
+
+(*
+7.2.5	Selectors
+
+IsDefined simply tests for the stack top being not NIL, returning true or false as
+appropriate.  This is a simple test for a defined stack object.
+*)
+
+PROCEDURE IsDefined (    theStack  : Stack    (*-- in    *))
+                                   : BOOLEAN  (*-- out   *);
+BEGIN
+   RETURN (theStack # NIL);
+END IsDefined;
+(*----------------------------*)
+
+
+(*
+IsEmpty simply tests the link to the stack top being NIL, returning the appropriate
+logical value.  As mentioned in the interface, an undefined stack is considered empty.
+*)
+
+PROCEDURE IsEmpty  (    theStack   : Stack    (*-- in    *))
+                                   : BOOLEAN  (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.top = NIL;
+  END (*--if*);
+
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+
+(*
+IsEqual scans both stacks looking for the first inequality between items which indicates
+the stacks are unequal, otherwise if the loop completes the stacks must be equal.  This
+assumes that both stacks (1) have been defined, (2) have been given the same data type
+ID, and (3) have the same depth.  The first two of these assumptions, if unfounded, cause
+the exceptions, undefined and typeerror, respectively, to be raised.  Invariant: Since the
+stacks have the same depth, when leftIndex is NIL, by definition rightIndex will also be
+NIL.
+*)
+
+PROCEDURE IsEqual  (    left      : Stack     (*-- in    *);
+                        right     : Stack     (*-- in    *))
+                                  : BOOLEAN   (*-- out   *);
+
+VAR   leftIndex : NodePtr;
+      rightIndex: NodePtr;
+	  compare   : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  stackError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.depth = right^.depth) THEN
+	compare   := CompareOf(left^.dataID);
+        leftIndex := left^.top;
+        rightIndex:= right^.top;
+        WHILE (leftIndex # NIL) &
+              (compare(leftIndex^.item, rightIndex^.item) = equal) DO
+          leftIndex := leftIndex^.next;
+          rightIndex:= rightIndex^.next;
+        END (*--while*);
+        RETURN (leftIndex = NIL);
+      END (*--if*);
+    ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+
+PROCEDURE TypeOf    (    theStack  : Stack     (*-- in    *))
+                                   : TypeID    (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*----------------------------*)
+
+PROCEDURE DepthOf  (    theStack   : Stack         (*-- in    *))
+                                   : CARDINAL      (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.depth;
+  END (*--if*);
+  RaiseErrIn(depthof, undefined);
+  RETURN 0;
+END DepthOf;
+(*----------------------------*)
+
+PROCEDURE TopOf    (    theStack   : Stack         (*-- in    *))
+                                   : Item          (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # NIL) THEN
+        RETURN top^.item;
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(topof, underflow);
+  ELSE
+    RaiseErrIn(topof, undefined);
+  END (*--if*);
+
+  RETURN NullItem;
+END TopOf;
+(*----------------------------*)
+
+
+(*
+7.3.6	Iterators
+
+The two ╥looping╙ iterator routines, LoopOver and LoopChange, utilize the same
+algorithm; the essential difference is the type of procedure parameter invoked for each item
+processed.  A similar statement can be made about the two traversal routines, Traverse and
+TravChange.  In all cases, the iteration begins with the top stack item and ends with the
+bottom stack item.
+*)
+
+PROCEDURE LoopOver   (    theStack  : Stack          (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    index := theStack^.top;
+    WHILE (index # NIL) & theProcess(index^.item) DO
+      index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE LoopChange (    theStack  : Stack          (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+VAR   index : NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    index := theStack^.top;
+    WHILE (index # NIL) & theProcess(index^.item) DO
+      index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(loopchange, undefined);
+  END (*--if*);
+END LoopChange;
+(*----------------------------*)
+
+PROCEDURE Traverse  (    theStack  : Stack          (*-- in    *);
+                         theProcess: AccessProc     (*-- in    *));
+
+VAR   index : NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    index := theStack^.top;
+    WHILE (index # NIL) DO
+      theProcess(index^.item);
+      index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+PROCEDURE TravChange (    theStack  : Stack          (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+VAR   index : NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    index := theStack^.top;
+    WHILE (index # NIL) DO
+      theProcess(index^.item);
+      index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(travchange, undefined);
+  END (*--if*);
+END TravChange;
+(*----------------------------*)
+
+
+(*
+7.3.7	Module Initialization
+
+In the module initialization the local exception handlers array variables are set to default
+handlers (ExitOnError) except for the noerr handler which is given the null handler.
+stackError is given the value noerr  avoiding an undefined state.
+*)
+
+BEGIN
+  FOR stackError := initfailed TO MAX(Exceptions) DO
+    SetHandler(stackError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  stackError := noerr;
+END StkSUMI.
+
+
+(*
+References
+
+[1]	A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms, Addison-Wesley,
+	Reading, MA 1983, pp. 37-53.
+[2]	G. Booch, Software Components With Ada Structures, Tools, and Subsystems,
+	Benjamin/Cummings, Menlo Park, CA 1987.
+[3]	D. Knuth, The Art of Computer Programming, Vol. 1, Fundamental Algorithms,
+	Addison-Wesley, Reading, MA 1973.
+[4]	R. Wiener and R. Sincovec, Data Structures Using Modula-2, John Wiley & Sons, New
+	York, NY 1986.
+[5]	N. Wirth, Algorithms and Data Structures, Prentice-Hall, Englewood Cliffs, NJ 1986.
+[6]	N. Wirth, Algorithms + Data Structures = Programs, Prentice-Hall, Englewood Cliffs,
+	NJ 1976.
+[7]	N. Wirth, Programming in Modula-2, Springer-Verlag, New York, NY 1983.
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUMN.DEF
@@ -0,0 +1,199 @@
+(*
+
+7.3		StackSUMN Interface
+
+An implementation of the stack abstraction, described in chapter 5, is presented here.
+This particular form has the properties: Sequential, Unbounded, Managed, and Non-Iterator.
+These describe specific aspects of the implementation as follows:
+
+Sequential:		Can only be used in a non-tasking environment, or by only one task.
+Unbounded:		The size of a stack varies dynamically as items are added and removed.
+Managed:		Memory space for items and objects is returned to the system when no
+				longer needed.
+Non-Iterator:	Routines for looping over each of the stack items are not provided.
+
+
+The interface to the unbounded stack is presented below.  The purpose and
+implementation specifics of each routine is briefly described along with mention of the
+complexity measure of the actual implementation.
+*)
+
+
+DEFINITION MODULE StkSUMN;
+(*============================================================
+    Version  : 1.00  28 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Component: Monolithic Structures - Stack (Opaque version)
+               Sequential Unbounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module provides the stack ADT composed of generic Items.
+
+    REVISION HISTORY
+    v1.00  28 Apr 1989  C. Lins:
+      Initial implementation for TML Modula-2.
+============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM StackEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+
+TYPE  Stack;
+CONST NullStack  = Stack(NIL);
+
+
+(*
+7.3.1	Exceptions
+
+The ModuleID  is used by the exception handling mechanism to distinguish this module
+from other modules.
+
+StackError  returns the exception code from the most recent stack operation.  A result of
+noerr  indicates successful completion of the operation. O(1).
+
+GetHandler  returns the exception handler routine associated with the given exception.
+Though the routine is a function procedure returning a procedure as its result, the
+HandlerProc  may not be called from within the GetHandler  call itself.  The procedure
+result must be first assigned to a procedure variable before invocation.  Exception handlers
+are given an initial value of ExitOnError  except for the handler for noerr  which is
+initialized to the null exception handler. O(1).
+
+SetHandler  associates an exception handler routine with the given exception and is the
+inverse of GetHandler.  This routine may be used to override the default settings for the
+exception handlers. O(1).
+*)
+
+CONST ModuleID = 4;
+
+PROCEDURE StackError ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+
+(*
+7.3.2	Constructors
+
+The Create operation attempts to generate a new, empty stack associated with the given
+data type identifier (theType) and Item operations.  The TypeID is the method by which
+Items of any data type are supported.  Using theType, the component can assign one item
+to another and release any dynamically allocated resources associated with an Item without
+knowledge of the Item's internal composition.  In this way, one may create a stack whose
+items consist of other (dynamically allocated) structures, as well as stacks consisting of
+the basic data types.  Create returns the new stack upon successful completion of the
+routine.  If it is not possible for the stack to be created, the overflow exception is raised
+and the constant NullStack  will be returned. O(1).
+
+Destroy  takes the given stack, clears it of any items, and then destroys the stack itself.
+Where Create makes a defined stack, Destroy is its inverse, making the stack undefined.
+O(1).
+
+Clear  takes the given stack and removes all of its items.  theType attribute of the stack
+(assigned when the stack was created) is used to retrieve the item deallocation routine for
+the items of the stack.  Clearing the stack returns it to the empty state. O(n).
+
+The Assign  operation attempts to generate a duplicate of the source stack (theStack) in
+the target stack (toStack).  The target stack is automatically created using the data type
+attribute of the source stack, if necessary.  If this step is unnecessary, (the target stack has
+been previously created), the target is cleared of its present contents, and its data type is
+set to that of the source stack.  O(n).
+
+In order to allow Items of any data type, a method must be provided to assign the contents
+of one item to another item.  This is accomplished, as above for Create, through the
+TypeID of the source stack.
+
+The Push  operation adds items to the given stack.  The given item is placed on the stack
+top.  If the stack cannot be expanded for theItem the overflow  exception is raised and the
+stack remains unchanged. O(1).
+
+The Pop  operation removes the topmost item from the given stack.  If the given stack is
+empty on entry to Pop  the underflow  exception is raised and the stack remains
+unchanged. O(1).
+
+PopTopOf  is a convenience routine combining the semantics of the constructor Pop and
+the selector TopOf.  The only difference from Pop is that the item's value is not disposed
+of, but is returned instead. O(1).
+*)
+
+
+PROCEDURE Create    (    theType   : TypeID    (*-- in    *))
+                                   : Stack     (*-- out   *);
+
+PROCEDURE Destroy   (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE Clear     (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE Assign    (    theStack  : Stack     (*-- in    *);
+                     VAR toStack   : Stack     (*-- inout *));
+
+PROCEDURE Push      (VAR toStack   : Stack     (*-- inout *);
+                         theItem   : Item      (*-- in    *));
+
+PROCEDURE Pop       (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE PopTopOf  (VAR theStack  : Stack     (*-- inout *))
+                                   : Item      (*-- out   *);
+
+
+(*
+7.3.3	Selectors
+
+IsDefined  attempts to determine whether the given stack is valid, e.g., has been created
+and not yet destroyed.  How this is accomplished may be as simple or complicated as the
+implementor desires and the requirements of the application. O(1).
+
+IsEmpty  returns true if the given stack contains no items; in other words, its depth is
+zero.  Undefined stacks are always considered to be empty. O(1).
+
+IsEqual  returns true if the left and right stacks contain the same items.  Obviously, both
+must also have the same data type and have been created.  An undefined stack is not equal
+to any other stack, including itself. O(n).
+
+The routine TypeOf  returns the type ID value given  to the stack when it was created or
+used as the target of an assignment operation, and is provided so that the user of the
+module need not maintain a separate variable recording this information. O(1).
+
+DepthOf  returns the number of items present on the given stack.  Undefined stacks are
+considered to have a depth of zero. O(1).
+
+TopOf  returns the item currently at the top of the stack.  If the stack is empty a stack
+underflow occurs and the NullItem is returned (since some Item must be).  Undefined
+stacks also cause the NullItem to be returned. O(1).
+*)
+
+
+PROCEDURE IsDefined (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE IsEmpty   (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE IsEqual   (    left      : Stack     (*-- in    *);
+                         right     : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE TypeOf    (    theStack  : Stack     (*-- in    *))
+                                   : TypeID    (*-- out   *);
+
+PROCEDURE DepthOf   (    theStack  : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+
+PROCEDURE TopOf     (    theStack  : Stack     (*-- in    *))
+                                   : Item      (*-- out   *);
+
+END StkSUMN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUMN.MOD
@@ -0,0 +1,656 @@
+
+(*
+7.4	StackSUMN Implementation
+*)
+
+
+IMPLEMENTATION MODULE StkSUMN;
+(*===========================================================
+    Version  : 1.00  28 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Stack (Opaque)
+               Sequential Unbounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module provides the implementation for the operations
+    of the unbounded stack abstract data type.
+
+    REVISION HISTORY
+    v1.00  28 Apr 1989 C. Lins:
+      Initial implementation
+===========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem, NoDisposeProc,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM StackEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+
+    (*--------------------*)
+
+(*
+7.4.1	Internal Unbounded Stack Representation
+
+Figure 7.1
+
+7.4.1.1	Stack Header
+
+For the internal representation of an unbounded stack we will use a singly linked list of
+nodes, with a header node, called UnboundedStack.  This header contains a pointer to the
+topmost node on the stack, a count of the current stack depth, and the data type ID of the
+stack.  An empty stack is represented by a UnboundedStack with a Top pointer of NIL
+and a Depth of zero.  Where possible, a NIL value for the Stack will be accepted as a legal
+value for an empty stack when this will not disrupt the semantics of the invoked
+operation.
+
+
+7.4.1.2	Node
+
+Each node in the list of stack items contains the Item stored on the stack, and a link to
+the node immediately beneath it.  The link for the bottommost node on the stack will
+contain a value of NIL to represent the end of the stack.
+
+
+7.4.1.3	Management of Free Stack Nodes
+
+A separate list of free nodes is kept global for all items popped from the stack.  The
+FreeList is effectively a FreeStack due to the LIFO management scheme employed.  This
+technique is used in order to minimize calls to Allocate and Deallocate system routines,
+since both (though especially Allocate) involve a rather large overhead compared to the
+bounded form.
+
+
+7.4.1.4	Stack ╨ Representation of Depth
+
+The cost to maintain the depth of each stack is relatively small, consisting of a field to
+store the depth (a CARDINAL) and the execution cost to maintain this field whenever an
+item is pushed or popped from the stack. The alternative would be to iterate over every
+item in the stack to calculate the depth whenever this operation was requested.  The
+implementation used  yields an algorithm of O(1) time complexity for determination of
+the stack's depth as opposed to an O(n) algorithm at the expense of a small increase in
+space complexity, and a small increase in the proportionality constants for the time
+complexity of Push and Pop.
+
+
+7.4.1.5	Stack ╨ Representation of an Empty Stack
+
+The representation of an opaque type is restricted to POINTER types [Wirth85, pg. 169].
+An alternative representation for an empty stack would be to use a value of NIL for the
+Stack.  Though this would simplify testing for an empty stack, it would complicate
+primitive operations such as Pop and Clear, which would then require the Free operation
+as a parameter.
+
+
+7.4.2	Efficiency of Operations
+
+Within the implementation of a component, we allow ourselves to violate the abstraction
+by examining the internal components of the data structure.  Repetitive invocations of
+procedures supporting the abstraction may be replaced with the ╥inline╙ equivalent of the
+operation.  This is most commonly done when testing for the empty stack condition and
+in copying items.
+*)
+
+TYPE  NodePtr = POINTER TO Node;
+TYPE  Node    = RECORD   (*-- a stack node *)
+        item  : Item;    (*-- generic data item *)
+        next  : NodePtr; (*-- next node beneath this one, if any *)
+      END (*-- Node *);
+
+TYPE  UnboundedStack = RECORD
+        dataID: TypeID;   (*-- Defined data type for this stack*)
+        depth : CARDINAL; (*-- current stack depth, := 0   *)
+        top   : NodePtr;  (*-- current stack top    := NIL *)
+      END (*-- UnboundedStack *);
+
+TYPE  Stack = POINTER TO UnboundedStack;
+
+    (*-----------------------*)
+
+
+(*
+7.4.3	Exceptions
+
+To support the exception handling mechanism two variables are needed.  The first,
+stackError, is used to record the exception code from each operation; while handlers  is an
+array of exception handling procedures indexed by the exception code.
+
+The routines StackError, GetHandler, and SetHandler  have been previously described in
+the definition module, and their operation should be readily apparent.  RaiseErrIn  is a
+local routine used to set stackError and invoke the Raise  routine of the ErrorHandling
+module.
+*)
+
+VAR   stackError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+
+PROCEDURE StackError ()              : Exceptions  (*-- out   *);
+BEGIN
+  RETURN stackError;
+END StackError;
+(*----------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*-- in    *);
+                          theError   : Exceptions  (*-- in    *));
+BEGIN
+  stackError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+
+(* ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤
+    µ  Local  µ  Local  µ  Local  µ  Local  µ  Local  µ  Local  µ
+   ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤ *)
+
+    MODULE FreeListMgr;
+
+    (*-- This local module controls access to the Available node list.
+      -- Version 1.00  07 Jun. 1987  C. Lins *)
+
+    IMPORT Node, NodePtr, Allocate, Deallocate;
+    EXPORT FreeNode, GetNode;
+
+    VAR   FreeList : NodePtr; (*-- Free list of available stack nodes *)
+
+    (*----------------------------*)
+
+(*
+FreeNode adds the given node to the front of the free list.  theNode's  next field is linked
+to the front of the free list and the node becomes the new front of the free list.
+*)
+
+    PROCEDURE FreeNode (VAR theNode: NodePtr);
+    BEGIN
+      theNode^.next := FreeList;
+      FreeList      := theNode;
+    END FreeNode;
+    (*----------------------------*)
+
+
+(*
+GetNode attempts to generate a new stack node.  If the free list is empty, attempt to
+allocate a brand new node.  If the allocation attempt fails, return False and exit, otherwise
+return the brand new node, a function result of True and exit.  If the free list is not empty,
+remove the first available node from the free list and return the used node to the caller
+along with a function result of True.
+*)
+
+    PROCEDURE GetNode (VAR theNode: NodePtr (*-- out *)): BOOLEAN;
+    BEGIN
+      IF (FreeList = NIL) THEN
+        Allocate(theNode, SIZE(Node));
+        IF (theNode = NIL) THEN
+          RETURN FALSE;
+        END (*--if*);
+      ELSE
+        theNode  := FreeList;
+        FreeList := FreeList^.next;
+      END (*--if*);
+      RETURN TRUE;
+    END GetNode;
+    (*----------------------------*)
+
+    (* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ *)
+    (* ~~~~~  Local Module Initialization  ~~~~~ *)
+
+    BEGIN
+      FreeList := NIL; (*-- Initialize the free list to empty. *)
+    END FreeListMgr;
+
+
+(* ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤
+    á  Local  á  Local  á  Local  á  Local  á  Local  á  Local  á
+   ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤ *)
+
+
+(*
+7.4.4	Constructors
+
+Create begins by clearing the stackError  field under the assumption of a successful result.
+
+The stack header is then allocated in a local variable since the function result cannot be
+manipulated but only returned.  If the unbounded stack could not be allocated, the
+overflow exception must be raised, and the NullStack returned.
+
+At this point, all possibility of failure has been avoided and the unbounded stack header
+can be initialized to its empty state (top is set to NIL, depth set to zero), and the data type
+ID  can be stored for this unbounded stack.  Lastly, the new stack is returned to the caller.
+Complexity: O(1).
+*)
+
+PROCEDURE Create    (    theType   : TypeID    (*-- in    *))
+                                   : Stack     (*-- out   *);
+
+VAR   newStack : Stack;
+
+BEGIN
+  stackError := noerr;
+  Allocate(newStack, SIZE(UnboundedStack));
+  IF (newStack # NIL) THEN
+    WITH newStack^ DO
+      dataID := theType;
+      depth  := 0;
+      top    := NIL;
+    END (*--with*);
+    RETURN newStack;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullStack;
+END Create;
+(*----------------------------*)
+
+
+(*
+Destroy  takes advantage that Clear  sets stackError  to noerr and raises the undefined
+stack exception.  So if Clear succeeds, Destroy simply releases the allocated stack header.
+Complexity: O(n).
+*)
+
+PROCEDURE Destroy  (VAR theStack  : Stack     (*-- inout *));
+BEGIN
+  Clear(theStack);
+  IF (stackError = noerr) THEN
+    Deallocate(theStack, SIZE(theStack^));
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+
+(*
+After initializing stackError and verifying that the given stack is a valid object, Clear
+retrieves the item disposal routine associated with the stack's data type from the
+TypeManager module.  Then each item on the stack is deallocated followed by its stack
+node.  To do this safely a local variable, nodeToFree, is used to hold each node.  The loop
+invariant takes advantage of the fact that the bottommost stack node contains a next field
+of NIL, and this will automatically cause top to contain that value once all stack nodes
+have been cleared.  The last step is to reset depth to zero.
+Complexity O(n).
+*)
+
+PROCEDURE Clear    (VAR theStack  : Stack     (*-- inout *));
+
+VAR   nodeToFree : NodePtr;
+      freeItem   : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      freeItem := DisposeOf(dataID);
+      WHILE (top # NIL) DO
+        nodeToFree := top;
+        top := top^.next;
+        freeItem(nodeToFree^.item);
+        FreeNode(nodeToFree);
+      END (*--while*);
+      depth := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+
+(*
+Assignment for unbounded objects has the complication that overflow may occur while
+adding individual stack nodes.  When the target object is undefined, it must be created
+using the data type attribute of the source object.  If overflow does not occur, the actual
+assignment can commence, otherwise its suffices to exit (Create has already raised the
+exception).  When the target object is defined on entry to the Assign operation, it is
+sufficient to Clear the existing contents and update the data type with that of the source
+stack.  If the source stack is empty, the routine may simply exit.  Otherwise, the top
+node is copied from the source to the target, followed by a loop over the remaining items,
+if any.
+
+In order to properly copy the source stack, two node pointers are necessary: one, to loop
+through each of the source nodes, and the second to keep track of the last node added to the
+target stack.
+
+The assignment operator cannot be used to copy individual items as the data type of those
+items is unknown; using assignment for dynamically allocated items would cause
+structural sharing of items, which is not desired.
+Complexity O(mn).
+*)
+
+PROCEDURE Assign   (    theStack  : Stack     (*-- in    *);
+                    VAR toStack   : Stack     (*-- inout *));
+
+VAR   fromIndex : NodePtr;    (*-- node to add from source stack *)
+      toIndex   : NodePtr;    (*-- last node added to target stack *)
+      assignItem: AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  IF (theStack # NIL) THEN
+    IF (toStack # NIL) THEN
+      Clear(toStack);
+      toStack^.dataID := theStack^.dataID;
+    ELSE
+      toStack := Create(theStack^.dataID);
+    END (*--if*);
+
+    IF (stackError # noerr) OR (theStack^.top = NIL) THEN
+      RETURN;
+    END (*--if*);
+
+    assignItem := AssignOf(theStack^.dataID);
+    IF GetNode(toStack^.top) THEN
+      WITH toStack^.top^ DO
+        item := assignItem(theStack^.top^.item);
+        next := NIL;
+      END (*--with*);
+      fromIndex := theStack^.top;
+      toIndex   := toStack^.top;
+      INC(toStack^.depth);
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+
+    WHILE (stackError = noerr) & (fromIndex^.next # NIL) DO
+      fromIndex := fromIndex^.next;
+      IF GetNode(toIndex^.next) THEN
+        toIndex := toIndex^.next;
+        WITH toIndex^ DO
+          item := assignItem(fromIndex^.item);
+          next := NIL;
+        END (*--with*);
+        INC(toStack^.depth);
+      ELSE
+        RaiseErrIn(assign, overflow);
+      END (*--if*);
+    END (*--while*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+
+(*
+Push  attempts retrieval of a stack node for the new item, which if successful allows us to
+store the data for new stack top and a link to the current stack top. Then the stack top can
+be updated to point to the new node and the depth can be updated. If a stack node could not
+be allocated the overflow exception is raised and the stack is left unchanged.
+Complexity O(1)
+*)
+
+PROCEDURE Push     (VAR toStack   : Stack     (*-- inout *);
+                        theItem   : Item      (*-- in    *));
+
+VAR   newNode: NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (toStack # NIL) THEN
+    IF GetNode(newNode) THEN
+      WITH toStack^ DO
+        newNode^.item := theItem;
+        newNode^.next := top;
+        top := newNode;
+        INC(depth);
+      END (*--with*);
+    ELSE
+      RaiseErrIn(push, overflow);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(push, undefined);
+  END (*--if*);
+END Push;
+(*----------------------------*)
+
+
+(*
+Pop  is the inverse of Push, requiring a test for stack underflow, before effectively
+undoing what was done in order to place a node on the stack.
+
+PopTopOf  is similar to Pop except the item is not deallocated, but instead is returned to
+the caller.
+*)
+
+PROCEDURE Pop       (VAR theStack  : Stack     (*-- inout *));
+
+VAR   nodeToPop: NodePtr;
+      freeItem : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # NIL) THEN       (*-- Check for stack underflow *)
+        nodeToPop := top;       (*-- Remember current top of stack *)
+        top       := top^.next; (*-- Update the top of stack *)
+        DEC(depth);             (*-- Maintain a correct depth count *)
+        freeItem := DisposeOf(dataID);
+        freeItem(nodeToPop^.item); (*-- Safely recover the item space *)
+        FreeNode(nodeToPop);    (*-- Recover the node space *)
+      ELSE
+        RaiseErrIn(pop, underflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(pop, undefined);
+  END (*--if*);
+END Pop;
+(*----------------------------*)
+
+PROCEDURE PopTopOf (VAR theStack  : Stack     (*-- inout *))
+                                  : Item      (*-- out   *);
+
+VAR   oldTop    : NodePtr;
+      topItem   : Item;
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # NIL) THEN    (*-- Check for stack underflow *)
+        oldTop := top;       (*-- Remember current top of stack *)
+        topItem:= top^.item; (*-- Remember current item at stack top *)
+        top    := top^.next; (*-- Update the stack top *)
+        DEC(depth);          (*-- Maintain a correct depth count *)
+        FreeNode(oldTop);    (*-- Recover the node space *)
+        RETURN topItem;      (*-- Return the data item *)
+      END (*--if*);
+    END (*--with*);
+
+    RaiseErrIn(poptopof, underflow);
+  ELSE
+    RaiseErrIn(poptopof, undefined);
+  END (*--if*);
+  RETURN NullItem;
+END PopTopOf;
+(*----------------------------*)
+
+
+(*
+7.4.5	Selectors
+
+IsDefined simply tests for the stack top being not NIL, returning true or false as
+appropriate.  This is a simple test for a defined stack object.
+*)
+
+PROCEDURE IsDefined (    theStack  : Stack    (*-- in    *))
+                                   : BOOLEAN  (*-- out   *);
+BEGIN
+   RETURN (theStack # NIL);
+END IsDefined;
+(*----------------------------*)
+
+
+(*
+IsEmpty simply tests the link to the stack top being NIL, returning the appropriate
+logical value.  As mentioned in the interface, an undefined stack is considered empty.
+*)
+
+PROCEDURE IsEmpty  (    theStack   : Stack    (*-- in    *))
+                                   : BOOLEAN  (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.top = NIL;
+  END (*--if*);
+
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+
+(*
+IsEqual scans both stacks looking for the first inequality between items which indicates
+the stacks are unequal, otherwise if the loop completes the stacks must be equal.  This
+assumes that both stacks (1) have been defined, (2) have been given the same data type
+ID, and (3) have the same depth.  The first two of these assumptions, if unfounded, cause
+the exceptions, undefined and typeerror, respectively, to be raised.  Invariant: Since the
+stacks have the same depth, when leftIndex is NIL, by definition rightIndex will also be
+NIL.
+*)
+
+PROCEDURE IsEqual  (    left      : Stack     (*-- in    *);
+                        right     : Stack     (*-- in    *))
+                                  : BOOLEAN   (*-- out   *);
+
+VAR   leftIndex : NodePtr;
+      rightIndex: NodePtr;
+      compare   : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  stackError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF (left^.dataID = right^.dataID) THEN
+      IF (left^.depth = right^.depth) THEN
+	compare   := CompareOf(left^.dataID);
+        leftIndex := left^.top;
+        rightIndex:= right^.top;
+        WHILE (leftIndex # NIL) &
+              (compare(leftIndex^.item, rightIndex^.item) = equal) DO
+          leftIndex := leftIndex^.next;
+          rightIndex:= rightIndex^.next;
+        END (*--while*);
+        RETURN (leftIndex = NIL);
+      END (*--if*);
+    ELSE
+      RaiseErrIn(isequal, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+
+PROCEDURE TypeOf    (    theStack  : Stack     (*-- in    *))
+                                   : TypeID    (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*----------------------------*)
+
+PROCEDURE DepthOf  (    theStack   : Stack         (*-- in    *))
+                                   : CARDINAL      (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.depth;
+  END (*--if*);
+  RaiseErrIn(depthof, undefined);
+  RETURN 0;
+END DepthOf;
+(*----------------------------*)
+
+PROCEDURE TopOf    (    theStack   : Stack         (*-- in    *))
+                                   : Item          (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # NIL) THEN
+        RETURN top^.item;
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(topof, underflow);
+  ELSE
+    RaiseErrIn(topof, undefined);
+  END (*--if*);
+
+  RETURN NullItem;
+END TopOf;
+(*----------------------------*)
+
+
+(*
+7.4.6	Module Initialization
+
+In the module initialization the local exception handlers array variables are set to default
+handlers (ExitOnError) except for the noerr handler which is given the null handler.
+stackError is given the value noerr  avoiding an undefined state.
+*)
+
+BEGIN
+  FOR stackError := initfailed TO MAX(Exceptions) DO
+    SetHandler(stackError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  stackError := noerr;
+END StkSUMN.
+
+
+(*
+References
+
+[1]	A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms, Addison-Wesley,
+	Reading, MA 1983, pp. 37-53.
+[2]	G. Booch, Software Components With Ada Structures, Tools, and Subsystems,
+	Benjamin/Cummings, Menlo Park, CA 1987.
+[3]	D. Knuth, The Art of Computer Programming, Vol. 1, Fundamental Algorithms,
+	Addison-Wesley, Reading, MA 1973.
+[4]	R. Wiener and R. Sincovec, Data Structures Using Modula-2, John Wiley & Sons, New
+	York, NY 1986.
+[5]	N. Wirth, Algorithms and Data Structures, Prentice-Hall, Englewood Cliffs, NJ 1986.
+[6]	N. Wirth, Algorithms + Data Structures = Programs, Prentice-Hall, Englewood Cliffs,
+	NJ 1976.
+[7]	N. Wirth, Programming in Modula-2, Springer-Verlag, New York, NY 1983.
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUUI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUUI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUUI.DEF
@@ -0,0 +1,90 @@
+DEFINITION MODULE StkSUUI;
+(*============================================================
+    Version  : 1.00  28 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Stack (Opaque version)
+               Sequential Unbounded Unmanaged Iterator
+
+    REVISION HISTORY
+    v1.00  28 Apr 1989  C. Lins:
+      Initial implementation from StackSUMI module.
+============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc, ChangeProc,
+               LoopChangeProc;
+
+FROM StackEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+    (*-----------------------*)
+
+TYPE  Stack;
+CONST NullStack  = Stack(NIL);
+
+CONST ModuleID = 6;
+
+PROCEDURE StackError ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+    (*-----------------------*)
+
+PROCEDURE Create    ()             : Stack     (*-- out   *);
+
+PROCEDURE Destroy   (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE Clear     (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE Assign    (    theStack  : Stack     (*-- in    *);
+                     VAR toStack   : Stack     (*-- inout *));
+
+PROCEDURE Push      (VAR toStack   : Stack     (*-- inout *);
+                         theItem   : Item      (*-- in    *));
+
+PROCEDURE Pop       (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE PopTopOf  (VAR theStack  : Stack     (*-- inout *))
+                                   : Item      (*-- out   *);
+
+    (*-----------------------*)
+
+PROCEDURE IsDefined (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE IsEmpty   (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE IsEqual   (    left      : Stack     (*-- in    *);
+                         right     : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE DepthOf   (    theStack  : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+
+PROCEDURE TopOf     (    theStack  : Stack     (*-- in    *))
+                                   : Item      (*-- out   *);
+
+    (*-----------------------*)
+
+PROCEDURE LoopOver   (    theStack  : Stack          (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE LoopChange (    theStack  : Stack          (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+PROCEDURE Traverse   (    theStack  : Stack          (*-- in    *);
+                          theProcess: AccessProc     (*-- in    *));
+
+PROCEDURE TravChange (    theStack  : Stack          (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+END StkSUUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUUI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUUI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUUI.MOD
@@ -0,0 +1,468 @@
+IMPLEMENTATION MODULE StkSUUI;
+(*===========================================================
+    Version  : 1.00  28 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Stack (Opaque)
+               Sequential Unbounded Unmanaged Iterator
+
+    REVISION HISTORY
+    v1.00  28 Apr 1989 C. Lins:
+      Initial implementation from StackSUMI module.
+===========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AccessProc, ChangeProc,
+               LoopAccessProc, LoopChangeProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM StackEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+    (*--------------------*)
+
+TYPE  NodePtr = POINTER TO Node;
+TYPE  Node    = RECORD   (*-- a stack node *)
+        item  : Item;    (*-- generic data item *)
+        next  : NodePtr; (*-- next node beneath this one, if any *)
+      END (*-- Node *);
+
+TYPE  UnboundedStack = RECORD
+        depth : CARDINAL; (*-- current stack depth, := 0   *)
+        top   : NodePtr;  (*-- current stack top    := NIL *)
+      END (*-- UnboundedStack *);
+
+TYPE  Stack = POINTER TO UnboundedStack;
+
+    (*-----------------------*)
+
+
+VAR   stackError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+    (*-----------------------*)
+
+
+PROCEDURE StackError ()              : Exceptions  (*-- out   *);
+BEGIN
+  RETURN stackError;
+END StackError;
+(*----------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*-- in    *);
+                          theError   : Exceptions  (*-- in    *));
+BEGIN
+  stackError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+
+(* ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤
+    µ  Local  µ  Local  µ  Local  µ  Local  µ  Local  µ  Local  µ
+   ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤ *)
+
+    MODULE FreeListMgr;
+
+    (*-- This local module controls access to the Available node list.
+      -- Version 1.00  07 Jun. 1987  C. Lins *)
+
+    IMPORT Node, NodePtr, Allocate, Deallocate;
+    EXPORT FreeNode, GetNode;
+
+    VAR   FreeList : NodePtr; (*-- Free list of available stack nodes *)
+
+    (*----------------------------*)
+
+    PROCEDURE FreeNode (VAR theNode: NodePtr);
+    BEGIN
+      theNode^.next := FreeList;
+      FreeList      := theNode;
+    END FreeNode;
+    (*----------------------------*)
+
+
+    PROCEDURE GetNode (VAR theNode: NodePtr (*-- out *)): BOOLEAN;
+    BEGIN
+      IF (FreeList = NIL) THEN
+        Allocate(theNode, SIZE(Node));
+        IF (theNode = NIL) THEN
+          RETURN FALSE;
+        END (*--if*);
+      ELSE
+        theNode  := FreeList;
+        FreeList := FreeList^.next;
+      END (*--if*);
+      RETURN TRUE;
+    END GetNode;
+    (*----------------------------*)
+
+    (* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ *)
+    (* ~~~~~  Local Module Initialization  ~~~~~ *)
+
+    BEGIN
+      FreeList := NIL; (*-- Initialize the free list to empty. *)
+    END FreeListMgr;
+
+
+(* ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤
+    á  Local  á  Local  á  Local  á  Local  á  Local  á  Local  á
+   ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤ *)
+
+
+PROCEDURE Create    ()             : Stack     (*-- out   *);
+
+VAR   newStack : Stack;
+
+BEGIN
+  stackError := noerr;
+  Allocate(newStack, SIZE(UnboundedStack));
+  IF (newStack # NIL) THEN
+    WITH newStack^ DO
+      depth  := 0;
+      top    := NIL;
+    END (*--with*);
+    RETURN newStack;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullStack;
+END Create;
+(*----------------------------*)
+
+PROCEDURE Destroy  (VAR theStack  : Stack     (*-- inout *));
+BEGIN
+  Clear(theStack);
+  IF (stackError = noerr) THEN
+    Deallocate(theStack, SIZE(theStack^));
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+PROCEDURE Clear    (VAR theStack  : Stack     (*-- inout *));
+
+VAR   nodeToFree : NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      WHILE (top # NIL) DO
+        nodeToFree := top;
+        top := top^.next;
+        FreeNode(nodeToFree);
+      END (*--while*);
+      depth := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+PROCEDURE Assign   (    theStack  : Stack     (*-- in    *);
+                    VAR toStack   : Stack     (*-- inout *));
+
+VAR   fromIndex : NodePtr;    (*-- node to add from source stack *)
+      toIndex   : NodePtr;    (*-- last node added to target stack *)
+
+BEGIN
+  IF (theStack # NIL) THEN
+    IF (toStack # NIL) THEN
+      Clear(toStack);
+    ELSE
+      toStack := Create();
+    END (*--if*);
+
+    IF (stackError # noerr) OR (theStack^.top = NIL) THEN
+      RETURN;
+    END (*--if*);
+
+    IF GetNode(toStack^.top) THEN
+      WITH toStack^.top^ DO
+        item := theStack^.top^.item;
+        next := NIL;
+      END (*--with*);
+      fromIndex := theStack^.top;
+      toIndex   := toStack^.top;
+      INC(toStack^.depth);
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+
+
+    WHILE (stackError = noerr) & (fromIndex^.next # NIL) DO
+      fromIndex := fromIndex^.next;
+      IF GetNode(toIndex^.next) THEN
+        toIndex := toIndex^.next;
+        WITH toIndex^ DO
+          item := fromIndex^.item;
+          next := NIL;
+        END (*--with*);
+        INC(toStack^.depth);
+      ELSE
+        RaiseErrIn(assign, overflow);
+      END (*--if*);
+    END (*--while*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+PROCEDURE Push     (VAR toStack   : Stack     (*-- inout *);
+                        theItem   : Item      (*-- in    *));
+
+VAR   newNode: NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (toStack # NIL) THEN
+    IF GetNode(newNode) THEN
+      WITH toStack^ DO
+        newNode^.item := theItem;
+        newNode^.next := top;
+        top := newNode;
+        INC(depth);
+      END (*--with*);
+    ELSE
+      RaiseErrIn(push, overflow);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(push, undefined);
+  END (*--if*);
+END Push;
+(*----------------------------*)
+
+PROCEDURE Pop       (VAR theStack  : Stack     (*-- inout *));
+
+VAR   nodeToPop: NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # NIL) THEN       (*-- Check for stack underflow *)
+        nodeToPop := top;       (*-- Remember current top of stack *)
+        top       := top^.next; (*-- Update the top of stack *)
+        DEC(depth);             (*-- Maintain a correct depth count *)
+        FreeNode(nodeToPop);    (*-- Recover the node space *)
+      ELSE
+        RaiseErrIn(pop, underflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(pop, undefined);
+  END (*--if*);
+END Pop;
+(*----------------------------*)
+
+PROCEDURE PopTopOf (VAR theStack  : Stack     (*-- inout *))
+                                  : Item      (*-- out   *);
+
+VAR   oldTop    : NodePtr;
+      topItem   : Item;
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # NIL) THEN    (*-- Check for stack underflow *)
+        oldTop := top;       (*-- Remember current top of stack *)
+        topItem:= top^.item; (*-- Remember current item at stack top *)
+        top    := top^.next; (*-- Update the stack top *)
+        DEC(depth);          (*-- Maintain a correct depth count *)
+        FreeNode(oldTop);    (*-- Recover the node space *)
+        RETURN topItem;      (*-- Return the data item *)
+      END (*--if*);
+    END (*--with*);
+
+    RaiseErrIn(poptopof, underflow);
+  ELSE
+    RaiseErrIn(poptopof, undefined);
+  END (*--if*);
+  RETURN NullItem;
+END PopTopOf;
+(*----------------------------*)
+
+PROCEDURE IsDefined (    theStack  : Stack    (*-- in    *))
+                                   : BOOLEAN  (*-- out   *);
+BEGIN
+   RETURN (theStack # NIL);
+END IsDefined;
+(*----------------------------*)
+
+PROCEDURE IsEmpty  (    theStack   : Stack    (*-- in    *))
+                                   : BOOLEAN  (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.top = NIL;
+  END (*--if*);
+
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+PROCEDURE IsEqual  (    left      : Stack     (*-- in    *);
+                        right     : Stack     (*-- in    *))
+                                  : BOOLEAN   (*-- out   *);
+
+VAR   leftIndex : NodePtr;
+      rightIndex: NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF (left^.depth = right^.depth) THEN
+      leftIndex := left^.top;
+      rightIndex:= right^.top;
+      WHILE (leftIndex # NIL) &
+            (leftIndex^.item = rightIndex^.item) DO
+        leftIndex := leftIndex^.next;
+        rightIndex:= rightIndex^.next;
+      END (*--while*);
+      RETURN (leftIndex = NIL);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE DepthOf  (    theStack   : Stack         (*-- in    *))
+                                   : CARDINAL      (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.depth;
+  END (*--if*);
+  RaiseErrIn(depthof, undefined);
+  RETURN 0;
+END DepthOf;
+(*----------------------------*)
+
+PROCEDURE TopOf    (    theStack   : Stack         (*-- in    *))
+                                   : Item          (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # NIL) THEN
+        RETURN top^.item;
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(topof, underflow);
+  ELSE
+    RaiseErrIn(topof, undefined);
+  END (*--if*);
+
+  RETURN NullItem;
+END TopOf;
+(*----------------------------*)
+
+PROCEDURE LoopOver   (    theStack  : Stack          (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    index := theStack^.top;
+    WHILE (index # NIL) & theProcess(index^.item) DO
+      index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE LoopChange (    theStack  : Stack          (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+VAR   index : NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    index := theStack^.top;
+    WHILE (index # NIL) & theProcess(index^.item) DO
+      index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(loopchange, undefined);
+  END (*--if*);
+END LoopChange;
+(*----------------------------*)
+
+PROCEDURE Traverse  (    theStack  : Stack          (*-- in    *);
+                         theProcess: AccessProc     (*-- in    *));
+
+VAR   index : NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    index := theStack^.top;
+    WHILE (index # NIL) DO
+      theProcess(index^.item);
+      index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+PROCEDURE TravChange (    theStack  : Stack          (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+VAR   index : NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    index := theStack^.top;
+    WHILE (index # NIL) DO
+      theProcess(index^.item);
+      index := index^.next;
+    END (*--while*);
+  ELSE
+    RaiseErrIn(travchange, undefined);
+  END (*--if*);
+END TravChange;
+(*----------------------------*)
+
+BEGIN
+  FOR stackError := initfailed TO MAX(Exceptions) DO
+    SetHandler(stackError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  stackError := noerr;
+END StkSUUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUUN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUUN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUUN.DEF
@@ -0,0 +1,97 @@
+(*
+
+7.3		StackSUUN Interface
+
+An implementation of the stack abstraction, described in chapter 5, is presented here.
+This particular form has the properties: Sequential, Unbounded, Unmanaged, and Non-Iterator.
+These describe specific aspects of the implementation as follows:
+
+Sequential:		Can only be used in a non-tasking environment, or by only one task.
+Unbounded:		The size of a stack varies dynamically as items are added and removed.
+Unmanaged:		Memory space for objects is returned to the system when no
+				longer needed. Items are NOT managed.
+Non-Iterator:	Routines for looping over each of the stack items are not provided.
+
+
+The interface to the unbounded stack is presented below.
+Refer to StackSUMN for comments.
+*)
+
+
+DEFINITION MODULE StkSUUN;
+(*============================================================
+    Version  : 1.00  28 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Stack (Opaque version)
+               Sequential Unbounded Unmanaged Non-Iterator
+
+    REVISION HISTORY
+    v1.00  28 Apr 1989  C. Lins:
+      Initial implementation
+============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM StackEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+    (*-----------------------*)
+
+TYPE  Stack;
+CONST NullStack  = Stack(NIL);
+
+    (*-----------------------*)
+
+CONST ModuleID = 7;
+
+PROCEDURE StackError ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+    (*-----------------------*)
+
+PROCEDURE Create    ()             : Stack     (*-- out   *);
+
+PROCEDURE Destroy   (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE Clear     (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE Assign    (    theStack  : Stack     (*-- in    *);
+                     VAR toStack   : Stack     (*-- inout *));
+
+PROCEDURE Push      (VAR toStack   : Stack     (*-- inout *);
+                         theItem   : Item      (*-- in    *));
+
+PROCEDURE Pop       (VAR theStack  : Stack     (*-- inout *));
+
+PROCEDURE PopTopOf  (VAR theStack  : Stack     (*-- inout *))
+                                   : Item      (*-- out   *);
+
+    (*-----------------------*)
+
+PROCEDURE IsDefined (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE IsEmpty   (    theStack  : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE IsEqual   (    left      : Stack     (*-- in    *);
+                         right     : Stack     (*-- in    *))
+                                   : BOOLEAN   (*-- out   *);
+
+PROCEDURE DepthOf   (    theStack  : Stack     (*-- in    *))
+                                   : CARDINAL  (*-- out   *);
+
+PROCEDURE TopOf     (    theStack  : Stack     (*-- in    *))
+                                   : Item      (*-- out   *);
+
+END StkSUUN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUUN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUUN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUUN.MOD
@@ -0,0 +1,394 @@
+
+(*
+7.4	StackSUUN Implementation
+*)
+
+
+IMPLEMENTATION MODULE StkSUUN;
+(*===========================================================
+    Version  : 1.00  28 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Stack (Opaque)
+               Sequential Unbounded Unmanaged Non-Iterator
+
+    REVISION HISTORY
+    v1.00  28 Apr 1989 C. Lins:
+      Initial implementation
+===========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM StackEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+    (*--------------------*)
+
+TYPE  NodePtr = POINTER TO Node;
+TYPE  Node    = RECORD   (*-- a stack node *)
+        item  : Item;    (*-- generic data item *)
+        next  : NodePtr; (*-- next node beneath this one, if any *)
+      END (*-- Node *);
+
+TYPE  UnboundedStack = RECORD
+        depth : CARDINAL; (*-- current stack depth, := 0   *)
+        top   : NodePtr;  (*-- current stack top    := NIL *)
+      END (*-- UnboundedStack *);
+
+TYPE  Stack = POINTER TO UnboundedStack;
+
+    (*-----------------------*)
+
+VAR   stackError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE StackError ()              : Exceptions  (*-- out   *);
+BEGIN
+  RETURN stackError;
+END StackError;
+(*----------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*-- in    *);
+                          theError   : Exceptions  (*-- in    *));
+BEGIN
+  stackError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+
+(* ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤
+    Ñ  Local  Ñ  Local  Ñ  Local  Ñ  Local  Ñ  Local  Ñ  Local  Ñ
+   ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤ *)
+
+    MODULE FreeListMgr;
+
+    (*-- This local module controls access to the Available node list.
+      -- Version 1.00  07 Jun. 1987  C. Lins *)
+
+    IMPORT Node, NodePtr, Allocate, Deallocate;
+    EXPORT FreeNode, GetNode;
+
+    VAR   FreeList : NodePtr; (*-- Free list of available stack nodes *)
+
+    (*----------------------------*)
+
+    PROCEDURE FreeNode (VAR theNode: NodePtr);
+    BEGIN
+      theNode^.next := FreeList;
+      FreeList      := theNode;
+    END FreeNode;
+    (*----------------------------*)
+
+    PROCEDURE GetNode (VAR theNode: NodePtr (*-- out *)): BOOLEAN;
+    BEGIN
+      IF (FreeList = NIL) THEN
+        Allocate(theNode, SIZE(Node));
+        IF (theNode = NIL) THEN
+          RETURN FALSE;
+        END (*--if*);
+      ELSE
+        theNode  := FreeList;
+        FreeList := FreeList^.next;
+      END (*--if*);
+      RETURN TRUE;
+    END GetNode;
+    (*----------------------------*)
+
+    (* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ *)
+    (* ~~~~~  Local Module Initialization  ~~~~~ *)
+
+    BEGIN
+      FreeList := NIL; (*-- Initialize the free list to empty. *)
+    END FreeListMgr;
+
+
+(* ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤
+    Ñ  Local  Ñ  Local  Ñ  Local  Ñ  Local  Ñ  Local  Ñ  Local  Ñ
+   ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤ *)
+
+
+PROCEDURE Create    ()             : Stack     (*-- out   *);
+
+VAR   newStack : Stack;
+
+BEGIN
+  stackError := noerr;
+  Allocate(newStack, SIZE(UnboundedStack));
+  IF (newStack # NIL) THEN
+    WITH newStack^ DO
+      depth  := 0;
+      top    := NIL;
+    END (*--with*);
+    RETURN newStack;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullStack;
+END Create;
+(*----------------------------*)
+
+PROCEDURE Destroy  (VAR theStack  : Stack     (*-- inout *));
+BEGIN
+  Clear(theStack);
+  IF (stackError = noerr) THEN
+    Deallocate(theStack, SIZE(theStack^));
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+PROCEDURE Clear    (VAR theStack  : Stack     (*-- inout *));
+
+VAR   nodeToFree : NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      WHILE (top # NIL) DO
+        nodeToFree := top;
+        top := top^.next;
+        FreeNode(nodeToFree);
+      END (*--while*);
+      depth := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+PROCEDURE Assign   (    theStack  : Stack     (*-- in    *);
+                    VAR toStack   : Stack     (*-- inout *));
+
+VAR   fromIndex : NodePtr;    (*-- node to add from source stack *)
+      toIndex   : NodePtr;    (*-- last node added to target stack *)
+
+BEGIN
+  IF (theStack # NIL) THEN
+    IF (toStack # NIL) THEN
+      Clear(toStack);
+    ELSE
+      toStack := Create();
+    END (*--if*);
+
+    IF (stackError # noerr) OR (theStack^.top = NIL) THEN
+      RETURN;
+    END (*--if*);
+
+    IF GetNode(toStack^.top) THEN
+      WITH toStack^.top^ DO
+        item := theStack^.top^.item;
+        next := NIL;
+      END (*--with*);
+      fromIndex := theStack^.top;
+      toIndex   := toStack^.top;
+      INC(toStack^.depth);
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+
+    WHILE (stackError = noerr) & (fromIndex^.next # NIL) DO
+      fromIndex := fromIndex^.next;
+      IF GetNode(toIndex^.next) THEN
+        toIndex := toIndex^.next;
+        WITH toIndex^ DO
+          item := fromIndex^.item;
+          next := NIL;
+        END (*--with*);
+        INC(toStack^.depth);
+      ELSE
+        RaiseErrIn(assign, overflow);
+      END (*--if*);
+    END (*--while*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+PROCEDURE Push     (VAR toStack   : Stack     (*-- inout *);
+                        theItem   : Item      (*-- in    *));
+
+VAR   newNode: NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (toStack # NIL) THEN
+    IF GetNode(newNode) THEN
+      WITH toStack^ DO
+        newNode^.item := theItem;
+        newNode^.next := top;
+        top := newNode;
+        INC(depth);
+      END (*--with*);
+    ELSE
+      RaiseErrIn(push, overflow);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(push, undefined);
+  END (*--if*);
+END Push;
+(*----------------------------*)
+
+PROCEDURE Pop       (VAR theStack  : Stack     (*-- inout *));
+
+VAR   nodeToPop: NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # NIL) THEN       (*-- Check for stack underflow *)
+        nodeToPop := top;       (*-- Remember current top of stack *)
+        top       := top^.next; (*-- Update the top of stack *)
+        DEC(depth);             (*-- Maintain a correct depth count *)
+        FreeNode(nodeToPop);    (*-- Recover the node space *)
+      ELSE
+        RaiseErrIn(pop, underflow);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(pop, undefined);
+  END (*--if*);
+END Pop;
+(*----------------------------*)
+
+PROCEDURE PopTopOf (VAR theStack  : Stack     (*-- inout *))
+                                  : Item      (*-- out   *);
+
+VAR   oldTop    : NodePtr;
+      topItem   : Item;
+
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # NIL) THEN    (*-- Check for stack underflow *)
+        oldTop := top;       (*-- Remember current top of stack *)
+        topItem:= top^.item; (*-- Remember current item at stack top *)
+        top    := top^.next; (*-- Update the stack top *)
+        DEC(depth);          (*-- Maintain a correct depth count *)
+        FreeNode(oldTop);    (*-- Recover the node space *)
+        RETURN topItem;      (*-- Return the data item *)
+      END (*--if*);
+    END (*--with*);
+
+    RaiseErrIn(poptopof, underflow);
+  ELSE
+    RaiseErrIn(poptopof, undefined);
+  END (*--if*);
+  RETURN NullItem;
+END PopTopOf;
+(*----------------------------*)
+
+PROCEDURE IsDefined (    theStack  : Stack    (*-- in    *))
+                                   : BOOLEAN  (*-- out   *);
+BEGIN
+   RETURN (theStack # NIL);
+END IsDefined;
+(*----------------------------*)
+
+PROCEDURE IsEmpty  (    theStack   : Stack    (*-- in    *))
+                                   : BOOLEAN  (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.top = NIL;
+  END (*--if*);
+
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+PROCEDURE IsEqual  (    left      : Stack     (*-- in    *);
+                        right     : Stack     (*-- in    *))
+                                  : BOOLEAN   (*-- out   *);
+
+VAR   leftIndex : NodePtr;
+      rightIndex: NodePtr;
+
+BEGIN
+  stackError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    IF (left^.depth = right^.depth) THEN
+	  leftIndex := left^.top;
+	  rightIndex:= right^.top;
+	  WHILE (leftIndex # NIL) &
+		    (leftIndex^.item = rightIndex^.item) DO
+	    leftIndex := leftIndex^.next;
+	    rightIndex:= rightIndex^.next;
+	  END (*--while*);
+	  RETURN (leftIndex = NIL);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE DepthOf  (    theStack   : Stack         (*-- in    *))
+                                   : CARDINAL      (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    RETURN theStack^.depth;
+  END (*--if*);
+  RaiseErrIn(depthof, undefined);
+  RETURN 0;
+END DepthOf;
+(*----------------------------*)
+
+PROCEDURE TopOf    (    theStack   : Stack         (*-- in    *))
+                                   : Item          (*-- out   *);
+BEGIN
+  stackError := noerr;
+  IF (theStack # NIL) THEN
+    WITH theStack^ DO
+      IF (top # NIL) THEN
+        RETURN top^.item;
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(topof, underflow);
+  ELSE
+    RaiseErrIn(topof, undefined);
+  END (*--if*);
+
+  RETURN NullItem;
+END TopOf;
+(*----------------------------*)
+
+BEGIN
+  FOR stackError := initfailed TO MAX(Exceptions) DO
+    SetHandler(stackError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  stackError := noerr;
+END StkSUUN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSBMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSBMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSBMI.DEF
@@ -0,0 +1,286 @@
+(*
+9			The Bounded Character String
+
+
+A bounded implementation of the String abstraction, described in the previous chapter, is
+presented.  This particular form has the properties: Sequential, Bounded, Managed, and
+Iterator, which describe specific aspects of the implementation as follows:
+
+Sequential:	Can only be used in a non-tasking environment, or by only one task.
+Bounded:	The maximum size of a string is given when the string is created.
+Managed:	Memory space for items and objects is returned to the system when no
+			longer needed.
+Iterator:	Routines for looping over each of the string items are provided.
+
+
+As noted last chapter, strings are nearly always formed of characters, or items that can be
+represented using characters.  For this reason both bounded and unbounded string modules
+will use the Character Items module instead of the more generic Items module.
+
+
+
+Section 9.1 contains the interface to the String Enumerations module which is used by
+the string implementations of this, and the next, chapter.  The bounded string module
+interface follows in Section 9.2 and its implementation in Section 9.3.
+*)
+
+
+
+(*
+9.2		StringCSBMI Interface
+
+
+The interface to the bounded string is presented below.  The purpose and implementation
+specifics of each routine is briefly described along with mention of the complexity
+measure of the actual implementation.
+*)
+
+
+
+DEFINITION MODULE StrCSBMI;
+(*==========================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structure String (Opaque version)
+               Character Sequential Bounded Managed Iterator
+
+    THE ABSTRACTION
+    This module provides the String data type localized for
+    CHAR items.
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+       Initial implementation.
+==========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM CharItems IMPORT
+    (*--Type*) Item, AccessProc, ChangeProc, LoopAccessProc,
+               LoopChangeProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions;
+
+    (*-----------------------*)
+
+
+TYPE  String;
+TYPE  StringSize = [ 1 .. 32000 ];
+TYPE  Position   = StringSize;
+CONST NullString = String(NIL);
+
+
+(*	9.2.1		Exceptions
+
+The ModuleID is used by the exception handling mechanism to distinguish this module
+from all other modules.
+
+StringError returns the exception code from the most recent string operation.  A result of
+noerr indicates successful completion of the operation.  O(1).
+
+GetHandler returns the exception handler routine associated with the given exception. 
+Though the routine is a function procedure returning a procedure as its result, the
+HandlerProc  may not be called from within the GetHandler call itself.  The procedure
+result must be first assigned to a procedure variable before invocation.  Exception handlers
+are given an initial value of ExitOnError except for the handler for noerr  which is
+initialized to the null exception handler.  For example, the statement
+
+  GetHandler(overflow)(someErrorCode);
+
+would be flagged as an error by the compiler.  O(1).
+
+SetHandler associates an exception handler routine with the given exception and is the
+inverse of GetHandler.  This routine may be used to override the default settings for the
+exception handlers.  O(1).
+*)
+
+CONST ModuleID = 1;
+
+PROCEDURE StringError ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    theError   : Exceptions  (*-- in    *))
+                                      : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    theError   : Exceptions  (*-- in    *);
+                           theHandler : HandlerProc (*-- in    *));
+
+
+
+(*	9.2.2		Constructors
+
+The Create operation attempts to generate a new, empty string of the given maximum
+size (theSize),  which defines the desired maximum string length.  Since this module uses
+character items, all the standard operations, (such as assignment and comparison), can be
+applied directly and therefore a TypeID and associated user-defined routines are
+unnecessary.  Create returns the new string upon successful completion of the routine.  If
+it is not possible to create the string, the overflow exception is raised and the constant
+NullString  will be returned. O(1).
+
+Destroy takes the given string, clears it of any items, and then destroys the string itself. 
+Where Create defines a string, Destroy is its inverse, making the string undefined. O(1).
+
+Clear takes the given string and removes all of its items.  Clearing the string returns it
+to the empty state. O(1).
+
+The Assign operation attempts to generate a duplicate of the source string (theString) in
+the target string (toString).  The target string is automatically created using the size
+attribute of the source string, if necessary.  If this step is unnecessary, (the target string
+has already been previously created), the target is cleared of its present contents, but the
+size is left unchanged.  There is no guarantee that the client module would desire the
+target string to be defined with the same size as the source.  The minimum requirement
+for the target string size is that it be capable of storing all of the items present in the
+source string.  It may be desirable that the target string size be greater than the source
+string size.  Such a situation could occur during error recovery of a bounded string
+overflow caused by the string length encountering the string size, and the client module
+may effectively attempt to increase the the string size using the assignment mechanism. 
+O(n).
+
+Prepend adds the first string to the beginning of the second string O(mn), Append adds the
+first string to the end of the second string  O(mn), while Insert adds adds the first string to
+the second string at the given string index position.  O(mn).
+
+Delete  removes characters from the given string between the given index positions,
+inclusive.  O(n).
+
+Replace removes characters from the given string from the given index position to the
+end of the string and then inserts the replacement string at the end of the given source
+string.  The length of the source string may grow due to the effects of the replacement.
+
+SetItem changes a single character of the source string at the specified index position.
+O(1).
+
+Construct  allows one to build a dynamic string from the usual Modula-2 form of string. 
+O(n).
+*)
+
+PROCEDURE Create    (    theSize    : StringSize (*-- in    *))
+                                    : String     (*-- out   *);
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *));
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+                         fromIndex  : Position   (*-- in    *);
+                         toIndex    : Position   (*-- in    *));
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         withString : String     (*-- in    *));
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         theItem    : Item       (*-- in    *));
+
+PROCEDURE Construct (VAR theString   : String        (*-- inout *);
+                         theSubstring: ARRAY OF Item (*-- in    *));
+
+
+
+(*	9.2.3		Selectors
+
+
+IsDefined attempts to determine whether the given string is valid, e.g., has been created
+and not yet destroyed.  How this is accomplished may be as simple or complicated as the
+implementer desires and the requirements of the application.  O(1).
+
+IsEmpty returns true if the given string contains no items, and false otherwise. 
+Undefined strings are considered empty.  O(1).
+
+SizeOf returns the maximum possible size (and therefore, position) for the given string
+O(1), while LengthOf  returns the number of characters present in the string O(1).  The
+function  result from both routines are declared CARDINAL (instead of StringSize or
+Position) as undefined strings cause zero to be returned.
+
+Compare establishes the ordering relation between two strings. IsEqual  returns true if
+two strings contain the same items.
+
+ItemOf retrieves a single item at the given index position from the string O(1); SliceOf
+returns a contiguous sequence of characters from a string between two index positions;
+and SubstringOf  returns the whole string as a contiguous sequence of characters.  Both
+SliceOf and SubstringOf terminate their results with 0C if necessary by the rules of
+Modula-2.
+*)
+
+PROCEDURE IsDefined  (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEmpty    (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE SizeOf     (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE LengthOf   (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE Compare    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : Relation    (*-- out   *);
+
+PROCEDURE IsEqual    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE ItemOf     (    theString  : String      (*-- in    *);
+                          theIndex   : Position    (*-- in    *))
+                                     : Item        (*-- out   *);
+
+PROCEDURE SliceOf    (    theString  : String        (*-- in    *);
+                          fromIndex  : Position      (*-- in    *);
+                          toIndex    : Position      (*-- in    *);
+                      VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+
+
+(*	9.2.4		Iterators
+
+The iterator routines LoopOver and LoopChange provide facilities for looping over some
+or all items of a string, with read-only and read-write access to each item, respectively. 
+theProcess  procedure parameter to these routines returns a BOOLEAN function result
+where TRUE allows the iteration to proceed to the next item and FALSE causes the
+iteration to be terminated.  O(n).
+
+Traverse and TravChange iterators provide facilities for looping over all items of a
+string, with read-only and read-write access to each item, respectively.  O(n).
+
+All four iterators traverse the given string from the item at the first position towards
+items at greater positions within the string.  Obviously, if given an empty string the
+processing procedure will not be invoked.
+*)
+
+PROCEDURE LoopOver   (    theString : String         (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE LoopChange (    theString : String         (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+PROCEDURE Traverse   (    theString : String         (*-- in    *);
+                          theProcess: AccessProc     (*-- in    *));
+
+PROCEDURE TravChange (    theString : String         (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+END StrCSBMI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSBMI.MOD
@@ -0,0 +1,927 @@
+(*
+9.3	StringCSBMI Implementation
+*)
+
+
+IMPLEMENTATION MODULE StrCSBMI;
+(*==========================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structure String (Opaque version)
+               Character Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+        Initial implementation.
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM CharItems IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AccessProc, ChangeProc,
+               LoopAccessProc, LoopChangeProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+
+    (*-----------------------*)
+
+
+(*	9.3.1	Internal Bounded String Representation
+
+╟Illustration Here╚
+
+Figure 9.1
+
+Like the internal representation for a bounded stack, the representation for the bounded
+string is a record dynamically allocated on the heap.  This record will be made just large
+enough to hold the declared maximum size of the string.  Though the items array type
+declaration covers the maximum allowed size range of a bounded string, only size entries
+are actually allocated.  This technique allows great savings in the amount of space
+actually used for each bounded string.
+
+length is initialized to zero when a string is created, and this value represents an empty
+string.  Furthermore, length may never exceed the value of size. Encountering this
+condition is an indication of string overflow.
+
+Representation Invariants:
+  *	MIN(SizeRange) <= size <= MAX(SizeRange)
+  *	MIN(SizeRange) <= length <= size
+*)
+
+
+TYPE  Substring  = ARRAY StringSize OF Item;
+
+TYPE  BoundedString = RECORD
+        size   : StringSize;  (*-- Maximum String Size *)
+        length : CARDINAL;    (*-- Current String Length *)
+        items  : Substring;   (*-- ARRAY[1..TheSize] of Items *)
+      END (*-- BoundedString *);
+
+TYPE  String = POINTER TO BoundedString;
+
+
+(*	9.3.2			Exceptions
+
+To support the exception handling mechanism two variables are needed.  The first,
+stringError, is used to record the exception code from each operation; while handlers  is an
+array of exception handling procedures indexed by the exception code.
+
+The routines StringError, GetHandler, and SetHandler have been previously described in
+the definition module, and their operation should be readily apparent.  RaiseErrIn  is a
+local routine used to set the stringError variable and invoke the Raise  routine of the
+ErrorHandling module.
+*)
+
+VAR   stringError : Exceptions;
+VAR   handler     : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE StringError ()              : Exceptions  (*-- out   *);
+BEGIN
+  RETURN stringError;
+END StringError;
+(*----------------------------*)
+
+PROCEDURE GetHandler  (    theError   : Exceptions  (*-- in    *))
+                                      : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler  (    theError   : Exceptions  (*-- in    *);
+                           theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn  (    theRoutine : Operations    (*-- in    *);
+                           theError   : Exceptions    (*-- in    *));
+BEGIN
+  stringError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+
+(*	9.3.3			Local Routines
+
+There are two routines local to the string module used by other, exported routines.  They
+are declared here following convention of having routines declared prior to their use.  This
+is not required by Modula-2 (as it was for Pascal) but some single-pass compilers have
+imposed restrictions in this regard and this technique facilitates porting to such compilers.
+
+LengthSubstr  determines that length of a substring  which for our purposes is a standard
+Modula-2 string.  The substring parameter being tested is declared call-by-reference to
+avoid the overhead involved in copying the open array implicit in call-by-value
+parameters.  Note that we must first explicitly check for the special case of an empty
+string, "", which is represented as a string containing only the string terminator character.
+
+The second routine, FromToOK, checks whether the following precondition holds:
+
+		fromIndex <= toIndex <= stringLength
+
+which is required for routines such as Delete and SliceOf.  The routine takes advantage of
+the fact that if the toIndex is less than or equal to the stringLength and the fromIndex is
+less than or equal to the toIndex, then the fromIndex must also be less than or equal to the
+stringLength.
+*)
+
+
+PROCEDURE LengthSubstr (VAR theSubstring : ARRAY OF Item (*-- in    *))
+                                         : CARDINAL      (*-- out   *);
+BEGIN
+  IF (HIGH(theSubstring) = 0) & (theSubstring[0] = NullItem) THEN
+    RETURN 0;
+  END (*--if*);
+  RETURN HIGH(theSubstring) + 1;
+END LengthSubstr;
+(*----------------------------*)
+
+PROCEDURE FromToOK (    fromIndex    : Position   (*-- in    *);
+                        toIndex      : Position   (*-- in    *);
+                        stringLength : CARDINAL   (*-- in    *))
+                                     : BOOLEAN    (*-- out   *);
+BEGIN
+  RETURN (toIndex <= stringLength) & (fromIndex <= toIndex);
+END FromToOK;
+(*----------------------------*)
+
+
+(*	9.3.4			Constructors
+
+Create begins by clearing the stringError  field under the assumption of a successful
+result.
+
+The header for the string must then be allocated in a local variable since the function
+result cannot be manipulated but only returned.  The key to this allocation step is the
+calculation of the number of bytes necessary based on the size of an individual item and
+the number of items requested.  We must not forget the space for storing theSize and the
+string length.  The constant expression staticSize  accomplishes this regardless of the
+number and size of these ╥static╙ fields and is unaffected by changes due to future
+maintenance.  If the bounded string could not be allocated, the overflow exception must
+be raised, and the NullString returned.
+
+At this point, all possibility of failure has been avoided and the bounded string header can
+be initialized to its empty state (length set to zero), and the size limit stored for this
+bounded string.  Lastly, the new string can be returned to the caller.
+*)
+
+PROCEDURE Create    (    theSize    : StringSize (*-- in    *))
+                                    : String     (*-- out   *);
+
+CONST staticSize = SIZE(BoundedString) - SIZE(Substring);
+CONST itemSize   = SIZE(Item);
+VAR   newString  : String;
+
+BEGIN
+  stringError := noerr;
+  Allocate(newString, staticSize + itemSize * theSize);
+  IF (newString # NIL) THEN
+    WITH newString^ DO
+      size   := theSize;
+      length := 0;
+    END (*--with*);
+    RETURN newString;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullString;
+END Create;
+(*----------------------------*)
+
+
+(*
+Destroy simply deallocates the bounded string header which automatically sets theString
+to the NullString.
+*)
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedString) - SIZE(Substring);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    Deallocate(theString, staticSize + itemSize * theString^.size);
+  ELSE
+    RaiseErrIn(destroy, undefined);
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+
+(*
+Clear simply sets the string length to zero, effectively removing all of its items.
+*)
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    theString^.length := 0;
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+
+(*
+Assignment for bounded objects is simpler to implement than their unbounded
+counterparts as the opportunity for overflow is restricted to when the target object is
+(re-)created.  The source string must be defined, otherwise the undefined exception is
+raised.
+
+If the target string exists, the source and target strings represent different string objects
+(assignment of a string to itself is a useless operation) and the target string capable of
+holding all of the source string's items the assignment can be safely accomplished. 
+Otherwise, the overflow exception is raised and the operation aborted.  When the target
+object is undefined it must be created using the size attribute of the source.  If overflow
+does not occur, the actual assignment can commence, otherwise its suffices to exit (Create
+has already raised the exception).
+
+The assignment operator cannot be used to copy the whole items array as only a slice of
+the array's index range was actually allocated and who knows what other dynamically
+allocated objects follow it in memory.  Since our strings are formed from the basic data
+type CHAR, the assignment operator can be used to copy individual items from one
+string to another as there is no chance for structural sharing to occur.  This is done
+through a simple loop over each of the items of the source.  Then the target string's
+length can be updated to match that of the source string.
+*)
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    IF (theString # toString) THEN
+
+      IF (toString # NIL) THEN
+        IF (theString^.length > toString^.size) THEN
+          RaiseErrIn(assign, overflow);
+        END (*--if*);
+      ELSE
+        toString := Create(theString^.size);
+      END (*--if*);
+      IF (stringError # noerr) THEN
+        RETURN;
+      END (*--if*);
+
+      WITH theString^ DO
+        FOR index := MIN(StringSize) TO length DO
+          toString^.items[index] := items[index];
+        END (*--for*);
+        toString^.length := length;
+      END (*--with*);
+    END (*--if*);
+
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+
+(*
+Prepend and Append simply make use of the Insert routine to add items to the front or
+the back of the target string, respectively.
+*)
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, 1);
+END Prepend;
+(*----------------------------*)
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, LengthOf(toString) + 1);
+END Append;
+(*----------------------------*)
+
+
+(*
+Insert adds the items of one string to an existing string at the given index position.
+Essentially, we must make room for new string items by shifting items from the
+insertion index to the right by the number of items being inserted. Then we proceed to
+insert the new string items into the vacated positions.  Finally, the modified string's
+length is updated to reflect the newly inserted items.
+*)
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *));
+
+VAR   newLength : CARDINAL;
+      index     : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) & (toString # NIL) THEN
+
+    WITH toString^ DO
+      newLength := theString^.length + length;
+
+      IF (theIndex > length + 1) THEN
+        RaiseErrIn(insert, positionerr);
+      ELSIF (newLength > size) THEN
+        RaiseErrIn(insert, overflow);
+      ELSE
+
+        FOR index := length TO theIndex BY -1 DO
+          items[index + theString^.length] := items[index];
+        END (*--for*);
+
+        FOR index := MIN(StringSize) TO theString^.length DO
+          items[theIndex + index - 1] := theString^.items[index];
+        END (*--for*);
+
+        length := newLength;
+
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(insert, undefined);
+  END (*--if*);
+END Insert;
+(*----------------------------*)
+
+
+(*
+Delete removes items from an existing string between the given index positions,
+inclusive.  Invalid index positions raise positionerr  and abort the operation.  The
+algorithm essentially shifts items above the toIndex down in the string into positions
+beginning with the fromIndex.  It calculates the amount of this shift, called the offset,
+loops through string items above toIndex, shifting each item into its new location.  After
+moving the items the string's length is updated.
+*)
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+                         fromIndex  : Position   (*-- in    *);
+                         toIndex    : Position   (*-- in    *));
+
+VAR   index  : CARDINAL; (*-- loop index over items *)
+      offset : CARDINAL; (*-- distance to move items down *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        offset := toIndex - fromIndex + 1;
+        FOR index := toIndex + 1 TO length DO
+          items[index - offset] := items[index];
+        END (*--for*);
+        DEC(length, offset);
+      ELSE
+        RaiseErrIn(delete, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(delete, undefined);
+  END (*--if*);
+END Delete;
+(*----------------------------*)
+
+
+(*
+Replace deletes all items of the source string from the given index to the end of the string
+and then inserts the replacement string at the end of the source.  If theString was expanded
+by the replacement process, the string length is adjusted accordingly.
+*)
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         withString : String     (*-- in    *));
+
+VAR   endPosition : CARDINAL; (*-- new length of theString *)
+      index       : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) & (withString # NIL) THEN
+    endPosition := theIndex + withString^.length - 1;
+    WITH theString^ DO
+      IF (theIndex <= length) & (endPosition <= size) THEN
+        FOR index := MIN(StringSize) TO withString^.length DO
+          items[theIndex + index - 1] := withString^.items[index];
+        END (*--for*);
+
+        IF (endPosition > length) THEN
+          length := endPosition;
+        END (*--if*);
+      ELSE
+        RaiseErrIn(replace, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(replace, undefined);
+  END (*--if*);
+END Replace;
+(*----------------------------*)
+
+
+(*
+SetItem attempts to assign the given item to the string at the given index position.  The
+index must be within the string's current length otherwise the positionerr exception is
+raised avoiding assignment outside the string's current bounds.
+*)
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         theItem    : Item       (*-- in    *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        items[theIndex] := theItem;
+      ELSE
+        RaiseErrIn(setitem, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(setitem, undefined);
+  END (*--if*);
+END SetItem;
+(*----------------------------*)
+
+
+(*
+Construct forms a bounded string from a standard Modula-2 string.  If theString has not
+yet been created then theSubstring must not be empty since it is meaningless to create a
+string with a maximum size of zero items.  If theString does exist and theSubstring is
+empty it is sufficient to clear theString.  Otherwise we simply loop through theSubstring
+copying items from there to the target string and when done update the string's length.
+*)
+
+PROCEDURE Construct (VAR theString   : String        (*-- inout *);
+                         theSubstring: ARRAY OF Item (*-- in    *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      lenSubstr : CARDINAL; (*-- # of chars in substring *)
+      newString : String;
+
+BEGIN
+  stringError := noerr;
+  lenSubstr := LengthSubstr(theSubstring);
+
+  IF (theString # NIL) THEN
+    IF (lenSubstr = 0) THEN
+      Clear(theString);
+      RETURN;
+    END (*--if*);
+  ELSIF (lenSubstr = 0) THEN
+    RaiseErrIn(construct, positionerr);
+    RETURN;
+  ELSE
+    newString := Create(lenSubstr);
+    IF (stringError = noerr) THEN
+      theString := newString;
+    ELSE
+      RETURN;
+    END (*--if*);
+  END (*--if*);
+
+  WITH theString^ DO
+
+    (*-- The minimum lenSubstr is one (1). *)
+
+    index := MIN(Position);
+    WHILE (index <= lenSubstr) & (theSubstring[index - 1] # NullItem) DO
+      items[index] := theSubstring[index - 1];
+      INC(index);
+    END (*--while*);
+    length := index - 1;
+  END (*--with*);
+END Construct;
+(*----------------------------*)
+
+
+
+(*	9.3.5			Selectors
+
+IsDefined returns true if the given string is not NIL, otherwise returning false.
+*)
+
+PROCEDURE IsDefined  (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN (theString # NIL);
+END IsDefined;
+(*----------------------------*)
+
+
+(*
+IsEmpty simply tests for a string length of zero, returning the appropriate logical value. 
+As mentioned in the interface, an undefined string is considered empty.
+*)
+
+PROCEDURE IsEmpty    (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length = 0;
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+
+(*
+SizeOf returns the size value for the given string.  An undefined string raises the
+exception of the same name and returns a size of zero.
+*)
+
+PROCEDURE SizeOf     (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*----------------------------*)
+
+
+(*
+LengthOf returns the string's current length, which is the number of items in the string. 
+An undefined string raises the exception of the same name and returns a length of zero.
+*)
+
+PROCEDURE LengthOf   (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*----------------------------*)
+
+
+(*
+Compare returns the ordering relation between two strings such that ╥left Relation right╙
+is True.  If either or both strings are undefined then the incomparable  relation is returned.
+
+Initially we set up minLength with the smaller of the two string lengths, as reaching the
+end of a string is one condition that terminates the comparison. We also preset relOrder 
+to the correct result based on length.  This is based on the fact that all other things being
+equal, the smaller of the strings is less than the other.
+
+One this initialization is done, the algorithm loops through the strings from the
+beginning examining each character item for the relation between them.  The loop
+continues as long as the strings are equal or until the end of the smaller string is reached. 
+The instant that the left item at the current index is less than its counterpart in the right
+string the loop is terminated and the relation less  is returned.  Likewise when the left
+item is greater than the right item the relation greater  is returned.  For equal items the
+index is incremented, advancing the algorithm towards the terminating condition.
+*)
+
+PROCEDURE Compare    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : Relation    (*-- out   *);
+
+VAR   index     : CARDINAL; (*-- Index into items arrays *)
+      minLength : CARDINAL; (*-- Smaller of the two string lengths *)
+      relOrder  : Relation; (*-- Most recent comparison result *)
+
+BEGIN
+  stringError := noerr;
+  relOrder    := incomparable;
+  IF (left # NIL) & (right # NIL) THEN
+
+    WITH left^ DO
+      IF (length = right^.length) THEN
+        relOrder  := equal;
+        minLength := length;
+      ELSIF (length < right^.length) THEN
+        relOrder  := less;
+        minLength := length;
+      ELSE
+        relOrder  := greater;
+        minLength := right^.length;
+      END (*--if*);
+    END (*--with*);
+
+    index := MIN(StringSize);
+    LOOP
+      IF (index > minLength) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+
+      IF (left^.items[index] < right^.items[index]) THEN
+        relOrder := less;
+        EXIT (*--loop*);
+      ELSIF (left^.items[index] > right^.items[index]) THEN
+        relOrder := greater;
+        EXIT (*--loop*);
+      END (*--if*);
+
+      INC(index);
+
+    END (*--loop*);
+  ELSE
+    RaiseErrIn(compare, undefined);
+  END (*--if*);
+  RETURN relOrder;
+END Compare;
+(*----------------------------*)
+
+
+(*
+IsEqual scans both strings looking for the first mismatch (inequality) which indicates the
+strings are unequal, otherwise if the FOR loop completes the strings must be equal.  This
+assumes that (1) the strings have been defined and (2) have the same length.  The first of
+these assumptions, if unfounded, raises the undefined exception; while the second is a
+simple determinant of inequality.
+*)
+
+PROCEDURE IsEqual    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    WITH left^ DO
+      IF (length = right^.length) THEN
+        FOR index := MIN(StringSize) TO length DO
+          IF (items[index] # right^.items[index]) THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--for*);
+        RETURN TRUE;
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+
+(*
+ItemOf attempts to return the item of the string at the given index position.  If theIndex
+exceeds the length of the string the positionerr  exception is raised.  This exception and
+also an undefined string cause the NullItem (0C) to be returned.
+*)
+
+PROCEDURE ItemOf     (    theString  : String      (*-- in    *);
+                          theIndex   : Position    (*-- in    *))
+                                     : Item        (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        RETURN items[theIndex];
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(itemof, positionerr);
+  ELSE
+    RaiseErrIn(itemof, undefined);
+  END (*--if*);
+  RETURN NullItem;
+END ItemOf;
+(*----------------------------*)
+
+
+(*
+SliceOf extracts a portion of the given string returning the sequence of characters as a
+standard Modula-2 string.  The portion of the string to be extracted is specified by the
+range of index positions within the string, fromIndex  and toIndex.  We must take care
+that the target slice is indexed from zero and so must shift items from their positions
+within the source string into the appropriate positions in the target slice.  The
+preconditions (1) fromIndex ▓ toIndex ▓ source string length, and (2) number of items
+between the from and to indices, inclusive, ▓ target slice size, must both be met.  If not,
+then the positionerr and overflow  exceptions are raised, respectively.  If necessary, the
+string terminator is added to the end of the slice.
+*)
+
+PROCEDURE SliceOf    (    theString  : String        (*-- in    *);
+                          fromIndex  : Position      (*-- in    *);
+                          toIndex    : Position      (*-- in    *);
+                      VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      sliceSize : CARDINAL; (*-- # items between from and to indexes *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        sliceSize := toIndex - fromIndex;
+        IF (sliceSize <= HIGH(theSlice)) THEN
+          FOR index := fromIndex TO toIndex DO
+            theSlice[index - fromIndex] := items[index];
+          END (*--for*);
+          IF (sliceSize < HIGH(theSlice)) THEN
+            theSlice[sliceSize + 1] := NullItem;
+          END (*--if*);
+        ELSE
+          RaiseErrIn(sliceof, overflow);
+        END (*--if*);
+      ELSE
+        RaiseErrIn(sliceof, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(sliceof, undefined);
+  END (*--if*);
+END SliceOf;
+(*----------------------------*)
+
+
+(*
+SubstringOf is similar to SliceOf, above, except that the whole string is returned. When
+the Target substring is too small for all the items in the Source string, overflow is raised
+and the target is filled with as many items that will fit.
+*)
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+VAR   index      : CARDINAL; (*-- loop index over items *)
+      copyLength : CARDINAL; (*-- # items to copy into substring *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (length > HIGH(toSubstring) + 1) THEN
+        RaiseErrIn(substringof, overflow);
+        copyLength := HIGH(toSubstring) + 1;
+      ELSE
+        copyLength := length;
+      END (*--if*);
+      FOR index := MIN(StringSize) TO copyLength DO
+        toSubstring[index - 1] := items[index];
+      END (*--for*);
+      IF (copyLength < HIGH(toSubstring)) THEN
+        toSubstring[copyLength + 1] := NullItem;
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(substringof, undefined);
+  END (*--if*);
+END SubstringOf;
+(*----------------------------*)
+
+
+
+(*	9.3.6			Iterators
+
+The bounded string iterators LoopOver and LoopChange use the same algorithm, which is
+almost identical to that used with the bounded stack.  The stringError state is reset to
+noerr and a test made for the undefined string, raising the undefined exception if such is
+the case.  Then simply loop through each item of the string passing it along to the given
+procedure for processing until either the end of the string is reached or the visiting process
+returns False indicating that the iteration be terminated.
+
+The bounded string iterators Traverse and TravChange use the same algorithm, which is
+almost identical to that used with the bounded stack.  The stringError state is reset to
+noerr and a test made for the undefined string, raising the undefined exception if such is
+the case.  Then simply loop through each item of the string passing it along to the given
+procedure for processing.
+*)
+
+PROCEDURE LoopOver   (    theString : String         (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(StringSize) TO length DO
+        IF ~theProcess(items[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE LoopChange (    theString : String         (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(StringSize) TO length DO
+        IF ~theProcess(items[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopchange, undefined);
+  END (*--if*);
+END LoopChange;
+(*----------------------------*)
+
+
+PROCEDURE Traverse   (    theString : String         (*-- in    *);
+                          theProcess: AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(StringSize) TO length DO
+        theProcess(items[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+PROCEDURE TravChange (    theString : String         (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(StringSize) TO length DO
+        theProcess(items[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(travchange, undefined);
+  END (*--if*);
+END TravChange;
+(*----------------------------*)
+
+
+(*	9.3.7		Module Initialization
+
+In the module initialization the local exception handlers array variables are set to default
+handlers (ExitOnError) except for the noerr handler which is given the null handler. 
+stringError is given the value noerr avoiding an undefined state.
+*)
+
+BEGIN
+  FOR stringError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(stringError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  stringError := noerr;
+END StrCSBMI.
+
+
+(*
+References
+
+[1]	G. Booch, Software Components With Ada Structures, Tools, and Subsystems,
+	Benjamin/Cummings, Menlo Park, CA, 1987, pp. 104-141.
+[2]	D. Knuth, The Art of Computer Programming, Vol. 1, Fundamental Algorithms,
+	Addison-Wesley, Reading, MA 1973.
+[3]	R. Sedgewick, Algorithms, Addison-Wesley, Reading, MA 1983.
+[4]	R. Wiener and R. Sincovec, Data Structures Using Modula-2, John Wiley & Sons, New
+	York, NY 1986, pp. 461-469.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSBMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSBMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSBMN.DEF
@@ -0,0 +1,251 @@
+(*
+9			The Bounded Character String (continued)
+
+
+A bounded implementation of the String abstraction, described in the previous chapter, is
+presented.  This particular form has the properties: Sequential, Bounded, Managed, and
+Non-Iterator, which describe specific aspects of the implementation as follows:
+
+Sequential:		Can only be used in a non-tasking environment, or by only one task.
+Bounded:		The maximum size of a string is given when the string is created.
+Managed:		Memory space for items and objects is returned to the system when no
+				longer needed.
+Non-Iterator:	Routines for looping over each of the string items are not provided.
+
+
+As noted last chapter, strings are nearly always formed of characters, or items that can be
+represented using characters.  For this reason both bounded and unbounded string modules
+will use the Character Items module instead of the more generic Items module.
+
+The bounded string module interface is presented in Section 9.4 and its implementation in
+Section 9.5.
+*)
+
+
+
+(*
+9.4		StringCSBMN Interface
+
+The interface to the bounded string is presented below.  The purpose and implementation
+specifics of each routine is briefly described along with mention of the complexity
+measure of the actual implementation.
+*)
+
+
+
+DEFINITION MODULE StrCSBMN;
+(*==========================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structure String (Opaque version)
+               Character Sequential Bounded Managed Non-Iterator
+
+    THE ABSTRACTION
+    This module provides the String data type localized for
+    CHAR items.
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+       Initial implementation.
+==========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM CharItems IMPORT
+    (*--Type*) Item;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions;
+
+    (*-----------------------*)
+
+
+TYPE  String;
+TYPE  StringSize = [ 1 .. 32000 ];
+TYPE  Position   = StringSize;
+CONST NullString = String(NIL);
+
+
+(*	9.4.1		Exceptions
+
+The ModuleID is used by the exception handling mechanism to distinguish this module
+from all other modules.
+
+StringError returns the exception code from the most recent string operation.  A result of
+noerr indicates successful completion of the operation.  O(1).
+
+GetHandler returns the exception handler routine associated with the given exception. 
+Though the routine is a function procedure returning a procedure as its result, the
+HandlerProc  may not be called from within the GetHandler call itself.  The procedure
+result must be first assigned to a procedure variable before invocation.  Exception handlers
+are given an initial value of ExitOnError except for the handler for noerr  which is
+initialized to the null exception handler.  For example, the statement
+
+  GetHandler(overflow)(someErrorCode);
+
+would be flagged as an error by the compiler.  O(1).
+
+SetHandler associates an exception handler routine with the given exception and is the
+inverse of GetHandler.  This routine may be used to override the default settings for the
+exception handlers.  O(1).
+*)
+
+CONST ModuleID = 2;
+
+PROCEDURE StringError ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    theError   : Exceptions  (*-- in    *))
+                                      : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    theError   : Exceptions  (*-- in    *);
+                           theHandler : HandlerProc (*-- in    *));
+
+
+
+(*	9.4.2		Constructors
+
+The Create operation attempts to generate a new, empty string of the given maximum
+size (theSize),  which defines the desired maximum string length.  Since this module uses
+character items, all the standard operations, (such as assignment and comparison), can be
+applied directly and therefore a TypeID and associated user-defined routines are
+unnecessary.  Create returns the new string upon successful completion of the routine.  If
+it is not possible to create the string, the overflow exception is raised and the constant
+NullString  will be returned. O(1).
+
+Destroy takes the given string, clears it of any items, and then destroys the string itself. 
+Where Create defines a string, Destroy is its inverse, making the string undefined. O(1).
+
+Clear takes the given string and removes all of its items.  Clearing the string returns it
+to the empty state. O(1).
+
+The Assign operation attempts to generate a duplicate of the source string (theString) in
+the target string (toString).  The target string is automatically created using the size
+attribute of the source string, if necessary.  If this step is unnecessary, (the target string
+has already been previously created), the target is cleared of its present contents, but the
+size is left unchanged.  There is no guarantee that the client module would desire the
+target string to be defined with the same size as the source.  The minimum requirement
+for the target string size is that it be capable of storing all of the items present in the
+source string.  It may be desirable that the target string size be greater than the source
+string size.  Such a situation could occur during error recovery of a bounded string
+overflow caused by the string length encountering the string size, and the client module
+may effectively attempt to increase the the string size using the assignment mechanism. 
+O(n).
+
+Prepend adds the first string to the beginning of the second string O(mn), Append adds the
+first string to the end of the second string  O(mn), while Insert adds adds the first string to
+the second string at the given string index position.  O(mn).
+
+Delete  removes characters from the given string between the given index positions,
+inclusive.  O(n).
+
+Replace removes characters from the given string from the given index position to the
+end of the string and then inserts the replacement string at the end of the given source
+string.  The length of the source string may grow due to the effects of the replacement.
+
+SetItem changes a single character of the source string at the specified index position.
+O(1).
+
+Construct  allows one to build a dynamic string from the usual Modula-2 form of string. 
+O(n).
+*)
+
+PROCEDURE Create    (    theSize    : StringSize (*-- in    *))
+                                    : String     (*-- out   *);
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *));
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+                         fromIndex  : Position   (*-- in    *);
+                         toIndex    : Position   (*-- in    *));
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         withString : String     (*-- in    *));
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         theItem    : Item       (*-- in    *));
+
+PROCEDURE Construct (VAR theString   : String        (*-- inout *);
+                         theSubstring: ARRAY OF Item (*-- in    *));
+
+
+
+(*	9.4.3		Selectors
+
+
+IsDefined attempts to determine whether the given string is valid, e.g., has been created
+and not yet destroyed.  How this is accomplished may be as simple or complicated as the
+implementer desires and the requirements of the application.  O(1).
+
+IsEmpty returns true if the given string contains no items, and false otherwise. 
+Undefined strings are considered empty.  O(1).
+
+SizeOf returns the maximum possible size (and therefore, position) for the given string
+O(1), while LengthOf  returns the number of characters present in the string O(1).  The
+function  result from both routines are declared CARDINAL (instead of StringSize or
+Position) as undefined strings cause zero to be returned.
+
+Compare establishes the ordering relation between two strings. IsEqual  returns true if
+two strings contain the same items.
+
+ItemOf retrieves a single item at the given index position from the string O(1); SliceOf
+returns a contiguous sequence of characters from a string between two index positions;
+and SubstringOf  returns the whole string as a contiguous sequence of characters.  Both
+SliceOf and SubstringOf terminate their results with 0C if necessary by the rules of
+Modula-2.
+*)
+
+PROCEDURE IsDefined  (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEmpty    (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE SizeOf     (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE LengthOf   (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE Compare    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : Relation    (*-- out   *);
+
+PROCEDURE IsEqual    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE ItemOf     (    theString  : String      (*-- in    *);
+                          theIndex   : Position    (*-- in    *))
+                                     : Item        (*-- out   *);
+
+PROCEDURE SliceOf    (    theString  : String        (*-- in    *);
+                          fromIndex  : Position      (*-- in    *);
+                          toIndex    : Position      (*-- in    *);
+                      VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+END StrCSBMN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSBMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSBMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSBMN.MOD
@@ -0,0 +1,826 @@
+(*
+9.5		StringCSBMN Implementation
+*)
+
+
+IMPLEMENTATION MODULE StrCSBMN;
+(*==========================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structure String (Opaque version)
+               Character Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+        Initial implementation.
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM CharItems IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+
+    (*-----------------------*)
+
+
+(*	9.5.1	Internal Bounded String Representation
+
+╟Illustration Here╚
+
+Figure 9.1
+
+Like the internal representation for a bounded stack, the representation for the bounded
+string is a record dynamically allocated on the heap.  This record will be made just large
+enough to hold the declared maximum size of the string.  Though the items array type
+declaration covers the maximum allowed size range of a bounded string, only size entries
+are actually allocated.  This technique allows great savings in the amount of space
+actually used for each bounded string.
+
+length is initialized to zero when a string is created, and this value represents an empty
+string.  Furthermore, length may never exceed the value of size. Encountering this
+condition is an indication of string overflow.
+
+Representation Invariants:
+  *	MIN(SizeRange) <= size <= MAX(SizeRange)
+  *	MIN(SizeRange) <= length <= size
+*)
+
+
+TYPE  Substring  = ARRAY StringSize OF Item;
+
+TYPE  BoundedString = RECORD
+        size   : StringSize;  (*-- Maximum String Size *)
+        length : CARDINAL;    (*-- Current String Length *)
+        items  : Substring;   (*-- ARRAY[1..TheSize] of Items *)
+      END (*-- BoundedString *);
+
+TYPE  String = POINTER TO BoundedString;
+
+
+(*	9.5.2			Exceptions
+
+To support the exception handling mechanism two variables are needed.  The first,
+stringError, is used to record the exception code from each operation; while handlers  is an
+array of exception handling procedures indexed by the exception code.
+
+The routines StringError, GetHandler, and SetHandler have been previously described in
+the definition module, and their operation should be readily apparent.  RaiseErrIn  is a
+local routine used to set the stringError variable and invoke the Raise  routine of the
+ErrorHandling module.
+*)
+
+VAR   stringError : Exceptions;
+VAR   handler     : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE StringError ()              : Exceptions  (*-- out   *);
+BEGIN
+  RETURN stringError;
+END StringError;
+(*----------------------------*)
+
+PROCEDURE GetHandler  (    theError   : Exceptions  (*-- in    *))
+                                      : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler  (    theError   : Exceptions  (*-- in    *);
+                           theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn  (    theRoutine : Operations    (*-- in    *);
+                           theError   : Exceptions    (*-- in    *));
+BEGIN
+  stringError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+
+(*	9.5.3			Local Routines
+
+There are two routines local to the string module used by other, exported routines.  They
+are declared here following convention of having routines declared prior to their use.  This
+is not required by Modula-2 (as it was for Pascal) but some single-pass compilers have
+imposed restrictions in this regard and this technique facilitates porting to such compilers.
+
+LengthSubstr  determines that length of a substring  which for our purposes is a standard
+Modula-2 string.  The substring parameter being tested is declared call-by-reference to
+avoid the overhead involved in copying the open array implicit in call-by-value
+parameters.  Note that we must first explicitly check for the special case of an empty
+string, "", which is represented as a string containing only the string terminator character.
+
+The second routine, FromToOK, checks whether the following precondition holds:
+
+		fromIndex ▓ toIndex ▓ stringLength
+
+which is required for routines such as Delete and SliceOf.  The routine takes advantage of
+the fact that if the toIndex is less than or equal to the stringLength and the fromIndex is
+less than or equal to the toIndex, then the fromIndex must also be less than or equal to the
+stringLength.
+*)
+
+
+PROCEDURE LengthSubstr (VAR theSubstring : ARRAY OF Item (*-- in    *))
+                                         : CARDINAL      (*-- out   *);
+BEGIN
+  IF (HIGH(theSubstring) = 0) & (theSubstring[0] = NullItem) THEN
+    RETURN 0;
+  END (*--if*);
+  RETURN HIGH(theSubstring) + 1;
+END LengthSubstr;
+(*----------------------------*)
+
+PROCEDURE FromToOK (    fromIndex    : Position   (*-- in    *);
+                        toIndex      : Position   (*-- in    *);
+                        stringLength : CARDINAL   (*-- in    *))
+                                     : BOOLEAN    (*-- out   *);
+BEGIN
+  RETURN (toIndex <= stringLength) & (fromIndex <= toIndex);
+END FromToOK;
+(*----------------------------*)
+
+
+(*	9.5.4			Constructors
+
+Create begins by clearing the stringError  field under the assumption of a successful
+result.
+
+The header for the string must then be allocated in a local variable since the function
+result cannot be manipulated but only returned.  The key to this allocation step is the
+calculation of the number of bytes necessary based on the size of an individual item and
+the number of items requested.  We must not forget the space for storing theSize and the
+string length.  The constant expression staticSize  accomplishes this regardless of the
+number and size of these ╥static╙ fields and is unaffected by changes due to future
+maintenance.  If the bounded string could not be allocated, the overflow exception must
+be raised, and the NullString returned.
+
+At this point, all possibility of failure has been avoided and the bounded string header can
+be initialized to its empty state (length set to zero), and the size limit stored for this
+bounded string.  Lastly, the new string can be returned to the caller.
+*)
+
+PROCEDURE Create    (    theSize    : StringSize (*-- in    *))
+                                    : String     (*-- out   *);
+
+CONST staticSize = SIZE(BoundedString) - SIZE(Substring);
+CONST itemSize   = SIZE(Item);
+VAR   newString  : String;
+
+BEGIN
+  stringError := noerr;
+  Allocate(newString, staticSize + itemSize * theSize);
+  IF (newString # NIL) THEN
+    WITH newString^ DO
+      size   := theSize;
+      length := 0;
+    END (*--with*);
+    RETURN newString;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullString;
+END Create;
+(*----------------------------*)
+
+
+(*
+Destroy simply deallocates the bounded string header which automatically sets theString
+to the NullString.
+*)
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedString) - SIZE(Substring);
+CONST itemSize   = SIZE(Item);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    Deallocate(theString, staticSize + itemSize * theString^.size);
+  ELSE
+    RaiseErrIn(destroy, undefined);
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+
+(*
+Clear simply sets the string length to zero, effectively removing all of its items.
+*)
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    theString^.length := 0;
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+
+(*
+Assignment for bounded objects is simpler to implement than their unbounded
+counterparts as the opportunity for overflow is restricted to when the target object is
+(re-)created.  The source string must be defined, otherwise the undefined exception is
+raised.
+
+If the target string exists, the source and target strings represent different string objects
+(assignment of a string to itself is a useless operation) and the target string capable of
+holding all of the source string's items the assignment can be safely accomplished. 
+Otherwise, the overflow exception is raised and the operation aborted.  When the target
+object is undefined it must be created using the size attribute of the source.  If overflow
+does not occur, the actual assignment can commence, otherwise its suffices to exit (Create
+has already raised the exception).
+
+The assignment operator cannot be used to copy the whole items array as only a slice of
+the array's index range was actually allocated and who knows what other dynamically
+allocated objects follow it in memory.  Since our strings are formed from the basic data
+type CHAR, the assignment operator can be used to copy individual items from one
+string to another as there is no chance for structural sharing to occur.  This is done
+through a simple loop over each of the items of the source.  Then the target string's
+length can be updated to match that of the source string.
+*)
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    IF (theString # toString) THEN
+
+      IF (toString # NIL) THEN
+        IF (theString^.length > toString^.size) THEN
+          RaiseErrIn(assign, overflow);
+        END (*--if*);
+      ELSE
+        toString := Create(theString^.size);
+      END (*--if*);
+      IF (stringError # noerr) THEN
+        RETURN;
+      END (*--if*);
+
+      WITH theString^ DO
+        FOR index := MIN(StringSize) TO length DO
+          toString^.items[index] := items[index];
+        END (*--for*);
+        toString^.length := length;
+      END (*--with*);
+    END (*--if*);
+
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+
+(*
+Prepend and Append simply make use of the Insert routine to add items to the front or
+the back of the target string, respectively.
+*)
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, 1);
+END Prepend;
+(*----------------------------*)
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, LengthOf(toString) + 1);
+END Append;
+(*----------------------------*)
+
+
+(*
+Insert adds the items of one string to an existing string at the given index position. 
+Essentially, we must make room for new string items by shifting items from the
+insertion index to the right by the number of items being inserted. Then we proceed to
+insert the new string items into the vacated positions.  Finally, the modified string's
+length is updated to reflect the newly inserted items.
+*)
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *));
+
+VAR   newLength : CARDINAL;
+      index     : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) & (toString # NIL) THEN
+
+    WITH toString^ DO
+      newLength := theString^.length + length;
+
+      IF (theIndex > length + 1) THEN
+        RaiseErrIn(insert, positionerr);
+      ELSIF (newLength > size) THEN
+        RaiseErrIn(insert, overflow);
+      ELSE
+
+        FOR index := length TO theIndex BY -1 DO
+          items[index + theString^.length] := items[index];
+        END (*--for*);
+
+        FOR index := MIN(StringSize) TO theString^.length DO
+          items[theIndex + index - 1] := theString^.items[index];
+        END (*--for*);
+
+        length := newLength;
+
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(insert, undefined);
+  END (*--if*);
+END Insert;
+(*----------------------------*)
+
+
+(*
+Delete removes items from an existing string between the given index positions,
+inclusive.  Invalid index positions raise positionerr  and abort the operation.  The
+algorithm essentially shifts items above the toIndex down in the string into positions
+beginning with the fromIndex.  It calculates the amount of this shift, called the offset,
+loops through string items above toIndex, shifting each item into its new location.  After
+moving the items the string's length is updated.
+*)
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+                         fromIndex  : Position   (*-- in    *);
+                         toIndex    : Position   (*-- in    *));
+
+VAR   index  : CARDINAL; (*-- loop index over items *)
+      offset : CARDINAL; (*-- distance to move items down *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        offset := toIndex - fromIndex + 1;
+        FOR index := toIndex + 1 TO length DO
+          items[index - offset] := items[index];
+        END (*--for*);
+        DEC(length, offset);
+      ELSE
+        RaiseErrIn(delete, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(delete, undefined);
+  END (*--if*);
+END Delete;
+(*----------------------------*)
+
+
+(*
+Replace deletes all items of the source string from the given index to the end of the string
+and then inserts the replacement string at the end of the source.  If theString was expanded
+by the replacement process, the string length is adjusted accordingly.
+*)
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         withString : String     (*-- in    *));
+
+VAR   endPosition : CARDINAL; (*-- new length of theString *)
+      index       : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) & (withString # NIL) THEN
+    endPosition := theIndex + withString^.length - 1;
+    WITH theString^ DO
+      IF (theIndex <= length) & (endPosition <= size) THEN
+        FOR index := MIN(StringSize) TO withString^.length DO
+          items[theIndex + index - 1] := withString^.items[index];
+        END (*--for*);
+
+        IF (endPosition > length) THEN
+          length := endPosition;
+        END (*--if*);
+      ELSE
+        RaiseErrIn(replace, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(replace, undefined);
+  END (*--if*);
+END Replace;
+(*----------------------------*)
+
+
+(*
+SetItem attempts to assign the given item to the string at the given index position.  The
+index must be within the string's current length otherwise the positionerr exception is
+raised avoiding assignment outside the string's current bounds.
+*)
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         theItem    : Item       (*-- in    *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        items[theIndex] := theItem;
+      ELSE
+        RaiseErrIn(setitem, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(setitem, undefined);
+  END (*--if*);
+END SetItem;
+(*----------------------------*)
+
+
+(*
+Construct forms a bounded string from a standard Modula-2 string.  If theString has not
+yet been created then theSubstring must not be empty since it is meaningless to create a
+string with a maximum size of zero items.  If theString does exist and theSubstring is
+empty it is sufficient to clear theString.  Otherwise we simply loop through theSubstring
+copying items from there to the target string and when done update the string's length.
+*)
+
+PROCEDURE Construct (VAR theString   : String        (*-- inout *);
+                         theSubstring: ARRAY OF Item (*-- in    *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      lenSubstr : CARDINAL; (*-- # of chars in substring *)
+      newString : String;
+
+BEGIN
+  stringError := noerr;
+  lenSubstr := LengthSubstr(theSubstring);
+
+  IF (theString # NIL) THEN
+    IF (lenSubstr = 0) THEN
+      Clear(theString);
+      RETURN;
+    END (*--if*);
+  ELSIF (lenSubstr = 0) THEN
+    RaiseErrIn(construct, positionerr);
+    RETURN;
+  ELSE
+    newString := Create(lenSubstr);
+    IF (stringError = noerr) THEN
+      theString := newString;
+    ELSE
+      RETURN;
+    END (*--if*);
+  END (*--if*);
+
+  WITH theString^ DO
+
+    (*-- The minimum lenSubstr is one (1). *)
+
+    index := MIN(Position);
+    WHILE (index <= lenSubstr) & (theSubstring[index - 1] # NullItem) DO
+      items[index] := theSubstring[index - 1];
+      INC(index);
+    END (*--while*);
+    length := index - 1;
+  END (*--with*);
+END Construct;
+(*----------------------------*)
+
+
+
+(*	9.5.5			Selectors
+
+IsDefined returns true if the given string is not NIL, otherwise returning false.
+*)
+
+PROCEDURE IsDefined  (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN (theString # NIL);
+END IsDefined;
+(*----------------------------*)
+
+
+(*
+IsEmpty simply tests for a string length of zero, returning the appropriate logical value. 
+As mentioned in the interface, an undefined string is considered empty.
+*)
+
+PROCEDURE IsEmpty    (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length = 0;
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+
+(*
+SizeOf returns the size value for the given string.  An undefined string raises the
+exception of the same name and returns a size of zero.
+*)
+
+PROCEDURE SizeOf     (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*----------------------------*)
+
+
+(*
+LengthOf returns the string's current length, which is the number of items in the string. 
+An undefined string raises the exception of the same name and returns a length of zero.
+*)
+
+PROCEDURE LengthOf   (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*----------------------------*)
+
+
+(*
+Compare returns the ordering relation between two strings such that ╥left Relation right╙
+is True.  If either or both strings are undefined then the incomparable  relation is returned.
+
+Initially we set up minLength with the smaller of the two string lengths, as reaching the
+end of a string is one condition that terminates the comparison. We also preset relOrder 
+to the correct result based on length.  This is based on the fact that all other things being
+equal, the smaller of the strings is less than the other.
+
+One this initialization is done, the algorithm loops through the strings from the
+beginning examining each character item for the relation between them.  The loop
+continues as long as the strings are equal or until the end of the smaller string is reached. 
+The instant that the left item at the current index is less than its counterpart in the right
+string the loop is terminated and the relation less  is returned.  Likewise when the left
+item is greater than the right item the relation greater  is returned.  For equal items the
+index is incremented, advancing the algorithm towards the terminating condition.
+*)
+
+PROCEDURE Compare    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : Relation    (*-- out   *);
+
+VAR   index     : CARDINAL; (*-- Index into items arrays *)
+      minLength : CARDINAL; (*-- Smaller of the two string lengths *)
+      relOrder  : Relation; (*-- Most recent comparison result *)
+
+BEGIN
+  stringError := noerr;
+  relOrder    := incomparable;
+  IF (left # NIL) & (right # NIL) THEN
+
+    WITH left^ DO
+      IF (length = right^.length) THEN
+        relOrder  := equal;
+        minLength := length;
+      ELSIF (length < right^.length) THEN
+        relOrder  := less;
+        minLength := length;
+      ELSE
+        relOrder  := greater;
+        minLength := right^.length;
+      END (*--if*);
+    END (*--with*);
+
+    index := MIN(StringSize);
+    LOOP
+      IF (index > minLength) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+
+      IF (left^.items[index] < right^.items[index]) THEN
+        relOrder := less;
+        EXIT (*--loop*);
+      ELSIF (left^.items[index] > right^.items[index]) THEN
+        relOrder := greater;
+        EXIT (*--loop*);
+      END (*--if*);
+
+      INC(index);
+
+    END (*--loop*);
+  ELSE
+    RaiseErrIn(compare, undefined);
+  END (*--if*);
+  RETURN relOrder;
+END Compare;
+(*----------------------------*)
+
+
+(*
+IsEqual scans both strings looking for the first mismatch (inequality) which indicates the
+strings are unequal, otherwise if the FOR loop completes the strings must be equal.  This
+assumes that (1) the strings have been defined and (2) have the same length.  The first of
+these assumptions, if unfounded, raises the undefined exception; while the second is a
+simple determinant of inequality.
+*)
+
+PROCEDURE IsEqual    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    WITH left^ DO
+      IF (length = right^.length) THEN
+        FOR index := MIN(StringSize) TO length DO
+          IF (items[index] # right^.items[index]) THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--for*);
+        RETURN TRUE;
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+
+(*
+ItemOf attempts to return the item of the string at the given index position.  If theIndex
+exceeds the length of the string the positionerr  exception is raised.  This exception and
+also an undefined string cause the NullItem (0C) to be returned.
+*)
+
+PROCEDURE ItemOf     (    theString  : String      (*-- in    *);
+                          theIndex   : Position    (*-- in    *))
+                                     : Item        (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        RETURN items[theIndex];
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(itemof, positionerr);
+  ELSE
+    RaiseErrIn(itemof, undefined);
+  END (*--if*);
+  RETURN NullItem;
+END ItemOf;
+(*----------------------------*)
+
+
+(*
+SliceOf extracts a portion of the given string returning the sequence of characters as a
+standard Modula-2 string.  The portion of the string to be extracted is specified by the
+range of index positions within the string, fromIndex  and toIndex.  We must take care
+that the target slice is indexed from zero and so must shift items from their positions
+within the source string into the appropriate positions in the target slice.  The
+preconditions (1) fromIndex <=toIndex <=source string length, and (2) number of items
+between the from and to indices, inclusive, <=target slice size, must both be met.  If not,
+then the positionerr and overflow  exceptions are raised, respectively.  If necessary, the
+string terminator is added to the end of the slice.
+*)
+
+PROCEDURE SliceOf    (    theString  : String        (*-- in    *);
+                          fromIndex  : Position      (*-- in    *);
+                          toIndex    : Position      (*-- in    *);
+                      VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      sliceSize : CARDINAL; (*-- # items between from and to indexes *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        sliceSize := toIndex - fromIndex;
+        IF (sliceSize <= HIGH(theSlice)) THEN
+          FOR index := fromIndex TO toIndex DO
+            theSlice[index - fromIndex] := items[index];
+          END (*--for*);
+          IF (sliceSize < HIGH(theSlice)) THEN
+            theSlice[sliceSize + 1] := NullItem;
+          END (*--if*);
+        ELSE
+          RaiseErrIn(sliceof, overflow);
+        END (*--if*);
+      ELSE
+        RaiseErrIn(sliceof, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(sliceof, undefined);
+  END (*--if*);
+END SliceOf;
+(*----------------------------*)
+
+
+(*
+SubstringOf is similar to SliceOf, above, except that the whole string is returned. When
+the Target substring is too small for all the items in the Source string, overflow is raised
+and the target is filled with as many items that will fit.
+*)
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+VAR   index      : CARDINAL; (*-- loop index over items *)
+      copyLength : CARDINAL; (*-- # items to copy into substring *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (length > HIGH(toSubstring) + 1) THEN
+        RaiseErrIn(substringof, overflow);
+        copyLength := HIGH(toSubstring) + 1;
+      ELSE
+        copyLength := length;
+      END (*--if*);
+      FOR index := MIN(StringSize) TO copyLength DO
+        toSubstring[index - 1] := items[index];
+      END (*--for*);
+      IF (copyLength < HIGH(toSubstring)) THEN
+        toSubstring[copyLength + 1] := NullItem;
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(substringof, undefined);
+  END (*--if*);
+END SubstringOf;
+(*----------------------------*)
+
+
+(*	9.5.6		Module Initialization
+
+In the module initialization the local exception handlers array variables are set to default
+handlers (ExitOnError) except for the noerr handler which is given the null handler. 
+stringError is given the value noerr  avoiding an undefined state.
+*)
+
+BEGIN
+  FOR stringError := initfailed TO MAX(Exceptions) DO
+    SetHandler(stringError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  stringError := noerr;
+END StrCSBMN.
+
+
+(*
+References
+
+[1]	G. Booch, Software Components With Ada Structures, Tools, and Subsystems,
+	Benjamin/Cummings, Menlo Park, CA, 1987, pp. 104-141.
+[2]	D. Knuth, The Art of Computer Programming, Vol. 1, Fundamental Algorithms,
+	Addison-Wesley, Reading, MA 1973.
+[3]	R. Sedgewick, Algorithms, Addison-Wesley, Reading, MA 1983.
+[4]	R. Wiener and R. Sincovec, Data Structures Using Modula-2, John Wiley & Sons, New
+	York, NY 1986, pp. 461-469.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSUMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSUMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSUMI.DEF
@@ -0,0 +1,261 @@
+(*
+10			The Unbounded Character String
+
+
+An unbounded implementation of the String abstraction, described in Chapter 8, is
+presented here.  This particular form has the properties: Sequential, Unbounded, Managed,
+and Iterator, describing specific aspects of the implementation as follows:
+
+Sequential:	Can only be used in a non-tasking environment, or by only one task.
+Unbounded:	The size of a string varies dynamically as items are inserted and removed
+			from the string.
+Managed:	Memory space for items and objects is returned to the system when no
+			longer needed.
+Iterator:	Routines for looping over each of the string items are provided.
+
+As noted in the previous chapter on the bounded string form, strings are nearly always
+formed of characters, or items that can be represented using characters, we use the
+Character Items module instead of the more generic Items module.
+
+There is one limitation in the implementation presented here: strings are limited to a
+maximum length of 32,000 characters.  This is primarily due to the TML Modula-2
+compiler excluding the type LONGINT and LONGCARD as array index types.
+
+Section 10.1 contains the interface to the unbounded string module while the
+implementation follows in Section 10.2.
+
+
+
+10.1		StringCSUMI Interface
+*)
+
+
+DEFINITION MODULE StrCSUMI;
+(*============================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structure - String
+               Character Sequential Unbounded Managed Iterator
+
+    THE ABSTRACTION
+    This module provides a String abstraction limited to CHARs
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+        Initial implementation.
+============================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM CharItems IMPORT
+    (*--Type*) Item, AccessProc, ChangeProc,
+               LoopAccessProc, LoopChangeProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions;
+
+    (*-----------------------*)
+
+TYPE  String;
+TYPE  Position   = [ 1 .. 32000 ];
+CONST NullString = String(NIL);
+
+
+(*
+10.1.1		Exceptions
+
+The ModuleID is used by the exception handling mechanism to distinguish this module
+from all other modules.
+
+StringError returns the exception code from the most recent string operation.  A result of
+noerr  indicates successful completion of the operation.
+
+GetHandler returns the exception handler routine associated with the given exception.
+Though the routine is a function procedure returning a procedure as its result, the
+HandlerProc  may not be called from within the GetHandler  call itself.  The procedure
+result must be first assigned to a procedure variable before invocation.  Exception handlers
+are given an initial value of ExitOnError  except for the handler for noerr  which is
+initialized to the null exception handler.  For example, the statement
+
+  GetHandler(overflow)(someErrorCode);
+
+would be flagged as an error by the compiler.
+
+
+SetHandler associates an exception handler routine with the given exception and is the
+inverse of GetHandler.  This routine may be used to override the default settings for the
+exception handlers.
+*)
+
+CONST ModuleID = 3;
+
+PROCEDURE StringError ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+(*
+10.1.2		Constructors
+
+The Create operation attempts to generate a new, empty, unbounded string.  Since this
+module uses character items all the standard operations, (such as assignment and
+comparison), can be done directly; user-defined routines are not needed. 
+
+Create will return the new string upon successful completion of the routine.  If it not
+possible for the string to be created, the constant NullString  will be returned instead.
+
+Destroy takes the given string, clears it of any items, and then destroys the string itself. 
+Where Create defines a string, Destroy is its inverse, making the string undefined.
+
+Clear takes the given string and removes all of its items.  Clearing the string returns it
+to the empty state.
+
+The Assign operation attempts to generate a duplicate of the source string (theString) in
+the target string (toString).  The target string is automatically created, if necessary,
+otherwise the target is simply cleared of its present contents.
+
+Prepend adds the first string to the beginning of the second string, Append  adds the first
+string to the end of the second string, while Insert  adds adds the first string to the second
+string at the given string index position.
+
+Delete removes characters from the given string between the given index positions,
+inclusive.
+
+Replace  removes characters from the given string from the given index position to the
+end of the string and then inserts the replacement string at the end of the given source
+string.  The length of the source string may grow due to the effects of the replacement.
+
+SetItem changes a single character of the source string at the specified index position.
+
+Construct allows one to build a dynamic string from the usual Modula-2 string form. 
+*)
+
+PROCEDURE Create    ()              : String     (*-- out   *);
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *));
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+                         fromIndex  : Position   (*-- in    *);
+                         toIndex    : Position   (*-- in    *));
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         withString : String     (*-- in    *));
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         theItem    : Item       (*-- in    *));
+
+PROCEDURE Construct (VAR theString   : String        (*-- inout *);
+                         theSubstring: ARRAY OF Item (*-- in    *));
+
+
+
+(*
+10.1.3		Selectors
+
+IsDefined attempts to determine whether the given string is valid, e.g., has been created
+and not yet destroyed.  How this is accomplished may be as simple or complicated as the
+implementer desires and the requirements of the application.
+
+IsEmpty returns true if the given string contains no items, and false otherwise. 
+Undefined strings are considered empty.
+
+LengthOf returns the number of characters present in the string.  The function  result is
+declared CARDINAL (instead of Position) as an undefined string returns zero.
+
+Compare establishes the ordering relation between two strings. IsEqual  returns true if
+two strings contain the same items.
+
+ItemOf retrieves a single item at the given index position from the string; SliceOf
+returns a contiguous sequence of characters from a string between two index positions;
+and SubstringOf  returns the whole string as a contiguous sequence of characters.  Both
+SliceOf and SubstringOf terminate their results with 0C if necessary by the rules of
+Modula-2.
+*)
+
+PROCEDURE IsDefined  (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEmpty    (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE LengthOf   (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE Compare    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : Relation    (*-- out   *);
+
+PROCEDURE IsEqual    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE ItemOf     (    theString  : String      (*-- in    *);
+                          theIndex   : Position    (*-- in    *))
+                                     : Item        (*-- out   *);
+
+PROCEDURE SliceOf    (    theString  : String        (*-- in    *);
+                          fromIndex  : Position      (*-- in    *);
+                          toIndex    : Position      (*-- in    *);
+                      VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+
+
+(*
+10.1.4		Iterators
+
+The iterator routines LoopOver and LoopChange provide facilities for looping over some
+or all items of a string, with read-only and read-write access to each item, respectively. 
+theProcess  procedure parameter to these routines returns a BOOLEAN function result
+where TRUE allows the iteration to proceed to the next item and FALSE causes the
+iteration to be terminated.
+
+Traverse and TravChange iterators provide facilities for looping over all items of a
+string, with read-only and read-write access to each item, respectively.
+
+All four iterators traverse the given string from the item at the first position towards
+items at greater positions within the string.  Obviously, if given an empty string the
+processing procedure will not be invoked.
+*)
+
+PROCEDURE LoopOver   (    theString : String         (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE LoopChange (    theString : String         (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+PROCEDURE Traverse   (    theString : String         (*-- in    *);
+                          theProcess: AccessProc     (*-- in    *));
+
+PROCEDURE TravChange (    theString : String         (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+END StrCSUMI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSUMI.MOD
@@ -0,0 +1,1025 @@
+(*
+10.2		StringCSUMI Implementation
+*)
+
+
+IMPLEMENTATION MODULE StrCSUMI;
+(*==========================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : JPI Modula-2 Compiler
+    Code Size: R+  bytes, R-  bytes
+    Component: Monolithic Structure String (Opaque version)
+               Character Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+        Initial JPI Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM CharItems IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AccessProc, ChangeProc,
+               LoopAccessProc, LoopChangeProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+    (*-----------------------*)
+
+
+(*
+10.2.1		Internal Unbounded String Representation
+
+╟Illustration Here╚
+
+Figure 10.1
+
+For the unbounded string an internal representation is needed that does not require a size
+specification when the string is created and allows the string length to vary dynamically
+as items are inserted and removed.  An examination of the literature (Standish [4] or
+Wiener and Sincovec [5], for example) reveals numerous possible representations each
+different in terms of space and time efficiency.  Booch [1] demonstrates an elegant
+solution that may be readily derived from the bounded string form, where one maintains
+in the string header a pointer to the dynamically allocated array of items.  To support this
+alternate structure requires an additional local routine delegated the responsibility for
+adjusting the size of this array.  Then only cosmetic changes are needed throughout the
+remainder of the module.  This routine has been named SetSize  in this module, the
+details of which are described below with its implementation.
+
+Like the internal representation for an unbounded stack, the representation for the
+unbounded string begins with a header record dynamically allocated on the heap.  This
+header is used to store two fields: (1) the current string length, and (2) a pointer to a
+dynamically allocated array of items large enough to hold the current length of the string.
+
+length is initialized to zero when a string is created, and this value represents an empty
+string.  Furthermore, items  is set to NIL when the length is zero.
+
+size is needed for the JPI version since Deallocate won't remember for us
+how much space was originally allocated.
+*)
+
+TYPE  Substring  = POINTER TO ARRAY Position OF Item;
+
+TYPE  UnboundedString = RECORD
+        size   : CARDINAL;    (*-- allocated string size *)
+        length : CARDINAL;    (*-- Current String Length *)
+        items  : Substring;   (*-- ARRAY[1..length] of Items *)
+      END (*-- UnboundedString *);
+
+TYPE  String = POINTER TO UnboundedString;
+
+
+
+(*
+10.2.2		Exceptions
+
+To support the exception handling mechanism two variables are needed.  The first,
+stringError, is used to record the exception code from each operation; while handlers  is an
+array of exception handling procedures indexed by the exception code.
+
+The routines StringError, GetHandler, and SetHandler have been previously described in
+the definition module, and their operation should be readily apparent.  RaiseErrIn is a
+local routine used to set the stringError variable and invoke the Raise  routine of the
+ErrorHandling module.
+*)
+
+VAR   stringError : Exceptions;
+VAR   handler     : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE StringError ()              : Exceptions  (*-- out   *);
+BEGIN
+  RETURN stringError;
+END StringError;
+(*----------------------------*)
+
+PROCEDURE GetHandler  (    theError   : Exceptions  (*-- in    *))
+                                      : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler  (    theError   : Exceptions  (*-- in    *);
+                           theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn  (    theRoutine : Operations    (*-- in    *);
+                           theError   : Exceptions    (*-- in    *));
+BEGIN
+  stringError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+
+
+(*
+10.2.3		Local Routines
+
+There are two routines local to the string module used by other, exported routines.  They
+are declared here following convention of having routines declared prior to their use.  This
+is not required by Modula-2 (as it was for Pascal) but some single-pass compilers have
+imposed restrictions in this regard and this technique facilitates porting to such compilers.
+
+LengthSubstr determines that length of a substring  which for our purposes is a standard
+Modula-2 string.  The substring parameter being tested is declared call-by-reference to
+avoid the overhead involved in copying the open array implicit in call-by-value
+parameters.  Note that we must first explicitly check for the special case of an empty
+string, "", which is represented as a string containing only the string terminator character.
+
+The second routine, FromToOK, checks whether the following precondition holds:
+
+		fromIndex <= toIndex <= stringLength
+
+which is required for routines such as Delete and SliceOf.  The routine takes advantage of
+the fact that if the toIndex is less than or equal to the stringLength and the fromIndex is
+less than or equal to the toIndex, then the fromIndex must also be less than or equal to the
+stringLength.
+*)
+
+PROCEDURE LengthSubstr  (VAR theSubstring : ARRAY OF Item (*-- in    *))
+                                          : CARDINAL      (*-- out   *);
+BEGIN
+  IF (HIGH(theSubstring) = 0) & (theSubstring[0] = NullItem) THEN
+    RETURN 0;
+  END (*--if*);
+  RETURN HIGH(theSubstring) + 1;
+END LengthSubstr;
+(*----------------------------*)
+
+PROCEDURE FromToOK      (    fromIndex    : Position   (*-- in    *);
+                             toIndex      : Position   (*-- in    *);
+                             stringLength : CARDINAL   (*-- in    *))
+                                          : BOOLEAN    (*-- out   *);
+BEGIN
+  RETURN (toIndex <= stringLength) & (fromIndex <= toIndex);
+END FromToOK;
+(*----------------------------*)
+
+
+(*
+10.2.4		SetSize
+
+The routine SetSize manages changing the length of and the pointer to the dynamic array
+of items for an unbounded string.  The input parameters are (1) the header record of the
+string being changed, (2) the desired new length, and (3) whether the current item values
+should be kept with the new item array.  SetSize must correctly account for the following
+situations based on the desired and current lengths (using a decision table format, where an
+X indicates a ╥don't care╙ value):
+
+Desired		Current		Preserve
+Length		Length		Value?	Action
+0		X		X	deallocate existing items array
+X		0		X	allocate new items array
+greater than current	        Yes	allocate new items array and copy item values
+greater than current    	No	allocate new items array and don't copy item values
+less than current		X	do nothing
+
+From the above table the reader can see that when the length of the string decreases we
+leave the string unchanged and may wonder as to the reason for this.  Basically, we are
+taking advantage of the semantics of the Deallocate operation which automatically
+releases the correct amount of space that was originally allocated and futhermore sets the
+pointer to NIL.  Therefore, we waste some space by not changing the items array's
+physical length through reallocation of the array but instead choose to save the time spent
+for this operation.
+
+The local variable setSizeOK indicates, when false, failure of the reallocation step.  In all
+other cases setSizeOK will be true (failure cannot occur when we deallocate an items
+array).  Since the value for setSizeOK does not always have meaning as some states never
+fail, it is better to use a local variable that can be checked when necessary instead of
+returning a function result that would have to be processed by the caller in every case.
+
+Let us examine each of the above cases from the decision table in further detail.  When
+the new size to zero we must effectively clear the items array.  This is done by simply
+deallocating the array and setting the string length to the desired value.
+
+When the new size is non-zero and the string is already empty it is necessary to allocate a
+new items array.  As there are no items to be preserved from an empty state we ignore the
+valueOption  parameter.  If this allocation fails, setSizeOK is set to false, and SetSize is
+aborted leaving the string unchanged.
+
+Expansion of the items array occurs when the desired size is greater than the current
+length.  A new items array is first allocated since it may be necessary to preserve the
+items from the current items array.  If this allocation fails, setSizeOK is set to false, and
+SetSize is aborted leaving the string unchanged.  Otherwise, if the valueOption has been
+set to preservevalue  the individual items are copied to the new structure.  Once the value
+has been preserved, if necessary, the current items array can be safely deallocated, and the
+pointer to the new items array stored in its place.  Lastly, the string length field can be
+updated.
+*)
+
+TYPE  SetOptions = (preservevalue, trashvalue);
+VAR   setSizeOK  : BOOLEAN;
+
+PROCEDURE SetSize   (VAR theString   : UnboundedString (*-- inout *);
+                         totheSize   : CARDINAL        (*-- in    *);
+                         valueOption : SetOptions      (*-- in    *));
+
+CONST itemSize = VAL(CARDINAL, SIZE(Item));
+VAR   newItems : Substring;
+      index    : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  setSizeOK := TRUE;
+  WITH theString DO
+    IF (totheSize = 0) THEN
+      Deallocate(items, itemSize * size);
+      size := 0;
+    ELSIF (items = NIL) THEN
+      Allocate(items, itemSize * totheSize);
+      IF (items = NIL) THEN
+        setSizeOK := FALSE;
+        RETURN;
+      END (*--if*);
+      size := totheSize;
+
+    ELSIF (totheSize > length) THEN
+      Allocate(newItems, itemSize * totheSize);
+      IF (newItems = NIL) THEN
+        setSizeOK := FALSE;
+        RETURN;
+      END (*--if*);
+
+      IF (valueOption = preservevalue) THEN
+        FOR index := MIN(Position) TO length DO
+          newItems^[index] := items^[index];
+        END (*--for*);
+      END (*--if*);
+
+      Deallocate(items, itemSize * size);
+      items := newItems;
+      size  := totheSize;
+    END (*--if*);
+    length := totheSize;
+  END (*--with*);
+END SetSize;
+(*----------------------------*)
+
+
+
+(*
+10.2.5		Constructors
+
+Create begins by clearing the stringError  field under the assumption of a successful
+result.
+
+The header for the string must then be allocated in a local variable since the function
+result cannot be manipulated but only returned.  The key to this allocation step is the
+calculation of the number of bytes necessary based on the size of an individual item and
+the number of items requested.  We must not forget the space for storing theSize and the
+string length.  The constant expression staticSize  accomplishes this regardless of the
+number and size of these ╥static╙ fields and is unaffected by changes that may come about
+due to future maintenance.  If the unbounded string could not be allocated, the overflow
+exception must be raised, and the NullString returned.
+
+At this point, all possibility of failure has been avoided and the bounded string header can
+be initialized to its empty state (length set to zero, items set to NIL).  Lastly, the new
+string can be returned to the caller.
+*)
+
+PROCEDURE Create    ()              : String     (*-- out   *);
+
+VAR   newString : String;
+
+BEGIN
+  stringError := noerr;
+  Allocate(newString, SIZE(UnboundedString));
+  IF (newString # NIL) THEN
+    WITH newString^ DO
+      size   := 0;
+      length := 0;
+      items  := NIL;
+    END (*--with*);
+    RETURN newString;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullString;
+END Create;
+(*----------------------------*)
+
+
+(*
+Destroy simply needs to call the SetSize routine to deallocate the items array itself
+followed by deallocation of the bounded string header which automatically sets theString
+to the NullString.
+*)
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    SetSize(theString^, 0, trashvalue);
+    Deallocate(theString, SIZE(UnboundedString));
+  ELSE
+    RaiseErrIn(destroy, undefined);
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+
+(*
+Clear simply needs to call the SetSize routine to deallocate the items array itself and set
+the length to zero, removing all of its items using the trashvalue  command.
+*)
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    SetSize(theString^, 0, trashvalue);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+
+(*
+The assignment for this implementation of unbounded string objects is simpler to
+implement than other unbounded objects due to the opportunity for restricting overflow to
+when the target object is (re-)created.  This is done by the SetSize routine described above. 
+If the target object exists and is capable of holding all of the source object's items the
+target can be safely cleared and its data type updated appropriately.  Otherwise, the
+overflow exception is raised and the assignment operation is aborted.  When the target
+object is in an undefined state it must then be created.  If overflow does not occur, the
+actual assignment can commence, otherwise its suffices to exit (Create has already raised
+the exception).
+
+The assignment operator cannot be used to copy the whole items array as only a slice of
+the array's index range was actually allocated and who knows what other dynamically
+allocated objects follow it in memory.  Nor can assignment be used to copy individual
+items as the data type of those items is unknown; using assignment for dynamically
+allocated items would cause structural sharing of items, which is not desired.
+*)
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    IF (theString # toString) THEN
+      IF (toString # NIL) THEN
+        SetSize(toString^, theString^.length, trashvalue);
+        IF ~setSizeOK THEN
+          RaiseErrIn(assign, overflow);
+          RETURN;
+        END (*--if*);
+      ELSE
+        toString := Create();
+        IF (stringError # noerr) THEN
+          RETURN;
+        END (*--if*);
+      END (*--if*);
+
+      WITH theString^ DO
+        FOR index := MIN(Position) TO length DO
+          toString^.items^[index] := items^[index];
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+
+(*
+Prepend and Append simply make use of the Insert routine to add items to the front or
+the back of the target string, respectively.
+*)
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, 1);
+END Prepend;
+(*----------------------------*)
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, LengthOf(toString) + 1);
+END Append;
+(*----------------------------*)
+
+
+(*
+Insert adds the items of one string to an existing string at the given index position.  First
+the target string is expanded to hold the new items using the SetSize routine with the new
+length and the command to preserve the current items.  Once the items array of the string
+has been made large enough, we make room for new string items by shifting items from
+the insertion index to the right by the number of items being inserted.  Then we proceed
+to insert the new string items into the vacated positions.  Remember that the modified
+string's length was updated to reflect the newly inserted items by SetSize.
+*)
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *));
+
+VAR   oldLength : CARDINAL;
+      newLength : CARDINAL;
+      index     : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (toString # NIL) & (theString # NIL) THEN
+
+    WITH toString^ DO
+      oldLength := length;
+      newLength := theString^.length + length;
+
+      IF (theIndex > oldLength + 1) THEN
+        RaiseErrIn(insert, positionerr);
+      ELSE
+        SetSize(toString^, newLength, preservevalue);
+        IF setSizeOK THEN
+
+          FOR index := oldLength TO theIndex BY -1 DO
+            items^[index + theString^.length] := items^[index];
+          END (*--for*);
+
+          FOR index := MIN(Position) TO theString^.length DO
+            items^[theIndex + index - 1] := theString^.items^[index];
+          END (*--for*);
+        ELSE
+          RaiseErrIn(insert, overflow);
+        END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(insert, undefined);
+  END (*--if*);
+END Insert;
+(*----------------------------*)
+
+
+(*
+Delete removes items from an existing string between the given index positions,
+inclusive.  Invalid index positions raise positionerr  and abort the operation.  The
+algorithm essentially shifts items above the toIndex down in the string into positions
+beginning with the fromIndex.  It calculates the amount of this shift, called the offset,
+loops through string items above toIndex, shifting each item into its new location.  After
+moving the items the string's length is updated.
+*)
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+                         fromIndex  : Position   (*-- in    *);
+                         toIndex    : Position   (*-- in    *));
+
+VAR   index  : CARDINAL; (*-- loop index over items *)
+      offset : CARDINAL; (*-- distance to move items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        offset := toIndex - fromIndex + 1;
+        FOR index := toIndex + 1 TO length DO
+          items^[index - offset] := items^[index];
+        END (*--for*);
+        SetSize(theString^, length - offset, preservevalue);
+      ELSE
+        RaiseErrIn(delete, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(delete, undefined);
+  END (*--if*);
+END Delete;
+(*----------------------------*)
+
+
+(*
+Replace deletes all items of the source string from the given index to the end of the string
+and then inserts the replacement string at the end of the source.  If theString was expanded
+by the replacement process, the string length is adjusted accordingly.
+*)
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         withString : String     (*-- in    *));
+
+VAR   endIndex : CARDINAL;
+      index    : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) & (withString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+
+        endIndex := theIndex + withString^.length - 1;
+        IF (endIndex > length) THEN
+          SetSize(theString^, endIndex, preservevalue);
+          IF ~setSizeOK THEN
+            RaiseErrIn(replace, overflow);
+            RETURN;
+          END (*--if*);
+        END (*--if*);
+
+        FOR index := MIN(Position) TO withString^.length DO
+          items^[theIndex + index - 1] := withString^.items^[index];
+        END (*--for*);
+      ELSE
+        RaiseErrIn(replace, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(replace, undefined);
+  END (*--if*);
+END Replace;
+(*----------------------------*)
+
+
+(*
+SetItem attempts to assign the given item to the string at the given index position.  The
+index must be within the string's current length otherwise the positionerr exception is
+raised avoiding assignment outside the string's current bounds.
+*)
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         theItem    : Item       (*-- in    *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        items^[theIndex] := theItem;
+      ELSE
+        RaiseErrIn(setitem, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(setitem, undefined);
+  END (*--if*);
+END SetItem;
+(*----------------------------*)
+
+
+(*
+Construct forms an unbounded string from a standard Modula-2 string.  If theString has
+not yet been created then theSubstring must not be empty for compatibility with the
+bounded form.  If theString does exist and theSubstring is empty it is sufficient to clear
+theString.  Otherwise we simply loop through theSubstring copying items from there to
+the target string and when done update the string's length.
+*)
+
+PROCEDURE Construct (VAR theString   : String        (*-- inout *);
+                         theSubstring: ARRAY OF Item (*-- in    *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      lenSubstr : CARDINAL; (*-- # of items in substring *)
+      newString : String;   (*-- new string, if necessary *)
+
+BEGIN
+  stringError := noerr;
+  lenSubstr := LengthSubstr(theSubstring);
+
+  IF (theString # NIL) THEN
+    IF (lenSubstr = 0) THEN
+      Clear(theString);
+      RETURN;
+    END (*--if*);
+  ELSIF (lenSubstr = 0) THEN
+    RaiseErrIn(construct, positionerr);
+  ELSE
+    newString := Create();
+    IF (stringError # noerr) THEN
+      RETURN;
+    END (*--if*);
+    theString := newString;
+  END (*--if*);
+
+  SetSize(theString^, lenSubstr, trashvalue);
+  IF setSizeOK THEN
+    WITH theString^ DO
+      index := MIN(Position);
+      WHILE (index <= lenSubstr) &
+            (theSubstring[index - 1] # NullItem) DO
+        items^[index] := theSubstring[index - 1];
+        INC(index);
+      END (*--while*);
+    END (*--with*);
+    SetSize(theString^, index-1, preservevalue);
+  ELSE
+    RaiseErrIn(construct, overflow);
+  END (*--if*);
+END Construct;
+(*----------------------------*)
+
+
+
+(*
+10.2.6		Selectors
+
+IsDefined tests the given string for a non-NIL value.
+
+IsEmpty tests the given string's length for zero which is the value used to represent the
+empty string.  While LengthOf  returns the value of the given string's length.
+*)
+
+PROCEDURE IsDefined  (    theString : String   (*-- in    *))
+                                    : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (theString # NIL);
+END IsDefined;
+(*----------------------------*)
+
+PROCEDURE IsEmpty    (    theString : String   (*-- in    *))
+                                    : BOOLEAN  (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length = 0;
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+PROCEDURE LengthOf   (    theString : String   (*-- in    *))
+                                    : CARDINAL (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*----------------------------*)
+
+
+(*
+Compare returns the ordering relation between two strings such that ╥left Relation right╙
+is True.  If either or both strings are undefined then the incomparable  relation is returned.
+
+Initially we set up minLength with the smaller of the two string lengths, as reaching the
+end of a string is one condition that terminates the comparison. We also set relOrder  to
+the correct result based on length.  This is based on the fact that all other things being
+equal, the smaller of the strings is less than the other.
+
+One this initialization is done, the algorithm loops through the strings from the
+beginning examining each character item for the relation between them.  The loop
+continues as long as the strings are equal or until the end of the smaller string is reached. 
+The instant that the left item at the current index is less than its counterpart in the right
+string the loop is terminated and the relation less  is returned.  Likewise when the left
+item is greater than the right item the relation greater  is returned.  For equal items the
+index is incremented, advancing the algorithm towards the terminating condition.
+*)
+
+PROCEDURE Compare    (    left      : String   (*-- in    *);
+                          right     : String   (*-- in    *))
+                                    : Relation (*-- out   *);
+
+VAR   index     : CARDINAL; (*-- Index into items arrays *)
+      minLength : CARDINAL; (*-- Smaller of the two string lengths *)
+      relOrder  : Relation; (*-- Most recent comparison result *)
+
+BEGIN
+  stringError := noerr;
+  relOrder    := incomparable;
+  IF (left # NIL) & (right # NIL) THEN
+
+    WITH left^ DO
+      IF (length = right^.length) THEN
+        relOrder  := equal;
+        minLength := length;
+      ELSIF (length < right^.length) THEN
+        relOrder  := less;
+        minLength := length;
+      ELSE
+        relOrder  := greater;
+        minLength := right^.length;
+      END (*--if*);
+    END (*--with*);
+
+    index := MIN(Position);
+    LOOP
+      IF (index > minLength) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+
+      IF (left^.items^[index] < right^.items^[index]) THEN
+        relOrder := less;
+        EXIT (*--loop*);
+      ELSIF (left^.items^[index] > right^.items^[index]) THEN
+        relOrder := greater;
+        EXIT (*--loop*);
+      END (*--if*);
+
+      INC(index);
+
+    END (*--loop*);
+  ELSE
+    RaiseErrIn(compare, undefined);
+  END (*--if*);
+
+  RETURN relOrder;
+END Compare;
+(*----------------------------*)
+
+
+(*
+IsEqual scans both strings looking for the first mismatch (inequality) which indicates the
+strings are unequal, otherwise if the FOR loop completes the strings must be equal.  This
+assumes that (1) the strings have been defined and (2) have the same length.  The first of
+these assumptions, if unfounded, raises the undefined exception; while the second is a
+simple determinant of inequality.
+*)
+
+PROCEDURE IsEqual    (    left      : String   (*-- in    *);
+                          right     : String   (*-- in    *))
+                                    : BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    WITH left^ DO
+      IF (length = right^.length) THEN
+        FOR index := MIN(Position) TO length DO
+          IF (items^[index] # right^.items^[index]) THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--for*);
+        RETURN TRUE;
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+
+(*
+ItemOf attempts to return the item of the string at the given index position.  If theIndex
+exceeds the length of the string the positionerr  exception is raised.  This exception and
+also an undefined string causes the NullItem (0C) to be returned.
+*)
+
+PROCEDURE ItemOf     (    theString : String   (*-- in    *);
+                          theIndex  : Position (*-- in    *))
+                                    : Item     (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        RETURN items^[theIndex];
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(itemof, positionerr);
+  ELSE
+    RaiseErrIn(itemof, undefined);
+  END (*--if*);
+  RETURN NullItem;
+END ItemOf;
+(*----------------------------*)
+
+
+(*
+SliceOf extracts a portion of the given string returning the sequence of characters as a
+standard Modula-2 string.  The portion of the string to be extracted is specified by the
+range of index positions within the string, fromIndex  and toIndex.  We must take care
+because the target slice is indexed from zero and so must shift items from their positions
+within the source string into the appropriate positions in the target slice.  The
+preconditions (1) fromIndex ▓ toIndex ▓ source string length, and (2) number of items
+between the from and to indices, inclusive, ▓ target slice size, must both be met.  If not,
+then the positionerr and overflow  exceptions are raised, respectively.  If necessary, the
+string terminator is added to the end of the slice.
+
+*)
+
+PROCEDURE SliceOf   (    theString  : String        (*-- in    *);
+                         fromIndex  : Position      (*-- in    *);
+                         toIndex    : Position      (*-- in    *);
+                     VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      sliceSize : CARDINAL; (*-- # items between from & to indexes *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        sliceSize := toIndex - fromIndex;
+        IF (sliceSize <= HIGH(theSlice)) THEN
+          FOR index := fromIndex TO toIndex DO
+            theSlice[index - fromIndex] := items^[index];
+          END (*--for*);
+          IF (sliceSize < HIGH(theSlice)) THEN
+            theSlice[sliceSize + 1] := NullItem;
+          END (*--if*);
+        ELSE
+          RaiseErrIn(sliceof, overflow);
+        END (*--if*);
+      ELSE
+        RaiseErrIn(sliceof, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(sliceof, undefined);
+  END (*--if*);
+END SliceOf;
+(*----------------------------*)
+
+
+(*
+SubstringOf is similar to SliceOf, above, except that the whole string is returned. When
+the Target substring is too small for all the items in the Source string, overflow is raised
+and the target is filled with as many items that will fit.
+*)
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+VAR   index      : CARDINAL; (*-- loop index over items *)
+      copyLength : CARDINAL; (*-- # items to copy into substring *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (length > HIGH(toSubstring) + 1) THEN
+        RaiseErrIn(substringof, overflow);
+        copyLength := HIGH(toSubstring) + 1;
+      ELSE
+        copyLength := length;
+      END (*--if*);
+      FOR index := MIN(Position) TO copyLength DO
+        toSubstring[index - 1] := items^[index];
+      END (*--for*);
+      IF copyLength < HIGH(toSubstring) THEN
+        toSubstring[copyLength + 1] := NullItem;
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(substringof, undefined);
+  END (*--if*);
+END SubstringOf;
+(*----------------------------*)
+
+
+
+(*
+10.2.7		Iterators
+
+The unbounded string iterators LoopOver and LoopChange use the same algorithm, which
+is almost identical to that used with the bounded string, the difference being that the items
+array must be dereferenced as we maintain a pointer to the dynamic structure.  The
+stringError state is reset to noerr and a test made for the undefined string, raising the
+undefined exception if such is the case.  Then simply loop through each item of the string
+passing it along to the given procedure for processing until either the end of the string is
+reached or the visiting process returns False indicating that the iteration be terminated.
+
+The unbounded string iterators Traverse and TravChange use the same algorithm, which is
+almost identical to that used with the bounded string, the difference being that the items
+array must be dereferenced as we maintain a pointer to the dynamic structure.  The
+stringError state is reset to noerr and a test made for the undefined string, raising the
+undefined exception if such is the case.  Then simply loop through each item of the string
+passing it along to the given procedure for processing.
+*)
+
+PROCEDURE LoopOver   (    theString : String         (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(Position) TO length DO
+        IF ~theProcess(items^[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE LoopChange (    theString : String         (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(Position) TO length DO
+        IF ~theProcess(items^[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopchange, undefined);
+  END (*--if*);
+END LoopChange;
+(*----------------------------*)
+
+
+PROCEDURE Traverse   (    theString : String         (*-- in    *);
+                          theProcess: AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(Position) TO length DO
+        theProcess(items^[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+
+PROCEDURE TravChange (    theString : String         (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(Position) TO length DO
+        theProcess(items^[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(travchange, undefined);
+  END (*--if*);
+END TravChange;
+(*----------------------------*)
+
+
+
+(*
+10.2.8		Module Initialization
+
+In the module initialization the local exception handlers array variables are set to default
+handlers (ExitOnError) except for the noerr handler which is given the null handler. 
+stringError is given the value noerr avoiding an undefined state.
+*)
+
+BEGIN
+  SetHandler(noerr, NullHandler);
+  FOR stringError := initfailed TO MAX(Exceptions) DO
+    SetHandler(stringError, ExitOnError);
+  END (*--for*);
+  stringError := noerr;
+END StrCSUMI.
+
+
+(*
+References
+
+[1]	G. Booch, Software Components With Ada Structures, Tools, and Subsystems,
+	Benjamin/Cummings, Menlo Park, CA, 1987, pp. 104-141.
+[2]	D. Knuth, The Art of Computer Programming, Vol. 1, Fundamental Algorithms,
+	Addison-Wesley, Reading, MA 1973.
+[3]	R. Sedgewick, Algorithms, Addison-Wesley, Reading, MA 1983.
+[4]	T. Standish, Data Structure Techniques, Addison-Wesley, Reading, MA 1980.
+[5]	R. Wiener and R. Sincovec, Data Structures Using Modula-2, John Wiley & Sons, New
+	York, NY 1986, pp. 461-469.
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSUMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSUMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSUMN.DEF
@@ -0,0 +1,229 @@
+(*
+10			The Unbounded Character String (continued)
+
+
+An unbounded implementation of the String abstraction, described in Chapter 8, is
+presented here.  This particular form has the properties: Sequential, Unbounded, Managed,
+and Non-Iterator, describing specific aspects of the implementation as follows:
+
+Sequential:		Can only be used in a non-tasking environment, or by only one task.
+Unbounded:		The size of a string varies dynamically as items are inserted and removed
+				from the string.
+Managed:		Memory space for items and objects is returned to the system when no
+				longer needed.
+Non-Iterator:	Routines for looping over each of the string items are provided.
+
+As noted in the previous chapter on the bounded string form, strings are nearly always
+formed of characters, or items that can be represented using characters, we use the
+Character Items module instead of the more generic Items module.
+
+There is one limitation in the implementation presented here: strings are limited to a
+maximum length of 32,000 characters.  This is primarily due to the TML Modula-2
+compiler excluding the type LONGINT and LONGCARD as array index types.
+
+Section 10.3 contains the interface to the unbounded string module while the
+implementation follows in Section 10.4.
+
+
+
+10.3		StringCSUMN Interface
+*)
+
+
+DEFINITION MODULE StrCSUMN;
+(*============================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Component: Monolithic Structure - String
+               Character Sequential Unbounded Managed Non-Iterator
+
+    THE ABSTRACTION
+    This module provides a String abstraction limited to CHARs
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+        Initial JPI Modula-2 implementation.
+============================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM CharItems IMPORT
+    (*--Type*) Item;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions;
+
+    (*-----------------------*)
+
+TYPE  String;
+TYPE  Position   = [ 1 .. 32000 ];
+CONST NullString = String(NIL);
+
+
+(*
+10.3.1		Exceptions
+
+The ModuleID is used by the exception handling mechanism to distinguish this module
+from all other modules.
+
+StringError returns the exception code from the most recent string operation.  A result of
+noerr  indicates successful completion of the operation.
+
+GetHandler returns the exception handler routine associated with the given exception.
+Though the routine is a function procedure returning a procedure as its result, the
+HandlerProc  may not be called from within the GetHandler  call itself.  The procedure
+result must be first assigned to a procedure variable before invocation.  Exception handlers
+are given an initial value of ExitOnError  except for the handler for noerr  which is
+initialized to the null exception handler.  For example, the statement
+
+  GetHandler(overflow)(someErrorCode);
+
+would be flagged as an error by the compiler.
+
+
+SetHandler associates an exception handler routine with the given exception and is the
+inverse of GetHandler.  This routine may be used to override the default settings for the
+exception handlers.
+*)
+
+CONST ModuleID = 4;
+
+PROCEDURE StringError ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+(*
+10.3.2		Constructors
+
+The Create operation attempts to generate a new, empty, unbounded string.  Since this
+module uses character items all the standard operations, (such as assignment and
+comparison), can be done directly; user-defined routines are not needed. 
+
+Create will return the new string upon successful completion of the routine.  If it not
+possible for the string to be created, the constant NullString  will be returned instead.
+
+Destroy takes the given string, clears it of any items, and then destroys the string itself. 
+Where Create defines a string, Destroy is its inverse, making the string undefined.
+
+Clear takes the given string and removes all of its items.  Clearing the string returns it
+to the empty state.
+
+The Assign operation attempts to generate a duplicate of the source string (theString) in
+the target string (toString).  The target string is automatically created, if necessary,
+otherwise the target is simply cleared of its present contents.
+
+Prepend adds the first string to the beginning of the second string, Append  adds the first
+string to the end of the second string, while Insert  adds adds the first string to the second
+string at the given string index position.
+
+Delete removes characters from the given string between the given index positions,
+inclusive.
+
+Replace  removes characters from the given string from the given index position to the
+end of the string and then inserts the replacement string at the end of the given source
+string.  The length of the source string may grow due to the effects of the replacement.
+
+SetItem changes a single character of the source string at the specified index position.
+
+Construct allows one to build a dynamic string from the usual Modula-2 string form. 
+*)
+
+PROCEDURE Create    ()              : String     (*-- out   *);
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *));
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+                         fromIndex  : Position   (*-- in    *);
+                         toIndex    : Position   (*-- in    *));
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         withString : String     (*-- in    *));
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         theItem    : Item       (*-- in    *));
+
+PROCEDURE Construct (VAR theString   : String        (*-- inout *);
+                         theSubstring: ARRAY OF Item (*-- in    *));
+
+
+
+(*
+10.3.3		Selectors
+
+IsDefined attempts to determine whether the given string is valid, e.g., has been created
+and not yet destroyed.  How this is accomplished may be as simple or complicated as the
+implementer desires and the requirements of the application.
+
+IsEmpty returns true if the given string contains no items, and false otherwise. 
+Undefined strings are considered empty.
+
+LengthOf returns the number of characters present in the string.  The function  result is
+declared CARDINAL (instead of Position) as an undefined string returns zero.
+
+Compare establishes the ordering relation between two strings. IsEqual  returns true if
+two strings contain the same items.
+
+ItemOf retrieves a single item at the given index position from the string; SliceOf
+returns a contiguous sequence of characters from a string between two index positions;
+and SubstringOf  returns the whole string as a contiguous sequence of characters.  Both
+SliceOf and SubstringOf terminate their results with 0C if necessary by the rules of
+Modula-2.
+*)
+
+PROCEDURE IsDefined  (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEmpty    (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE LengthOf   (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE Compare    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : Relation    (*-- out   *);
+
+PROCEDURE IsEqual    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE ItemOf     (    theString  : String      (*-- in    *);
+                          theIndex   : Position    (*-- in    *))
+                                     : Item        (*-- out   *);
+
+PROCEDURE SliceOf    (    theString  : String        (*-- in    *);
+                          fromIndex  : Position      (*-- in    *);
+                          toIndex    : Position      (*-- in    *);
+                      VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+END StrCSUMN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSUMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSUMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSUMN.MOD
@@ -0,0 +1,917 @@
+(*
+10.4		StringCSUMN Implementation
+*)
+
+
+IMPLEMENTATION MODULE StrCSUMN;
+(*==========================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2 Compiler
+    Code Size: R-  bytes
+    Component: Monolithic Structure String (Opaque version)
+               Character Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+        Initial JPI Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM CharItems IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+    (*-----------------------*)
+
+
+(*
+10.4.1		Internal Unbounded String Representation
+
+╟Illustration Here╚
+
+Figure 10.1
+
+For the unbounded string an internal representation is needed that does not require a size
+specification when the string is created and allows the string length to vary dynamically
+as items are inserted and removed.  An examination of the literature (Standish [4] or
+Wiener and Sincovec [5], for example) reveals numerous possible representations each
+different in terms of space and time efficiency.  Booch [1] demonstrates an elegant
+solution that may be readily derived from the bounded string form, where one maintains
+in the string header a pointer to the dynamically allocated array of items.  To support this
+alternate structure requires an additional local routine delegated the responsibility for
+adjusting the size of this array.  Then only cosmetic changes are needed throughout the
+remainder of the module.  This routine has been named SetSize  in this module, the
+details of which are described below with its implementation.
+
+Like the internal representation for an unbounded stack, the representation for the
+unbounded string begins with a header record dynamically allocated on the heap.  This
+header is used to store two fields: (1) the current string length, and (2) a pointer to a
+dynamically allocated array of items large enough to hold the current length of the string.
+
+length is initialized to zero when a string is created, and this value represents an empty
+string.  Furthermore, items is set to NIL when the length is zero.
+*)
+
+TYPE  Substring  = POINTER TO ARRAY Position OF Item;
+
+TYPE  UnboundedString = RECORD
+        size   : CARDINAL;    (*-- actual allocated size *)
+        length : CARDINAL;    (*-- Current String Length *)
+        items  : Substring;   (*-- ARRAY[1..length] of Items *)
+      END (*-- UnboundedString *);
+
+TYPE  String = POINTER TO UnboundedString;
+
+
+
+(*
+10.4.2		Exceptions
+
+To support the exception handling mechanism two variables are needed.  The first,
+stringError, is used to record the exception code from each operation; while handlers is an
+array of exception handling procedures indexed by the exception code.
+
+The routines StringError, GetHandler, and SetHandler have been previously described in
+the definition module, and their operation should be readily apparent.  RaiseErrIn is a
+local routine used to set the stringError variable and invoke the Raise  routine of the
+ErrorHandling module.
+*)
+
+VAR   stringError : Exceptions;
+VAR   handler     : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE StringError ()              : Exceptions  (*-- out   *);
+BEGIN
+  RETURN stringError;
+END StringError;
+(*----------------------------*)
+
+PROCEDURE GetHandler  (    theError   : Exceptions  (*-- in    *))
+                                      : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler  (    theError   : Exceptions  (*-- in    *);
+                           theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn  (    theRoutine : Operations    (*-- in    *);
+                           theError   : Exceptions    (*-- in    *));
+BEGIN
+  stringError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+
+
+(*
+10.4.3		Local Routines
+
+There are two routines local to the string module used by other, exported routines.  They
+are declared here following convention of having routines declared prior to their use.  This
+is not required by Modula-2 (as it was for Pascal) but some single-pass compilers have
+imposed restrictions in this regard and this technique facilitates porting to such compilers.
+
+LengthSubstr determines that length of a substring  which for our purposes is a standard
+Modula-2 string.  The substring parameter being tested is declared call-by-reference to
+avoid the overhead involved in copying the open array implicit in call-by-value
+parameters.  Note that we must first explicitly check for the special case of an empty
+string, "", which is represented as a string containing only the string terminator character.
+
+The second routine, FromToOK, checks whether the following precondition holds:
+
+		fromIndex <= toIndex <= stringLength
+
+which is required for routines such as Delete and SliceOf.  The routine takes advantage of
+the fact that if the toIndex is less than or equal to the stringLength and the fromIndex is
+less than or equal to the toIndex, then the fromIndex must also be less than or equal to the
+stringLength.
+*)
+
+PROCEDURE LengthSubstr  (VAR theSubstring : ARRAY OF Item (*-- in    *))
+                                          : CARDINAL      (*-- out   *);
+BEGIN
+  IF (HIGH(theSubstring) = 0) & (theSubstring[0] = NullItem) THEN
+    RETURN 0;
+  END (*--if*);
+  RETURN HIGH(theSubstring) + 1;
+END LengthSubstr;
+(*----------------------------*)
+
+PROCEDURE FromToOK      (    fromIndex    : Position   (*-- in    *);
+                             toIndex      : Position   (*-- in    *);
+                             stringLength : CARDINAL   (*-- in    *))
+                                          : BOOLEAN    (*-- out   *);
+BEGIN
+  RETURN (toIndex <= stringLength) & (fromIndex <= toIndex);
+END FromToOK;
+(*----------------------------*)
+
+
+(*
+10.4.4		SetSize
+
+The routine SetSize manages changing the length of and the pointer to the dynamic array
+of items for an unbounded string.  The input parameters are (1) the header record of the
+string being changed, (2) the desired new length, and (3) whether the current item values
+should be kept with the new item array.  SetSize must correctly account for the following
+situations based on the desired and current lengths (using a decision table format, where an
+X indicates a ╥don't care╙ value):
+
+Desired		Current		Preserve
+Length		Length		Value?	Action
+0		X		X	deallocate existing items array
+X		0		X	allocate new items array
+greater than current            Yes	allocate new items array and copy item values
+greater than current            No	allocate new items array and don't copy item values
+less than current		X	do nothing
+
+From the above table the reader can see that when the length of the string decreases we
+leave the string unchanged and may wonder as to the reason for this.  Basically, we are
+taking advantage of the semantics of the Deallocate operation which automatically
+releases the correct amount of space that was originally allocated and futhermore sets the
+pointer to NIL.  Therefore, we waste some space by not changing the items array's
+physical length through reallocation of the array but instead choose to save the time spent
+for this operation.
+
+The local variable setSizeOK indicates, when false, failure of the reallocation step.  In all
+other cases setSizeOK will be true (failure cannot occur when we deallocate an items
+array).  Since the value for setSizeOK does not always have meaning as some states never
+fail, it is better to use a local variable that can be checked when necessary instead of
+returning a function result that would have to be processed by the caller in every case.
+
+Let us examine each of the above cases from the decision table in further detail.  When
+the new size to zero we must effectively clear the items array.  This is done by simply
+deallocating the array and setting the string length to the desired value.
+
+When the new size is non-zero and the string is already empty it is necessary to allocate a
+new items array.  As there are no items to be preserved from an empty state we ignore the
+valueOption  parameter.  If this allocation fails, setSizeOK is set to false, and SetSize is
+aborted leaving the string unchanged.
+
+Expansion of the items array occurs when the desired size is greater than the current
+length.  A new items array is first allocated since it may be necessary to preserve the
+items from the current items array.  If this allocation fails, setSizeOK is set to false, and
+SetSize is aborted leaving the string unchanged.  Otherwise, if the valueOption has been
+set to preservevalue  the individual items are copied to the new structure.  Once the value
+has been preserved, if necessary, the current items array can be safely deallocated, and the
+pointer to the new items array stored in its place.  Lastly, the string length field can be
+updated.
+*)
+
+TYPE  SetOptions = (preservevalue, trashvalue);
+VAR   setSizeOK  : BOOLEAN;
+
+PROCEDURE SetSize   (VAR theString   : UnboundedString (*-- inout *);
+                         totheSize   : CARDINAL        (*-- in    *);
+                         valueOption : SetOptions      (*-- in    *));
+
+CONST itemSize = SIZE(Item);
+VAR   newItems : Substring;
+      index    : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  setSizeOK := TRUE;
+  WITH theString DO
+    IF (totheSize = 0) THEN
+      Deallocate(items, itemSize * size);
+      size := 0;
+    ELSIF (items = NIL) THEN
+      Allocate(items, itemSize * totheSize);
+      IF (items = NIL) THEN
+        setSizeOK := FALSE;
+        RETURN;
+      END (*--if*);
+      size := totheSize;
+
+    ELSIF (totheSize > length) THEN
+      Allocate(newItems, itemSize * totheSize);
+      IF (newItems = NIL) THEN
+        setSizeOK := FALSE;
+        RETURN;
+      END (*--if*);
+
+      IF (valueOption = preservevalue) THEN
+        FOR index := MIN(Position) TO length DO
+          newItems^[index] := items^[index];
+        END (*--for*);
+      END (*--if*);
+
+      Deallocate(items, itemSize * size);
+      items := newItems;
+      size  := totheSize;
+    END (*--if*);
+    length := totheSize;
+  END (*--with*);
+END SetSize;
+(*----------------------------*)
+
+
+
+(*
+10.4.5		Constructors
+
+Create begins by clearing the stringError  field under the assumption of a successful
+result.
+
+The header for the string must then be allocated in a local variable since the function
+result cannot be manipulated but only returned.  The key to this allocation step is the
+calculation of the number of bytes necessary based on the size of an individual item and
+the number of items requested.  We must not forget the space for storing theSize and the
+string length.  The constant expression staticSize  accomplishes this regardless of the
+number and size of these ╥static╙ fields and is unaffected by changes that may come about
+due to future maintenance.  If the unbounded string could not be allocated, the overflow
+exception must be raised, and the NullString returned.
+
+At this point, all possibility of failure has been avoided and the bounded string header can
+be initialized to its empty state (length set to zero, items set to NIL).  Lastly, the new
+string can be returned to the caller.
+*)
+
+PROCEDURE Create    ()              : String     (*-- out   *);
+
+VAR   newString : String;
+
+BEGIN
+  stringError := noerr;
+  Allocate(newString, SIZE(UnboundedString));
+  IF (newString # NIL) THEN
+    WITH newString^ DO
+      size   := 0;
+      length := 0;
+      items  := NIL;
+    END (*--with*);
+    RETURN newString;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullString;
+END Create;
+(*----------------------------*)
+
+
+(*
+Destroy simply needs to call the SetSize routine to deallocate the items array itself
+followed by deallocation of the bounded string header which automatically sets theString
+to the NullString.
+*)
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    SetSize(theString^, 0, trashvalue);
+    Deallocate(theString, SIZE(UnboundedString));
+  ELSE
+    RaiseErrIn(destroy, undefined);
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+
+(*
+Clear simply needs to call the SetSize routine to deallocate the items array itself and set
+the length to zero, removing all of its items using the trashvalue  command.
+*)
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    SetSize(theString^, 0, trashvalue);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+
+(*
+The assignment for this implementation of unbounded string objects is simpler to
+implement than other unbounded objects due to the opportunity for restricting overflow to
+when the target object is (re-)created.  This is done by the SetSize routine described above. 
+If the target object exists and is capable of holding all of the source object's items the
+target can be safely cleared and its data type updated appropriately.  Otherwise, the
+overflow exception is raised and the assignment operation is aborted.  When the target
+object is in an undefined state it must then be created.  If overflow does not occur, the
+actual assignment can commence, otherwise its suffices to exit (Create has already raised
+the exception).
+
+The assignment operator cannot be used to copy the whole items array as only a slice of
+the array's index range was actually allocated and who knows what other dynamically
+allocated objects follow it in memory.  Nor can assignment be used to copy individual
+items as the data type of those items is unknown; using assignment for dynamically
+allocated items would cause structural sharing of items, which is not desired.
+*)
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    IF (theString # toString) THEN
+      IF (toString # NIL) THEN
+        SetSize(toString^, theString^.length, trashvalue);
+        IF ~setSizeOK THEN
+          RaiseErrIn(assign, overflow);
+          RETURN;
+        END (*--if*);
+      ELSE
+        toString := Create();
+        IF (stringError # noerr) THEN
+          RETURN;
+        END (*--if*);
+      END (*--if*);
+
+      WITH theString^ DO
+        FOR index := MIN(Position) TO length DO
+          toString^.items^[index] := items^[index];
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+
+(*
+Prepend and Append simply make use of the Insert routine to add items to the front or
+the back of the target string, respectively.
+*)
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, 1);
+END Prepend;
+(*----------------------------*)
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, LengthOf(toString) + 1);
+END Append;
+(*----------------------------*)
+
+
+(*
+Insert adds the items of one string to an existing string at the given index position.  First
+the target string is expanded to hold the new items using the SetSize routine with the new
+length and the command to preserve the current items.  Once the items array of the string
+has been made large enough, we make room for new string items by shifting items from
+the insertion index to the right by the number of items being inserted.  Then we proceed
+to insert the new string items into the vacated positions.  Remember that the modified
+string's length was updated to reflect the newly inserted items by SetSize.
+*)
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *));
+
+VAR   oldLength : CARDINAL;
+      newLength : CARDINAL;
+      index     : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (toString # NIL) & (theString # NIL) THEN
+
+    WITH toString^ DO
+      oldLength := length;
+      newLength := theString^.length + length;
+
+      IF (theIndex > oldLength + 1) THEN
+        RaiseErrIn(insert, positionerr);
+      ELSE
+        SetSize(toString^, newLength, preservevalue);
+        IF setSizeOK THEN
+
+          FOR index := oldLength TO theIndex BY -1 DO
+            items^[index + theString^.length] := items^[index];
+          END (*--for*);
+
+          FOR index := MIN(Position) TO theString^.length DO
+            items^[theIndex + index - 1] := theString^.items^[index];
+          END (*--for*);
+        ELSE
+          RaiseErrIn(insert, overflow);
+        END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(insert, undefined);
+  END (*--if*);
+END Insert;
+(*----------------------------*)
+
+
+(*
+Delete removes items from an existing string between the given index positions,
+inclusive.  Invalid index positions raise positionerr  and abort the operation.  The
+algorithm essentially shifts items above the toIndex down in the string into positions
+beginning with the fromIndex.  It calculates the amount of this shift, called the offset,
+loops through string items above toIndex, shifting each item into its new location.  After
+moving the items the string's length is updated.
+*)
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+                         fromIndex  : Position   (*-- in    *);
+                         toIndex    : Position   (*-- in    *));
+
+VAR   index  : CARDINAL; (*-- loop index over items *)
+      offset : CARDINAL; (*-- distance to move items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        offset := toIndex - fromIndex + 1;
+        FOR index := toIndex + 1 TO length DO
+          items^[index - offset] := items^[index];
+        END (*--for*);
+        SetSize(theString^, length - offset, preservevalue);
+      ELSE
+        RaiseErrIn(delete, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(delete, undefined);
+  END (*--if*);
+END Delete;
+(*----------------------------*)
+
+
+(*
+Replace deletes all items of the source string from the given index to the end of the string
+and then inserts the replacement string at the end of the source.  If theString was expanded
+by the replacement process, the string length is adjusted accordingly.
+*)
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         withString : String     (*-- in    *));
+
+VAR   endIndex : CARDINAL;
+      index    : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) & (withString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+
+        endIndex := theIndex + withString^.length - 1;
+        IF (endIndex > length) THEN
+          SetSize(theString^, endIndex, preservevalue);
+          IF ~setSizeOK THEN
+            RaiseErrIn(replace, overflow);
+            RETURN;
+          END (*--if*);
+        END (*--if*);
+
+        FOR index := MIN(Position) TO withString^.length DO
+          items^[theIndex + index - 1] := withString^.items^[index];
+        END (*--for*);
+      ELSE
+        RaiseErrIn(replace, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(replace, undefined);
+  END (*--if*);
+END Replace;
+(*----------------------------*)
+
+
+(*
+SetItem attempts to assign the given item to the string at the given index position.  The
+index must be within the string's current length otherwise the positionerr exception is
+raised avoiding assignment outside the string's current bounds.
+*)
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         theItem    : Item       (*-- in    *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        items^[theIndex] := theItem;
+      ELSE
+        RaiseErrIn(setitem, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(setitem, undefined);
+  END (*--if*);
+END SetItem;
+(*----------------------------*)
+
+
+(*
+Construct forms an unbounded string from a standard Modula-2 string.  If theString has
+not yet been created then theSubstring must not be empty for compatibility with the
+bounded form.  If theString does exist and theSubstring is empty it is sufficient to clear
+theString.  Otherwise we simply loop through theSubstring copying items from there to
+the target string and when done update the string's length.
+*)
+
+PROCEDURE Construct (VAR theString   : String        (*-- inout *);
+                         theSubstring: ARRAY OF Item (*-- in    *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      lenSubstr : CARDINAL; (*-- # of items in substring *)
+      newString : String;   (*-- new string, if necessary *)
+
+BEGIN
+  stringError := noerr;
+  lenSubstr := LengthSubstr(theSubstring);
+
+  IF (theString # NIL) THEN
+    IF (lenSubstr = 0) THEN
+      Clear(theString);
+      RETURN;
+    END (*--if*);
+  ELSIF (lenSubstr = 0) THEN
+    RaiseErrIn(construct, positionerr);
+  ELSE
+    newString := Create();
+    IF (stringError # noerr) THEN
+      RETURN;
+    END (*--if*);
+    theString := newString;
+  END (*--if*);
+
+  SetSize(theString^, lenSubstr, trashvalue);
+  IF setSizeOK THEN
+    WITH theString^ DO
+      index := MIN(Position);
+      WHILE (index <= lenSubstr) &
+            (theSubstring[index - 1] # NullItem) DO
+        items^[index] := theSubstring[index - 1];
+        INC(index);
+      END (*--while*);
+    END (*--with*);
+    SetSize(theString^, index-1, preservevalue);
+  ELSE
+    RaiseErrIn(construct, overflow);
+  END (*--if*);
+END Construct;
+(*----------------------------*)
+
+
+
+(*
+10.4.6		Selectors
+
+IsDefined tests the given string for a non-NIL value.
+
+IsEmpty tests the given string's length for zero which is the value used to represent the
+empty string.  While LengthOf  returns the value of the given string's length.
+*)
+
+PROCEDURE IsDefined  (    theString : String   (*-- in    *))
+                                    : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (theString # NIL);
+END IsDefined;
+(*----------------------------*)
+
+PROCEDURE IsEmpty    (    theString : String   (*-- in    *))
+                                    : BOOLEAN  (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length = 0;
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+PROCEDURE LengthOf   (    theString : String   (*-- in    *))
+                                    : CARDINAL (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*----------------------------*)
+
+
+(*
+Compare returns the ordering relation between two strings such that ╥left Relation right╙
+is True.  If either or both strings are undefined then the incomparable  relation is returned.
+
+Initially we set up minLength with the smaller of the two string lengths, as reaching the
+end of a string is one condition that terminates the comparison. We also set relOrder  to
+the correct result based on length.  This is based on the fact that all other things being
+equal, the smaller of the strings is less than the other.
+
+One this initialization is done, the algorithm loops through the strings from the
+beginning examining each character item for the relation between them.  The loop
+continues as long as the strings are equal or until the end of the smaller string is reached. 
+The instant that the left item at the current index is less than its counterpart in the right
+string the loop is terminated and the relation less  is returned.  Likewise when the left
+item is greater than the right item the relation greater  is returned.  For equal items the
+index is incremented, advancing the algorithm towards the terminating condition.
+*)
+
+PROCEDURE Compare    (    left      : String   (*-- in    *);
+                          right     : String   (*-- in    *))
+                                    : Relation (*-- out   *);
+
+VAR   index     : CARDINAL; (*-- Index into items arrays *)
+      minLength : CARDINAL; (*-- Smaller of the two string lengths *)
+      relOrder  : Relation; (*-- Most recent comparison result *)
+
+BEGIN
+  stringError := noerr;
+  relOrder    := incomparable;
+  IF (left # NIL) & (right # NIL) THEN
+
+    WITH left^ DO
+      IF (length = right^.length) THEN
+        relOrder  := equal;
+        minLength := length;
+      ELSIF (length < right^.length) THEN
+        relOrder  := less;
+        minLength := length;
+      ELSE
+        relOrder  := greater;
+        minLength := right^.length;
+      END (*--if*);
+    END (*--with*);
+
+    index := MIN(Position);
+    LOOP
+      IF (index > minLength) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+
+      IF (left^.items^[index] < right^.items^[index]) THEN
+        relOrder := less;
+        EXIT (*--loop*);
+      ELSIF (left^.items^[index] > right^.items^[index]) THEN
+        relOrder := greater;
+        EXIT (*--loop*);
+      END (*--if*);
+
+      INC(index);
+
+    END (*--loop*);
+  ELSE
+    RaiseErrIn(compare, undefined);
+  END (*--if*);
+
+  RETURN relOrder;
+END Compare;
+(*----------------------------*)
+
+
+(*
+IsEqual scans both strings looking for the first mismatch (inequality) which indicates the
+strings are unequal, otherwise if the FOR loop completes the strings must be equal.  This
+assumes that (1) the strings have been defined and (2) have the same length.  The first of
+these assumptions, if unfounded, raises the undefined exception; while the second is a
+simple determinant of inequality.
+*)
+
+PROCEDURE IsEqual    (    left      : String   (*-- in    *);
+                          right     : String   (*-- in    *))
+                                    : BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    WITH left^ DO
+      IF (length = right^.length) THEN
+        FOR index := MIN(Position) TO length DO
+          IF (items^[index] # right^.items^[index]) THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--for*);
+        RETURN TRUE;
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+
+(*
+ItemOf attempts to return the item of the string at the given index position.  If theIndex
+exceeds the length of the string the positionerr  exception is raised.  This exception and
+also an undefined string causes the NullItem (0C) to be returned.
+*)
+
+PROCEDURE ItemOf     (    theString : String   (*-- in    *);
+                          theIndex  : Position (*-- in    *))
+                                    : Item     (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        RETURN items^[theIndex];
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(itemof, positionerr);
+  ELSE
+    RaiseErrIn(itemof, undefined);
+  END (*--if*);
+  RETURN NullItem;
+END ItemOf;
+(*----------------------------*)
+
+
+(*
+SliceOf extracts a portion of the given string returning the sequence of characters as a
+standard Modula-2 string.  The portion of the string to be extracted is specified by the
+range of index positions within the string, fromIndex  and toIndex.  We must take care
+because the target slice is indexed from zero and so must shift items from their positions
+within the source string into the appropriate positions in the target slice.  The
+preconditions (1) fromIndex ▓ toIndex ▓ source string length, and (2) number of items
+between the from and to indices, inclusive, ▓ target slice size, must both be met.  If not,
+then the positionerr and overflow  exceptions are raised, respectively.  If necessary, the
+string terminator is added to the end of the slice.
+
+*)
+
+PROCEDURE SliceOf   (    theString  : String        (*-- in    *);
+                         fromIndex  : Position      (*-- in    *);
+                         toIndex    : Position      (*-- in    *);
+                     VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      sliceSize : CARDINAL; (*-- # items between from & to indexes *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        sliceSize := toIndex - fromIndex;
+        IF (sliceSize <= HIGH(theSlice)) THEN
+          FOR index := fromIndex TO toIndex DO
+            theSlice[index - fromIndex] := items^[index];
+          END (*--for*);
+          IF (sliceSize < HIGH(theSlice)) THEN
+            theSlice[sliceSize + 1] := NullItem;
+          END (*--if*);
+        ELSE
+          RaiseErrIn(sliceof, overflow);
+        END (*--if*);
+      ELSE
+        RaiseErrIn(sliceof, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(sliceof, undefined);
+  END (*--if*);
+END SliceOf;
+(*----------------------------*)
+
+
+(*
+SubstringOf is similar to SliceOf, above, except that the whole string is returned. When
+the Target substring is too small for all the items in the Source string, overflow is raised
+and the target is filled with as many items that will fit.
+*)
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+VAR   index      : CARDINAL; (*-- loop index over items *)
+      copyLength : CARDINAL; (*-- # items to copy into substring *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (length > HIGH(toSubstring) + 1) THEN
+        RaiseErrIn(substringof, overflow);
+        copyLength := HIGH(toSubstring) + 1;
+      ELSE
+        copyLength := length;
+      END (*--if*);
+      FOR index := MIN(Position) TO copyLength DO
+        toSubstring[index - 1] := items^[index];
+      END (*--for*);
+      IF copyLength < HIGH(toSubstring) THEN
+        toSubstring[copyLength + 1] := NullItem;
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(substringof, undefined);
+  END (*--if*);
+END SubstringOf;
+(*----------------------------*)
+
+
+(*
+10.2.7		Module Initialization
+
+In the module initialization the local exception handlers array variables are set to default
+handlers (ExitOnError) except for the noerr handler which is given the null handler. 
+stringError is given the value noerr avoiding an undefined state.
+*)
+
+BEGIN
+  SetHandler(noerr, NullHandler);
+  FOR stringError := initfailed TO MAX(Exceptions) DO
+    SetHandler(stringError, ExitOnError);
+  END (*--for*);
+  stringError := noerr;
+END StrCSUMN.
+
+
+(*
+References
+
+[1]	G. Booch, Software Components With Ada Structures, Tools, and Subsystems,
+	Benjamin/Cummings, Menlo Park, CA, 1987, pp. 104-141.
+[2]	D. Knuth, The Art of Computer Programming, Vol. 1, Fundamental Algorithms,
+	Addison-Wesley, Reading, MA 1973.
+[3]	R. Sedgewick, Algorithms, Addison-Wesley, Reading, MA 1983.
+[4]	T. Standish, Data Structure Techniques, Addison-Wesley, Reading, MA 1980.
+[5]	R. Wiener and R. Sincovec, Data Structures Using Modula-2, John Wiley & Sons, New
+	York, NY 1986, pp. 461-469.
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRENUM.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRENUM.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRENUM.DEF
@@ -0,0 +1,49 @@
+DEFINITION MODULE StrEnum;
+(*==========================================================
+    Version  : 1.00  28 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tool - String Enumerations Utility
+
+    THE ABSTRACTION
+    This module provides enumeration definitions for string
+    operations and exceptions.
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+        Initial implementation.
+==========================================================*)
+
+CONST ComponentID = 512;	(*-- must be a multiple of 256 *)
+
+TYPE  Operations = (modinit,
+
+                    create, destroy, clear, assign,
+		    prepend, append, insert, delete,
+                    replace, setitem, construct,
+
+                    isdefined, isempty, lengthof, sizeof,
+		    typeof, compare, isequal, itemof,
+                    substringof, sliceof,
+                    loopover, loopchange, traverse,
+		    travchange,
+
+		    seize, release
+                   );
+
+TYPE  Constructors = Operations [create    .. construct];
+TYPE  Selectors    = Operations [isdefined .. sliceof];
+TYPE  Iterators    = Operations [loopover  .. travchange];
+TYPE  GuardedOps   = Operations [seize     .. release];
+
+
+TYPE  Exceptions   = (noerr,
+                      initfailed,
+                      overflow,
+                      positionerr,
+                      typeerror,
+                      undefined
+                     );
+
+TYPE  ExceptionSet = SET OF Exceptions;
+
+END StrEnum.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRENUM.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRENUM.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRENUM.MOD
@@ -0,0 +1,17 @@
+IMPLEMENTATION MODULE StrEnum;
+(*==========================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R+ 32 bytes, R- 32 bytes
+    Component: Tool - String Enumerations Utility
+
+    THE ABSTRACTION
+    This module provides enumeration definitions for string
+    operations and exceptions.
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+        Initial implementation.
+==========================================================*)
+
+END StrEnum.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRHANDL.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRHANDL.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRHANDL.DEF
@@ -0,0 +1,30 @@
+(*
+This module provides a simple exception handler for the
+various String abstractions. Given an error code, it reports
+the exception to standard output in the following format:
+### Error "<error text>" raised in Routine "<routine name>" in Module <module #>
+
+*)
+
+DEFINITION MODULE StrHandlers;
+(*==============================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: String Exception Handlers Utility
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins:
+        Initial implementation
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM StrEnum IMPORT
+	(*--type*) Exceptions, Operations;
+
+
+PROCEDURE WriteHandler (    theModule    : CARDINAL   (*--in   *);
+                            theOperation : Operations (*--in   *);
+                            theException : Exceptions (*--in   *));
+
+END StrHandlers.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRHANDL.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRHANDL.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRHANDL.MOD
@@ -0,0 +1,73 @@
+IMPLEMENTATION MODULE StrHandlers;
+(*==============================================================
+    Version  : 1.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: String Exception Handlers Utility
+
+    REVISION HISTORY
+    v1.00  30 Apr 1989  C. Lins:
+        Initial implementation
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM StrEnum IMPORT
+	(*--type*) Exceptions, Operations;
+
+FROM IO IMPORT
+	(*--proc*) WrStr, WrLn, WrCard;
+
+
+PROCEDURE WriteHandler (    theModule 	: CARDINAL;
+	                    theOperation: Operations;
+	  	            theException: Exceptions);
+BEGIN
+  WrStr('### Error "');
+
+  CASE theException OF
+    noerr      : WrStr('No Error');
+  | typeerror  : WrStr('Type mismatch');
+  | overflow   : WrStr('Overflow');
+  | positionerr: WrStr('Position Error');
+  | undefined  : WrStr('Undefined String');
+  END (*--case*);
+
+  WrStr('" raised in Routine "');
+
+  CASE theOperation OF
+    assign   : WrStr('Assign');
+  | create   : WrStr('Create');
+  | destroy  : WrStr('Destroy');
+  | clear    : WrStr('Clear');
+  | prepend  : WrStr('Prepend');
+  | append   : WrStr('Append');
+  | insert   : WrStr('Insert');
+  | delete   : WrStr('Delete');
+  | replace  : WrStr('Replace');
+  | setitem  : WrStr('SetItem');
+  | construct: WrStr('Construct');
+
+  | isempty    : WrStr('IsEmpty');
+  | isequal    : WrStr('IsEqual');
+  | typeof     : WrStr('TypeOf');
+  | lengthof   : WrStr('LengthOf');
+  | sizeof     : WrStr('SizeOf');
+  | compare    : WrStr('Compare');
+  | itemof     : WrStr('ItemOf');
+  | substringof: WrStr('SubstringOf');
+  | sliceof    : WrStr('SliceOf');
+	
+  | loopover   : WrStr('LoopOver');
+  | loopchange : WrStr('LoopChange');
+  | traverse   : WrStr('Traverse');
+  | travchange : WrStr('TravChange');
+  ELSE
+    WrStr('?????');
+  END (*--case*);
+
+  WrStr('" in Module ');
+  WrCard(theModule, 1);
+  WrLn;
+END WriteHandler;
+
+END StrHandlers.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBMI.DEF
@@ -0,0 +1,142 @@
+DEFINITION MODULE StrSBMI;
+(*====================================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structure String (Opaque version)
+               Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+	  Initial implementation.
+====================================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc, LoopChangeProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  String;
+TYPE  StringSize = [1..8100];
+TYPE  Position   = StringSize;
+CONST NullString = String(NIL);
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+CONST ModuleID = 5;
+
+PROCEDURE StringError () : Exceptions (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+    (*---------------------------------*)
+    (*--         CONSTRUCTORS        --*)
+
+PROCEDURE Create    (    withSizeOf   : StringSize    (*-- in    *);
+                         theDataType  : TypeID        (*-- in    *))
+                                      : String        (*-- out   *);
+
+PROCEDURE Destroy   (VAR theString    : String        (*-- inout *));
+
+PROCEDURE Clear     (VAR theString    : String        (*-- inout *));
+
+PROCEDURE Assign    (    fromString   : String        (*-- in    *);
+                     VAR toString     : String        (*-- inout *));
+
+PROCEDURE Prepend   (    theString    : String        (*-- in    *);
+                     VAR toString     : String        (*-- inout *));
+
+PROCEDURE Append    (    theString    : String        (*-- in    *);
+                     VAR toString     : String        (*-- inout *));
+
+PROCEDURE Insert    (    theString    : String        (*-- in    *);
+                     VAR toString     : String        (*-- inout *);
+                         theIndex     : Position      (*-- in    *));
+
+PROCEDURE Delete    (VAR theString    : String        (*-- inout *);
+                         fromIndex    : Position      (*-- in    *);
+                         toIndex      : Position      (*-- in    *));
+
+PROCEDURE Replace   (VAR theString    : String        (*-- inout *);
+                         theIndex     : Position      (*-- in    *);
+                         withString   : String        (*-- in    *));
+
+PROCEDURE SetItem   (VAR theString    : String        (*-- inout *);
+                         theIndex     : Position      (*-- in    *);
+                         theItem      : Item          (*-- in    *));
+
+PROCEDURE Construct (VAR theString    : String        (*-- inout *);
+	            		 theDataType  : TypeID	      (*-- in    *);
+                     VAR theSubstring : ARRAY OF Item (*-- in    *));
+
+
+    (*---------------------------------*)
+    (*--          SELECTORS          --*)
+
+PROCEDURE IsDefined  (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEmpty    (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE LengthOf   (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE SizeOf     (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE TypeOf     (    theString  : String      (*-- in    *))
+                                     : TypeID      (*-- out   *);
+
+PROCEDURE Compare    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : Relation    (*-- out   *);
+
+PROCEDURE IsEqual    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE ItemOf     (    theString  : String      (*-- in    *);
+                          atIndex    : Position    (*-- in    *))
+                                     : Item        (*-- out   *);
+
+PROCEDURE SliceOf    (    theString  : String        (*-- in    *);
+                          fromIndex  : Position      (*-- in    *);
+                          toIndex    : Position      (*-- in    *);
+                      VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+
+    (*---------------------------------*)
+    (*--          ITERATORS          --*)
+
+PROCEDURE LoopOver   (    theString : String         (*-- in    *);
+                          process   : LoopAccessProc (*-- in    *));
+
+PROCEDURE LoopChange (    theString : String         (*-- in    *);
+                          process   : LoopChangeProc (*-- in    *));
+
+PROCEDURE Traverse   (    theString : String         (*-- in    *);
+                          process   : AccessProc     (*-- in    *));
+
+END StrSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBMI.MOD
@@ -0,0 +1,681 @@
+IMPLEMENTATION MODULE StrSBMI;
+(*==============================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structure String (Opaque version)
+               Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+      Initial implementation.
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, CompareProc, DisposeProc,
+               AccessProc, LoopAccessProc, LoopChangeProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*-----------------------*)
+
+TYPE  Substring  = ARRAY StringSize OF Item;
+
+TYPE  BoundedString = RECORD
+        dataID : TypeID;      (*-- data type identifier *)
+        size   : StringSize;  (*-- Maximum String Size *)
+        length : CARDINAL;    (*-- Current String Length *)
+        items  : Substring;   (*-- ARRAY[1..size] of Items *)
+      END (*-- BoundedString *);
+
+TYPE  String = POINTER TO BoundedString;
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+VAR   stringError : Exceptions;
+VAR   handler     : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE StringError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN stringError;
+END StringError;
+(*----------------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[ofError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[ofError] := toHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn  (    theRoutine : Operations    (*-- in    *);
+                           theError   : Exceptions    (*-- in    *));
+BEGIN
+  stringError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+
+    (*---------------------------------*)
+    (*--       LOCAL ROUTINES        --*)
+
+PROCEDURE LengthSubstr  (VAR theSubstring : ARRAY OF Item (*-- in    *))
+                                          : CARDINAL      (*-- out   *);
+BEGIN
+  IF (HIGH(theSubstring) = 0) & (theSubstring[0] = NullItem) THEN
+    RETURN 0;
+  END (*--if*);
+  RETURN HIGH(theSubstring) + 1;
+END LengthSubstr;
+(*----------------------------*)
+
+PROCEDURE FromToOK      (    fromIndex    : Position   (*-- in    *);
+                             toIndex      : Position   (*-- in    *);
+                             stringLength : CARDINAL   (*-- in    *))
+                                          : BOOLEAN    (*-- out   *);
+
+(*-- Checks whether: fromPosition ▓ toPosition ▓ stringLength. Takes
+  -- advantage of the fact that if toIndex is ▓ the stringLength and
+  -- fromIndex is ▓ toIndex, then fromIndex must also be ▓ stringLength. *)
+
+BEGIN
+  RETURN (toIndex <= stringLength) & (fromIndex <= toIndex);
+END FromToOK;
+(*----------------------------*)
+
+
+    (*---------------------------------*)
+    (*--         CONSTRUCTORS        --*)
+
+PROCEDURE Create    (    withSizeOf   : StringSize    (*-- in    *);
+                         theDataType  : TypeID        (*-- in    *))
+                                      : String        (*-- out   *);
+
+CONST staticSize = SIZE(BoundedString)-SIZE(Substring);
+CONST itemSize   = SIZE(Item);
+VAR   newString  : String;
+
+BEGIN
+  IF (withSizeOf <= MAX(StringSize)) THEN
+    Allocate(newString, staticSize + itemSize * withSizeOf);
+    IF (newString # NIL) THEN
+      WITH newString^ DO
+        dataID := theDataType;
+        size   := withSizeOf;
+        length := 0;
+      END (*--with*);
+      RETURN newString;
+    END (*--if*);
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullString;
+END Create;
+(*----------------------------*)
+
+PROCEDURE Destroy   (VAR theString    : String        (*-- inout *));
+
+CONST staticSize = SIZE(BoundedString)-SIZE(Substring);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theString);
+  IF (stringError = noerr) THEN
+    Deallocate(theString, staticSize + itemSize * theString^.size);
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+PROCEDURE Clear     (VAR theString    : String        (*-- inout *));
+
+VAR   index : CARDINAL;
+      free  : DisposeProc;
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      free := DisposeOf(dataID);
+      FOR index := MIN(StringSize) TO length DO
+        free(items[index]);
+      END (*--for*);
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+PROCEDURE Assign    (    fromString   : String        (*-- in    *);
+                     VAR toString     : String        (*-- inout *));
+
+VAR   index      : CARDINAL;
+      assignment : AssignProc;
+
+BEGIN
+  stringError := noerr;
+  IF (fromString = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (fromString # toString) THEN
+    IF (toString = NIL) THEN
+      toString := Create(fromString^.size, fromString^.dataID);
+    ELSIF (fromString^.length <= toString^.size) THEN
+      Clear(toString);
+      toString^.dataID := fromString^.dataID;
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (stringError = noerr) THEN
+      WITH fromString^ DO
+        assignment := AssignOf(dataID);
+        FOR index := MIN(StringSize) TO length DO
+          toString^.items[index] := assignment(items[index]);
+        END (*--for*);
+        toString^.length := length;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+PROCEDURE Prepend   (    theString    : String        (*-- in    *);
+                     VAR toString     : String        (*-- inout *));
+BEGIN
+  Insert(theString, toString, 1);
+END Prepend;
+(*----------------------------*)
+
+PROCEDURE Append    (    theString    : String        (*-- in    *);
+                     VAR toString     : String        (*-- inout *));
+BEGIN
+  Insert(theString, toString, LengthOf(toString) + 1);
+END Append;
+(*----------------------------*)
+
+PROCEDURE Insert    (    theString    : String        (*-- in    *);
+                     VAR toString     : String        (*-- inout *);
+                         theIndex     : Position      (*-- in    *));
+
+VAR   newLength : CARDINAL;
+      index     : CARDINAL;
+      assignment: AssignProc;
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) & (toString # NIL) THEN
+    IF (theString^.dataID = toString^.dataID) THEN
+
+      WITH toString^ DO
+        newLength := theString^.length + length;
+
+        IF (theIndex > length + 1) THEN
+          RaiseErrIn(insert, positionerr);
+        ELSIF (newLength > size) THEN
+          RaiseErrIn(insert, overflow);
+        ELSE
+
+          assignment := AssignOf(dataID);
+
+          FOR index := length TO theIndex BY -1 DO
+            items[index + theString^.length] := items[index];
+          END (*--for*);
+
+          FOR index := MIN(StringSize) TO theString^.length DO
+            items[theIndex + index - 1] := assignment(theString^.items[index]);
+          END (*--for*);
+
+          length := newLength;
+
+        END (*--if*);
+      END (*--with*);
+    ELSE
+      RaiseErrIn(insert, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(insert, undefined);
+  END (*--if*);
+END Insert;
+(*----------------------------*)
+
+PROCEDURE Delete    (VAR theString    : String        (*-- inout *);
+                         fromIndex    : Position      (*-- in    *);
+                         toIndex      : Position      (*-- in    *));
+
+VAR   index  : CARDINAL;
+      offset : CARDINAL;
+      free   : DisposeProc;
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        free   := DisposeOf(dataID);
+        offset := toIndex - fromIndex + 1;
+        FOR index := toIndex + 1 TO length DO
+	  free(items[index - offset]);
+          items[index - offset] := items[index];
+        END (*--for*);
+        DEC(length, offset);
+      ELSE
+        RaiseErrIn(delete, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(delete, undefined);
+  END (*--if*);
+END Delete;
+(*----------------------------*)
+
+PROCEDURE Replace   (VAR theString    : String        (*-- inout *);
+                         theIndex     : Position      (*-- in    *);
+                         withString   : String        (*-- in    *));
+
+VAR   endPosition : CARDINAL;
+      index       : CARDINAL;
+      free        : DisposeProc;
+      assignment  : AssignProc;
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) & (withString # NIL) THEN
+    IF (theString^.dataID = withString^.dataID) THEN
+      endPosition := theIndex + withString^.length - 1;
+      WITH theString^ DO
+        IF (theIndex <= length) & (endPosition <= size) THEN
+          free := DisposeOf(theString^.dataID);
+          assignment := AssignOf(theString^.dataID);
+          FOR index := MIN(StringSize) TO withString^.length DO
+	    free(items[theIndex + index - 1]);
+            items[theIndex + index - 1] := assignment(withString^.items[index]);
+          END (*--for*);
+
+          IF (endPosition > length) THEN
+            length := endPosition;
+          END (*--if*);
+        ELSE
+          RaiseErrIn(replace, positionerr);
+        END (*--if*);
+      END (*--with*);
+    ELSE
+      RaiseErrIn(replace, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(replace, undefined);
+  END (*--if*);
+END Replace;
+(*----------------------------*)
+
+PROCEDURE SetItem   (VAR theString  : String        (*-- inout *);
+                         theIndex   : Position      (*-- in    *);
+                         theItem    : Item          (*-- in    *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        items[theIndex] := theItem;
+      ELSE
+        RaiseErrIn(setitem, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(setitem, undefined);
+  END (*--if*);
+END SetItem;
+(*----------------------------*)
+
+PROCEDURE Construct (VAR theString    : String        (*-- inout *);
+			 theDataType  : TypeID	      (*-- in    *);
+                     VAR theSubstring : ARRAY OF Item (*-- in    *));
+
+VAR   index     : CARDINAL;
+      lenSubstr : CARDINAL;
+      newString : String;
+
+BEGIN
+  stringError := noerr;
+  lenSubstr := LengthSubstr(theSubstring);
+
+  IF (theString # NIL) THEN
+    IF (lenSubstr = 0) THEN
+      Clear(theString);
+      RETURN;
+    END (*--if*);
+
+  ELSIF (lenSubstr = 0) THEN
+
+    (*-- ERROR: cannot create string of length zero *)
+
+    RaiseErrIn(construct, positionerr);
+    RETURN;
+  ELSE
+    newString := Create(lenSubstr, theDataType);
+    IF (stringError = noerr) THEN
+      theString := newString;
+    ELSE
+      RETURN;
+    END (*--if*);
+  END (*--if*);
+
+  WITH theString^ DO
+
+    (*-- The minimum lenSubstr is one (1). *)
+
+    index := MIN(Position);
+    WHILE (index <= lenSubstr) & (theSubstring[index - 1] # NullItem) DO
+      items[index] := theSubstring[index - 1];
+      INC(index);
+    END (*--while*);
+    length := index - 1;
+  END (*--with*);
+END Construct;
+(*----------------------------*)
+
+
+    (*---------------------------------*)
+    (*--          SELECTORS          --*)
+
+PROCEDURE IsDefined  (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN (theString # NIL);
+END IsDefined;
+(*----------------------------*)
+
+PROCEDURE IsEmpty    (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length = 0;
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+PROCEDURE LengthOf   (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*----------------------------*)
+
+PROCEDURE SizeOf     (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*----------------------------*)
+
+PROCEDURE TypeOf     (    theString  : String      (*-- in    *))
+                                     : TypeID      (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*----------------------------*)
+
+PROCEDURE Compare    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : Relation    (*-- out   *);
+
+VAR   index     : CARDINAL; (*-- Index into items arrays *)
+      minLength : CARDINAL; (*-- Smaller of the two string lengths *)
+      relOrder  : Relation; (*-- Most recent comparison result *)
+      comparison: CompareProc;
+
+BEGIN
+  stringError := noerr;
+  relOrder    := incomparable;
+  IF (left # NIL) & (right # NIL) THEN
+
+    IF (left^.dataID = right^.dataID) THEN
+
+      WITH left^ DO
+        comparison := CompareOf(dataID);
+        IF (length = right^.length) THEN
+          relOrder  := equal;
+          minLength := length;
+        ELSIF (length < right^.length) THEN
+          relOrder  := less;
+          minLength := length;
+        ELSE
+          relOrder  := greater;
+          minLength := right^.length;
+        END (*--if*);
+      END (*--with*);
+
+      index := MIN(StringSize);
+      WITH left^ DO
+        LOOP
+          IF (index > minLength) THEN
+            EXIT (*--loop*);
+          END (*--if*);
+          relOrder := comparison(items[index], right^.items[index]);
+          IF (relOrder # equal) THEN
+            EXIT (*--loop*);
+          END (*--if*);
+          INC(index);
+        END (*--loop*);
+      END (*--with*);
+    ELSE
+      RaiseErrIn(compare, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(compare, undefined);
+  END (*--if*);
+  RETURN relOrder;
+END Compare;
+(*----------------------------*)
+
+PROCEDURE IsEqual    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  stringError := noerr;
+  RETURN Compare(left, right) = equal;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE ItemOf     (    theString  : String      (*-- in    *);
+                          theIndex   : Position    (*-- in    *))
+                                     : Item        (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        RETURN items[theIndex];
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(itemof, positionerr);
+  ELSE
+    RaiseErrIn(itemof, undefined);
+  END (*--if*);
+  RETURN NullItem;
+END ItemOf;
+(*----------------------------*)
+
+PROCEDURE SliceOf    (    theString  : String        (*-- in    *);
+                          fromIndex  : Position      (*-- in    *);
+                          toIndex    : Position      (*-- in    *);
+                      VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+VAR   index     : CARDINAL;
+      sliceSize : CARDINAL;
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        sliceSize := toIndex - fromIndex;
+        IF (sliceSize <= HIGH(theSlice)) THEN
+          FOR index := fromIndex TO toIndex DO
+            theSlice[index - fromIndex] := items[index];
+          END (*--for*);
+          IF (sliceSize < HIGH(theSlice)) THEN
+            theSlice[sliceSize + 1] := NullItem;
+          END (*--if*);
+        ELSE
+          RaiseErrIn(sliceof, overflow);
+        END (*--if*);
+      ELSE
+        RaiseErrIn(sliceof, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(sliceof, undefined);
+  END (*--if*);
+END SliceOf;
+(*----------------------------*)
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+VAR   index      : CARDINAL;
+      copyLength : CARDINAL; (*-- # of items to copy into substring *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (length > HIGH(toSubstring) + 1) THEN
+        RaiseErrIn(substringof, overflow);
+        copyLength := HIGH(toSubstring) + 1;
+      ELSE
+        copyLength := length;
+      END (*--if*);
+      FOR index := MIN(StringSize) TO copyLength DO
+        toSubstring[index - 1] := items[index];
+      END (*--for*);
+      IF (copyLength < HIGH(toSubstring)) THEN
+        toSubstring[copyLength + 1] := NullItem;
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(substringof, undefined);
+  END (*--if*);
+END SubstringOf;
+(*----------------------------*)
+
+
+    (*---------------------------------*)
+    (*--          ITERATORS          --*)
+
+PROCEDURE LoopOver   (    theString : String         (*-- in    *);
+                          process   : LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL;
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(StringSize) TO length DO
+        IF ~process(items[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE LoopChange (    theString : String         (*-- in    *);
+                          process   : LoopChangeProc (*-- in    *));
+
+VAR   index : CARDINAL;
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(StringSize) TO length DO
+        IF ~process(items[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopchange, undefined);
+  END (*--if*);
+END LoopChange;
+(*----------------------------*)
+
+PROCEDURE Traverse   (    theString : String         (*-- in    *);
+                          process   : AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL;
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(StringSize) TO length DO
+        process(items[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+
+(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
+(*~~ Module Initialization  ~~*)
+
+BEGIN
+  FOR stringError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(stringError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  stringError := noerr;
+END StrSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBMN.DEF
@@ -0,0 +1,129 @@
+DEFINITION MODULE StrSBMN;
+(*====================================================================
+    Version  : 1.00  28 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structure String (Opaque version)
+               Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+	  Initial implementation.
+====================================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  String;
+TYPE  StringSize = [1..8100];
+TYPE  Position   = StringSize;
+CONST NullString = String(NIL);
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+CONST ModuleID = 6;
+
+PROCEDURE StringError () : Exceptions (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+    (*---------------------------------*)
+    (*--         CONSTRUCTORS        --*)
+
+PROCEDURE Create    (    withSizeOf   : StringSize    (*-- in    *);
+                         theDataType  : TypeID        (*-- in    *))
+                                      : String        (*-- out   *);
+
+PROCEDURE Destroy   (VAR theString    : String        (*-- inout *));
+
+PROCEDURE Clear     (VAR theString    : String        (*-- inout *));
+
+PROCEDURE Assign    (    fromString   : String        (*-- in    *);
+                     VAR toString     : String        (*-- inout *));
+
+PROCEDURE Prepend   (    theString    : String        (*-- in    *);
+                     VAR toString     : String        (*-- inout *));
+
+PROCEDURE Append    (    theString    : String        (*-- in    *);
+                     VAR toString     : String        (*-- inout *));
+
+PROCEDURE Insert    (    theString    : String        (*-- in    *);
+                     VAR toString     : String        (*-- inout *);
+                         theIndex     : Position      (*-- in    *));
+
+PROCEDURE Delete    (VAR theString    : String        (*-- inout *);
+                         fromIndex    : Position      (*-- in    *);
+                         toIndex      : Position      (*-- in    *));
+
+PROCEDURE Replace   (VAR theString    : String        (*-- inout *);
+                         theIndex     : Position      (*-- in    *);
+                         withString   : String        (*-- in    *));
+
+PROCEDURE SetItem   (VAR theString    : String        (*-- inout *);
+                         theIndex     : Position      (*-- in    *);
+                         theItem      : Item          (*-- in    *));
+
+PROCEDURE Construct (VAR theString    : String        (*-- inout *);
+	            		 theDataType  : TypeID	      (*-- in    *);
+                     VAR theSubstring : ARRAY OF Item (*-- in    *));
+
+
+    (*---------------------------------*)
+    (*--          SELECTORS          --*)
+
+PROCEDURE IsDefined  (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEmpty    (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE LengthOf   (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE SizeOf     (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE TypeOf     (    theString  : String      (*-- in    *))
+                                     : TypeID      (*-- out   *);
+
+PROCEDURE Compare    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : Relation    (*-- out   *);
+
+PROCEDURE IsEqual    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE ItemOf     (    theString  : String      (*-- in    *);
+                          atIndex    : Position    (*-- in    *))
+                                     : Item        (*-- out   *);
+
+PROCEDURE SliceOf    (    theString  : String        (*-- in    *);
+                          fromIndex  : Position      (*-- in    *);
+                          toIndex    : Position      (*-- in    *);
+                      VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+END StrSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBMN.MOD
@@ -0,0 +1,616 @@
+IMPLEMENTATION MODULE StrSBMN;
+(*==============================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structure String (Opaque version)
+               Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+      Initial implementation.
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*-----------------------*)
+
+TYPE  Substring  = ARRAY StringSize OF Item;
+
+TYPE  BoundedString = RECORD
+        dataID : TypeID;      (*-- data type identifier *)
+        size   : StringSize;  (*-- Maximum String Size *)
+        length : CARDINAL;    (*-- Current String Length *)
+        items  : Substring;   (*-- ARRAY[1..size] of Items *)
+      END (*-- BoundedString *);
+
+TYPE  String = POINTER TO BoundedString;
+
+
+    (*---------------------------------*)
+    (*--          EXCEPTIONS         --*)
+
+VAR   stringError : Exceptions;
+VAR   handler     : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE StringError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN stringError;
+END StringError;
+(*----------------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[ofError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[ofError] := toHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn  (    theRoutine : Operations    (*-- in    *);
+                           theError   : Exceptions    (*-- in    *));
+BEGIN
+  stringError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+
+    (*---------------------------------*)
+    (*--       LOCAL ROUTINES        --*)
+
+PROCEDURE LengthSubstr  (VAR theSubstring : ARRAY OF Item (*-- in    *))
+                                          : CARDINAL      (*-- out   *);
+BEGIN
+  IF (HIGH(theSubstring) = 0) & (theSubstring[0] = NullItem) THEN
+    RETURN 0;
+  END (*--if*);
+  RETURN HIGH(theSubstring) + 1;
+END LengthSubstr;
+(*----------------------------*)
+
+PROCEDURE FromToOK      (    fromIndex    : Position   (*-- in    *);
+                             toIndex      : Position   (*-- in    *);
+                             stringLength : CARDINAL   (*-- in    *))
+                                          : BOOLEAN    (*-- out   *);
+
+(*-- Checks whether: fromPosition <= toPosition <= stringLength. Takes
+  -- advantage of the fact that if toIndex is <= the stringLength and
+  -- fromIndex is <= toIndex, then fromIndex must also be <= stringLength. *)
+
+BEGIN
+  RETURN (toIndex <= stringLength) & (fromIndex <= toIndex);
+END FromToOK;
+(*----------------------------*)
+
+
+    (*---------------------------------*)
+    (*--         CONSTRUCTORS        --*)
+
+PROCEDURE Create    (    withSizeOf   : StringSize    (*-- in    *);
+                         theDataType  : TypeID        (*-- in    *))
+                                      : String        (*-- out   *);
+
+CONST staticSize = SIZE(BoundedString)-SIZE(Substring);
+CONST itemSize   = SIZE(Item);
+VAR   newString  : String;
+
+BEGIN
+  IF (withSizeOf <= MAX(StringSize)) THEN
+    Allocate(newString, staticSize + itemSize * withSizeOf);
+    IF (newString # NIL) THEN
+      WITH newString^ DO
+        dataID := theDataType;
+        size   := withSizeOf;
+        length := 0;
+      END (*--with*);
+      RETURN newString;
+    END (*--if*);
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullString;
+END Create;
+(*----------------------------*)
+
+PROCEDURE Destroy   (VAR theString    : String        (*-- inout *));
+
+CONST staticSize = SIZE(BoundedString)-SIZE(Substring);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theString);
+  IF (stringError = noerr) THEN
+    Deallocate(theString, staticSize + itemSize * theString^.size);
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+PROCEDURE Clear     (VAR theString    : String        (*-- inout *));
+
+VAR   index : CARDINAL;
+      free  : DisposeProc;
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      free := DisposeOf(dataID);
+      FOR index := MIN(StringSize) TO length DO
+        free(items[index]);
+      END (*--for*);
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+PROCEDURE Assign    (    fromString   : String        (*-- in    *);
+                     VAR toString     : String        (*-- inout *));
+
+VAR   index      : CARDINAL;
+      assignment : AssignProc;
+
+BEGIN
+  stringError := noerr;
+  IF (fromString = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (fromString # toString) THEN
+    IF (toString = NIL) THEN
+      toString := Create(fromString^.size, fromString^.dataID);
+    ELSIF (fromString^.length <= toString^.size) THEN
+      Clear(toString);
+      toString^.dataID := fromString^.dataID;
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (stringError = noerr) THEN
+      WITH fromString^ DO
+        assignment := AssignOf(dataID);
+        FOR index := MIN(StringSize) TO length DO
+          toString^.items[index] := assignment(items[index]);
+        END (*--for*);
+        toString^.length := length;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+PROCEDURE Prepend   (    theString    : String        (*-- in    *);
+                     VAR toString     : String        (*-- inout *));
+BEGIN
+  Insert(theString, toString, 1);
+END Prepend;
+(*----------------------------*)
+
+PROCEDURE Append    (    theString    : String        (*-- in    *);
+                     VAR toString     : String        (*-- inout *));
+BEGIN
+  Insert(theString, toString, LengthOf(toString) + 1);
+END Append;
+(*----------------------------*)
+
+PROCEDURE Insert    (    theString    : String        (*-- in    *);
+                     VAR toString     : String        (*-- inout *);
+                         theIndex     : Position      (*-- in    *));
+
+VAR   newLength : CARDINAL;
+      index     : CARDINAL;
+      assignment: AssignProc;
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) & (toString # NIL) THEN
+    IF (theString^.dataID = toString^.dataID) THEN
+
+      WITH toString^ DO
+        newLength := theString^.length + length;
+
+        IF (theIndex > length + 1) THEN
+          RaiseErrIn(insert, positionerr);
+        ELSIF (newLength > size) THEN
+          RaiseErrIn(insert, overflow);
+        ELSE
+
+          assignment := AssignOf(dataID);
+
+          FOR index := length TO theIndex BY -1 DO
+            items[index + theString^.length] := items[index];
+          END (*--for*);
+
+          FOR index := MIN(StringSize) TO theString^.length DO
+            items[theIndex + index - 1] := assignment(theString^.items[index]);
+          END (*--for*);
+
+          length := newLength;
+
+        END (*--if*);
+      END (*--with*);
+    ELSE
+      RaiseErrIn(insert, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(insert, undefined);
+  END (*--if*);
+END Insert;
+(*----------------------------*)
+
+PROCEDURE Delete    (VAR theString    : String        (*-- inout *);
+                         fromIndex    : Position      (*-- in    *);
+                         toIndex      : Position      (*-- in    *));
+
+VAR   index  : CARDINAL;
+      offset : CARDINAL;
+      free   : DisposeProc;
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        free   := DisposeOf(dataID);
+        offset := toIndex - fromIndex + 1;
+        FOR index := toIndex + 1 TO length DO
+	  free(items[index - offset]);
+          items[index - offset] := items[index];
+        END (*--for*);
+        DEC(length, offset);
+      ELSE
+        RaiseErrIn(delete, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(delete, undefined);
+  END (*--if*);
+END Delete;
+(*----------------------------*)
+
+PROCEDURE Replace   (VAR theString    : String        (*-- inout *);
+                         theIndex     : Position      (*-- in    *);
+                         withString   : String        (*-- in    *));
+
+VAR   endPosition : CARDINAL;
+      index       : CARDINAL;
+      free        : DisposeProc;
+      assignment  : AssignProc;
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) & (withString # NIL) THEN
+    IF (theString^.dataID = withString^.dataID) THEN
+      endPosition := theIndex + withString^.length - 1;
+      WITH theString^ DO
+        IF (theIndex <= length) & (endPosition <= size) THEN
+          free := DisposeOf(theString^.dataID);
+          assignment := AssignOf(theString^.dataID);
+          FOR index := MIN(StringSize) TO withString^.length DO
+	    free(items[theIndex + index - 1]);
+            items[theIndex + index - 1] := assignment(withString^.items[index]);
+          END (*--for*);
+
+          IF (endPosition > length) THEN
+            length := endPosition;
+          END (*--if*);
+        ELSE
+          RaiseErrIn(replace, positionerr);
+        END (*--if*);
+      END (*--with*);
+    ELSE
+      RaiseErrIn(replace, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(replace, undefined);
+  END (*--if*);
+END Replace;
+(*----------------------------*)
+
+PROCEDURE SetItem   (VAR theString  : String        (*-- inout *);
+                         theIndex   : Position      (*-- in    *);
+                         theItem    : Item          (*-- in    *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        items[theIndex] := theItem;
+      ELSE
+        RaiseErrIn(setitem, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(setitem, undefined);
+  END (*--if*);
+END SetItem;
+(*----------------------------*)
+
+PROCEDURE Construct (VAR theString    : String        (*-- inout *);
+			 theDataType  : TypeID	      (*-- in    *);
+                     VAR theSubstring : ARRAY OF Item (*-- in    *));
+
+VAR   index     : CARDINAL;
+      lenSubstr : CARDINAL;
+      newString : String;
+
+BEGIN
+  stringError := noerr;
+  lenSubstr := LengthSubstr(theSubstring);
+
+  IF (theString # NIL) THEN
+    IF (lenSubstr = 0) THEN
+      Clear(theString);
+      RETURN;
+    END (*--if*);
+
+  ELSIF (lenSubstr = 0) THEN
+
+    (*-- ERROR: cannot create string of length zero *)
+
+    RaiseErrIn(construct, positionerr);
+    RETURN;
+  ELSE
+    newString := Create(lenSubstr, theDataType);
+    IF (stringError = noerr) THEN
+      theString := newString;
+    ELSE
+      RETURN;
+    END (*--if*);
+  END (*--if*);
+
+  WITH theString^ DO
+
+    (*-- The minimum lenSubstr is one (1). *)
+
+    index := MIN(Position);
+    WHILE (index <= lenSubstr) & (theSubstring[index - 1] # NullItem) DO
+      items[index] := theSubstring[index - 1];
+      INC(index);
+    END (*--while*);
+    length := index - 1;
+  END (*--with*);
+END Construct;
+(*----------------------------*)
+
+
+    (*---------------------------------*)
+    (*--          SELECTORS          --*)
+
+PROCEDURE IsDefined  (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN (theString # NIL);
+END IsDefined;
+(*----------------------------*)
+
+PROCEDURE IsEmpty    (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length = 0;
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+PROCEDURE LengthOf   (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*----------------------------*)
+
+PROCEDURE SizeOf     (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*----------------------------*)
+
+PROCEDURE TypeOf     (    theString  : String      (*-- in    *))
+                                     : TypeID      (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*----------------------------*)
+
+PROCEDURE Compare    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : Relation    (*-- out   *);
+
+VAR   index     : CARDINAL; (*-- Index into items arrays *)
+      minLength : CARDINAL; (*-- Smaller of the two string lengths *)
+      relOrder  : Relation; (*-- Most recent comparison result *)
+      comparison: CompareProc;
+
+BEGIN
+  stringError := noerr;
+  relOrder    := incomparable;
+  IF (left # NIL) & (right # NIL) THEN
+
+    IF (left^.dataID = right^.dataID) THEN
+
+      WITH left^ DO
+        comparison := CompareOf(dataID);
+        IF (length = right^.length) THEN
+          relOrder  := equal;
+          minLength := length;
+        ELSIF (length < right^.length) THEN
+          relOrder  := less;
+          minLength := length;
+        ELSE
+          relOrder  := greater;
+          minLength := right^.length;
+        END (*--if*);
+      END (*--with*);
+
+      index := MIN(StringSize);
+      WITH left^ DO
+        LOOP
+          IF (index > minLength) THEN
+            EXIT (*--loop*);
+          END (*--if*);
+          relOrder := comparison(items[index], right^.items[index]);
+          IF (relOrder # equal) THEN
+            EXIT (*--loop*);
+          END (*--if*);
+          INC(index);
+        END (*--loop*);
+      END (*--with*);
+    ELSE
+      RaiseErrIn(compare, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(compare, undefined);
+  END (*--if*);
+  RETURN relOrder;
+END Compare;
+(*----------------------------*)
+
+PROCEDURE IsEqual    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  stringError := noerr;
+  RETURN Compare(left, right) = equal;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE ItemOf     (    theString  : String      (*-- in    *);
+                          theIndex   : Position    (*-- in    *))
+                                     : Item        (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        RETURN items[theIndex];
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(itemof, positionerr);
+  ELSE
+    RaiseErrIn(itemof, undefined);
+  END (*--if*);
+  RETURN NullItem;
+END ItemOf;
+(*----------------------------*)
+
+PROCEDURE SliceOf    (    theString  : String        (*-- in    *);
+                          fromIndex  : Position      (*-- in    *);
+                          toIndex    : Position      (*-- in    *);
+                      VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+VAR   index     : CARDINAL;
+      sliceSize : CARDINAL;
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        sliceSize := toIndex - fromIndex;
+        IF (sliceSize <= HIGH(theSlice)) THEN
+          FOR index := fromIndex TO toIndex DO
+            theSlice[index - fromIndex] := items[index];
+          END (*--for*);
+          IF (sliceSize < HIGH(theSlice)) THEN
+            theSlice[sliceSize + 1] := NullItem;
+          END (*--if*);
+        ELSE
+          RaiseErrIn(sliceof, overflow);
+        END (*--if*);
+      ELSE
+        RaiseErrIn(sliceof, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(sliceof, undefined);
+  END (*--if*);
+END SliceOf;
+(*----------------------------*)
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+VAR   index      : CARDINAL;
+      copyLength : CARDINAL; (*-- # of items to copy into substring *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (length > HIGH(toSubstring) + 1) THEN
+        RaiseErrIn(substringof, overflow);
+        copyLength := HIGH(toSubstring) + 1;
+      ELSE
+        copyLength := length;
+      END (*--if*);
+      FOR index := MIN(StringSize) TO copyLength DO
+        toSubstring[index - 1] := items[index];
+      END (*--for*);
+      IF (copyLength < HIGH(toSubstring)) THEN
+        toSubstring[copyLength + 1] := NullItem;
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(substringof, undefined);
+  END (*--if*);
+END SubstringOf;
+(*----------------------------*)
+
+
+(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
+(*~~ Module Initialization  ~~*)
+
+BEGIN
+  FOR stringError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(stringError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  stringError := noerr;
+END StrSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBUI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBUI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBUI.DEF
@@ -0,0 +1,144 @@
+DEFINITION MODULE StrSBUI;
+(*==========================================================
+    Version  : 1.00 29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structure String (Opaque version)
+               Sequential Bounded Unmanaged Iterator
+
+    THE ABSTRACTION
+    This module provides the String data type for statically
+    allocated data items such as INTEGERs. Any basic data type
+	whose SIZE(T) is ▓ 4 bytes is supported. An item comparison
+	routine is necessary to support comparison of strings.
+
+    REVISION HISTORY
+    v1.00 29 Apr 1989  C. Lins:
+       Initial implementation. Derived from StringCSBMI module.
+==========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc, AccessProc, ChangeProc,
+               LoopAccessProc, LoopChangeProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions;
+
+    (*-----------------------*)
+
+
+TYPE  String;
+TYPE  StringSize = [ 1 .. 8100 ];
+TYPE  Position   = StringSize;
+CONST NullString = String(NIL);
+
+    (*-----------------------*)
+
+
+CONST ModuleID = 7;
+
+PROCEDURE StringError ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    theError   : Exceptions  (*-- in    *))
+                                      : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    theError   : Exceptions  (*-- in    *);
+                           theHandler : HandlerProc (*-- in    *));
+
+    (*-----------------------*)
+
+
+PROCEDURE Create    (    theSize    : StringSize  (*--in   *);
+						 compareItem: CompareProc (*--in   *))
+                                    : String      (*--out  *);
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *));
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+                         fromIndex  : Position   (*-- in    *);
+                         toIndex    : Position   (*-- in    *));
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         withString : String     (*-- in    *));
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         theItem    : Item       (*-- in    *));
+
+PROCEDURE Construct (VAR theString   : String        (*--inout*);
+                         theSubstring: ARRAY OF Item (*--in   *);
+						 compareItem : CompareProc   (*--in   *));
+
+    (*-----------------------*)
+
+
+PROCEDURE IsDefined  (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEmpty    (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE SizeOf     (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE LengthOf   (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE Compare    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : Relation    (*-- out   *);
+
+PROCEDURE IsEqual    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE ItemOf     (    theString  : String      (*-- in    *);
+                          theIndex   : Position    (*-- in    *))
+                                     : Item        (*-- out   *);
+
+PROCEDURE SliceOf    (    theString  : String        (*-- in    *);
+                          fromIndex  : Position      (*-- in    *);
+                          toIndex    : Position      (*-- in    *);
+                      VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+    (*-----------------------*)
+
+
+PROCEDURE LoopOver   (    theString : String         (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE LoopChange (    theString : String         (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+PROCEDURE Traverse   (    theString : String         (*-- in    *);
+                          theProcess: AccessProc     (*-- in    *));
+
+PROCEDURE TravChange (    theString : String         (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+END StrSBUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBUI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBUI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBUI.MOD
@@ -0,0 +1,658 @@
+IMPLEMENTATION MODULE StrSBUI;
+(*==========================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structure String (Opaque version)
+               Sequential Bounded Unmanaged Iterator
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+       Initial implementation. Derived from StringCSBMI module.
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, CompareProc, AccessProc, ChangeProc,
+               LoopAccessProc, LoopChangeProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+
+    (*-----------------------*)
+
+
+TYPE  Substring  = ARRAY StringSize OF Item;
+
+TYPE  BoundedString = RECORD
+	kompare: CompareProc; (*-- item comparison routine *)
+        size   : StringSize;  (*-- Maximum String Size *)
+        length : CARDINAL;    (*-- Current String Length *)
+        items  : Substring;   (*-- ARRAY[1..TheSize] of Items *)
+      END (*-- BoundedString *);
+
+TYPE  String = POINTER TO BoundedString;
+
+    (*-----------------------*)
+
+
+VAR   stringError : Exceptions;
+VAR   handler     : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE StringError ()              : Exceptions  (*-- out   *);
+BEGIN
+  RETURN stringError;
+END StringError;
+(*----------------------------*)
+
+PROCEDURE GetHandler  (    theError   : Exceptions  (*-- in    *))
+                                      : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler  (    theError   : Exceptions  (*-- in    *);
+                           theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn  (    theRoutine : Operations    (*-- in    *);
+                           theError   : Exceptions    (*-- in    *));
+BEGIN
+  stringError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+
+PROCEDURE LengthSubstr (VAR theSubstring : ARRAY OF Item (*-- in    *))
+                                         : CARDINAL      (*-- out   *);
+BEGIN
+  IF (HIGH(theSubstring) = 0) & (theSubstring[0] = NullItem) THEN
+    RETURN 0;
+  END (*--if*);
+  RETURN HIGH(theSubstring) + 1;
+END LengthSubstr;
+(*----------------------------*)
+
+PROCEDURE FromToOK (    fromIndex    : Position   (*-- in    *);
+                        toIndex      : Position   (*-- in    *);
+                        stringLength : CARDINAL   (*-- in    *))
+                                     : BOOLEAN    (*-- out   *);
+BEGIN
+  RETURN (toIndex <= stringLength) & (fromIndex <= toIndex);
+END FromToOK;
+(*----------------------------*)
+
+
+PROCEDURE Create    (    theSize    : StringSize  (*--in   *);
+		         compareItem: CompareProc (*--in   *))
+                                    : String      (*--out  *);
+
+CONST staticSize = SIZE(BoundedString) - SIZE(Substring);
+CONST itemSize   = SIZE(Item);
+VAR   newString  : String;
+
+BEGIN
+  stringError := noerr;
+  Allocate(newString, staticSize + itemSize * theSize);
+  IF (newString # NIL) THEN
+    WITH newString^ DO
+	  kompare:= compareItem;
+      size   := theSize;
+      length := 0;
+    END (*--with*);
+    RETURN newString;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullString;
+END Create;
+(*----------------------------*)
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedString) - SIZE(Substring);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    Deallocate(theString, staticSize + itemSize * theString^.size);
+  ELSE
+    RaiseErrIn(destroy, undefined);
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    theString^.length := 0;
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    IF (theString # toString) THEN
+
+      IF (toString # NIL) THEN
+        IF (theString^.length > toString^.size) THEN
+          RaiseErrIn(assign, overflow);
+	ELSE
+	  toString^.kompare := theString^.kompare;
+        END (*--if*);
+      ELSE
+        toString := Create(theString^.size, theString^.kompare);
+      END (*--if*);
+      IF (stringError # noerr) THEN
+        RETURN;
+      END (*--if*);
+
+      WITH theString^ DO
+        FOR index := MIN(StringSize) TO length DO
+          toString^.items[index] := items[index];
+        END (*--for*);
+        toString^.length := length;
+      END (*--with*);
+    END (*--if*);
+
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, 1);
+END Prepend;
+(*----------------------------*)
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, LengthOf(toString) + 1);
+END Append;
+(*----------------------------*)
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *));
+
+VAR   newLength : CARDINAL;
+      index     : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) & (toString # NIL) THEN
+
+    WITH toString^ DO
+      newLength := theString^.length + length;
+
+      IF (theIndex > length + 1) THEN
+        RaiseErrIn(insert, positionerr);
+      ELSIF (newLength > size) THEN
+        RaiseErrIn(insert, overflow);
+      ELSE
+
+        FOR index := length TO theIndex BY -1 DO
+          items[index + theString^.length] := items[index];
+        END (*--for*);
+
+        FOR index := MIN(StringSize) TO theString^.length DO
+          items[theIndex + index - 1] := theString^.items[index];
+        END (*--for*);
+
+        length := newLength;
+
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(insert, undefined);
+  END (*--if*);
+END Insert;
+(*----------------------------*)
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+                         fromIndex  : Position   (*-- in    *);
+                         toIndex    : Position   (*-- in    *));
+
+VAR   index  : CARDINAL; (*-- loop index over items *)
+      offset : CARDINAL; (*-- distance to move items down *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        offset := toIndex - fromIndex + 1;
+        FOR index := toIndex + 1 TO length DO
+          items[index - offset] := items[index];
+        END (*--for*);
+        DEC(length, offset);
+      ELSE
+        RaiseErrIn(delete, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(delete, undefined);
+  END (*--if*);
+END Delete;
+(*----------------------------*)
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         withString : String     (*-- in    *));
+
+VAR   endPosition : CARDINAL; (*-- new length of theString *)
+      index       : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) & (withString # NIL) THEN
+    endPosition := theIndex + withString^.length - 1;
+    WITH theString^ DO
+      IF (theIndex <= length) & (endPosition <= size) THEN
+        FOR index := MIN(StringSize) TO withString^.length DO
+          items[theIndex + index - 1] := withString^.items[index];
+        END (*--for*);
+
+        IF (endPosition > length) THEN
+          length := endPosition;
+        END (*--if*);
+      ELSE
+        RaiseErrIn(replace, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(replace, undefined);
+  END (*--if*);
+END Replace;
+(*----------------------------*)
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         theItem    : Item       (*-- in    *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        items[theIndex] := theItem;
+      ELSE
+        RaiseErrIn(setitem, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(setitem, undefined);
+  END (*--if*);
+END SetItem;
+(*----------------------------*)
+
+PROCEDURE Construct (VAR theString   : String        (*--inout*);
+                         theSubstring: ARRAY OF Item (*--in   *);
+			 compareItem : CompareProc   (*--in   *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      lenSubstr : CARDINAL; (*-- # of chars in substring *)
+      newString : String;
+
+BEGIN
+  stringError := noerr;
+  lenSubstr := LengthSubstr(theSubstring);
+
+  IF (theString # NIL) THEN
+    IF (lenSubstr = 0) THEN
+      Clear(theString);
+      theString^.kompare := compareItem;
+      RETURN;
+    END (*--if*);
+  ELSIF (lenSubstr = 0) THEN
+    RaiseErrIn(construct, positionerr);
+    RETURN;
+  ELSE
+    newString := Create(lenSubstr, compareItem);
+    IF (stringError = noerr) THEN
+      theString := newString;
+    ELSE
+      RETURN;
+    END (*--if*);
+  END (*--if*);
+
+  WITH theString^ DO
+
+    (*-- The minimum lenSubstr is one (1). *)
+
+    index := MIN(Position);
+    WHILE (index <= lenSubstr) & (theSubstring[index - 1] # NullItem) DO
+      items[index] := theSubstring[index - 1];
+      INC(index);
+    END (*--while*);
+    length := index - 1;
+  END (*--with*);
+END Construct;
+(*----------------------------*)
+
+
+PROCEDURE IsDefined  (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN (theString # NIL);
+END IsDefined;
+(*----------------------------*)
+
+PROCEDURE IsEmpty    (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length = 0;
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+PROCEDURE SizeOf     (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*----------------------------*)
+
+PROCEDURE LengthOf   (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*----------------------------*)
+
+PROCEDURE Compare    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : Relation    (*-- out   *);
+
+VAR   index     : CARDINAL; (*-- Index into items arrays *)
+      minLength : CARDINAL; (*-- Smaller of the two string lengths *)
+      relOrder  : Relation; (*-- Most recent comparison result *)
+
+BEGIN
+  stringError := noerr;
+  relOrder    := incomparable;
+  IF (left # NIL) & (right # NIL) THEN
+
+    IF (left^.kompare # right^.kompare) THEN
+      RaiseErrIn(compare, typeerror);
+      RETURN less;
+    END (*--if*);
+
+    WITH left^ DO
+      IF (length = right^.length) THEN
+        relOrder  := equal;
+        minLength := length;
+      ELSIF (length < right^.length) THEN
+        relOrder  := less;
+        minLength := length;
+      ELSE
+        relOrder  := greater;
+        minLength := right^.length;
+      END (*--if*);
+    END (*--with*);
+
+    index := MIN(StringSize);
+    LOOP
+      IF (index > minLength) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+
+      WITH left^ DO
+        relOrder := kompare(items[index], right^.items[index]);
+      END (*--with*);
+      IF (relOrder # equal) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+
+      INC(index);
+
+    END (*--loop*);
+  ELSE
+    RaiseErrIn(compare, undefined);
+  END (*--if*);
+  RETURN relOrder;
+END Compare;
+(*----------------------------*)
+
+PROCEDURE IsEqual    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    WITH left^ DO
+      IF (length = right^.length) THEN
+        FOR index := MIN(StringSize) TO length DO
+          IF (items[index] # right^.items[index]) THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--for*);
+        RETURN TRUE;
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE ItemOf     (    theString  : String      (*-- in    *);
+                          theIndex   : Position    (*-- in    *))
+                                     : Item        (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        RETURN items[theIndex];
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(itemof, positionerr);
+  ELSE
+    RaiseErrIn(itemof, undefined);
+  END (*--if*);
+  RETURN NullItem;
+END ItemOf;
+(*----------------------------*)
+
+PROCEDURE SliceOf    (    theString  : String        (*-- in    *);
+                          fromIndex  : Position      (*-- in    *);
+                          toIndex    : Position      (*-- in    *);
+                      VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      sliceSize : CARDINAL; (*-- # items between from and to indexes *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        sliceSize := toIndex - fromIndex;
+        IF (sliceSize <= HIGH(theSlice)) THEN
+          FOR index := fromIndex TO toIndex DO
+            theSlice[index - fromIndex] := items[index];
+          END (*--for*);
+          IF (sliceSize < HIGH(theSlice)) THEN
+            theSlice[sliceSize + 1] := NullItem;
+          END (*--if*);
+        ELSE
+          RaiseErrIn(sliceof, overflow);
+        END (*--if*);
+      ELSE
+        RaiseErrIn(sliceof, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(sliceof, undefined);
+  END (*--if*);
+END SliceOf;
+(*----------------------------*)
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+VAR   index      : CARDINAL; (*-- loop index over items *)
+      copyLength : CARDINAL; (*-- # items to copy into substring *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (length > HIGH(toSubstring) + 1) THEN
+        RaiseErrIn(substringof, overflow);
+        copyLength := HIGH(toSubstring) + 1;
+      ELSE
+        copyLength := length;
+      END (*--if*);
+      FOR index := MIN(StringSize) TO copyLength DO
+        toSubstring[index - 1] := items[index];
+      END (*--for*);
+      IF (copyLength < HIGH(toSubstring)) THEN
+        toSubstring[copyLength + 1] := NullItem;
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(substringof, undefined);
+  END (*--if*);
+END SubstringOf;
+(*----------------------------*)
+
+
+PROCEDURE LoopOver   (    theString : String         (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(StringSize) TO length DO
+        IF ~theProcess(items[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE LoopChange (    theString : String         (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(StringSize) TO length DO
+        IF ~theProcess(items[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopchange, undefined);
+  END (*--if*);
+END LoopChange;
+(*----------------------------*)
+
+
+PROCEDURE Traverse   (    theString : String         (*-- in    *);
+                          theProcess: AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(StringSize) TO length DO
+        theProcess(items[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+PROCEDURE TravChange (    theString : String         (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(StringSize) TO length DO
+        theProcess(items[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(travchange, undefined);
+  END (*--if*);
+END TravChange;
+(*----------------------------*)
+
+
+BEGIN
+  FOR stringError := initfailed TO MAX(Exceptions) DO
+    SetHandler(stringError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  stringError := noerr;
+END StrSBUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBUN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBUN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBUN.DEF
@@ -0,0 +1,128 @@
+DEFINITION MODULE StrSBUN;
+(*==========================================================
+    Version  : 1.00 29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structure String (Opaque version)
+               Sequential Bounded Unmanaged Non-Iterator
+
+    THE ABSTRACTION
+    This module provides the String data type for statically
+    allocated data items such as INTEGERs. Any basic data type
+	whose SIZE(T) is ▓ 4 bytes is supported. An item comparison
+	routine is necessary to support comparison of strings.
+
+    REVISION HISTORY
+    v1.00 29 Apr 1989  C. Lins:
+       Initial implementation. Derived from StringSBUI module.
+==========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions;
+
+    (*-----------------------*)
+
+
+TYPE  String;
+TYPE  StringSize = [ 1 .. 8100 ];
+TYPE  Position   = StringSize;
+CONST NullString = String(NIL);
+
+    (*-----------------------*)
+
+
+CONST ModuleID = 8;
+
+PROCEDURE StringError ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    theError   : Exceptions  (*-- in    *))
+                                      : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    theError   : Exceptions  (*-- in    *);
+                           theHandler : HandlerProc (*-- in    *));
+
+    (*-----------------------*)
+
+
+PROCEDURE Create    (    theSize    : StringSize  (*--in   *);
+						 compareItem: CompareProc (*--in   *))
+                                    : String      (*--out  *);
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *));
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+                         fromIndex  : Position   (*-- in    *);
+                         toIndex    : Position   (*-- in    *));
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         withString : String     (*-- in    *));
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         theItem    : Item       (*-- in    *));
+
+PROCEDURE Construct (VAR theString   : String        (*--inout*);
+                         theSubstring: ARRAY OF Item (*--in   *);
+						 compareItem : CompareProc   (*--in   *));
+
+    (*-----------------------*)
+
+
+PROCEDURE IsDefined  (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEmpty    (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE SizeOf     (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE LengthOf   (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE Compare    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : Relation    (*-- out   *);
+
+PROCEDURE IsEqual    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE ItemOf     (    theString  : String      (*-- in    *);
+                          theIndex   : Position    (*-- in    *))
+                                     : Item        (*-- out   *);
+
+PROCEDURE SliceOf    (    theString  : String        (*-- in    *);
+                          fromIndex  : Position      (*-- in    *);
+                          toIndex    : Position      (*-- in    *);
+                      VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+END StrSBUN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBUN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBUN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSBUN.MOD
@@ -0,0 +1,574 @@
+IMPLEMENTATION MODULE StrSBUN;
+(*==========================================================
+    Version  : 1.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structure String (Opaque version)
+               Sequential Bounded Unmanaged Non-Iterator
+
+    REVISION HISTORY
+    v1.00  29 Apr 1989  C. Lins:
+       Initial implementation. Derived from StringSBUI module.
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, CompareProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+
+    (*-----------------------*)
+
+
+TYPE  Substring  = ARRAY StringSize OF Item;
+
+TYPE  BoundedString = RECORD
+		kompare: CompareProc; (*-- item comparison routine *)
+        size   : StringSize;  (*-- Maximum String Size *)
+        length : CARDINAL;    (*-- Current String Length *)
+        items  : Substring;   (*-- ARRAY[1..TheSize] of Items *)
+      END (*-- BoundedString *);
+
+TYPE  String = POINTER TO BoundedString;
+
+    (*-----------------------*)
+
+
+VAR   stringError : Exceptions;
+VAR   handler     : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE StringError ()              : Exceptions  (*-- out   *);
+BEGIN
+  RETURN stringError;
+END StringError;
+(*----------------------------*)
+
+PROCEDURE GetHandler  (    theError   : Exceptions  (*-- in    *))
+                                      : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler  (    theError   : Exceptions  (*-- in    *);
+                           theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn  (    theRoutine : Operations    (*-- in    *);
+                           theError   : Exceptions    (*-- in    *));
+BEGIN
+  stringError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+
+PROCEDURE LengthSubstr (VAR theSubstring : ARRAY OF Item (*-- in    *))
+                                         : CARDINAL      (*-- out   *);
+BEGIN
+  IF (HIGH(theSubstring) = 0) & (theSubstring[0] = NullItem) THEN
+    RETURN 0;
+  END (*--if*);
+  RETURN HIGH(theSubstring) + 1;
+END LengthSubstr;
+(*----------------------------*)
+
+PROCEDURE FromToOK (    fromIndex    : Position   (*-- in    *);
+                        toIndex      : Position   (*-- in    *);
+                        stringLength : CARDINAL   (*-- in    *))
+                                     : BOOLEAN    (*-- out   *);
+BEGIN
+  RETURN (toIndex <= stringLength) & (fromIndex <= toIndex);
+END FromToOK;
+(*----------------------------*)
+
+
+PROCEDURE Create    (    theSize    : StringSize  (*--in   *);
+			 compareItem: CompareProc (*--in   *))
+                                    : String      (*--out  *);
+
+CONST staticSize = SIZE(BoundedString) - SIZE(Substring);
+CONST itemSize   = SIZE(Item);
+VAR   newString  : String;
+
+BEGIN
+  stringError := noerr;
+  Allocate(newString, staticSize + itemSize * theSize);
+  IF (newString # NIL) THEN
+    WITH newString^ DO
+      kompare:= compareItem;
+      size   := theSize;
+      length := 0;
+    END (*--with*);
+    RETURN newString;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullString;
+END Create;
+(*----------------------------*)
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedString) - SIZE(Substring);
+CONST itemSize   = SIZE(Item);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    Deallocate(theString, staticSize + itemSize * theString^.size);
+  ELSE
+    RaiseErrIn(destroy, undefined);
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    theString^.length := 0;
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    IF (theString # toString) THEN
+
+      IF (toString # NIL) THEN
+        IF (theString^.length > toString^.size) THEN
+          RaiseErrIn(assign, overflow);
+	ELSE
+	  toString^.kompare := theString^.kompare;
+        END (*--if*);
+      ELSE
+        toString := Create(theString^.size, theString^.kompare);
+      END (*--if*);
+      IF (stringError # noerr) THEN
+        RETURN;
+      END (*--if*);
+
+      WITH theString^ DO
+        FOR index := MIN(StringSize) TO length DO
+          toString^.items[index] := items[index];
+        END (*--for*);
+        toString^.length := length;
+      END (*--with*);
+    END (*--if*);
+
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, 1);
+END Prepend;
+(*----------------------------*)
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, LengthOf(toString) + 1);
+END Append;
+(*----------------------------*)
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *));
+
+VAR   newLength : CARDINAL;
+      index     : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) & (toString # NIL) THEN
+
+    WITH toString^ DO
+      newLength := theString^.length + length;
+
+      IF (theIndex > length + 1) THEN
+        RaiseErrIn(insert, positionerr);
+      ELSIF (newLength > size) THEN
+        RaiseErrIn(insert, overflow);
+      ELSE
+
+        FOR index := length TO theIndex BY -1 DO
+          items[index + theString^.length] := items[index];
+        END (*--for*);
+
+        FOR index := MIN(StringSize) TO theString^.length DO
+          items[theIndex + index - 1] := theString^.items[index];
+        END (*--for*);
+
+        length := newLength;
+
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(insert, undefined);
+  END (*--if*);
+END Insert;
+(*----------------------------*)
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+                         fromIndex  : Position   (*-- in    *);
+                         toIndex    : Position   (*-- in    *));
+
+VAR   index  : CARDINAL; (*-- loop index over items *)
+      offset : CARDINAL; (*-- distance to move items down *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        offset := toIndex - fromIndex + 1;
+        FOR index := toIndex + 1 TO length DO
+          items[index - offset] := items[index];
+        END (*--for*);
+        DEC(length, offset);
+      ELSE
+        RaiseErrIn(delete, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(delete, undefined);
+  END (*--if*);
+END Delete;
+(*----------------------------*)
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         withString : String     (*-- in    *));
+
+VAR   endPosition : CARDINAL; (*-- new length of theString *)
+      index       : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) & (withString # NIL) THEN
+    endPosition := theIndex + withString^.length - 1;
+    WITH theString^ DO
+      IF (theIndex <= length) & (endPosition <= size) THEN
+        FOR index := MIN(StringSize) TO withString^.length DO
+          items[theIndex + index - 1] := withString^.items[index];
+        END (*--for*);
+
+        IF (endPosition > length) THEN
+          length := endPosition;
+        END (*--if*);
+      ELSE
+        RaiseErrIn(replace, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(replace, undefined);
+  END (*--if*);
+END Replace;
+(*----------------------------*)
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         theItem    : Item       (*-- in    *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        items[theIndex] := theItem;
+      ELSE
+        RaiseErrIn(setitem, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(setitem, undefined);
+  END (*--if*);
+END SetItem;
+(*----------------------------*)
+
+PROCEDURE Construct (VAR theString   : String        (*--inout*);
+                         theSubstring: ARRAY OF Item (*--in   *);
+						 compareItem : CompareProc   (*--in   *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      lenSubstr : CARDINAL; (*-- # of chars in substring *)
+      newString : String;
+
+BEGIN
+  stringError := noerr;
+  lenSubstr := LengthSubstr(theSubstring);
+
+  IF (theString # NIL) THEN
+    IF (lenSubstr = 0) THEN
+      Clear(theString);
+      theString^.kompare := compareItem;
+      RETURN;
+    END (*--if*);
+  ELSIF (lenSubstr = 0) THEN
+    RaiseErrIn(construct, positionerr);
+    RETURN;
+  ELSE
+    newString := Create(lenSubstr, compareItem);
+    IF (stringError = noerr) THEN
+      theString := newString;
+    ELSE
+      RETURN;
+    END (*--if*);
+  END (*--if*);
+
+  WITH theString^ DO
+
+    (*-- The minimum lenSubstr is one (1). *)
+
+    index := MIN(Position);
+    WHILE (index <= lenSubstr) & (theSubstring[index - 1] # NullItem) DO
+      items[index] := theSubstring[index - 1];
+      INC(index);
+    END (*--while*);
+    length := index - 1;
+  END (*--with*);
+END Construct;
+(*----------------------------*)
+
+
+PROCEDURE IsDefined  (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN (theString # NIL);
+END IsDefined;
+(*----------------------------*)
+
+PROCEDURE IsEmpty    (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length = 0;
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+PROCEDURE SizeOf     (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*----------------------------*)
+
+PROCEDURE LengthOf   (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*----------------------------*)
+
+PROCEDURE Compare    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : Relation    (*-- out   *);
+
+VAR   index     : CARDINAL; (*-- Index into items arrays *)
+      minLength : CARDINAL; (*-- Smaller of the two string lengths *)
+      relOrder  : Relation; (*-- Most recent comparison result *)
+
+BEGIN
+  stringError := noerr;
+  relOrder    := incomparable;
+  IF (left # NIL) & (right # NIL) THEN
+
+    IF (left^.kompare # right^.kompare) THEN
+      RaiseErrIn(compare, typeerror);
+      RETURN less;
+    END (*--if*);
+
+    WITH left^ DO
+      IF (length = right^.length) THEN
+        relOrder  := equal;
+        minLength := length;
+      ELSIF (length < right^.length) THEN
+        relOrder  := less;
+        minLength := length;
+      ELSE
+        relOrder  := greater;
+        minLength := right^.length;
+      END (*--if*);
+    END (*--with*);
+
+    index := MIN(StringSize);
+    LOOP
+      IF (index > minLength) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+
+      WITH left^ DO
+        relOrder := kompare(items[index], right^.items[index]);
+      END (*--with*);
+      IF (relOrder # equal) THEN
+        EXIT (*--loop*);
+      END (*--if*);
+
+      INC(index);
+
+    END (*--loop*);
+  ELSE
+    RaiseErrIn(compare, undefined);
+  END (*--if*);
+  RETURN relOrder;
+END Compare;
+(*----------------------------*)
+
+PROCEDURE IsEqual    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (left # NIL) & (right # NIL) THEN
+    WITH left^ DO
+      IF (length = right^.length) THEN
+        FOR index := MIN(StringSize) TO length DO
+          IF (items[index] # right^.items[index]) THEN
+            RETURN FALSE;
+          END (*--if*);
+        END (*--for*);
+        RETURN TRUE;
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(isequal, undefined);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE ItemOf     (    theString  : String      (*-- in    *);
+                          theIndex   : Position    (*-- in    *))
+                                     : Item        (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        RETURN items[theIndex];
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(itemof, positionerr);
+  ELSE
+    RaiseErrIn(itemof, undefined);
+  END (*--if*);
+  RETURN NullItem;
+END ItemOf;
+(*----------------------------*)
+
+PROCEDURE SliceOf    (    theString  : String        (*-- in    *);
+                          fromIndex  : Position      (*-- in    *);
+                          toIndex    : Position      (*-- in    *);
+                      VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      sliceSize : CARDINAL; (*-- # items between from and to indexes *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        sliceSize := toIndex - fromIndex;
+        IF (sliceSize <= HIGH(theSlice)) THEN
+          FOR index := fromIndex TO toIndex DO
+            theSlice[index - fromIndex] := items[index];
+          END (*--for*);
+          IF (sliceSize < HIGH(theSlice)) THEN
+            theSlice[sliceSize + 1] := NullItem;
+          END (*--if*);
+        ELSE
+          RaiseErrIn(sliceof, overflow);
+        END (*--if*);
+      ELSE
+        RaiseErrIn(sliceof, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(sliceof, undefined);
+  END (*--if*);
+END SliceOf;
+(*----------------------------*)
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+VAR   index      : CARDINAL; (*-- loop index over items *)
+      copyLength : CARDINAL; (*-- # items to copy into substring *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (length > HIGH(toSubstring) + 1) THEN
+        RaiseErrIn(substringof, overflow);
+        copyLength := HIGH(toSubstring) + 1;
+      ELSE
+        copyLength := length;
+      END (*--if*);
+      FOR index := MIN(StringSize) TO copyLength DO
+        toSubstring[index - 1] := items[index];
+      END (*--for*);
+      IF (copyLength < HIGH(toSubstring)) THEN
+        toSubstring[copyLength + 1] := NullItem;
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(substringof, undefined);
+  END (*--if*);
+END SubstringOf;
+(*----------------------------*)
+
+
+BEGIN
+  FOR stringError := initfailed TO MAX(Exceptions) DO
+    SetHandler(stringError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  stringError := noerr;
+END StrSBUN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUMI.DEF
@@ -0,0 +1,139 @@
+DEFINITION MODULE StrSUMI; 
+(*============================================================
+    Version  : 1.00  21 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Component: Monolithic Structure - String
+	Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins:
+	Initial re-implementation from StringSUUI module.
+
+    c 1989 Charles A. Lins.
+============================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, ChangeProc,
+	LoopAccessProc, LoopChangeProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StringEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  String;
+TYPE  Position   = [ 1 .. 8100 ];
+CONST NullString = VAL(String, NIL);
+
+
+    (*-----------------------*)
+
+CONST ModuleID = 11;
+
+PROCEDURE StringError ()	: Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+	toHandler : HandlerProc (*-- in    *));
+
+
+    (*-----------------------*)
+
+PROCEDURE Create    (    theDataType: TypeID     (*-- in    *)) 
+									: String     (*-- out   *);
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+	VAR toString   : String     (*-- inout *));
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+	VAR toString   : String     (*-- inout *));
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+	VAR toString   : String     (*-- inout *));
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+	VAR toString   : String     (*-- inout *);
+	theIndex   : Position   (*-- in    *));
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+	fromIndex  : Position   (*-- in    *);
+	toIndex    : Position   (*-- in    *));
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+	theIndex   : Position   (*-- in    *);
+	withString : String     (*-- in    *));
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+	theIndex   : Position   (*-- in    *);
+	theItem    : Item       (*-- in    *));
+
+PROCEDURE Construct (VAR theString   : String	(*-- inout *);
+												 theDataType : TypeID				 (*-- in    *);
+	theSubstring: ARRAY OF Item (*-- in    *));
+
+
+    (*-----------------------*)
+
+PROCEDURE IsDefined  (    theString  : String      (*-- in    *))
+	: BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEmpty    (    theString  : String      (*-- in    *))
+	: BOOLEAN     (*-- out   *);
+
+PROCEDURE LengthOf   (    theString  : String      (*-- in    *))
+	: CARDINAL    (*-- out   *);
+
+PROCEDURE TypeOf     (    theString  : String      (*-- in    *))
+	: TypeID      (*-- out   *);
+
+PROCEDURE Compare    (    left       : String      (*-- in    *);
+	right      : String      (*-- in    *))
+	: Relation    (*-- out   *);
+
+PROCEDURE IsEqual    (    left       : String      (*-- in    *);
+	right      : String      (*-- in    *))
+	: BOOLEAN     (*-- out   *);
+
+PROCEDURE ItemOf     (    theString  : String      (*-- in    *);
+	theIndex   : Position    (*-- in    *))
+	: Item	(*-- out   *);
+
+PROCEDURE SliceOf    (    theString  : String	(*-- in    *);
+	fromIndex  : Position      (*-- in    *);
+	toIndex    : Position      (*-- in    *);
+	VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+PROCEDURE SubstringOf(    theString  : String	(*-- in    *);
+	VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+
+    (*-----------------------*)
+
+PROCEDURE LoopOver   (    theString : String	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE LoopChange (    theString : String	(*-- in    *);
+	theProcess: LoopChangeProc (*-- in    *));
+
+PROCEDURE Traverse   (    theString : String	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *));
+
+PROCEDURE TravChange (    theString : String	(*-- in    *);
+	theProcess: ChangeProc     (*-- in    *));
+
+END StrSUMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUMI.MOD
@@ -0,0 +1,785 @@
+IMPLEMENTATION MODULE StringSUMI; 
+(*==========================================================
+    Version  : 1.00  21 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Code Size: R-  bytes
+    Component: Monolithic Structure String (Opaque version)
+	Sequential Unbounded Managed Iterator
+
+	The major change necessary was the freeing items of
+	a string. This effected the following routines:
+	* SetSize
+		All items must be freed when the string is cleared or
+		when the string size is increased and the value is not
+		preserved.
+		When the string length is decreased, any items beyond
+		the end of the new string length must be freed.
+	* Replace
+		Must free the items being overwritten.
+	* SetItem
+		Must free the single item being overwritten.
+	
+	Secondarily, the assignment operation derived from the
+	string's data type id must be used instead of simple
+	assignment. Simple assignment (:=) is still used internally
+	by Insert and Delete to move items within the string.
+	
+	For the JPI version we must keep track of the physically
+	allocated size of the array for when we deallocate the array.
+	
+    REVISION HISTORY
+    v1.00  21 May 1989  C. Lins:
+	Initial re-implementation from StringCSUMI module.
+
+    c 1989 Charles A. Lins.
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, ChangeProc, CompareProc,
+			   AccessProc, LoopAccessProc, LoopChangeProc,
+			   DisposeProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StringEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+	(*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, CompareOf, DisposeOf;
+
+    (*-----------------------*)
+
+
+TYPE  Substring  = POINTER TO ARRAY Position OF Item;
+
+TYPE  UnboundedString = RECORD
+		dataID : TypeID;	  (*-- data type of the string *)
+		size   : CARDINAL;	  (*-- actual allocated size *)
+	length : CARDINAL;    (*-- Current String Length *)
+	items  : Substring;   (*-- ARRAY[1..length] of Items *)
+      END (*-- UnboundedString *);
+
+TYPE  String = POINTER TO UnboundedString;
+
+
+    (*-----------------------*)
+
+
+VAR   stringError : Exceptions;
+VAR   handler     : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE StringError ()	: Exceptions  (*-- out   *);
+BEGIN
+  RETURN stringError;
+END StringError;
+(*----------------------------*)
+
+PROCEDURE GetHandler  (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler  (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn  (    theRoutine : Operations    (*-- in    *);
+	theError   : Exceptions    (*-- in    *));
+BEGIN
+  stringError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+
+    (*-----------------------*)
+
+PROCEDURE LengthSubstr  (VAR theSubstring : ARRAY OF Item (*-- in    *))
+	: CARDINAL      (*-- out   *);
+BEGIN
+  IF (HIGH(theSubstring) = 0) & (theSubstring[0] = NullItem) THEN
+    RETURN 0;
+  END (*--if*);
+  RETURN HIGH(theSubstring) + 1;
+END LengthSubstr;
+(*----------------------------*)
+
+PROCEDURE FromToOK      (    fromIndex    : Position   (*-- in    *);
+	toIndex      : Position   (*-- in    *);
+	stringLength : CARDINAL   (*-- in    *))
+	: BOOLEAN    (*-- out   *);
+BEGIN
+  RETURN (toIndex <= stringLength) & (fromIndex <= toIndex);
+END FromToOK;
+(*----------------------------*)
+
+
+TYPE  SetOptions = (preservevalue, trashvalue);
+VAR   setSizeOK  : BOOLEAN;
+
+PROCEDURE SetSize   (VAR theString   : UnboundedString (*-- inout *);
+	totheSize   : CARDINAL	(*-- in    *);
+	valueOption : SetOptions      (*-- in    *));
+
+CONST itemSize = SIZE(Item);
+VAR   newItems : Substring;
+      index    : CARDINAL; (*-- loop index over items *)
+	  free	   : DisposeProc;
+	  assign   : AssignProc;
+
+BEGIN
+  setSizeOK := TRUE;
+  WITH theString DO
+    IF (totheSize = 0) THEN
+	  free := DisposeOf(dataID);
+	  FOR index := MIN(Position) TO length DO
+	  	free(items^[index]);
+	  END (*--for*);
+      Deallocate(items, itemSize * size);
+	  size := 0;
+    ELSIF (items = NIL) THEN
+      Allocate(items, itemSize * totheSize);
+      IF (items = NIL) THEN
+	setSizeOK := FALSE;
+	RETURN;
+      END (*--if*);
+	  size := totheSize;
+
+    ELSIF (totheSize > size) THEN
+      Allocate(newItems, itemSize * totheSize);
+      IF (newItems = NIL) THEN
+	setSizeOK := FALSE;
+	RETURN;
+      END (*--if*);
+
+      IF (valueOption = preservevalue) THEN
+	  	assign := AssignOf(dataID);
+	FOR index := MIN(Position) TO length DO
+	newItems^[index] := assign(items^[index]);
+	END (*--for*);
+	  ELSE
+	  	free := DisposeOf(dataID);
+	  	FOR index := MIN(Position) TO length DO
+	  	  free(items^[index]);
+	  	END (*--for*);
+      END (*--if*);
+
+      Deallocate(items, itemSize * size);
+	  size  := totheSize;
+      items := newItems;
+	ELSIF (valueOption = trashvalue) THEN
+	  free := DisposeOf(dataID);
+	  FOR index := totheSize+1 TO length DO
+	  	free(items^[index]);
+	  END (*--for*);
+    END (*--if*);
+    length := totheSize;
+  END (*--with*);
+END SetSize;
+(*----------------------------*)
+
+
+    (*-----------------------*)
+
+PROCEDURE Create    (    theDataType: TypeID     (*-- in    *)) 
+									: String     (*-- out   *);
+
+VAR   newString : String;
+
+BEGIN
+  stringError := noerr;
+  Allocate(newString, SIZE(UnboundedString));
+  IF (newString # NIL) THEN
+    WITH newString^ DO
+	  dataID := theDataType;
+	  size   := 0;
+      length := 0;
+      items  := NIL;
+    END (*--with*);
+    RETURN newString;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullString;
+END Create;
+(*----------------------------*)
+
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    SetSize(theString^, 0, trashvalue);
+    Deallocate(theString);
+  ELSE
+    RaiseErrIn(destroy, undefined);
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    SetSize(theString^, 0, trashvalue);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+	VAR toString   : String     (*-- inout *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+	  assignment : AssignProc;
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    IF (theString # toString) THEN
+      IF (toString # NIL) THEN
+	SetSize(toString^, theString^.length, trashvalue);
+	IF ~setSizeOK THEN
+	RaiseErrIn(assign, overflow);
+	RETURN;
+	END (*--if*);
+      ELSE
+	toString := Create(theString^.dataID);
+	IF (stringError # noerr) THEN
+	RETURN;
+	END (*--if*);
+      END (*--if*);
+
+      WITH theString^ DO
+	  	assignment := AssignOf(dataID);
+	FOR index := MIN(Position) TO length DO
+	toString^.items^[index] := assignment(items^[index]);
+	END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+	VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, 1);
+END Prepend;
+(*----------------------------*)
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+	VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, LengthOf(toString) + 1);
+END Append;
+(*----------------------------*)
+
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+	VAR toString   : String     (*-- inout *);
+	theIndex   : Position   (*-- in    *));
+
+VAR   oldLength : CARDINAL;
+      newLength : CARDINAL;
+      index     : CARDINAL; (*-- loop index over items *)
+	  assignment: AssignProc;
+
+BEGIN
+  stringError := noerr;
+  IF (toString # NIL) & (theString # NIL) THEN
+
+    WITH toString^ DO
+      oldLength := length;
+      newLength := theString^.length + length;
+
+      IF (theIndex > oldLength + 1) THEN
+	RaiseErrIn(insert, positionerr);
+      ELSE
+	SetSize(toString^, newLength, preservevalue);
+	IF setSizeOK THEN
+
+	FOR index := oldLength TO theIndex BY -1 DO
+	items^[index + theString^.length] := items^[index];
+	END (*--for*);
+
+	  	  assignment := AssignOf(dataID);
+	FOR index := MIN(Position) TO theString^.length DO
+	items^[theIndex + index - 1] := assignment(theString^.items^[index]);
+	END (*--for*);
+	ELSE
+	RaiseErrIn(insert, overflow);
+	END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(insert, undefined);
+  END (*--if*);
+END Insert;
+(*----------------------------*)
+
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+	fromIndex  : Position   (*-- in    *);
+	toIndex    : Position   (*-- in    *));
+
+VAR   index  : CARDINAL; (*-- loop index over items *)
+      offset : CARDINAL; (*-- distance to move items *)
+	  free   : DisposeProc;
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+
+	  	free := DisposeOf(dataID);
+		FOR index := fromIndex TO toIndex DO
+		  free(items^[index]);
+		END (*--for*);
+
+	offset := toIndex - fromIndex + 1;
+	FOR index := toIndex + 1 TO length DO
+	items^[index - offset] := items^[index];
+	END (*--for*);
+	SetSize(theString^, length - offset, preservevalue);
+      ELSE
+	RaiseErrIn(delete, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(delete, undefined);
+  END (*--if*);
+END Delete;
+(*----------------------------*)
+
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+	theIndex   : Position   (*-- in    *);
+	withString : String     (*-- in    *));
+
+VAR   endIndex   : CARDINAL;
+      index      : CARDINAL; (*-- loop index over items *)
+	  oldLength  : CARDINAL;
+	  assignment : AssignProc;
+	  free       : DisposeProc;
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) & (withString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+
+		oldLength := length;
+	endIndex  := theIndex + withString^.length - 1;
+	IF (endIndex > length) THEN
+	SetSize(theString^, endIndex, preservevalue);
+	IF ~setSizeOK THEN
+	RaiseErrIn(replace, overflow);
+	RETURN;
+	END (*--if*);
+	END (*--if*);
+
+		(*
+		  -- Free the items about to be overwritten. We do this after
+		  -- increasing the string's size, since if that fails we won't
+		  -- damage the original string. Note that there's always at
+		  -- least one item being freed as Replace cannot be used as
+		  -- an append operation.
+		*)
+	  	free := DisposeOf(dataID);
+		FOR index := theIndex TO oldLength DO
+		  free(items^[index]);
+		END (*--for*);
+		
+	  	assignment := AssignOf(dataID);
+	FOR index := MIN(Position) TO withString^.length DO
+	items^[theIndex + index - 1] := assignment(withString^.items^[index]);
+	END (*--for*);
+      ELSE
+	RaiseErrIn(replace, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(replace, undefined);
+  END (*--if*);
+END Replace;
+(*----------------------------*)
+
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+	theIndex   : Position   (*-- in    *);
+	theItem    : Item       (*-- in    *));
+
+VAR	  free : DisposeProc;
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+	  	free := DisposeOf(dataID);
+		free(items^[theIndex]);
+	items^[theIndex] := theItem;
+      ELSE
+	RaiseErrIn(setitem, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(setitem, undefined);
+  END (*--if*);
+END SetItem;
+(*----------------------------*)
+
+
+PROCEDURE Construct (VAR theString   : String	(*-- inout *);
+						 theDataType : TypeID		 (*-- in    *);
+	theSubstring: ARRAY OF Item (*-- in    *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      lenSubstr : CARDINAL; (*-- # of items in substring *)
+      newString : String;   (*-- new string, if necessary *)
+
+BEGIN
+  stringError := noerr;
+  lenSubstr := LengthSubstr(theSubstring);
+
+  IF (theString # NIL) THEN
+    IF (lenSubstr = 0) THEN
+      Clear(theString);
+      RETURN;
+    END (*--if*);
+  ELSIF (lenSubstr = 0) THEN
+    RaiseErrIn(construct, positionerr);
+  ELSE
+    newString := Create(theDataType);
+    IF (stringError # noerr) THEN
+      RETURN;
+    END (*--if*);
+    theString := newString;
+  END (*--if*);
+
+  SetSize(theString^, lenSubstr, trashvalue);
+  IF setSizeOK THEN
+    WITH theString^ DO
+      index := MIN(Position);
+      WHILE (index <= lenSubstr) &
+	(theSubstring[index - 1] # NullItem) DO
+	items^[index] := theSubstring[index - 1];
+	INC(index);
+      END (*--while*);
+    END (*--with*);
+	SetSize(theString^, index-1, preservevalue);
+  ELSE
+    RaiseErrIn(construct, overflow);
+  END (*--if*);
+END Construct;
+(*----------------------------*)
+
+
+PROCEDURE IsDefined  (    theString : String   (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (theString # NIL);
+END IsDefined;
+(*----------------------------*)
+
+PROCEDURE IsEmpty    (    theString : String   (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length = 0;
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+PROCEDURE LengthOf   (    theString : String   (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*----------------------------*)
+
+PROCEDURE TypeOf     (    theString : String   (*-- in    *))
+	: TypeID   (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*----------------------------*)
+
+PROCEDURE Compare    (    left      : String   (*-- in    *);
+	right     : String   (*-- in    *))
+	: Relation (*-- out   *);
+
+VAR   index     : CARDINAL; (*-- Index into items arrays *)
+      minLength : CARDINAL; (*-- Smaller of the two string lengths *)
+      relOrder  : Relation; (*-- Most recent comparison result *)
+	  comparison: CompareProc;
+
+BEGIN
+  stringError := noerr;
+  relOrder    := incomparable;
+  IF (left # NIL) & (right # NIL) THEN
+
+	IF (left^.dataID = right^.dataID) THEN
+      WITH left^ DO
+	    comparison := CompareOf(dataID);
+	IF (length = right^.length) THEN
+	relOrder  := equal;
+	minLength := length;
+	ELSIF (length < right^.length) THEN
+	relOrder  := less;
+	minLength := length;
+	ELSE
+	relOrder  := greater;
+	minLength := right^.length;
+	END (*--if*);
+      END (*--with*);
+
+      index := MIN(Position);
+      LOOP
+	IF (index > minLength) THEN
+	EXIT (*--loop*);
+	END (*--if*);
+
+	IF (comparison(left^.items^[index], right^.items^[index]) = less) THEN
+	relOrder := less;
+	EXIT (*--loop*);
+	ELSIF (comparison(left^.items^[index], right^.items^[index]) = greater) THEN
+	relOrder := greater;
+	EXIT (*--loop*);
+	END (*--if*);
+
+	INC(index);
+
+      END (*--loop*);
+    ELSE
+  	  RaiseErrIn(compare, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(compare, undefined);
+  END (*--if*);
+
+  RETURN relOrder;
+END Compare;
+(*----------------------------*)
+
+
+PROCEDURE IsEqual    (    left      : String   (*-- in    *);
+	right     : String   (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN Compare(left, right) = equal;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE ItemOf     (    theString : String   (*-- in    *);
+	theIndex  : Position (*-- in    *))
+	: Item     (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+	RETURN items^[theIndex];
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(itemof, positionerr);
+  ELSE
+    RaiseErrIn(itemof, undefined);
+  END (*--if*);
+  RETURN NullItem;
+END ItemOf;
+(*----------------------------*)
+
+PROCEDURE SliceOf   (    theString  : String	(*-- in    *);
+	fromIndex  : Position      (*-- in    *);
+	toIndex    : Position      (*-- in    *);
+	VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      sliceSize : CARDINAL; (*-- # items between from & to indexes *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+	sliceSize := toIndex - fromIndex;
+	IF (sliceSize <= HIGH(theSlice)) THEN
+	FOR index := fromIndex TO toIndex DO
+	theSlice[index - fromIndex] := items^[index];
+	END (*--for*);
+	IF (sliceSize < HIGH(theSlice)) THEN
+	theSlice[sliceSize + 1] := NullItem;
+	END (*--if*);
+	ELSE
+	RaiseErrIn(sliceof, overflow);
+	END (*--if*);
+      ELSE
+	RaiseErrIn(sliceof, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(sliceof, undefined);
+  END (*--if*);
+END SliceOf;
+(*----------------------------*)
+
+
+PROCEDURE SubstringOf(    theString  : String	(*-- in    *);
+	VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+VAR   index      : CARDINAL; (*-- loop index over items *)
+      copyLength : CARDINAL; (*-- # items to copy into substring *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (length > HIGH(toSubstring) + 1) THEN
+	RaiseErrIn(substringof, overflow);
+	copyLength := HIGH(toSubstring) + 1;
+      ELSE
+	copyLength := length;
+      END (*--if*);
+      FOR index := MIN(Position) TO copyLength DO
+	toSubstring[index - 1] := items^[index];
+      END (*--for*);
+      IF copyLength < HIGH(toSubstring) THEN
+	toSubstring[copyLength + 1] := NullItem;
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(substringof, undefined);
+  END (*--if*);
+END SubstringOf;
+(*----------------------------*)
+
+
+PROCEDURE LoopOver   (    theString : String	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(Position) TO length DO
+	IF ~theProcess(items^[index]) THEN
+	RETURN;
+	END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE LoopChange (    theString : String	(*-- in    *);
+	theProcess: LoopChangeProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(Position) TO length DO
+	IF ~theProcess(items^[index]) THEN
+	RETURN;
+	END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopchange, undefined);
+  END (*--if*);
+END LoopChange;
+(*----------------------------*)
+
+
+PROCEDURE Traverse   (    theString : String	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(Position) TO length DO
+	theProcess(items^[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+
+PROCEDURE TravChange (    theString : String	(*-- in    *);
+	theProcess: ChangeProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(Position) TO length DO
+	theProcess(items^[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(travchange, undefined);
+  END (*--if*);
+END TravChange;
+(*----------------------------*)
+
+
+BEGIN
+  FOR stringError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(stringError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  stringError := noerr;
+END StringSUMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUUI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUUI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUUI.DEF
@@ -0,0 +1,140 @@
+DEFINITION MODULE StrSUUI;
+(*============================================================
+    Version  : 2.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structure - String
+               Sequential Unbounded Unmanaged Iterator
+
+    REVISION HISTORY
+    v2.00  29 Apr 1989  C. Lins:
+        Initial re-implementation from StringCSUMI module.
+
+    (C) Copyright 1989 Charles A. Lins
+============================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, ChangeProc,
+               LoopAccessProc, LoopChangeProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  String;
+TYPE  Position   = [ 1 .. 8100 ];
+CONST NullString = String(NIL);
+
+
+    (*-----------------------*)
+
+CONST ModuleID = 9;
+
+PROCEDURE StringError ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+    (*-----------------------*)
+
+PROCEDURE Create    (    theDataType: TypeID     (*-- in    *)) 
+									: String     (*-- out   *);
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *));
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+                         fromIndex  : Position   (*-- in    *);
+                         toIndex    : Position   (*-- in    *));
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         withString : String     (*-- in    *));
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         theItem    : Item       (*-- in    *));
+
+PROCEDURE Construct (VAR theString   : String        (*-- inout *);
+						 theDataType : TypeID		 (*-- in    *);
+                         theSubstring: ARRAY OF Item (*-- in    *));
+
+
+    (*-----------------------*)
+
+PROCEDURE IsDefined  (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEmpty    (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE LengthOf   (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE TypeOf     (    theString  : String      (*-- in    *))
+                                     : TypeID      (*-- out   *);
+
+PROCEDURE Compare    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : Relation    (*-- out   *);
+
+PROCEDURE IsEqual    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE ItemOf     (    theString  : String      (*-- in    *);
+                          theIndex   : Position    (*-- in    *))
+                                     : Item        (*-- out   *);
+
+PROCEDURE SliceOf    (    theString  : String        (*-- in    *);
+                          fromIndex  : Position      (*-- in    *);
+                          toIndex    : Position      (*-- in    *);
+                      VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+
+    (*-----------------------*)
+
+PROCEDURE LoopOver   (    theString : String         (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE LoopChange (    theString : String         (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+PROCEDURE Traverse   (    theString : String         (*-- in    *);
+                          theProcess: AccessProc     (*-- in    *));
+
+PROCEDURE TravChange (    theString : String         (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+END StrSUUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUUI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUUI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUUI.MOD
@@ -0,0 +1,714 @@
+IMPLEMENTATION MODULE StrSUUI;
+(*==========================================================
+    Version  : 2.00  29 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structure String (Opaque version)
+               Sequential Unbounded Unmanaged Iterator
+
+    REVISION HISTORY
+    v2.00  29 Apr 1989  C. Lins:
+        Initial re-implementation from StringCSUMI module.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, CompareProc, AccessProc, ChangeProc,
+               LoopAccessProc, LoopChangeProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) CompareOf;
+
+    (*-----------------------*)
+
+
+TYPE  Substring  = POINTER TO ARRAY Position OF Item;
+
+TYPE  UnboundedString = RECORD
+	dataID : TypeID;      (*-- data type of the string *)
+	size   : CARDINAL;    (*-- allocated size *)
+        length : CARDINAL;    (*-- Current String Length *)
+        items  : Substring;   (*-- ARRAY[1..length] of Items *)
+      END (*-- UnboundedString *);
+
+TYPE  String = POINTER TO UnboundedString;
+
+
+    (*-----------------------*)
+
+
+VAR   stringError : Exceptions;
+VAR   handler     : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE StringError ()              : Exceptions  (*-- out   *);
+BEGIN
+  RETURN stringError;
+END StringError;
+(*----------------------------*)
+
+PROCEDURE GetHandler  (    theError   : Exceptions  (*-- in    *))
+                                      : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler  (    theError   : Exceptions  (*-- in    *);
+                           theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn  (    theRoutine : Operations    (*-- in    *);
+                           theError   : Exceptions    (*-- in    *));
+BEGIN
+  stringError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+
+    (*-----------------------*)
+
+PROCEDURE LengthSubstr  (VAR theSubstring : ARRAY OF Item (*-- in    *))
+                                          : CARDINAL      (*-- out   *);
+BEGIN
+  IF (HIGH(theSubstring) = 0) & (theSubstring[0] = NullItem) THEN
+    RETURN 0;
+  END (*--if*);
+  RETURN HIGH(theSubstring) + 1;
+END LengthSubstr;
+(*----------------------------*)
+
+PROCEDURE FromToOK      (    fromIndex    : Position   (*-- in    *);
+                             toIndex      : Position   (*-- in    *);
+                             stringLength : CARDINAL   (*-- in    *))
+                                          : BOOLEAN    (*-- out   *);
+BEGIN
+  RETURN (toIndex <= stringLength) & (fromIndex <= toIndex);
+END FromToOK;
+(*----------------------------*)
+
+
+TYPE  SetOptions = (preservevalue, trashvalue);
+VAR   setSizeOK  : BOOLEAN;
+
+PROCEDURE SetSize   (VAR theString   : UnboundedString (*-- inout *);
+                         totheSize   : CARDINAL        (*-- in    *);
+                         valueOption : SetOptions      (*-- in    *));
+
+CONST itemSize = SIZE(Item);
+VAR   newItems : Substring;
+      index    : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  setSizeOK := TRUE;
+  WITH theString DO
+    IF (totheSize = 0) THEN
+      Deallocate(items, itemSize * size);
+      size := 0;
+    ELSIF (items = NIL) THEN
+      Allocate(items, itemSize * totheSize);
+      IF (items = NIL) THEN
+        setSizeOK := FALSE;
+        RETURN;
+      END (*--if*);
+      size := totheSize;
+
+    ELSIF (totheSize > length) THEN
+      Allocate(newItems, itemSize * totheSize);
+      IF (newItems = NIL) THEN
+        setSizeOK := FALSE;
+        RETURN;
+      END (*--if*);
+
+      IF (valueOption = preservevalue) THEN
+        FOR index := MIN(Position) TO length DO
+          newItems^[index] := items^[index];
+        END (*--for*);
+      END (*--if*);
+
+      Deallocate(items, itemSize * size);
+      items := newItems;
+      size  := totheSize;
+    END (*--if*);
+    length := totheSize;
+  END (*--with*);
+END SetSize;
+(*----------------------------*)
+
+
+    (*-----------------------*)
+
+PROCEDURE Create    (    theDataType: TypeID     (*-- in    *)) 
+									: String     (*-- out   *);
+
+VAR   newString : String;
+
+BEGIN
+  stringError := noerr;
+  Allocate(newString, SIZE(UnboundedString));
+  IF (newString # NIL) THEN
+    WITH newString^ DO
+      dataID := theDataType;
+      size   := 0;
+      length := 0;
+      items  := NIL;
+    END (*--with*);
+    RETURN newString;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullString;
+END Create;
+(*----------------------------*)
+
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    SetSize(theString^, 0, trashvalue);
+    Deallocate(theString, SIZE(UnboundedString));
+  ELSE
+    RaiseErrIn(destroy, undefined);
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    SetSize(theString^, 0, trashvalue);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    IF (theString # toString) THEN
+      IF (toString # NIL) THEN
+        SetSize(toString^, theString^.length, trashvalue);
+        IF ~setSizeOK THEN
+          RaiseErrIn(assign, overflow);
+          RETURN;
+        END (*--if*);
+      ELSE
+        toString := Create(theString^.dataID);
+        IF (stringError # noerr) THEN
+          RETURN;
+        END (*--if*);
+      END (*--if*);
+
+      WITH theString^ DO
+        FOR index := MIN(Position) TO length DO
+          toString^.items^[index] := items^[index];
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, 1);
+END Prepend;
+(*----------------------------*)
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, LengthOf(toString) + 1);
+END Append;
+(*----------------------------*)
+
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *));
+
+VAR   oldLength : CARDINAL;
+      newLength : CARDINAL;
+      index     : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (toString # NIL) & (theString # NIL) THEN
+
+    WITH toString^ DO
+      oldLength := length;
+      newLength := theString^.length + length;
+
+      IF (theIndex > oldLength + 1) THEN
+        RaiseErrIn(insert, positionerr);
+      ELSE
+        SetSize(toString^, newLength, preservevalue);
+        IF setSizeOK THEN
+
+          FOR index := oldLength TO theIndex BY -1 DO
+            items^[index + theString^.length] := items^[index];
+          END (*--for*);
+
+          FOR index := MIN(Position) TO theString^.length DO
+            items^[theIndex + index - 1] := theString^.items^[index];
+          END (*--for*);
+        ELSE
+          RaiseErrIn(insert, overflow);
+        END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(insert, undefined);
+  END (*--if*);
+END Insert;
+(*----------------------------*)
+
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+                         fromIndex  : Position   (*-- in    *);
+                         toIndex    : Position   (*-- in    *));
+
+VAR   index  : CARDINAL; (*-- loop index over items *)
+      offset : CARDINAL; (*-- distance to move items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        offset := toIndex - fromIndex + 1;
+        FOR index := toIndex + 1 TO length DO
+          items^[index - offset] := items^[index];
+        END (*--for*);
+        SetSize(theString^, length - offset, preservevalue);
+      ELSE
+        RaiseErrIn(delete, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(delete, undefined);
+  END (*--if*);
+END Delete;
+(*----------------------------*)
+
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         withString : String     (*-- in    *));
+
+VAR   endIndex : CARDINAL;
+      index    : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) & (withString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+
+        endIndex := theIndex + withString^.length - 1;
+        IF (endIndex > length) THEN
+          SetSize(theString^, endIndex, preservevalue);
+          IF ~setSizeOK THEN
+            RaiseErrIn(replace, overflow);
+            RETURN;
+          END (*--if*);
+        END (*--if*);
+
+        FOR index := MIN(Position) TO withString^.length DO
+          items^[theIndex + index - 1] := withString^.items^[index];
+        END (*--for*);
+      ELSE
+        RaiseErrIn(replace, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(replace, undefined);
+  END (*--if*);
+END Replace;
+(*----------------------------*)
+
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         theItem    : Item       (*-- in    *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        items^[theIndex] := theItem;
+      ELSE
+        RaiseErrIn(setitem, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(setitem, undefined);
+  END (*--if*);
+END SetItem;
+(*----------------------------*)
+
+
+PROCEDURE Construct (VAR theString   : String        (*-- inout *);
+			 theDataType : TypeID        (*-- in    *);
+                         theSubstring: ARRAY OF Item (*-- in    *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      lenSubstr : CARDINAL; (*-- # of items in substring *)
+      newString : String;   (*-- new string, if necessary *)
+
+BEGIN
+  stringError := noerr;
+  lenSubstr := LengthSubstr(theSubstring);
+
+  IF (theString # NIL) THEN
+    IF (lenSubstr = 0) THEN
+      Clear(theString);
+      RETURN;
+    END (*--if*);
+  ELSIF (lenSubstr = 0) THEN
+    RaiseErrIn(construct, positionerr);
+  ELSE
+    newString := Create(theDataType);
+    IF (stringError # noerr) THEN
+      RETURN;
+    END (*--if*);
+    theString := newString;
+  END (*--if*);
+
+  SetSize(theString^, lenSubstr, trashvalue);
+  IF setSizeOK THEN
+    WITH theString^ DO
+      index := MIN(Position);
+      WHILE (index <= lenSubstr) &
+            (theSubstring[index - 1] # NullItem) DO
+        items^[index] := theSubstring[index - 1];
+        INC(index);
+      END (*--while*);
+    END (*--with*);
+    SetSize(theString^, index-1, preservevalue);
+  ELSE
+    RaiseErrIn(construct, overflow);
+  END (*--if*);
+END Construct;
+(*----------------------------*)
+
+
+PROCEDURE IsDefined  (    theString : String   (*-- in    *))
+                                    : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (theString # NIL);
+END IsDefined;
+(*----------------------------*)
+
+PROCEDURE IsEmpty    (    theString : String   (*-- in    *))
+                                    : BOOLEAN  (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length = 0;
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+PROCEDURE LengthOf   (    theString : String   (*-- in    *))
+                                    : CARDINAL (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*----------------------------*)
+
+PROCEDURE TypeOf     (    theString : String   (*-- in    *))
+                                    : TypeID   (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*----------------------------*)
+
+PROCEDURE Compare    (    left      : String   (*-- in    *);
+                          right     : String   (*-- in    *))
+                                    : Relation (*-- out   *);
+
+VAR   index     : CARDINAL; (*-- Index into items arrays *)
+      minLength : CARDINAL; (*-- Smaller of the two string lengths *)
+      relOrder  : Relation; (*-- Most recent comparison result *)
+      comparison: CompareProc;
+
+BEGIN
+  stringError := noerr;
+  relOrder    := incomparable;
+  IF (left # NIL) & (right # NIL) THEN
+
+    IF (left^.dataID = right^.dataID) THEN
+      WITH left^ DO
+	comparison := CompareOf(dataID);
+        IF (length = right^.length) THEN
+          relOrder  := equal;
+          minLength := length;
+        ELSIF (length < right^.length) THEN
+          relOrder  := less;
+          minLength := length;
+        ELSE
+          relOrder  := greater;
+          minLength := right^.length;
+        END (*--if*);
+      END (*--with*);
+
+      index := MIN(Position);
+      LOOP
+        IF (index > minLength) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+        IF (comparison(left^.items^[index], right^.items^[index]) = less) THEN
+          relOrder := less;
+          EXIT (*--loop*);
+        ELSIF (comparison(left^.items^[index], right^.items^[index]) = greater) THEN
+          relOrder := greater;
+          EXIT (*--loop*);
+        END (*--if*);
+
+        INC(index);
+
+      END (*--loop*);
+    ELSE
+      RaiseErrIn(compare, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(compare, undefined);
+  END (*--if*);
+
+  RETURN relOrder;
+END Compare;
+(*----------------------------*)
+
+
+PROCEDURE IsEqual    (    left      : String   (*-- in    *);
+                          right     : String   (*-- in    *))
+                                    : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN Compare(left, right) = equal;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE ItemOf     (    theString : String   (*-- in    *);
+                          theIndex  : Position (*-- in    *))
+                                    : Item     (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        RETURN items^[theIndex];
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(itemof, positionerr);
+  ELSE
+    RaiseErrIn(itemof, undefined);
+  END (*--if*);
+  RETURN NullItem;
+END ItemOf;
+(*----------------------------*)
+
+PROCEDURE SliceOf   (    theString  : String        (*-- in    *);
+                         fromIndex  : Position      (*-- in    *);
+                         toIndex    : Position      (*-- in    *);
+                     VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      sliceSize : CARDINAL; (*-- # items between from & to indexes *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        sliceSize := toIndex - fromIndex;
+        IF (sliceSize <= HIGH(theSlice)) THEN
+          FOR index := fromIndex TO toIndex DO
+            theSlice[index - fromIndex] := items^[index];
+          END (*--for*);
+          IF (sliceSize < HIGH(theSlice)) THEN
+            theSlice[sliceSize + 1] := NullItem;
+          END (*--if*);
+        ELSE
+          RaiseErrIn(sliceof, overflow);
+        END (*--if*);
+      ELSE
+        RaiseErrIn(sliceof, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(sliceof, undefined);
+  END (*--if*);
+END SliceOf;
+(*----------------------------*)
+
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+VAR   index      : CARDINAL; (*-- loop index over items *)
+      copyLength : CARDINAL; (*-- # items to copy into substring *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (length > HIGH(toSubstring) + 1) THEN
+        RaiseErrIn(substringof, overflow);
+        copyLength := HIGH(toSubstring) + 1;
+      ELSE
+        copyLength := length;
+      END (*--if*);
+      FOR index := MIN(Position) TO copyLength DO
+        toSubstring[index - 1] := items^[index];
+      END (*--for*);
+      IF copyLength < HIGH(toSubstring) THEN
+        toSubstring[copyLength + 1] := NullItem;
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(substringof, undefined);
+  END (*--if*);
+END SubstringOf;
+(*----------------------------*)
+
+
+PROCEDURE LoopOver   (    theString : String         (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(Position) TO length DO
+        IF ~theProcess(items^[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopover, undefined);
+  END (*--if*);
+END LoopOver;
+(*----------------------------*)
+
+PROCEDURE LoopChange (    theString : String         (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(Position) TO length DO
+        IF ~theProcess(items^[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(loopchange, undefined);
+  END (*--if*);
+END LoopChange;
+(*----------------------------*)
+
+
+PROCEDURE Traverse   (    theString : String         (*-- in    *);
+                          theProcess: AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(Position) TO length DO
+        theProcess(items^[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(traverse, undefined);
+  END (*--if*);
+END Traverse;
+(*----------------------------*)
+
+
+PROCEDURE TravChange (    theString : String         (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      FOR index := MIN(Position) TO length DO
+        theProcess(items^[index]);
+      END (*--for*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(travchange, undefined);
+  END (*--if*);
+END TravChange;
+(*----------------------------*)
+
+
+BEGIN
+  FOR stringError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(stringError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  stringError := noerr;
+END StrSUUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUUN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUUN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUUN.DEF
@@ -0,0 +1,124 @@
+DEFINITION MODULE StrSUUN;
+(*============================================================
+    Version  : 2.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structure - String
+               Sequential Unbounded Unmanaged Non-Iterator
+
+    REVISION HISTORY
+    v2.00  30 Apr 1989  C. Lins:
+        Initial re-implementation from StringSUUI module.
+
+    (C) Copyright 1989 Charles A. Lins
+============================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*-----------------------*)
+
+TYPE  String;
+TYPE  Position   = [ 1 .. 8100 ];
+CONST NullString = String(NIL);
+
+
+    (*-----------------------*)
+
+CONST ModuleID = 10;
+
+PROCEDURE StringError ()             : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+                           toHandler : HandlerProc (*-- in    *));
+
+
+    (*-----------------------*)
+
+PROCEDURE Create    (    theDataType: TypeID     (*-- in    *)) 
+									: String     (*-- out   *);
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *));
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+                         fromIndex  : Position   (*-- in    *);
+                         toIndex    : Position   (*-- in    *));
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         withString : String     (*-- in    *));
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         theItem    : Item       (*-- in    *));
+
+PROCEDURE Construct (VAR theString   : String        (*-- inout *);
+						 theDataType : TypeID		 (*-- in    *);
+                         theSubstring: ARRAY OF Item (*-- in    *));
+
+
+    (*-----------------------*)
+
+PROCEDURE IsDefined  (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE IsEmpty    (    theString  : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE LengthOf   (    theString  : String      (*-- in    *))
+                                     : CARDINAL    (*-- out   *);
+
+PROCEDURE TypeOf     (    theString  : String      (*-- in    *))
+                                     : TypeID      (*-- out   *);
+
+PROCEDURE Compare    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : Relation    (*-- out   *);
+
+PROCEDURE IsEqual    (    left       : String      (*-- in    *);
+                          right      : String      (*-- in    *))
+                                     : BOOLEAN     (*-- out   *);
+
+PROCEDURE ItemOf     (    theString  : String      (*-- in    *);
+                          theIndex   : Position    (*-- in    *))
+                                     : Item        (*-- out   *);
+
+PROCEDURE SliceOf    (    theString  : String        (*-- in    *);
+                          fromIndex  : Position      (*-- in    *);
+                          toIndex    : Position      (*-- in    *);
+                      VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+END StrSUUN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUUN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUUN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRSUUN.MOD
@@ -0,0 +1,630 @@
+IMPLEMENTATION MODULE StrSUUN;
+(*==========================================================
+    Version  : 2.00  30 Apr 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structure String (Opaque version)
+               Sequential Unbounded Unmanaged Non-Iterator
+
+    REVISION HISTORY
+    v2.00  30 Apr 1989  C. Lins:
+        Initial re-implementation from StringSUUI module.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, ExitOnError, Raise;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, CompareProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM StrEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) CompareOf;
+
+    (*-----------------------*)
+
+
+TYPE  Substring  = POINTER TO ARRAY Position OF Item;
+
+TYPE  UnboundedString = RECORD
+	dataID : TypeID;      (*-- data type of the string *)
+	size   : CARDINAL;    (*-- allocated size *)
+        length : CARDINAL;    (*-- Current String Length *)
+        items  : Substring;   (*-- ARRAY[1..length] of Items *)
+      END (*-- UnboundedString *);
+
+TYPE  String = POINTER TO UnboundedString;
+
+
+    (*-----------------------*)
+
+
+VAR   stringError : Exceptions;
+VAR   handler     : ARRAY Exceptions OF HandlerProc;
+
+    (*-----------------------*)
+
+PROCEDURE StringError ()              : Exceptions  (*-- out   *);
+BEGIN
+  RETURN stringError;
+END StringError;
+(*----------------------------*)
+
+PROCEDURE GetHandler  (    theError   : Exceptions  (*-- in    *))
+                                      : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*----------------------------*)
+
+PROCEDURE SetHandler  (    theError   : Exceptions  (*-- in    *);
+                           theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*----------------------------*)
+
+PROCEDURE RaiseErrIn  (    theRoutine : Operations    (*-- in    *);
+                           theError   : Exceptions    (*-- in    *));
+BEGIN
+  stringError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*----------------------------*)
+
+
+    (*-----------------------*)
+
+PROCEDURE LengthSubstr  (VAR theSubstring : ARRAY OF Item (*-- in    *))
+                                          : CARDINAL      (*-- out   *);
+BEGIN
+  IF (HIGH(theSubstring) = 0) & (theSubstring[0] = NullItem) THEN
+    RETURN 0;
+  END (*--if*);
+  RETURN HIGH(theSubstring) + 1;
+END LengthSubstr;
+(*----------------------------*)
+
+PROCEDURE FromToOK      (    fromIndex    : Position   (*-- in    *);
+                             toIndex      : Position   (*-- in    *);
+                             stringLength : CARDINAL   (*-- in    *))
+                                          : BOOLEAN    (*-- out   *);
+BEGIN
+  RETURN (toIndex <= stringLength) & (fromIndex <= toIndex);
+END FromToOK;
+(*----------------------------*)
+
+
+TYPE  SetOptions = (preservevalue, trashvalue);
+VAR   setSizeOK  : BOOLEAN;
+
+PROCEDURE SetSize   (VAR theString   : UnboundedString (*-- inout *);
+                         totheSize   : CARDINAL        (*-- in    *);
+                         valueOption : SetOptions      (*-- in    *));
+
+CONST itemSize = SIZE(Item);
+VAR   newItems : Substring;
+      index    : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  setSizeOK := TRUE;
+  WITH theString DO
+    IF (totheSize = 0) THEN
+      Deallocate(items, itemSize * size);
+      size := 0;
+    ELSIF (items = NIL) THEN
+      Allocate(items, itemSize * totheSize);
+      IF (items = NIL) THEN
+        setSizeOK := FALSE;
+        RETURN;
+      END (*--if*);
+      size := totheSize;
+
+    ELSIF (totheSize > length) THEN
+      Allocate(newItems, itemSize * totheSize);
+      IF (newItems = NIL) THEN
+        setSizeOK := FALSE;
+        RETURN;
+      END (*--if*);
+
+      IF (valueOption = preservevalue) THEN
+        FOR index := MIN(Position) TO length DO
+          newItems^[index] := items^[index];
+        END (*--for*);
+      END (*--if*);
+
+      Deallocate(items, itemSize * size);
+      items := newItems;
+      size  := totheSize;
+    END (*--if*);
+    length := totheSize;
+  END (*--with*);
+END SetSize;
+(*----------------------------*)
+
+
+    (*-----------------------*)
+
+PROCEDURE Create    (    theDataType: TypeID     (*-- in    *)) 
+				    : String     (*-- out   *);
+
+VAR   newString : String;
+
+BEGIN
+  stringError := noerr;
+  Allocate(newString, SIZE(UnboundedString));
+  IF (newString # NIL) THEN
+    WITH newString^ DO
+      dataID := theDataType;
+      size   := 0;
+      length := 0;
+      items  := NIL;
+    END (*--with*);
+    RETURN newString;
+  END (*--if*);
+  RaiseErrIn(create, overflow);
+  RETURN NullString;
+END Create;
+(*----------------------------*)
+
+
+PROCEDURE Destroy   (VAR theString  : String     (*-- inout *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    SetSize(theString^, 0, trashvalue);
+    Deallocate(theString, SIZE(UnboundedString));
+  ELSE
+    RaiseErrIn(destroy, undefined);
+  END (*--if*);
+END Destroy;
+(*----------------------------*)
+
+
+PROCEDURE Clear     (VAR theString  : String     (*-- inout *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    SetSize(theString^, 0, trashvalue);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*----------------------------*)
+
+
+PROCEDURE Assign    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    IF (theString # toString) THEN
+      IF (toString # NIL) THEN
+        SetSize(toString^, theString^.length, trashvalue);
+        IF ~setSizeOK THEN
+          RaiseErrIn(assign, overflow);
+          RETURN;
+        END (*--if*);
+      ELSE
+        toString := Create(theString^.dataID);
+        IF (stringError # noerr) THEN
+          RETURN;
+        END (*--if*);
+      END (*--if*);
+
+      WITH theString^ DO
+        FOR index := MIN(Position) TO length DO
+          toString^.items^[index] := items^[index];
+        END (*--for*);
+      END (*--with*);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(assign, undefined);
+  END (*--if*);
+END Assign;
+(*----------------------------*)
+
+
+PROCEDURE Prepend   (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, 1);
+END Prepend;
+(*----------------------------*)
+
+PROCEDURE Append    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *));
+BEGIN
+  Insert(theString, toString, LengthOf(toString) + 1);
+END Append;
+(*----------------------------*)
+
+
+PROCEDURE Insert    (    theString  : String     (*-- in    *);
+                     VAR toString   : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *));
+
+VAR   oldLength : CARDINAL;
+      newLength : CARDINAL;
+      index     : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (toString # NIL) & (theString # NIL) THEN
+
+    WITH toString^ DO
+      oldLength := length;
+      newLength := theString^.length + length;
+
+      IF (theIndex > oldLength + 1) THEN
+        RaiseErrIn(insert, positionerr);
+      ELSE
+        SetSize(toString^, newLength, preservevalue);
+        IF setSizeOK THEN
+
+          FOR index := oldLength TO theIndex BY -1 DO
+            items^[index + theString^.length] := items^[index];
+          END (*--for*);
+
+          FOR index := MIN(Position) TO theString^.length DO
+            items^[theIndex + index - 1] := theString^.items^[index];
+          END (*--for*);
+        ELSE
+          RaiseErrIn(insert, overflow);
+        END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(insert, undefined);
+  END (*--if*);
+END Insert;
+(*----------------------------*)
+
+
+PROCEDURE Delete    (VAR theString  : String     (*-- inout *);
+                         fromIndex  : Position   (*-- in    *);
+                         toIndex    : Position   (*-- in    *));
+
+VAR   index  : CARDINAL; (*-- loop index over items *)
+      offset : CARDINAL; (*-- distance to move items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        offset := toIndex - fromIndex + 1;
+        FOR index := toIndex + 1 TO length DO
+          items^[index - offset] := items^[index];
+        END (*--for*);
+        SetSize(theString^, length - offset, preservevalue);
+      ELSE
+        RaiseErrIn(delete, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(delete, undefined);
+  END (*--if*);
+END Delete;
+(*----------------------------*)
+
+
+PROCEDURE Replace   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         withString : String     (*-- in    *));
+
+VAR   endIndex : CARDINAL;
+      index    : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) & (withString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+
+        endIndex := theIndex + withString^.length - 1;
+        IF (endIndex > length) THEN
+          SetSize(theString^, endIndex, preservevalue);
+          IF ~setSizeOK THEN
+            RaiseErrIn(replace, overflow);
+            RETURN;
+          END (*--if*);
+        END (*--if*);
+
+        FOR index := MIN(Position) TO withString^.length DO
+          items^[theIndex + index - 1] := withString^.items^[index];
+        END (*--for*);
+      ELSE
+        RaiseErrIn(replace, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(replace, undefined);
+  END (*--if*);
+END Replace;
+(*----------------------------*)
+
+
+PROCEDURE SetItem   (VAR theString  : String     (*-- inout *);
+                         theIndex   : Position   (*-- in    *);
+                         theItem    : Item       (*-- in    *));
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        items^[theIndex] := theItem;
+      ELSE
+        RaiseErrIn(setitem, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(setitem, undefined);
+  END (*--if*);
+END SetItem;
+(*----------------------------*)
+
+
+PROCEDURE Construct (VAR theString   : String        (*-- inout *);
+			 theDataType : TypeID	     (*-- in    *);
+                         theSubstring: ARRAY OF Item (*-- in    *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      lenSubstr : CARDINAL; (*-- # of items in substring *)
+      newString : String;   (*-- new string, if necessary *)
+
+BEGIN
+  stringError := noerr;
+  lenSubstr := LengthSubstr(theSubstring);
+
+  IF (theString # NIL) THEN
+    IF (lenSubstr = 0) THEN
+      Clear(theString);
+      RETURN;
+    END (*--if*);
+  ELSIF (lenSubstr = 0) THEN
+    RaiseErrIn(construct, positionerr);
+  ELSE
+    newString := Create(theDataType);
+    IF (stringError # noerr) THEN
+      RETURN;
+    END (*--if*);
+    theString := newString;
+  END (*--if*);
+
+  SetSize(theString^, lenSubstr, trashvalue);
+  IF setSizeOK THEN
+    WITH theString^ DO
+      index := MIN(Position);
+      WHILE (index <= lenSubstr) &
+            (theSubstring[index - 1] # NullItem) DO
+        items^[index] := theSubstring[index - 1];
+        INC(index);
+      END (*--while*);
+    END (*--with*);
+    SetSize(theString^, index-1, preservevalue);
+  ELSE
+    RaiseErrIn(construct, overflow);
+  END (*--if*);
+END Construct;
+(*----------------------------*)
+
+
+PROCEDURE IsDefined  (    theString : String   (*-- in    *))
+                                    : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (theString # NIL);
+END IsDefined;
+(*----------------------------*)
+
+PROCEDURE IsEmpty    (    theString : String   (*-- in    *))
+                                    : BOOLEAN  (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length = 0;
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*----------------------------*)
+
+PROCEDURE LengthOf   (    theString : String   (*-- in    *))
+                                    : CARDINAL (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*----------------------------*)
+
+PROCEDURE TypeOf     (    theString : String   (*-- in    *))
+                                    : TypeID   (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    RETURN theString^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*----------------------------*)
+
+PROCEDURE Compare    (    left      : String   (*-- in    *);
+                          right     : String   (*-- in    *))
+                                    : Relation (*-- out   *);
+
+VAR   index     : CARDINAL; (*-- Index into items arrays *)
+      minLength : CARDINAL; (*-- Smaller of the two string lengths *)
+      relOrder  : Relation; (*-- Most recent comparison result *)
+	  comparison: CompareProc;
+
+BEGIN
+  stringError := noerr;
+  relOrder    := incomparable;
+  IF (left # NIL) & (right # NIL) THEN
+
+    IF (left^.dataID = right^.dataID) THEN
+      WITH left^ DO
+	comparison := CompareOf(dataID);
+        IF (length = right^.length) THEN
+          relOrder  := equal;
+          minLength := length;
+        ELSIF (length < right^.length) THEN
+          relOrder  := less;
+          minLength := length;
+        ELSE
+          relOrder  := greater;
+          minLength := right^.length;
+        END (*--if*);
+      END (*--with*);
+
+      index := MIN(Position);
+      LOOP
+        IF (index > minLength) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+        IF (comparison(left^.items^[index], right^.items^[index]) = less) THEN
+          relOrder := less;
+          EXIT (*--loop*);
+        ELSIF (comparison(left^.items^[index], right^.items^[index]) = greater) THEN
+          relOrder := greater;
+          EXIT (*--loop*);
+        END (*--if*);
+
+        INC(index);
+
+      END (*--loop*);
+    ELSE
+      RaiseErrIn(compare, typeerror);
+    END (*--if*);
+  ELSE
+    RaiseErrIn(compare, undefined);
+  END (*--if*);
+
+  RETURN relOrder;
+END Compare;
+(*----------------------------*)
+
+
+PROCEDURE IsEqual    (    left      : String   (*-- in    *);
+                          right     : String   (*-- in    *))
+                                    : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN Compare(left, right) = equal;
+END IsEqual;
+(*----------------------------*)
+
+PROCEDURE ItemOf     (    theString : String   (*-- in    *);
+                          theIndex  : Position (*-- in    *))
+                                    : Item     (*-- out   *);
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (theIndex <= length) THEN
+        RETURN items^[theIndex];
+      END (*--if*);
+    END (*--with*);
+    RaiseErrIn(itemof, positionerr);
+  ELSE
+    RaiseErrIn(itemof, undefined);
+  END (*--if*);
+  RETURN NullItem;
+END ItemOf;
+(*----------------------------*)
+
+PROCEDURE SliceOf   (    theString  : String        (*-- in    *);
+                         fromIndex  : Position      (*-- in    *);
+                         toIndex    : Position      (*-- in    *);
+                     VAR theSlice   : ARRAY OF Item (*-- out   *));
+
+VAR   index     : CARDINAL; (*-- loop index over items *)
+      sliceSize : CARDINAL; (*-- # items between from & to indexes *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF FromToOK(fromIndex, toIndex, length) THEN
+        sliceSize := toIndex - fromIndex;
+        IF (sliceSize <= HIGH(theSlice)) THEN
+          FOR index := fromIndex TO toIndex DO
+            theSlice[index - fromIndex] := items^[index];
+          END (*--for*);
+          IF (sliceSize < HIGH(theSlice)) THEN
+            theSlice[sliceSize + 1] := NullItem;
+          END (*--if*);
+        ELSE
+          RaiseErrIn(sliceof, overflow);
+        END (*--if*);
+      ELSE
+        RaiseErrIn(sliceof, positionerr);
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(sliceof, undefined);
+  END (*--if*);
+END SliceOf;
+(*----------------------------*)
+
+
+PROCEDURE SubstringOf(    theString  : String        (*-- in    *);
+                      VAR toSubstring: ARRAY OF Item (*-- out   *));
+
+VAR   index      : CARDINAL; (*-- loop index over items *)
+      copyLength : CARDINAL; (*-- # items to copy into substring *)
+
+BEGIN
+  stringError := noerr;
+  IF (theString # NIL) THEN
+    WITH theString^ DO
+      IF (length > HIGH(toSubstring) + 1) THEN
+        RaiseErrIn(substringof, overflow);
+        copyLength := HIGH(toSubstring) + 1;
+      ELSE
+        copyLength := length;
+      END (*--if*);
+      FOR index := MIN(Position) TO copyLength DO
+        toSubstring[index - 1] := items^[index];
+      END (*--for*);
+      IF copyLength < HIGH(toSubstring) THEN
+        toSubstring[copyLength + 1] := NullItem;
+      END (*--if*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(substringof, undefined);
+  END (*--if*);
+END SubstringOf;
+(*----------------------------*)
+
+
+BEGIN
+  FOR stringError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(stringError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  stringError := noerr;
+END StrSUUN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/ASCII.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/ASCII.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/ASCII.DEF
@@ -0,0 +1,115 @@
+DEFINITION MODULE ASCII;
+(*====================================================================
+    Version : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler: JPI TopSpeed Modula-2
+
+    INTRODUCTION
+    This module provides standard mnemonics for the ISO/ASCII control
+    characters and non-alphanumeric characters common to most keyboards.
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    INTERFACE DESIGN ISSUES
+    * The mnemonic names are given in all lowercase letters for
+      compatibility with other Modula-2 systems.
+
+    * Should the names for non-alphanumeric characters be capitalized?
+      The decision was to not capitalize, and use all lowercase letters.
+	+ Easier to key without using Shift-Key.
+	+ Consistant with mnemonics for control characters.
+====================================================================*)
+
+	(*-- Mnemonics for the non-printing ASCII control codes --*)
+
+CONST	nul = 000C; (*-- null			  *)
+	soh = 001C; (*-- start of header	  *)
+	stx = 002C; (*-- start of text		  *)
+	etx = 003C; (*-- end of text		  *)
+	eot = 004C; (*-- end of transmission	  *)
+	enq = 005C; (*-- enquiry		  *)
+	ack = 006C; (*-- acknowledge		  *)
+	bel = 007C; (*-- bell			  *)
+
+	bs  = 010C; (*-- backspace		  *)
+	ht  = 011C; (*-- horizontal tab 	  *)
+	lf  = 012C; (*-- line feed		  *)
+	vt  = 013C; (*-- vertical tab		  *)
+	ff  = 014C; (*-- form feed		  *)
+	cr  = 015C; (*-- carriage return	  *)
+	so  = 016C; (*-- shift out		  *)
+	si  = 017C; (*-- shift in		  *)
+
+	dle = 020C; (*-- data link escape	  *)
+	dc1 = 021C; (*-- device-control 1	  *)
+	dc2 = 022C; (*-- device-control 2	  *)
+	dc3 = 023C; (*-- device-control 3	  *)
+	dc4 = 024C; (*-- device-control 4	  *)
+	nak = 025C; (*-- negative acknowledge	  *)
+	syn = 026C; (*--			  *)
+	etb = 027C; (*-- end transmission block   *)
+
+	can = 030C; (*-- cancel 		  *)
+	em  = 031C; (*-- end of message 	  *)
+	sub = 032C; (*--			  *)
+	esc = 033C; (*-- escape 		  *)
+	fs  = 034C; (*-- file seperator 	  *)
+	gs  = 035C; (*-- group seperator	  *)
+	rs  = 036C; (*-- record seperator	  *)
+	us  = 037C; (*-- unit seperator 	  *)
+
+	del = 177C; (*-- delete 		  *)
+
+
+	(*-- Mnemonics for the non-alphanumeric ASCII codes --*)
+
+CONST	space	   = ' ';
+
+	ampersand  = '&' ;
+	asterisk   = '*' ;
+	atsign	   = '@' ;
+
+	backslash  = '\' ;
+	bar	   = '|' ;
+
+	circumflex = '^' ;
+	colon	   = ':' ;
+	comma	   = ',' ;
+
+	dollar	   = '$' ;
+
+	equalsign  = '=' ;
+	exclam	   = '!' ;
+
+	grave	   = '`' ;
+	gtrsign    = '>' ;
+
+	lesssign   = '<' ;
+	lbrace	   = '{' ;
+	lbracket   = '[' ;
+	lparen	   = '(' ;
+
+	minussign  = '-' ;
+
+	percent    = '%' ;
+	period	   = '.' ;
+	plussign   = '+' ;
+
+	query	   = '?' ;
+	quote	   = "'" ;
+	quotequote = '"' ;
+
+	rbrace	   = '}' ;
+	rbracket   = ']' ;
+	rparen	   = ')' ;
+
+	semicolon  = ';' ;
+	sharp	   = '#' ;
+	slash	   = '/' ;
+
+	tilde	   = '~' ;
+
+	underscore = '_' ;
+
+END ASCII.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/ASCII.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/ASCII.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/ASCII.MOD
@@ -0,0 +1,2 @@
+IMPLEMENTATION MODULE ASCII;
+END ASCII.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/CARDUTIL.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/CARDUTIL.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/CARDUTIL.DEF
@@ -0,0 +1,58 @@
+DEFINITION MODULE CardUtils;
+(*==========================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Primitive Utility - Cardinal Utilities
+
+    Introduction
+    This module provides a collection of utilities for the
+    Modula-2 numeric types CARDINAL and LONGCARD.
+
+    Interface Design Issues
+    * Most of these routines are selectors since the operations they represent
+      are commonly used within expressions.
+    * In the MacMETH and JPI compilers CARDINAL and LONGCARD are assignment compatible.
+    * The elements of the arrays are assumed to be unordered.
+
+    Exceptions
+    * Underflow
+    * Overflow
+
+    Revision History
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    References
+    [1] N. Wirth, Programming in Modula-2, 3rd corrected
+	edition, Springer-Verlag, New York, NY 1985
+    [2] G. Booch, Software Components in Ada, pp. 395-397,
+	Benjamin/Cummings, Menlo Park, CA 1987
+
+    Proprietary Notices
+    "CardUtils.DEF", Copyright (C) 1989 Charles A. Lins.
+==========================================================*)
+
+
+PROCEDURE Min	(    left  : LONGCARD  (*--in	*);
+		     right : LONGCARD  (*--in	*))
+			   : LONGCARD  (*--out	*);
+
+PROCEDURE Max	(    left  : LONGCARD  (*--in	*);
+		     right : LONGCARD  (*--in	*))
+			   : LONGCARD  (*--out	*);
+
+
+PROCEDURE MinOf (    theNumbers : ARRAY OF CARDINAL (*--in   *))
+				: CARDINAL	    (*--out  *);
+
+PROCEDURE MaxOf (    theNumbers : ARRAY OF CARDINAL (*--in   *))
+				: CARDINAL	    (*--out  *);
+
+
+PROCEDURE MinOfLong (	 theNumbers : ARRAY OF LONGCARD (*--in	 *))
+				    : LONGCARD		(*--out  *);
+
+PROCEDURE MaxOfLong (	 theNumbers : ARRAY OF LONGCARD (*--in	 *))
+				    : LONGCARD		(*--out  *);
+
+END CardUtils.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/CARDUTIL.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/CARDUTIL.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/CARDUTIL.MOD
@@ -0,0 +1,116 @@
+IMPLEMENTATION MODULE CardUtils;
+(*==========================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Primitive Utility - Cardinal Utilities
+    Code Size: R-  bytes
+
+    Revision History
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    Introduction
+    This module provides a collection of utilities for the
+    Modula-2 numeric types CARDINAL and LONGCARD.
+
+    Implementation Notes
+    * The standard procedure HIGH, as defined in [1], should return a result
+      of type CARDINAL. In [3], INTEGER is used instead. Since these two types
+      are incompatible within the context of a FOR loop control index, the
+      index has been defined as INTEGER, even though the minimum value is 0.
+
+    Proprietary Notices
+    CardUtils.MOD, Copyright (C) 1989 Charles A. Lins.
+==========================================================*)
+
+PROCEDURE Min	(    left  : LONGCARD  (*--in	*);
+		     right : LONGCARD  (*--in	*))
+			   : LONGCARD  (*--out	*);
+BEGIN
+  IF left < right THEN
+    RETURN left;
+  END(*--if*);
+  RETURN right;
+END Min;
+(*-------------------------*)
+
+PROCEDURE Max	(    left  : LONGCARD  (*--in	*);
+		     right : LONGCARD  (*--in	*))
+			   : LONGCARD  (*--out	*);
+BEGIN
+  IF left > right THEN
+    RETURN left;
+  END(*--if*);
+  RETURN right;
+END Max;
+(*-------------------------*)
+
+PROCEDURE MinOf (    theNumbers : ARRAY OF CARDINAL (*--in   *))
+				: CARDINAL	    (*--out  *);
+
+VAR   smallest: CARDINAL; (*-- current smallest value in theNumbers *)
+      index   : INTEGER;  (*-- loop index over theNumbers *)
+
+BEGIN
+  smallest := theNumbers[0];
+  FOR index := 1 TO HIGH(theNumbers) DO
+    IF theNumbers[index] < smallest THEN
+      smallest := theNumbers[index];
+    END (*--if*);
+  END (*--for*);
+  RETURN smallest;
+END MinOf;
+(*-------------------------*)
+
+PROCEDURE MaxOf (    theNumbers : ARRAY OF CARDINAL (*--in   *))
+				: CARDINAL	    (*--out  *);
+
+VAR   largest: CARDINAL; (*-- current largest value in theNumbers *)
+      index  : INTEGER;  (*-- loop index over theNumbers *)
+
+BEGIN
+  largest := theNumbers[0];
+  FOR index := 1 TO HIGH(theNumbers) DO
+    IF theNumbers[index] > largest THEN
+      largest := theNumbers[index];
+    END (*--if*);
+  END (*--for*);
+  RETURN largest;
+END MaxOf;
+(*-------------------------*)
+
+PROCEDURE MinOfLong (	 theNumbers : ARRAY OF LONGCARD (*--in	 *))
+				    : LONGCARD		(*--out  *);
+
+VAR   smallest: LONGCARD; (*-- current smallest value in theNumbers *)
+      index   : INTEGER;  (*-- loop index over theNumbers *)
+
+BEGIN
+  smallest := theNumbers[0];
+  FOR index := 1 TO HIGH(theNumbers) DO
+    IF theNumbers[index] < smallest THEN
+      smallest := theNumbers[index];
+    END (*--if*);
+  END (*--for*);
+  RETURN smallest;
+END MinOfLong;
+(*-------------------------*)
+
+PROCEDURE MaxOfLong (	 theNumbers : ARRAY OF LONGCARD (*--in	 *))
+				    : LONGCARD		(*--out  *);
+
+VAR   largest: LONGCARD; (*-- current largest value in theNumbers *)
+      index  : INTEGER;  (*-- loop index over theNumbers *)
+
+BEGIN
+  largest := theNumbers[0];
+  FOR index := 1 TO HIGH(theNumbers) DO
+    IF theNumbers[index] > largest THEN
+      largest := theNumbers[index];
+    END (*--if*);
+  END (*--for*);
+  RETURN largest;
+END MaxOfLong;
+(*-------------------------*)
+
+END CardUtils.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/CHARUTIL.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/CHARUTIL.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/CHARUTIL.DEF
@@ -0,0 +1,133 @@
+DEFINITION MODULE CharUtils;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Tool- Primitive Utility - Character Utilities
+
+    INTRODUCTION
+    This module provides elementary character operations.
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    PROPRIETARY NOTICES
+    CharUtils.DEF Copyright (C) 1989 Charles A. Lins.
+====================================================================*)
+
+FROM ASCII IMPORT (*--Cons*) nul, us, del, space, tilde;
+
+       (*--------------------*)
+
+TYPE  AsciiCharacter	 = CHAR [ nul	.. del	 ];
+TYPE  ControlCharacter	 = CHAR [ nul	.. us	 ];
+TYPE  GraphicCharacter	 = CHAR [ space .. tilde ];
+
+TYPE  UppercaseCharacter = CHAR [ 'A' .. 'Z' ];
+TYPE  LowercaseCharacter = CHAR [ 'a' .. 'z' ];
+
+TYPE  BinaryCharacter	 = CHAR [ '0' .. '1' ];
+TYPE  OctalCharacter	 = CHAR [ '0' .. '7' ];
+TYPE  DigitCharacter	 = CHAR [ '0' .. '9' ];
+TYPE  HexCharacter	 = CHAR [ 'A' .. 'F' ];
+
+
+TYPE  Digit = CARDINAL [ 0 .. 15 ];
+
+TYPE  BinaryDigit  = CARDINAL [ 0 .. 1 ];
+TYPE  OctalDigit   = CARDINAL [ 0 .. 7 ];
+TYPE  DecimalDigit = CARDINAL [ 0 .. 9 ];
+TYPE  HexDigit	   = Digit;
+
+TYPE  Letter = CARDINAL [ 1 .. 26 ];
+
+       (*--------------------*)
+
+PROCEDURE MakeUppercase  (VAR theChar : CHAR	(*-- inout *));
+
+PROCEDURE MakeLowercase  (VAR theChar : CHAR	(*-- inout *));
+
+
+PROCEDURE Uppercase	 (    theChar : CHAR	(*-- in    *))
+				      : CHAR	(*-- out   *);
+
+PROCEDURE Lowercase	 (    theChar : CHAR	(*-- in    *))
+				      : CHAR	(*-- out   *);
+
+
+PROCEDURE IsAscii	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+
+PROCEDURE IsControl	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+
+PROCEDURE IsGraphic	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+
+
+PROCEDURE IsLowercase	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+
+PROCEDURE IsUppercase	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+
+PROCEDURE IsAlphabetic	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+
+
+PROCEDURE IsDigit	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+
+PROCEDURE IsBinaryDigit  (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+
+PROCEDURE IsOctalDigit	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+
+PROCEDURE IsDecimalDigit (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+
+PROCEDURE IsHexDigit	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+
+
+PROCEDURE IsAlphanumeric (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+
+PROCEDURE IsSpecial	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+
+
+PROCEDURE ValueOf	 (    theChar : CHAR	(*-- in    *))
+				      : Digit	(*-- out   *);
+
+PROCEDURE ImageOf	 (    theDigit: Digit	(*-- in    *))
+				      : CHAR	(*-- out   *);
+
+
+PROCEDURE IndexOf	 (    theChar : CHAR	(*-- in    *))
+				      : Letter	(*-- out   *);
+
+PROCEDURE UppercaseOf	 (    theLetter: Letter (*-- in    *))
+				       : CHAR	(*-- out   *);
+
+PROCEDURE LowercaseOf	 (    theLetter: Letter (*-- in    *))
+				       : CHAR	(*-- out   *);
+
+
+PROCEDURE IsEqual	 (    left	   : CHAR     (*-- in	 *);
+			      right	   : CHAR     (*-- in	 *);
+			      caseSensitive: BOOLEAN  (*-- in	 *))
+					   : BOOLEAN  (*-- out	 *);
+
+PROCEDURE IsLessThan	 (    left	   : CHAR     (*-- in	 *);
+			      right	   : CHAR     (*-- in	 *);
+			      caseSensitive: BOOLEAN  (*-- in	 *))
+					   : BOOLEAN  (*-- out	 *);
+
+PROCEDURE IsGreaterThan  (    left	   : CHAR     (*-- in	 *);
+			      right	   : CHAR     (*-- in	 *);
+			      caseSensitive: BOOLEAN  (*-- in	 *))
+					   : BOOLEAN  (*-- out	 *);
+
+END CharUtils.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/CHARUTIL.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/CHARUTIL.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/CHARUTIL.MOD
@@ -0,0 +1,304 @@
+IMPLEMENTATION MODULE CharUtils;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Tool- Primitive Utility - Character Utilities
+
+    INTRODUCTION
+    This module provides elementary character operations.
+    The JPI version was converted from the MacModula-2 version of
+    Alpha (V2.01), which was also by the same author.
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    LOCAL CONSTANTS
+    * LowercaseOffset
+      Numeric difference between the ordinal values of the lower-
+      and upper-case ASCII characters, such that when added to the
+      ordinal value of an uppercase character will yield the lowercase
+      letter equivalent.
+
+    INFORMATION HIDDEN
+    * Specifics related to the ASCII character set.
+
+			  IMPLEMENTATION DESIGN NOTES
+    * The ASCII character set is assumed.
+
+    * Procedure call overhead in the MacMETH compiler is excessive for small
+      routines (few parameters, 0-4 bytes of locals, 1-4 lines of source code,
+      no procedure calls within the routine).  It is much larger than for a
+      functionally equivalent assembly language version of the routine.
+
+    * In [2], using Ada, the operator IN can be used for membership tests on a
+      subtype or subrange, see sample usage on pg. 388.
+
+      To achieve the equivalent in Modula-2 one could:
+      * define a character set ADT module, since most M2 compilers
+	support SET types with a small maximum cardinality, (16 to
+	32 elements), when 128/256 elements are needed for the ASCII
+	characters. The problem is space: 8/16 words for each
+	character set variable plus the bit manipulation code to
+	implement IN (set membership test).
+
+      * hide within the implementation module tests to determine
+	whether a given character lies within the subrange bounds.
+
+      For efficiency reasons the second option was chosen.
+
+    * Routines that make a procedure call to another routine within
+      the module to accomplish a character test, should be transformed
+      to the in-line equivalent, in the interests of efficiency, which
+      (hopefully) will promote using the module.
+
+      The duplicate comparisons should not adversely effect the
+      maintainance effort for these reasons:
+	a. module is already specific to the ASCII characters;
+	b. the ASCII character definition is an ISO standard,
+	   ╘freezing╒ the specification and internal constraints;
+	c. no change to module functionality is anticipated.
+	d. statements are simple character comparisons against constant value(s).
+
+    REFERENCES and SUPPORTING DOCUMENTS
+    [1] Niklaus Wirth, Programming in Modula-2, 3rd ed., pg. 162,
+	Springer-Verlag Berlin Heidelberg, 1985.
+    [2] Grady Booch, Software Components in Ada, pp. 386-391,
+	Benjamin/Cummings Publishing Co, 1987.
+
+			    PROPRIETARY NOTICES
+    CharUtils.MOD Copyright (C) 1989 Charles A. Lins.
+====================================================================*)
+
+CONST	LowercaseOffset =   VAL(INTEGER,MIN(LowercaseCharacter))
+			  - VAL(INTEGER,MIN(UppercaseCharacter));
+
+       (*--------------------*)
+
+PROCEDURE MakeUppercase  (VAR theChar : CHAR	(*-- inout *));
+BEGIN
+  IF IsLowercase(theChar) THEN
+    (*-- Yes, convert to uppercase equivalent *)
+    theChar := CAP(theChar);
+  END (*--if*);
+END MakeUppercase;
+(*--------------------*)
+
+PROCEDURE MakeLowercase  (VAR theChar : CHAR	(*-- inout *));
+BEGIN
+  IF IsUppercase(theChar) THEN
+    (*-- Yes, convert to lowercase equivalent *)
+    theChar := CHR(ORD(theChar) + LowercaseOffset);
+  END (*--if*);
+END MakeLowercase;
+(*--------------------*)
+
+
+PROCEDURE Uppercase	 (    theChar : CHAR	(*-- in    *))
+				      : CHAR	(*-- out   *);
+BEGIN
+  theChar := CAP(theChar);
+  RETURN theChar;
+END Uppercase;
+(*--------------------*)
+
+PROCEDURE Lowercase	 (    theChar : CHAR	(*-- in    *))
+				      : CHAR	(*-- out   *);
+BEGIN
+  IF IsUppercase(theChar) THEN
+    (*-- Yes, convert to lowercase equivalent *)
+    theChar := CHR(ORD(theChar) + LowercaseOffset);
+  END (*--if*);
+  RETURN theChar;
+END Lowercase;
+(*--------------------*)
+
+
+PROCEDURE IsAscii	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN (MIN(AsciiCharacter) <= theChar) & (theChar <= MAX(AsciiCharacter));
+END IsAscii;
+(*--------------------*)
+
+PROCEDURE IsControl	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN (MIN(ControlCharacter) <= theChar) & (theChar <= MAX(ControlCharacter));
+END IsControl;
+(*--------------------*)
+
+PROCEDURE IsGraphic	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN (MIN(GraphicCharacter) <= theChar) & (theChar <= MAX(GraphicCharacter));
+END IsGraphic;
+(*--------------------*)
+
+PROCEDURE IsLowercase	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN (MIN(LowercaseCharacter) <= theChar) & (theChar <= MAX(LowercaseCharacter));
+END IsLowercase;
+(*--------------------*)
+
+PROCEDURE IsUppercase	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN (MIN(UppercaseCharacter) <= theChar) & (theChar <= MAX(UppercaseCharacter));
+END IsUppercase;
+(*--------------------*)
+
+PROCEDURE IsAlphabetic	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN IsLowercase(theChar) OR IsUppercase(theChar);
+END IsAlphabetic;
+(*--------------------*)
+
+PROCEDURE IsDigit	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN (MIN(DigitCharacter) <= theChar) & (theChar <= MAX(DigitCharacter))
+	 OR
+	 (MIN(HexCharacter) <= theChar) & (theChar <= MAX(HexCharacter));
+END IsDigit;
+(*--------------------*)
+
+PROCEDURE IsBinaryDigit  (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN (MIN(BinaryCharacter) <= theChar) & (theChar <= MAX(BinaryCharacter));
+END IsBinaryDigit;
+(*--------------------*)
+
+PROCEDURE IsOctalDigit	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN (MIN(OctalCharacter) <= theChar) & (theChar <= MAX(OctalCharacter));
+END IsOctalDigit;
+(*--------------------*)
+
+PROCEDURE IsDecimalDigit (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN (MIN(DigitCharacter) <= theChar) & (theChar <= MAX(DigitCharacter));
+END IsDecimalDigit;
+(*--------------------*)
+
+PROCEDURE IsHexDigit	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+BEGIN
+  MakeUppercase(theChar);
+  RETURN (MIN(HexCharacter) <= theChar) & (theChar <= MAX(HexCharacter));
+END IsHexDigit;
+(*--------------------*)
+
+PROCEDURE IsAlphanumeric (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN IsDigit(theChar) OR IsLowercase(theChar) OR IsUppercase(theChar);
+END IsAlphanumeric;
+(*--------------------*)
+
+PROCEDURE IsSpecial	 (    theChar : CHAR	(*-- in    *))
+				      : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN ~(IsDigit(theChar) OR IsAlphabetic(theChar)) OR IsControl(theChar);
+END IsSpecial;
+(*--------------------*)
+
+
+PROCEDURE ValueOf	 (    theChar : CHAR	(*-- in    *))
+				      : Digit	(*-- out   *);
+
+CONST MinDecCharValue = VAL(CARDINAL,MIN(DigitCharacter));
+      MinHexCharValue = VAL(CARDINAL,MIN(HexCharacter));
+
+BEGIN
+  IF IsDecimalDigit(theChar) THEN
+    RETURN ORD(theChar) - MinDecCharValue;
+
+  ELSIF IsHexDigit(theChar) THEN
+    RETURN ORD(theChar) - MinHexCharValue + 10;
+  END (*--if*);
+END ValueOf;
+(*--------------------*)
+
+PROCEDURE ImageOf	 (    theDigit: Digit	(*-- in    *))
+				      : CHAR	(*-- out   *);
+BEGIN
+  IF (theDigit <= VAL(Digit,MAX(DecimalDigit))) THEN
+    RETURN CHR(ORD(MIN(DigitCharacter)) + VAL(CARDINAL,theDigit));
+  ELSE
+    DEC(theDigit,MAX(DecimalDigit)+1);
+    RETURN CHR(ORD(MIN(HexCharacter)) + VAL(CARDINAL,theDigit));
+  END (*--if*);
+END ImageOf;
+(*--------------------*)
+
+
+PROCEDURE IndexOf	 (    theChar : CHAR	(*-- in    *))
+				      : Letter	(*-- out   *);
+BEGIN
+  IF IsLowercase(theChar) THEN
+    RETURN ORD(theChar) - ORD(MIN(LowercaseCharacter)) + 1;
+  ELSIF IsUppercase(theChar) THEN
+    RETURN ORD(theChar) - ORD(MIN(UppercaseCharacter)) + 1;
+  END (*--if*);
+END IndexOf;
+(*--------------------*)
+
+PROCEDURE UppercaseOf	 (    theLetter: Letter (*-- in    *))
+				       : CHAR	(*-- out   *);
+BEGIN
+  RETURN CHR(ORD(MIN(UppercaseCharacter)) + VAL(CARDINAL,theLetter - 1) );
+END UppercaseOf;
+(*--------------------*)
+
+PROCEDURE LowercaseOf	 (    theLetter: Letter (*-- in    *))
+				       : CHAR	(*-- out   *);
+BEGIN
+  RETURN CHR(ORD(MIN(LowercaseCharacter)) + VAL(CARDINAL,theLetter - 1) );
+END LowercaseOf;
+(*--------------------*)
+
+
+PROCEDURE IsEqual	 (    left	   : CHAR     (*-- in	 *);
+			      right	   : CHAR     (*-- in	 *);
+			      caseSensitive: BOOLEAN  (*-- in	 *))
+					   : BOOLEAN  (*-- out	 *);
+BEGIN
+  IF caseSensitive THEN
+    RETURN (left = right);
+  END (*--if*);
+  RETURN (CAP(left) = CAP(right));
+END IsEqual;
+(*--------------------*)
+
+PROCEDURE IsLessThan	 (    left	   : CHAR     (*-- in	 *);
+			      right	   : CHAR     (*-- in	 *);
+			      caseSensitive: BOOLEAN  (*-- in	 *))
+					   : BOOLEAN  (*-- out	 *);
+BEGIN
+  IF caseSensitive THEN
+    RETURN (left < right);
+  END (*--if*);
+  RETURN (CAP(left) < CAP(right));
+END IsLessThan;
+(*--------------------*)
+
+PROCEDURE IsGreaterThan  (    left	   : CHAR     (*-- in	 *);
+			      right	   : CHAR     (*-- in	 *);
+			      caseSensitive: BOOLEAN  (*-- in	 *))
+					   : BOOLEAN  (*-- out	 *);
+BEGIN
+  IF caseSensitive THEN
+    RETURN (left > right);
+  END (*--if*);
+  RETURN (CAP(left) > CAP(right));
+END IsGreaterThan;
+(*--------------------*)
+
+END CharUtils.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/INOUTUTI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/INOUTUTI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/INOUTUTI.DEF
@@ -0,0 +1,79 @@
+DEFINITION MODULE InOutUtils;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Author   : Chuck Lins
+    Compiler : JPI TopSpeed Modula-2
+
+    Component Class: Tool
+    Component Form : Standard I/O Support Utility - InOut Utilities
+
+    INTRODUCTION
+    This module provides support routines for simplifying use of InOut.
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved. 
+====================================================================*)
+
+PROCEDURE CarriageReturn;
+
+PROCEDURE LineFeed;
+
+PROCEDURE BackSpace	  (    n: CARDINAL	      (*-- in *));
+
+PROCEDURE Erase 	  (    n: CARDINAL	      (*-- in *));
+
+PROCEDURE Beep		  (    n: CARDINAL	      (*-- in *));
+
+PROCEDURE WriteNChars	  (    c: CHAR		      (*-- in *);
+			       n: CARDINAL	      (*-- in *));
+
+PROCEDURE WriteBlanks	  (    n: CARDINAL	      (*-- in *));
+
+PROCEDURE WriteBlankLines (    n: CARDINAL	      (*-- in *));
+
+PROCEDURE WriteLnString   (    string : ARRAY OF CHAR (*-- in *));
+
+PROCEDURE WriteLnsString  (    string : ARRAY OF CHAR (*-- in *);
+			       nLines : CARDINAL      (*-- in *));
+
+PROCEDURE WriteYesOrNo	  (    logical: BOOLEAN       (*-- in *));
+
+PROCEDURE WriteLblBoolean (    s : ARRAY OF CHAR      (*--in   *);
+			       b : BOOLEAN	      (*--in   *));
+
+PROCEDURE WriteLblCardinal(    s : ARRAY OF CHAR      (*--in   *);
+			       c : CARDINAL	      (*--in   *);
+			       w : CARDINAL	      (*--in   *));
+
+PROCEDURE WriteLblInteger (    s : ARRAY OF CHAR      (*--in   *);
+			       n : INTEGER	      (*--in   *);
+			       w : CARDINAL	      (*--in   *));
+
+PROCEDURE WriteLblReal	  (    s : ARRAY OF CHAR      (*--in   *);
+			       r : REAL 	      (*--in   *);
+			       n : CARDINAL	      (*--in   *);
+			       d : CARDINAL	      (*--in   *);
+			       fixed : BOOLEAN	      (*--in   *));
+
+PROCEDURE WriteLblLongCard(    s : ARRAY OF CHAR      (*--in   *);
+			       c : LONGCARD	      (*--in   *);
+			       w : CARDINAL	      (*--in   *));
+
+PROCEDURE WriteLblLongInt (    s : ARRAY OF CHAR      (*--in   *);
+			       n : LONGINT	      (*--in   *);
+			       w : CARDINAL	      (*--in   *));
+
+PROCEDURE WaitForUser;
+
+
+
+PROCEDURE AnswerIsYesTo   (    query  : ARRAY OF CHAR (*-- in *))
+				      : BOOLEAN       (*-- out *);
+
+PROCEDURE InputString	  (VAR string : ARRAY OF CHAR (*-- out *));
+
+END InOutUtils.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/INOUTUTI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/INOUTUTI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/INOUTUTI.MOD
@@ -0,0 +1,223 @@
+IMPLEMENTATION MODULE InOutUtils;
+(*=======================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Code Size: R-  bytes
+
+    Component Class: Tool
+    Component Form : Standard I/O Support Utility - InOut Utilities
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    INTRODUCTION
+    This module implements support routines for simplifying use of InOut.
+
+    LOCAL VARIABLES
+    * yesNoString   Array of strings Yes and No indexed by a boolean.
+
+    Copyright (C) 1989 Charles A. Lins. All rights reserved.
+=======================================================================*)
+
+FROM IO        IMPORT (*--Proc*) RdChar, WrChar, WrStr, WrLn,
+				 WrCard, WrInt, WrLngInt,
+				 WrLngCard, WrReal;
+FROM ASCII     IMPORT (*--Cons*) nul, cr, lf, bs, bel, del;
+FROM CharUtils IMPORT (*--Proc*) MakeUppercase, Uppercase;
+
+(*--------------------*)
+
+PROCEDURE CarriageReturn;
+BEGIN
+  WrChar(cr);
+END CarriageReturn;
+(*--------------------*)
+
+PROCEDURE LineFeed;
+BEGIN
+  WrChar(lf);
+END LineFeed;
+(*--------------------*)
+
+PROCEDURE WriteNChars	  (    c: CHAR		      (*-- in *);
+			       n: CARDINAL	      (*-- in *));
+VAR   i: CARDINAL;
+BEGIN
+  FOR i:=1 TO n DO
+    WrChar(c);
+  END(*--for*);
+END WriteNChars;
+(*--------------------*)
+
+PROCEDURE BackSpace	  (    n: CARDINAL	      (*-- in *));
+BEGIN
+  WriteNChars(bs,n);
+END BackSpace;
+(*--------------------*)
+
+PROCEDURE Erase 	  (    n: CARDINAL	      (*-- in *));
+BEGIN
+  WriteNChars(del,n);
+END Erase;
+(*--------------------*)
+
+PROCEDURE Beep		  (    n: CARDINAL	      (*-- in *));
+BEGIN
+  WriteNChars(bel,n);
+END Beep;
+(*--------------------*)
+
+PROCEDURE WaitForUser;
+VAR   ch: CHAR;
+BEGIN
+  WrStr("Press any key to continue...");
+  ch:=RdChar();
+  WrChar(ch);
+  WrLn;
+  IF Uppercase(ch) = 'A' THEN
+    HALT; (*-- Terminate program *)
+  END(*--if*);
+END WaitForUser;
+(*--------------------*)
+
+PROCEDURE WriteBlanks	  (    n: CARDINAL	      (*-- in *));
+BEGIN
+  WriteNChars(' ',n);
+END WriteBlanks;
+(*--------------------*)
+
+PROCEDURE WriteBlankLines (    n: CARDINAL	      (*-- in *));
+VAR   i: CARDINAL;
+BEGIN
+  FOR i:=1 TO n DO
+    WrLn;
+  END(*--for*);
+END WriteBlankLines;
+(*--------------------*)
+
+PROCEDURE WriteLnString   (    string : ARRAY OF CHAR (*-- in *));
+BEGIN
+  WrStr(string);
+  WrLn;
+END WriteLnString;
+(*--------------------*)
+
+PROCEDURE WriteLnsString  (    string : ARRAY OF CHAR (*-- in *);
+			       nLines : CARDINAL      (*-- in *));
+BEGIN
+  WrStr(string);
+  WriteBlankLines(nLines);
+END WriteLnsString;
+(*--------------------*)
+
+VAR   yesNoString: ARRAY BOOLEAN OF ARRAY [0..4] OF CHAR;
+
+PROCEDURE WriteYesOrNo	  (    logical: BOOLEAN       (*-- in *));
+BEGIN
+  WrStr(yesNoString[logical]);
+END WriteYesOrNo;
+(*--------------------*)
+
+PROCEDURE WriteLblBoolean (    s : ARRAY OF CHAR    (*--in   *);
+			       b : BOOLEAN	    (*--in   *));
+BEGIN
+    WrStr(s);
+    WrStr(yesNoString[b]);
+END WriteLblBoolean;
+(*--------------------*)
+
+PROCEDURE WriteLblCardinal (	s : ARRAY OF CHAR   (*--in   *);
+				c : CARDINAL	    (*--in   *);
+				w : CARDINAL	    (*--in   *));
+BEGIN
+    WrStr(s);
+    WrCard(c, w);
+END WriteLblCardinal;
+(*--------------------*)
+
+PROCEDURE WriteLblInteger  (	s : ARRAY OF CHAR   (*--in   *);
+				n : INTEGER	    (*--in   *);
+				w : CARDINAL	    (*--in   *));
+BEGIN
+    WrStr(s);
+    WrInt(n, w);
+END WriteLblInteger;
+(*--------------------*)
+
+PROCEDURE WriteLblReal	  (    s : ARRAY OF CHAR    (*--in   *);
+			       r : REAL 	    (*--in   *);
+			       n : CARDINAL	    (*--in   *);
+			       d : CARDINAL	    (*--in   *);
+			       fixed : BOOLEAN	    (*--in   *));
+BEGIN
+    WrStr(s);
+    WrReal(r, n, d);
+END WriteLblReal;
+(*--------------------*)
+
+PROCEDURE WriteLblLongCard(    s : ARRAY OF CHAR    (*--in   *);
+			       c : LONGCARD	    (*--in   *);
+			       w : CARDINAL	    (*--in   *));
+BEGIN
+    WrStr(s);
+    WrLngCard(c, w);
+END WriteLblLongCard;
+(*--------------------*)
+
+PROCEDURE WriteLblLongInt (    s : ARRAY OF CHAR    (*--in   *);
+			       n : LONGINT	    (*--in   *);
+			       w : CARDINAL	    (*--in   *));
+BEGIN
+    WrStr(s);
+    WrLngInt(n, w);
+END WriteLblLongInt;
+(*--------------------*)
+
+PROCEDURE AnswerIsYesTo   (    query  : ARRAY OF CHAR (*-- in *))
+				      : BOOLEAN       (*-- out *);
+VAR   ch: CHAR;
+BEGIN
+  WrStr(query);
+  WrStr(" [y/n]? ");
+  REPEAT
+    ch:=RdChar();
+    MakeUppercase(ch);
+  UNTIL (ch = "Y") OR (ch = "N");
+  RETURN ch = "Y";
+END AnswerIsYesTo;
+(*--------------------*)
+
+PROCEDURE InputString	  (VAR string : ARRAY OF CHAR (*-- out *));
+VAR   currentChar : CHAR;
+      currentIndex: CARDINAL;
+      maximumIndex: CARDINAL;
+BEGIN
+  currentIndex := 0;
+  maximumIndex := HIGH(string);
+  LOOP
+    currentChar:=RdChar();
+    WrChar(currentChar);
+    IF (currentChar = bs) THEN
+      IF (0 < currentIndex) THEN
+	DEC(currentIndex);
+      END (*--if*);
+
+    ELSIF (currentChar = lf) OR (currentChar = cr) THEN
+      EXIT (*--loop*);
+
+    ELSIF (currentIndex < maximumIndex)  THEN
+      string[currentIndex] := currentChar;
+      INC(currentIndex);
+    END (*--if*);
+  END (*--loop*);
+  string[currentIndex] := nul;
+END InputString;
+(*--------------------*)
+
+
+BEGIN (*~~~~~ Module Initializarion ~~~~~*)
+  yesNoString[FALSE]:="FALSE";
+  yesNoString[TRUE ]:="TRUE";
+END InOutUtils.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/INTUTILS.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/INTUTILS.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/INTUTILS.DEF
@@ -0,0 +1,41 @@
+DEFINITION MODULE IntUtils;
+(*==========================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Primitive Utility - Integer Utilities
+
+    Revision History
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved. 
+==========================================================*)
+
+PROCEDURE Min	(    left  : LONGINT  (*--in   *);
+		     right : LONGINT  (*--in   *))
+			   : LONGINT  (*--out  *);
+
+PROCEDURE Max	(    left  : LONGINT  (*--in   *);
+		     right : LONGINT  (*--in   *))
+			   : LONGINT  (*--out  *);
+
+PROCEDURE RoundUp   (	 theNumber  : LONGINT (*--in   *);
+			 theModulus : INTEGER (*--in   *))
+				    : LONGINT (*--out  *);
+
+
+PROCEDURE MinOf (    theNumbers : ARRAY OF INTEGER (*--in   *))
+				: INTEGER	   (*--out  *);
+
+PROCEDURE MaxOf (    theNumbers : ARRAY OF INTEGER (*--in   *))
+				: INTEGER	   (*--out  *);
+
+
+PROCEDURE MinOfLong (	 theNumbers : ARRAY OF LONGINT (*--in	*))
+				    : LONGINT	       (*--out	*);
+
+PROCEDURE MaxOfLong (	 theNumbers : ARRAY OF LONGINT (*--in	*))
+				    : LONGINT	       (*--out	*);
+
+END IntUtils.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/INTUTILS.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/INTUTILS.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/INTUTILS.MOD
@@ -0,0 +1,128 @@
+IMPLEMENTATION MODULE IntUtils; 
+(*==========================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Primitive Utility - Integer Utilities
+    Code Size: R-  bytes
+
+    Revision History
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    Introduction
+    This module provides a collection of utilities for the Modula-2 numeric
+    types INTEGER and LONGINT.
+
+    Implementation Notes
+    * The standard procedure HIGH, as defined in [1], should return a result
+      of type CARDINAL. In [3], INTEGER is used instead. Since these two types
+      are incompatible within the context of a FOR loop control index, the
+      index has been defined as INTEGER, even though the minimum value is 0.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved. 
+==========================================================*)
+
+PROCEDURE Min	(    left  : LONGINT  (*--in   *);
+		     right : LONGINT  (*--in   *))
+			   : LONGINT  (*--out  *);
+BEGIN
+  IF left < right THEN
+    RETURN left;
+  END(*--if*);
+  RETURN right;
+END Min;
+(*-------------------------*)
+
+PROCEDURE Max	(    left  : LONGINT  (*--in   *);
+		     right : LONGINT  (*--in   *))
+			   : LONGINT  (*--out  *);
+BEGIN
+  IF left > right THEN
+    RETURN left;
+  END(*--if*);
+  RETURN right;
+END Max;
+(*-------------------------*)
+
+PROCEDURE RoundUp   (	 theNumber  : LONGINT (*--in   *);
+			 theModulus : INTEGER (*--in   *))
+				    : LONGINT (*--out  *);
+BEGIN
+  RETURN ((theNumber + VAL(LONGINT, theModulus) - 1)
+         DIV VAL(LONGINT, theModulus)) * VAL(LONGINT, theModulus);
+END RoundUp;
+(*-------------------------*)
+
+
+PROCEDURE MinOf (    theNumbers : ARRAY OF INTEGER (*--in   *))
+				: INTEGER	   (*--out  *);
+
+VAR   smallest: INTEGER;
+      index   : INTEGER;
+
+BEGIN
+  smallest := theNumbers[0];
+  FOR index := 1 TO HIGH(theNumbers) DO
+    IF theNumbers[index] < smallest THEN
+      smallest := theNumbers[index];
+    END (*--if*);
+  END (*--for*);
+  RETURN smallest;
+END MinOf;
+(*-------------------------*)
+
+PROCEDURE MaxOf (    theNumbers : ARRAY OF INTEGER (*--in   *))
+				: INTEGER	   (*--out  *);
+
+VAR   largest: INTEGER;
+      index  : INTEGER;
+
+BEGIN
+  largest := theNumbers[0];
+  FOR index := 1 TO HIGH(theNumbers) DO
+    IF theNumbers[index] > largest THEN
+      largest := theNumbers[index];
+    END (*--if*);
+  END (*--for*);
+  RETURN largest;
+END MaxOf;
+(*-------------------------*)
+
+
+PROCEDURE MinOfLong (	 theNumbers : ARRAY OF LONGINT (*--in	*))
+				    : LONGINT	       (*--out	*);
+
+VAR   smallest: LONGINT;
+      index   : INTEGER;
+
+BEGIN
+  smallest := theNumbers[0];
+  FOR index := 1 TO HIGH(theNumbers) DO
+    IF theNumbers[index] < smallest THEN
+      smallest := theNumbers[index];
+    END (*--if*);
+  END (*--for*);
+  RETURN smallest;
+END MinOfLong;
+(*-------------------------*)
+
+PROCEDURE MaxOfLong (	 theNumbers : ARRAY OF LONGINT (*--in	*))
+				    : LONGINT	       (*--out	*);
+
+VAR   largest: LONGINT;
+      index  : INTEGER;
+
+BEGIN
+  largest := theNumbers[0];
+  FOR index := 1 TO HIGH(theNumbers) DO
+    IF theNumbers[index] > largest THEN
+      largest := theNumbers[index];
+    END (*--if*);
+  END (*--for*);
+  RETURN largest;
+END MaxOfLong;
+(*-------------------------*)
+
+END IntUtils.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/JPISTORA.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/JPISTORA.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/JPISTORA.DEF
@@ -0,0 +1,38 @@
+DEFINITION MODULE JPIStorage; 
+(*====================================================================
+    Version  : 1.0	Sat, Mar 4, 1989	C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Tool - JPI Storage Management Utility for M2SCL
+
+    INTRODUCTION
+    This module provides facilities for allocation and deallocation of
+	dynamic memory.  The routines are compatible with the JPI Storage
+	module. Allocate differs from ALLOCATE in returning NIL
+	if unsuccessful instead of HALTing. Deallocate does nothing if
+	the given pointer is NIL, otherwise NIL is returned.
+
+    REVISION HISTORY
+    v1.00  04 Mar 1989  C. Lins:
+        Initial implementation.
+
+    UNDESIRED EVENTS and EXCEPTIONS
+    * Overflow - Memory allocation failure, insufficient memory.
+
+    INTERFACE DESIGN ISSUES
+    * Interface compatibility with the module Storage.
+====================================================================*)
+
+FROM SYSTEM IMPORT
+    (*--Type*) ADDRESS;
+
+
+    (*-----------------------*)
+    (*     CONSTRUCTORS      *)
+
+PROCEDURE Allocate   (VAR thePointer : ADDRESS  (*--out  *);
+                          theSize    : CARDINAL (*--in   *));
+
+PROCEDURE Deallocate (VAR thePointer : ADDRESS  (*--inout*);
+                          theSize    : CARDINAL (*--in   *));
+
+END JPIStorage.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/JPISTORA.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/JPISTORA.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/JPISTORA.MOD
@@ -0,0 +1,53 @@
+IMPLEMENTATION MODULE JPIStorage; 
+(*====================================================================
+    Version  : 1.0	Sat, Mar 4, 1989	C. Lins
+    Compiler : JPI TopSpeed Modula-2
+	Code Size: R-  bytes
+    Component: Tool - JPI M2SCL Storage Management Utility
+
+    INTRODUCTION
+    This module provides facilities for allocation and deallocation of
+	dynamic memory.  The routines are compatible with the JPI Storage
+	module. Allocate differs from ALLOCATE in returning NIL
+	if unsuccessful instead of HALTing. Deallocate does nothing if
+	the given pointer is NIL, otherwise NIL is returned.
+
+    REVISION HISTORY
+    v1.0	Sat, Mar 4, 1989	C. Lins
+      Initial implementation.
+
+	PROPRIETARY NOTICES
+    JPIStorage.MOD Copyright (C) 1989 Charles A. Lins.
+====================================================================*)
+
+FROM SYSTEM IMPORT
+    (*--Type*) ADDRESS;
+
+FROM Storage IMPORT
+    (*--Proc*) ALLOCATE, DEALLOCATE, Available;
+
+    (*-----------------------*)
+    (*     CONSTRUCTORS      *)
+
+PROCEDURE Allocate   (VAR thePointer : ADDRESS  (*--out  *);
+                          theSize    : CARDINAL (*--in   *));
+BEGIN
+  IF Available(theSize) THEN
+    ALLOCATE(thePointer, theSize);
+  ELSE
+  	thePointer := NIL;
+  END (*--if*);
+END Allocate;
+(*--------------------*)
+
+PROCEDURE Deallocate (VAR thePointer : ADDRESS  (*--inout*);
+                          theSize    : CARDINAL (*--in   *));
+BEGIN
+  IF (thePointer # NIL) THEN
+    DEALLOCATE(thePointer, theSize);
+	thePointer := NIL;
+  END (*--if*);
+END Deallocate;
+(*--------------------*)
+
+END JPIStorage.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/LREALUTI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/LREALUTI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/LREALUTI.DEF
@@ -0,0 +1,27 @@
+DEFINITION MODULE LRealUtils;
+(*==========================================================
+    Version  : 1.0	Sat, Mar 4, 1989	C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Primitive Utility - Long Real Utilities
+
+    Revision History
+    v1.0	Sat, Mar 4, 1989	C. Lins
+      Initial JPI Modula-2 implementation.
+	Copyright (C) 1989 Charles A. Lins. All rights reserved.
+==========================================================*)
+
+PROCEDURE Min   (    left  : LONGREAL  (*--in   *);
+                     right : LONGREAL  (*--in   *))
+                           : LONGREAL  (*--out  *);
+
+PROCEDURE Max   (    left  : LONGREAL  (*--in   *);
+                     right : LONGREAL  (*--in   *))
+                           : LONGREAL  (*--out  *);
+
+PROCEDURE MinOf (    theNumbers : ARRAY OF LONGREAL (*--in   *))
+                                : LONGREAL          (*--out  *);
+
+PROCEDURE MaxOf (    theNumbers : ARRAY OF LONGREAL (*--in   *))
+                                : LONGREAL          (*--out  *);
+
+END LRealUtils.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/LREALUTI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/LREALUTI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/LREALUTI.MOD
@@ -0,0 +1,83 @@
+IMPLEMENTATION MODULE LRealUtils;
+(*==========================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Primitive Utility - LongReal Utilities
+    Code Size: R-  bytes
+
+    Revision History
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    Introduction
+    This module provides a collection of utilities for the
+    Modula-2 numeric type LONGREAL.
+
+    Implementation Notes
+    * The standard procedure HIGH, as defined in [1], should return a result
+      of type CARDINAL. In [3], INTEGER is used instead. Since these two types
+      are incompatible within the context of a FOR loop control index, the
+      index has been defined as INTEGER, even though the minimum value is 0.
+
+    Proprietary Notices
+    LongRealUtils.MOD, Copyright (C) 1989 Charles A. Lins.
+==========================================================*)
+
+PROCEDURE Min	(    left  : LONGREAL  (*--in	*);
+		     right : LONGREAL  (*--in	*))
+			   : LONGREAL  (*--out	*);
+BEGIN
+  IF left < right THEN
+    RETURN left;
+  END(*--if*);
+  RETURN right;
+END Min;
+(*-------------------------*)
+
+PROCEDURE Max	(    left  : LONGREAL  (*--in	*);
+		     right : LONGREAL  (*--in	*))
+			   : LONGREAL  (*--out	*);
+BEGIN
+  IF left > right THEN
+    RETURN left;
+  END(*--if*);
+  RETURN right;
+END Max;
+(*-------------------------*)
+
+PROCEDURE MinOf (    theNumbers : ARRAY OF LONGREAL (*--in   *))
+				: LONGREAL	    (*--out  *);
+
+VAR   smallest: LONGREAL; (*-- current smallest value in theNumbers *)
+      index   : INTEGER;  (*-- loop index over theNumbers *)
+
+BEGIN
+  smallest := theNumbers[0];
+  FOR index := 1 TO HIGH(theNumbers) DO
+    IF theNumbers[index] < smallest THEN
+      smallest := theNumbers[index];
+    END (*--if*);
+  END (*--for*);
+  RETURN smallest;
+END MinOf;
+(*-------------------------*)
+
+PROCEDURE MaxOf (    theNumbers : ARRAY OF LONGREAL (*--in   *))
+				: LONGREAL	    (*--out  *);
+
+VAR   largest: LONGREAL; (*-- current largest value in theNumbers *)
+      index  : INTEGER;  (*-- loop index over theNumbers *)
+
+BEGIN
+  largest := theNumbers[0];
+  FOR index := 1 TO HIGH(theNumbers) DO
+    IF theNumbers[index] > largest THEN
+      largest := theNumbers[index];
+    END (*--if*);
+  END (*--for*);
+  RETURN largest;
+END MaxOf;
+(*-------------------------*)
+
+END LRealUtils.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/STRINGUT.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/STRINGUT.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/STRINGUT.DEF
@@ -0,0 +1,178 @@
+DEFINITION MODULE StringUtils;
+(*==========================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Tool - String Utilities
+
+    Revision History
+    v1.0  Sat, Mar 4, 1989  C. Lins
+   	  Initial JPI Modula-2 implementation.
+
+    Introduction
+    This module provides elementary String operations.
+
+    Basic Assumptions and Caveats
+    * Input string parameters are assumed to be defined, meaning that they have
+   	  been assigned a value.
+
+    Exceptions
+    * Undefined
+   	  Input parameter value is undefined. All inputs are assumed to be defined.
+
+    * WidthError
+      Specified width is less than input string length.
+
+    * StringOverflow
+      Destination string size insufficient for result.
+
+    * LexicalError
+   	  Routine to be invoked on occurance of a lexical error.
+   	  The default routine writes a line identifying the error and
+   	  after the user acknowledges the condition, terminates the program.
+
+    References
+   	[1] N. Wirth, Programming in Modula-2, 3rd corrected edition,
+       	Springer-Verlag, New York NY, 1985, pg. 162
+    [2] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+   	   	Benjamin/Cummings, Menlo Park, CA 1987, pp. 386-391
+
+    Proprietary Notices
+    "StringUtils.DEF", Copyright (C) 1989 Charles A. Lins
+==========================================================*)
+
+
+CONST EOS = 0C;
+
+(*--------------------*)
+(*--  Constructors  --*)
+
+PROCEDURE MakeUppercase  (VAR theString    : ARRAY OF CHAR (*--inout*));
+
+PROCEDURE MakeLowercase  (VAR theString    : ARRAY OF CHAR (*--inout*));
+
+PROCEDURE Replace        (    theChar      : CHAR          (*--in   *);
+       	       	       	      withChar     : CHAR          (*--in   *);
+                          VAR theString    : ARRAY OF CHAR (*--inout*);
+                              caseSensitive: BOOLEAN       (*--in   *));
+
+PROCEDURE Centered       (VAR theString    : ARRAY OF CHAR (*--inout*);
+       	       	       	      inWidth      : CARDINAL      (*--in   *);
+                              withTheFiller: CHAR          (*--in   *));
+
+PROCEDURE LeftJustified  (VAR theString    : ARRAY OF CHAR (*--inout*);
+       	       	       	      inWidth      : CARDINAL      (*--in   *);
+                              withTheFiller: CHAR          (*--in   *));
+
+PROCEDURE RightJustified (VAR theString    : ARRAY OF CHAR (*--inout*);
+       	       	       	      inWidth      : CARDINAL      (*--in   *);
+                              withTheFiller: CHAR          (*--in   *));
+
+PROCEDURE Stripped       (VAR fromTheString: ARRAY OF CHAR (*--inout*);
+       	       	       	      theChar      : CHAR          (*--in   *);
+                              caseSensitive: BOOLEAN       (*--in   *));
+
+PROCEDURE StripLeading   (VAR fromTheString: ARRAY OF CHAR (*--inout*);
+       	       	       	      theChar      : CHAR          (*--in   *);
+                              caseSensitive: BOOLEAN       (*--in   *));
+
+PROCEDURE StripTrailing  (VAR fromTheString: ARRAY OF CHAR (*--inout*);
+       	       	       	      theChar      : CHAR          (*--in   *);
+                              caseSensitive: BOOLEAN       (*--in   *));
+
+PROCEDURE Append         (    theString    : ARRAY OF CHAR (*--in   *);
+                          VAR toTheString  : ARRAY OF CHAR (*--inout*));
+
+PROCEDURE Fill           (    theChar      : CHAR          (*--in   *);
+       	       	       	  VAR inTheString  : ARRAY OF CHAR (*--out  *));
+
+PROCEDURE FillSpaces     (VAR inTheString  : ARRAY OF CHAR (*--out  *));
+
+PROCEDURE FillPartial    (    withTheChar  : CHAR          (*--in   *);
+       	       	       	      atTheIndex   : CARDINAL      (*--in   *);
+                              forTheLength : CARDINAL      (*--in   *);
+       	       	       	  VAR inTheString  : ARRAY OF CHAR (*--out  *));
+
+PROCEDURE InsertChar     (    withTheChar  : CHAR          (*--in   *);
+       	       	       	      atTheIndex   : CARDINAL      (*--in   *);
+                              forTheLength : CARDINAL      (*--in   *);
+       	       	       	  VAR inTheString  : ARRAY OF CHAR (*--out  *));
+
+
+(*--------------------*)
+(*--   Selectors    --*)
+
+PROCEDURE Uppercase      (    theString    : ARRAY OF CHAR (*--in   *);
+       	       	       	  VAR newString    : ARRAY OF CHAR (*--out  *));
+
+PROCEDURE Lowercase      (    theString    : ARRAY OF CHAR (*--in   *);
+       	       	       	  VAR newString    : ARRAY OF CHAR (*--out  *));
+
+PROCEDURE Replaced       (    theChar      : CHAR          (*--in   *);
+       	       	       	      withChar     : CHAR          (*--in   *);
+                              inTheString  : ARRAY OF CHAR (*--in   *);
+                              caseSensitive: BOOLEAN       (*--in   *);
+       	       	       	  VAR newString    : ARRAY OF CHAR (*--out  *));
+
+PROCEDURE IsEmpty        (    theString    : ARRAY OF CHAR (*--in   *))
+       	       	       	                   : BOOLEAN       (*--out  *);
+
+PROCEDURE IsAscii        (    theString    : ARRAY OF CHAR (*--in   *))
+       	       	       	                   : BOOLEAN       (*--out  *);
+
+PROCEDURE IsControl      (    theString    : ARRAY OF CHAR (*--in   *))
+       	       	       	                   : BOOLEAN       (*--out  *);
+
+PROCEDURE IsGraphic      (    theString    : ARRAY OF CHAR (*--in   *))
+       	       	       	                   : BOOLEAN       (*--out  *);
+
+PROCEDURE IsLowercase    (    theString    : ARRAY OF CHAR (*--in   *))
+       	       	       	                   : BOOLEAN       (*--out  *);
+
+PROCEDURE IsUppercase    (    theString    : ARRAY OF CHAR (*--in   *))
+       	       	       	                   : BOOLEAN       (*--out  *);
+
+PROCEDURE IsDigit        (    theString    : ARRAY OF CHAR (*--in   *))
+       	       	       	                   : BOOLEAN       (*--out  *);
+
+PROCEDURE IsAlphabetic   (    theString    : ARRAY OF CHAR (*--in   *))
+       	       	       	                   : BOOLEAN       (*--out  *);
+
+PROCEDURE IsAlphanumeric (    theString    : ARRAY OF CHAR (*--in   *))
+       	       	       	                   : BOOLEAN       (*--out  *);
+
+PROCEDURE IsSpecial      (    theString    : ARRAY OF CHAR (*--in   *))
+       	       	       	                   : BOOLEAN       (*--out  *);
+
+PROCEDURE NumberOf       (    theChar      : CHAR          (*--in   *);
+       	       	       	      inTheString  : ARRAY OF CHAR (*--in   *);
+                              caseSensitive: BOOLEAN       (*--in   *))
+                               	   	   	   : CARDINAL      (*--out  *);
+
+PROCEDURE LocationOf     (    theChar      : CHAR          (*--in   *);
+       	       	       	      inTheString  : ARRAY OF CHAR (*--in   *);
+                              caseSensitive: BOOLEAN       (*--in   *);
+                              forward      : BOOLEAN       (*--in   *))
+                               	   	   	   : CARDINAL      (*--out  *);
+
+PROCEDURE Scan           (    theString    : ARRAY OF CHAR (*--in   *);
+                              forAnyChar   : ARRAY OF CHAR (*--in   *);
+                              matchEqual   : BOOLEAN       (*--in   *);
+                          VAR atIndex      : CARDINAL      (*--inout*))
+                                           : BOOLEAN       (*--out  *);
+
+PROCEDURE IsEqual        (    left         : ARRAY OF CHAR (*--in   *);
+   	   	   	   	   	   	   	  right        : ARRAY OF CHAR (*--in   *);
+                              caseSensitive: BOOLEAN       (*--in   *))
+                               	   	   	   : BOOLEAN       (*--out  *);
+
+PROCEDURE IsLessThan     (    left         : ARRAY OF CHAR (*--in   *);
+   	   	   	   	   	   	   	  right        : ARRAY OF CHAR (*--in   *);
+                              caseSensitive: BOOLEAN       (*--in   *))
+                               	   	   	   : BOOLEAN       (*--out  *);
+
+PROCEDURE IsGreaterThan  (    left         : ARRAY OF CHAR (*--in   *);
+   	   	   	   	   	   	   	  right        : ARRAY OF CHAR (*--in   *);
+                              caseSensitive: BOOLEAN       (*--in   *))
+                               	   	   	   : BOOLEAN       (*--out  *);
+
+END StringUtils.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/STRINGUT.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/STRINGUT.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/UTILS/STRINGUT.MOD
@@ -0,0 +1,708 @@
+IMPLEMENTATION MODULE StringUtils;
+(*==========================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Tool - String Utilities
+    Code Size: R-  bytes
+
+    Revision History
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    Introduction
+    This module provides elementary String operations.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved. 
+==========================================================*)
+
+FROM Str IMPORT
+    (*--Proc*) Insert, Delete, Length, Compare;
+
+IMPORT CharUtils;
+
+       (*--------------------*)
+
+PROCEDURE MakeUppercase  (VAR theString    : ARRAY OF CHAR (*--inout*));
+
+VAR   index: CARDINAL; (*-- loop index over characters in the string *)
+
+BEGIN
+  index := 0;
+  WHILE (index <= HIGH(theString)) & (theString[index] # EOS) DO
+    CharUtils.MakeUppercase(theString[index]);
+    INC(index);
+  END (*--while*);
+END MakeUppercase;
+(*--------------------*)
+
+PROCEDURE MakeLowercase  (VAR theString    : ARRAY OF CHAR (*-- inout *));
+
+VAR   index: CARDINAL; (*-- loop index over characters in the string *)
+
+BEGIN
+  index := 0;
+  WHILE (index <= HIGH(theString)) & (theString[index] # EOS) DO
+    CharUtils.MakeLowercase(theString[index]);
+    INC(index);
+  END (*--while*);
+END MakeLowercase;
+(*--------------------*)
+
+PROCEDURE Replace	 (    theChar	   : CHAR	   (*--in   *);
+			      withChar	   : CHAR	   (*--in   *);
+			  VAR theString    : ARRAY OF CHAR (*--inout*);
+			      caseSensitive: BOOLEAN	   (*--in   *));
+VAR   index: CARDINAL;
+BEGIN
+  index := 0;
+  WHILE (index <= HIGH(theString)) & (theString[index] # EOS) DO
+    IF CharUtils.IsEqual(theChar, theString[index], caseSensitive) THEN
+      theString[index] := withChar;
+    END (*--if*);
+    INC(index);
+  END (*--while*);
+END Replace;
+(*--------------------*)
+
+PROCEDURE Append	 (    theString    : ARRAY OF CHAR (*--in   *);
+			  VAR toTheString  : ARRAY OF CHAR (*--inout*));
+
+VAR   srcLimit : CARDINAL; (*-- Source string high index bound *)
+      srcIndex : CARDINAL; (*-- Source string working index *)
+      destLimit: CARDINAL; (*-- Destination string high index bound *)
+      destIndex: CARDINAL; (*-- Destination string working index *)
+
+BEGIN
+  destLimit := HIGH(toTheString);
+  destIndex := 0;
+
+  (*-- Find the end of the string that is being appended to *)
+  WHILE (destIndex <= destLimit) & (toTheString[destIndex] # EOS) DO
+    INC(destIndex);
+  END(*--while*);
+
+  srcLimit := HIGH(theString);
+  srcIndex := 0;
+
+  (*-- Append source to end of destination *)
+  WHILE (destIndex < destLimit) & (srcIndex <= srcLimit) &
+	(theString[srcIndex] # EOS) DO
+    toTheString[destIndex] := theString[srcIndex];
+    INC(destIndex);
+    INC(srcIndex);
+  END(*--while*);
+  toTheString[destIndex] := EOS;
+END Append;
+(*--------------------*)
+
+PROCEDURE Fill		 (    theChar	   : CHAR	   (*--in   *);
+			  VAR inTheString  : ARRAY OF CHAR (*--out  *));
+
+VAR   index : INTEGER; (*-- loop index over characters in the string *)
+
+BEGIN
+  FOR index:= 0 TO HIGH(inTheString) DO
+    inTheString[index] := theChar;
+  END(*--for*);
+END Fill;
+(*--------------------*)
+
+PROCEDURE FillSpaces	 (VAR inTheString  : ARRAY OF CHAR (*--out   *));
+
+VAR   index : INTEGER; (*-- loop index over characters in the string *)
+
+BEGIN
+  FOR index:= 0 TO HIGH(inTheString) DO
+    inTheString[index] := ' ';
+  END(*--for*);
+END FillSpaces;
+(*--------------------*)
+
+PROCEDURE FillPartial	 (    withTheChar  : CHAR	   (*--in   *);
+			      atTheIndex   : CARDINAL	   (*--in   *);
+			      forTheLength : CARDINAL	   (*--in   *);
+			  VAR inTheString  : ARRAY OF CHAR (*--out  *));
+
+VAR   lastIndex: CARDINAL;
+
+BEGIN
+  lastIndex := HIGH(inTheString);
+  WHILE (atTheIndex <= lastIndex) & (inTheString[atTheIndex] # EOS) &
+	(forTheLength > 0) DO
+    inTheString[atTheIndex] := withTheChar;
+    INC(atTheIndex);
+    DEC(forTheLength);
+  END (*--while*);
+END FillPartial;
+(*--------------------*)
+
+PROCEDURE InsertChar	 (    withTheChar  : CHAR	   (*--in   *);
+			      atTheIndex   : CARDINAL	   (*--in   *);
+			      forTheLength : CARDINAL	   (*--in   *);
+			  VAR inTheString  : ARRAY OF CHAR (*--out  *));
+
+VAR   insertCount     : CARDINAL;
+      insertCharString: ARRAY [0..0] OF CHAR;
+
+BEGIN
+  IF atTheIndex <= VAL(CARDINAL,HIGH(inTheString)) THEN
+    insertCharString[0] := withTheChar;
+    insertCount := 0;
+    WHILE insertCount < forTheLength DO
+      Insert(insertCharString, inTheString, atTheIndex);
+      INC(insertCount);
+    END (*--while*);
+  END (*--if*);
+END InsertChar;
+(*--------------------*)
+
+PROCEDURE Centered	 (VAR theString    : ARRAY OF CHAR (*--inout*);
+			      inWidth	   : CARDINAL	   (*--in   *);
+			      withTheFiller: CHAR	   (*--in   *));
+
+VAR   leftMargin : CARDINAL;
+      rightMargin: CARDINAL;
+      sourceLen  : CARDINAL;
+      sourceLimit: CARDINAL;
+
+BEGIN
+  sourceLen := Length(theString);
+
+  IF inWidth > sourceLen THEN
+    sourceLimit := HIGH(theString);
+    IF (inWidth > sourceLimit) THEN
+      inWidth := sourceLimit;
+    END (*--if*);
+
+    leftMargin	:= (inWidth - sourceLen) DIV 2;
+    rightMargin := inWidth - sourceLen - leftMargin;
+
+    (*-- Fill at the left *)
+    InsertChar(withTheFiller,0,leftMargin,theString);
+
+    (*-- Fill at the right *)
+    InsertChar(withTheFiller,sourceLen+leftMargin,rightMargin,theString);
+
+  END (*--if*);
+END Centered;
+(*--------------------*)
+
+PROCEDURE LeftJustified  (VAR theString    : ARRAY OF CHAR (*--inout*);
+			      inWidth	   : CARDINAL	   (*--in   *);
+			      withTheFiller: CHAR	   (*--in   *));
+
+VAR   index: CARDINAL; (*-- loop index over characters of the string *)
+
+BEGIN
+  index := 0;
+  WHILE (index < HIGH(theString)) & (theString[index] # EOS) DO
+    INC(index);
+  END (*--while*);
+
+  WHILE (index < HIGH(theString)) & (VAL(CARDINAL, index) < inWidth) DO
+    theString [index] := withTheFiller;
+    INC(index);
+  END (*--while*);
+
+  theString[index] := EOS;
+END LeftJustified;
+(*--------------------*)
+
+PROCEDURE RightJustified (VAR theString    : ARRAY OF CHAR (*--inout*);
+			      inWidth	   : CARDINAL	   (*--in   *);
+			      withTheFiller: CHAR	   (*--in   *));
+VAR   srcIndex : CARDINAL;
+      srcLength: CARDINAL;
+      moveWidth: CARDINAL;
+
+BEGIN
+  srcLength := Length(theString);
+
+  IF (srcLength < inWidth) THEN
+
+    (*-- If given width exceeds limit of string, readjust to the limit *)
+    IF VAL(CARDINAL,HIGH(theString)) < inWidth THEN
+      inWidth := HIGH(theString);
+    END (*--if*);
+
+    (*-- Calculate how many positions to added to the string *)
+    moveWidth := inWidth - srcLength;
+
+    (*-- Shift the input string right, based on given width *)
+    FOR srcIndex := inWidth TO moveWidth BY -1 DO
+      theString[srcIndex] := theString[srcIndex-moveWidth];
+    END (*--for*);
+
+    (*-- Fill the front of the string with the given filler character *)
+    DEC(moveWidth);
+    FOR srcIndex := 0 TO moveWidth DO
+      theString[srcIndex] := withTheFiller;
+    END (*--for*);
+  END (*--if*);
+END RightJustified;
+(*--------------------*)
+
+PROCEDURE Stripped	 (VAR fromTheString: ARRAY OF CHAR (*--inout*);
+			      theChar	   : CHAR	   (*--in   *);
+			      caseSensitive: BOOLEAN	   (*--in   *));
+
+VAR   srcIndex	 : CARDINAL;
+      maxIndex	 : CARDINAL;
+      stripIndex : CARDINAL;
+      stripCount : CARDINAL;
+
+BEGIN
+  maxIndex := HIGH(fromTheString);
+  srcIndex := 0;
+  WHILE (srcIndex <= maxIndex) & (fromTheString[srcIndex] # EOS) DO
+    IF CharUtils.IsEqual(theChar, fromTheString[srcIndex], caseSensitive) THEN
+      stripIndex := srcIndex;
+      stripCount := 1;
+      INC(srcIndex);
+      WHILE (srcIndex <= maxIndex) & (fromTheString[srcIndex] # EOS) &
+	    CharUtils.IsEqual(theChar, fromTheString[srcIndex], caseSensitive) DO
+	INC(stripCount);
+	INC(srcIndex);
+      END (*--while*);
+      Delete(fromTheString, stripIndex, stripCount);
+      DEC(srcIndex, stripCount);
+
+    ELSE
+      INC(srcIndex);
+    END (*--if*);
+  END (*--while*);
+END Stripped;
+(*--------------------*)
+
+PROCEDURE StripLeading	 (VAR fromTheString: ARRAY OF CHAR (*--inout*);
+			      theChar	   : CHAR	   (*--in   *);
+			      caseSensitive: BOOLEAN	   (*--in   *));
+
+VAR   srcIndex	 : CARDINAL;
+      maxIndex	 : CARDINAL;
+      stripIndex : CARDINAL;
+      stripCount : CARDINAL;
+
+BEGIN
+  maxIndex   := HIGH(fromTheString);
+  srcIndex   := 0;
+  stripCount := 0;
+  WHILE (srcIndex <= maxIndex) & (fromTheString[srcIndex] # EOS) &
+	CharUtils.IsEqual(theChar, fromTheString[srcIndex], caseSensitive) DO
+    INC(stripCount);
+    INC(srcIndex);
+  END (*--while*);
+  Delete(fromTheString, 0, stripCount);
+END StripLeading;
+(*--------------------*)
+
+PROCEDURE StripTrailing  (VAR fromTheString: ARRAY OF CHAR (*--inout*);
+			      theChar	   : CHAR	   (*--in   *);
+			      caseSensitive: BOOLEAN	   (*--in   *));
+
+VAR   srcIndex: CARDINAL;
+      srcLen  : CARDINAL;
+      newEOS  : CARDINAL;
+
+BEGIN
+  srcIndex := Length(fromTheString);
+  IF srcIndex > 0 THEN
+    REPEAT
+      newEOS := srcIndex;
+      DEC(srcIndex);
+    UNTIL (srcIndex = 0) OR
+	  ~CharUtils.IsEqual(theChar, fromTheString[srcIndex], caseSensitive);
+    IF newEOS <= VAL(CARDINAL,HIGH(fromTheString)) THEN
+      fromTheString[newEOS] := EOS;
+    END (*--if*);
+  END (*--if*);
+END StripTrailing;
+(*--------------------*)
+
+
+PROCEDURE Uppercase	 (    theString    : ARRAY OF CHAR (*--in   *);
+			  VAR newString    : ARRAY OF CHAR (*--out  *));
+
+VAR   index: CARDINAL; (*-- loop index over characters of theString *)
+
+BEGIN
+  index := 0;
+  WHILE (index <= HIGH(theString)) & (theString[index] # EOS) &
+	(index <= HIGH(newString)) DO
+    newString[index] := CharUtils.Uppercase(theString[index]);
+    INC(index);
+  END (*--while*);
+  newString[index] := EOS;
+END Uppercase;
+(*--------------------*)
+
+PROCEDURE Lowercase	 (    theString    : ARRAY OF CHAR (*--in   *);
+			  VAR newString    : ARRAY OF CHAR (*--out  *));
+
+VAR   index: CARDINAL; (*-- loop index over characters of theString *)
+
+BEGIN
+  index := 0;
+  WHILE (index <= HIGH(theString)) & (theString[index] # EOS) &
+	(index <= HIGH(newString)) DO
+    newString[index] := CharUtils.Lowercase(theString[index]);
+    INC(index);
+  END (*--while*);
+  newString[index] := EOS;
+END Lowercase;
+(*--------------------*)
+
+PROCEDURE Capitalized	 (    theString    : ARRAY OF CHAR (*--in   *);
+			  VAR newString    : ARRAY OF CHAR (*--out  *));
+
+VAR   index: CARDINAL; (*-- loop index over characters of theString *)
+
+BEGIN
+  index := 0;
+  WHILE (index <= HIGH(theString)) & (theString[index] # EOS) &
+	(index <= HIGH(newString)) DO
+    INC(index);
+  END (*--while*);
+  newString[index] := EOS;
+END Capitalized;
+(*--------------------*)
+
+PROCEDURE Uncapitalized  (    theString    : ARRAY OF CHAR (*--in   *);
+			  VAR newString    : ARRAY OF CHAR (*--out  *));
+
+VAR   index: CARDINAL; (*-- loop index over characters of theString *)
+
+BEGIN
+  index := 0;
+  WHILE (index <= HIGH(theString)) & (theString[index] # EOS) &
+	(index <= HIGH(newString)) DO
+    INC(index);
+  END (*--while*);
+  newString[index] := EOS;
+END Uncapitalized;
+(*--------------------*)
+
+PROCEDURE Replaced	 (    theChar	   : CHAR	   (*--in   *);
+			      withChar	   : CHAR	   (*--in   *);
+			      inTheString  : ARRAY OF CHAR (*--in   *);
+			      caseSensitive: BOOLEAN	   (*--in   *);
+			  VAR newString    : ARRAY OF CHAR (*--out  *));
+
+VAR   index: CARDINAL; (*-- loop index over characters of theString *)
+
+BEGIN
+  index := 0;
+  WHILE (index <= HIGH(inTheString)) & (inTheString[index] # EOS) &
+	(index <= HIGH(newString)) DO
+    IF CharUtils.IsEqual(theChar, inTheString[index], caseSensitive) THEN
+      newString[index] := withChar;
+    ELSE
+      newString[index] := inTheString[index];
+    END (*--if*);
+    INC(index);
+  END (*--while*);
+  newString[index] := EOS;
+END Replaced;
+(*--------------------*)
+
+PROCEDURE IsEmpty	 (    theString    : ARRAY OF CHAR (*--in   *))
+					   : BOOLEAN	   (*--out  *);
+BEGIN
+  RETURN (HIGH(theString) = 0) & (theString[0] = EOS);
+END IsEmpty;
+(*--------------------*)
+
+PROCEDURE IsAscii	 (    theString    : ARRAY OF CHAR (*--in   *))
+					   : BOOLEAN	   (*--out  *);
+
+VAR   index: CARDINAL; (*-- loop index over characters of theString *)
+
+BEGIN
+  index := 0;
+  WHILE (index <= HIGH(theString)) & (theString[index] # EOS) DO
+    IF ~CharUtils.IsAscii(theString[index]) THEN
+      RETURN FALSE;
+    END (*--if*);
+    INC(index);
+  END (*--while*);
+  RETURN TRUE;
+END IsAscii;
+(*--------------------*)
+
+PROCEDURE IsControl	 (    theString    : ARRAY OF CHAR (*--in   *))
+					   : BOOLEAN	   (*--out  *);
+
+VAR   index: CARDINAL; (*-- loop index over characters of theString *)
+
+BEGIN
+  index := 0;
+  WHILE (index <= HIGH(theString)) & (theString[index] # EOS) DO
+    IF ~CharUtils.IsControl(theString[index]) THEN
+      RETURN FALSE;
+    END (*--if*);
+    INC(index);
+  END (*--while*);
+  RETURN TRUE;
+END IsControl;
+(*--------------------*)
+
+PROCEDURE IsGraphic	 (    theString    : ARRAY OF CHAR (*--in   *))
+					   : BOOLEAN	   (*--out  *);
+
+VAR   index: CARDINAL; (*-- loop index over characters of theString *)
+
+BEGIN
+  index := 0;
+  WHILE (index <= HIGH(theString)) & (theString[index] # EOS) DO
+    IF ~CharUtils.IsGraphic(theString[index]) THEN
+      RETURN FALSE;
+    END (*--if*);
+    INC(index);
+  END (*--while*);
+  RETURN TRUE;
+END IsGraphic;
+(*--------------------*)
+
+PROCEDURE IsLowercase	 (    theString    : ARRAY OF CHAR (*--in   *))
+					   : BOOLEAN	   (*--out  *);
+
+VAR   index: CARDINAL; (*-- loop index over characters of theString *)
+
+BEGIN
+  index := 0;
+  WHILE (index <= HIGH(theString)) & (theString[index] # EOS) DO
+    IF ~CharUtils.IsLowercase(theString[index]) THEN
+      RETURN FALSE;
+    END (*--if*);
+    INC(index);
+  END (*--while*);
+  RETURN TRUE;
+END IsLowercase;
+(*--------------------*)
+
+PROCEDURE IsUppercase	 (    theString    : ARRAY OF CHAR (*--in   *))
+					   : BOOLEAN	   (*--out  *);
+
+VAR   index: CARDINAL; (*-- loop index over characters of theString *)
+
+BEGIN
+  index := 0;
+  WHILE (index <= HIGH(theString)) & (theString[index] # EOS) DO
+    IF ~CharUtils.IsUppercase(theString[index]) THEN
+      RETURN FALSE;
+    END (*--if*);
+    INC(index);
+  END (*--while*);
+  RETURN TRUE;
+END IsUppercase;
+(*--------------------*)
+
+PROCEDURE IsDigit	 (    theString    : ARRAY OF CHAR (*--in   *))
+					   : BOOLEAN	   (*--out  *);
+
+VAR   index: CARDINAL; (*-- loop index over characters of theString *)
+
+BEGIN
+  index := 0;
+  WHILE (index <= HIGH(theString)) & (theString[index] # EOS) DO
+    IF ~CharUtils.IsDigit(theString[index]) THEN
+      RETURN FALSE;
+    END (*--if*);
+    INC(index);
+  END (*--while*);
+  RETURN TRUE;
+END IsDigit;
+(*--------------------*)
+
+PROCEDURE IsAlphabetic	 (    theString    : ARRAY OF CHAR (*--in   *))
+					   : BOOLEAN	   (*--out  *);
+
+VAR   index: CARDINAL; (*-- loop index over characters of theString *)
+
+BEGIN
+  index := 0;
+  WHILE (index <= HIGH(theString)) & (theString[index] # EOS) DO
+    IF ~CharUtils.IsAlphabetic(theString[index]) THEN
+      RETURN FALSE;
+    END (*--if*);
+    INC(index);
+  END (*--while*);
+  RETURN TRUE;
+END IsAlphabetic;
+(*--------------------*)
+
+PROCEDURE IsAlphanumeric (    theString    : ARRAY OF CHAR (*--in   *))
+					   : BOOLEAN	   (*--out  *);
+
+VAR   index: CARDINAL; (*-- loop index over characters of theString *)
+
+BEGIN
+  index := 0;
+  WHILE (index <= HIGH(theString)) & (theString[index] # EOS) DO
+    IF ~CharUtils.IsAlphanumeric(theString[index]) THEN
+      RETURN FALSE;
+    END (*--if*);
+    INC(index);
+  END (*--while*);
+  RETURN TRUE;
+END IsAlphanumeric;
+(*--------------------*)
+
+PROCEDURE IsSpecial	 (    theString    : ARRAY OF CHAR (*--in   *))
+					   : BOOLEAN	   (*--out  *);
+
+VAR   index: CARDINAL; (*-- loop index over characters of theString *)
+
+BEGIN
+  index := 0;
+  WHILE (index <= HIGH(theString)) & (theString[index] # EOS) DO
+    IF ~CharUtils.IsSpecial(theString[index]) THEN
+      RETURN FALSE;
+    END (*--if*);
+    INC(index);
+  END (*--while*);
+  RETURN TRUE;
+END IsSpecial;
+(*--------------------*)
+
+PROCEDURE NumberOf	 (    theChar	   : CHAR	   (*--in   *);
+			      inTheString  : ARRAY OF CHAR (*--in   *);
+			      caseSensitive: BOOLEAN	   (*--in   *))
+					   : CARDINAL	   (*--out  *);
+
+VAR   index: CARDINAL;  (*-- loop index over characters of theString *)
+      count: CARDINAL;
+
+BEGIN
+  count := 0;
+  index := 0;
+  WHILE (index <= HIGH(inTheString)) & (inTheString[index] # EOS) DO
+    IF CharUtils.IsEqual(theChar, inTheString[index], caseSensitive) THEN
+      INC(count);
+    END (*--if*);
+    INC(index);
+  END (*--while*);
+  RETURN count;
+END NumberOf;
+(*--------------------*)
+
+PROCEDURE LocationOf	 (    theChar	   : CHAR	   (*--in   *);
+			      inTheString  : ARRAY OF CHAR (*--in   *);
+			      caseSensitive: BOOLEAN	   (*--in   *);
+			      forward	   : BOOLEAN	   (*--in   *))
+					   : CARDINAL	   (*--out  *);
+
+VAR   index: CARDINAL; (*-- loop index over characters of theString *)
+
+BEGIN
+  IF forward THEN
+    index := 0;
+    WHILE (index <= HIGH(inTheString)) & (inTheString[index] # EOS) DO
+      IF CharUtils.IsEqual(theChar, inTheString[index], caseSensitive) THEN
+	RETURN index;
+      END (*--if*);
+      INC(index);
+    END (*--while*);
+  ELSE
+    index := Length(inTheString);
+    WHILE (index >= 0) DO
+      IF CharUtils.IsEqual(theChar, inTheString[index], caseSensitive) THEN
+	RETURN index;
+      END (*--if*);
+      DEC(index);
+    END (*--while*);
+  END (*--if*);
+  RETURN 0;
+END LocationOf;
+(*--------------------*)
+
+PROCEDURE Scan		 (    theString    : ARRAY OF CHAR (*--in   *);
+			      forAnyChar   : ARRAY OF CHAR (*--in   *);
+			      matchEqual   : BOOLEAN	   (*--in   *);
+			  VAR atIndex	   : CARDINAL	   (*--inout*))
+					   : BOOLEAN	   (*--out  *);
+
+VAR   length,		(*-- maximum index of source string array *)
+      initialIndex,	(*-- index upon entry to the routine *)
+      cindex,		(*-- current index of pattern array *)
+      clength: CARDINAL;(*-- maximum index of pattern array *)
+
+BEGIN
+  length      :=HIGH(theString);
+  clength     :=HIGH(forAnyChar);
+  initialIndex:=atIndex;
+
+  (*-- Traverse the input string *)
+  WHILE (atIndex <= length) & (theString[atIndex] # EOS) DO
+
+    cindex:=0;
+    IF matchEqual THEN
+
+      (*-- Traverse the scanning string to find first match *)
+      WHILE (cindex <= clength) & (forAnyChar[cindex] # EOS) DO
+	IF (theString[atIndex] = forAnyChar[cindex]) THEN
+	  RETURN TRUE;
+	END (*--if*);
+	INC(cindex);
+      END (*--while*);
+
+    ELSE
+      (*-- Traverse the scanning string to find first non-match  *)
+      WHILE (cindex <= clength) & (forAnyChar[cindex] # EOS) DO
+	IF (theString[atIndex] # forAnyChar[cindex]) THEN
+	  RETURN TRUE;
+	END (*--if*);
+	INC(cindex);
+      END (*--while*);
+    END (*--if*);
+
+    INC(atIndex);	   (*-- Advance to next character of the input string *)
+  END (*--while*);
+
+  atIndex := initialIndex; (*-- restore index value upon failure *)
+  RETURN FALSE;
+END Scan;
+(*--------------------*)
+
+PROCEDURE IsEqual	 (    left	   : ARRAY OF CHAR (*--in   *);
+			      right	   : ARRAY OF CHAR (*--in   *);
+			      caseSensitive: BOOLEAN	   (*--in   *))
+					   : BOOLEAN	   (*--out  *);
+BEGIN
+  IF ~caseSensitive THEN
+    MakeLowercase(left);
+    MakeLowercase(right);
+  END (*--if*);
+  RETURN Compare(left, right) = 0;
+END IsEqual;
+(*--------------------*)
+
+PROCEDURE IsLessThan	 (    left	   : ARRAY OF CHAR (*--in   *);
+			      right	   : ARRAY OF CHAR (*--in   *);
+			      caseSensitive: BOOLEAN	   (*--in   *))
+					   : BOOLEAN	   (*--out  *);
+BEGIN
+  IF ~caseSensitive THEN
+    MakeLowercase(left);
+    MakeLowercase(right);
+  END (*--if*);
+  RETURN Compare(left, right) = -1;
+END IsLessThan;
+(*--------------------*)
+
+PROCEDURE IsGreaterThan  (    left	   : ARRAY OF CHAR (*--in   *);
+			      right	   : ARRAY OF CHAR (*--in   *);
+			      caseSensitive: BOOLEAN	   (*--in   *))
+					   : BOOLEAN	   (*--out  *);
+BEGIN
+  IF ~caseSensitive THEN
+    MakeLowercase(left);
+    MakeLowercase(right);
+  END (*--if*);
+  RETURN Compare(left, right) = +1;
+END IsGreaterThan;
+(*--------------------*)
+
+END StringUtils.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQHANDLE.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQHANDLE.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQHANDLE.DEF
@@ -0,0 +1,31 @@
+(*
+This module provides a simple exception handler for the
+various Deque abstractions. Given an error code, it reports
+the exception to standard output in the following format:
+### Error "<error text>" raised in Routine "<routine name>" in Module <module #>
+
+The system beep is made before issuing the message and a WriteLn
+follows the message display.
+*)
+
+DEFINITION MODULE DQHandlers; 
+(*==============================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Deque Exception Handlers Utility
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	Initial implementation
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM QEnum IMPORT
+	(*--type*) Exceptions, Operations;
+
+
+PROCEDURE WriteHandler (    theModule 	 : CARDINAL   (*--in   *);
+							theOperation : Operations (*--in   *);
+							theException : Exceptions (*--in   *));
+
+END DQHandlers.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQHANDLE.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQHANDLE.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQHANDLE.MOD
@@ -0,0 +1,69 @@
+IMPLEMENTATION MODULE DQHandlers; 
+(*==============================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Deque Exception Handlers Utility
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	Initial TopSpeed Modula-2 implementation
+==============================================================*)
+
+FROM QEnum IMPORT
+	(*--type*) Exceptions, Operations;
+
+FROM IO IMPORT
+	(*--proc*) WrStr, WrLn, WrCard;
+
+
+PROCEDURE WriteHandler (    theModule 	 : CARDINAL   (*--in   *);
+							theOperation : Operations (*--in   *);
+							theException : Exceptions (*--in   *));
+
+BEGIN
+  WrStr('### Error "');
+
+  CASE theException OF
+  	noerr     : WrStr('No Error');
+  |	initfailed: WrStr('Initialization failure');
+  | notfound  : WrStr('Item not found in Deque');
+  | overflow  : WrStr('Deque Overflow');
+  | typeerror : WrStr('Type mismatch between Deques');
+  | underflow : WrStr('Deque Underflow');
+  | undefined : WrStr('Undefined Deque');
+  END (*--case*);
+
+  WrStr('" raised in Routine "');
+
+  CASE theOperation OF
+  	assign   : WrStr('Assign');
+  | create   : WrStr('Create');
+  | destroy  : WrStr('Destroy');
+  | clear    : WrStr('Clear');
+  | arrive   : WrStr('Arrive');
+  | depart   : WrStr('Depart');
+  | leave    : WrStr('Leave');
+ 
+  | isempty    : WrStr('IsEmpty');
+  | isequal    : WrStr('IsEqual');
+  | typeof     : WrStr('TypeOf');
+  | sizeof     : WrStr('SizeOf');
+  | lengthof   : WrStr('LengthOf');
+  | frontof    : WrStr('FrontOf');
+  | rearof     : WrStr('RearOf');
+  | endof      : WrStr('EndOf');
+  | positionof : WrStr('PositionOf');
+	
+	| loopover   : WrStr('LoopOver');
+	| traverse   : WrStr('Traverse');
+	
+  ELSE
+    WrStr('?????');
+  END (*--case*);
+
+  WrStr('" in Module ');
+  WrCard(theModule, 1);
+  WrLn;
+END WriteHandler;
+
+END DQHandlers.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSBMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSBMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSBMI.DEF
@@ -0,0 +1,163 @@
+DEFINITION MODULE DQNBSBMI;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Non-priority Balking Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1988  C. Lins:
+	  Initial implementation.
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+(*
+12.1.1 Type Declarations
+
+A deque is declared as the abstract data type, Deque.  In the bounded
+form presented here a deque is limited to a maximum size of 8100
+items.  Since the deque insertion and removal operations, Arrive and
+Depart, may occur at either the front or the back of the deque the
+enumeration Location is declared to represent these choices.
+*)
+
+TYPE  Deque;
+TYPE  DequeSize = [1..8100];
+TYPE  Location  = (front, back);
+CONST NullDeque = Deque(NIL);
+
+
+(*
+12.1.2 Exceptions
+
+The ModuleID uniquely identifies this module from all others.
+
+DequeError returns the most recent queue exception, or noerr if the
+last operation was successful.  While SetHandler and GetHandler allow
+assignment and retrieval of exception handling routines for specific
+exceptions.
+*)
+
+CONST ModuleID = 1;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+
+(*
+12.1.3 Constructors
+
+An additional constructor, Leave, has been added to implement the
+actual balking mechanism.  The difference between this version of
+Leave and the queue version is the addition of the parameter theEnd.
+This is done for consistency with the Arrive and Depart operations.
+
+All other constructors remain unchanged from the non-priority
+non-balking form of deque.
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+	theSize  : DequeSize (*-- in    *))
+	: Deque     (*-- out   *);
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Leave   (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+
+(*
+12.1.4 Selectors
+
+All of the selector interfaces are unchanged from the non-priority
+non-balking form of deque.
+
+An additional selector has been added, PositionOf, that returns the
+number of positions from the given item to the front of the queue. If
+theItem is not present in theDeque then zero is returned.  Note that
+the position is always from the front of the deque as the position
+from the back can be easily calculated by the client.
+*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE PositionOf (    theDeque: Deque    (*-- in    *);
+       	       		theItem : Item     (*-- in    *))
+							: CARDINAL (*-- out   *);
+
+
+(*
+12.1.5 Iterators
+
+The interfaces to both iterators are unchanged from the non-priority
+non-balking form of deque.
+*)
+
+PROCEDURE LoopOver (    theDeque  : Deque	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+PROCEDURE Traverse (    theDeque  : Deque	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+END DQNBSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSBMI.MOD
@@ -0,0 +1,724 @@
+IMPLEMENTATION MODULE DQNBSBMI;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+	Code Size: R-  bytes
+    Component: Monolithic Structures - Deque (Opaque version)
+      Non-priority Balking Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  19 Jan 1988  C. Lins:
+	  Initial implementation.
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc,
+		AccessProc, LoopAccessProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, DequeComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+13.3.1 Internal Bounded Balking Deque Representation
+
+A dynamically created array of Items is created when a deque
+is created. The front of the deque is always accessible by the
+index [1].  The header record is used to hold the deque size limit (size),
+the current rear index (rear), data type id (dataID), and the dynamic
+array of items (items).
+Items are stored in a linear fashion within the array.  Figure 13.1,
+below, graphically depicts the internal structure used for the bounded
+deque:
+
+FIGURE 13.1
+
+Representation Invariants:
+* MIN(DequeSize) <= size <= MAX(DequeSize)
+* 0 <= rear <= size
+* the deque is empty when rear is zero
+* when not empty, the front of the deque is at items[MIN(DequeSize)]
+*)
+
+TYPE  ItemsArray   = ARRAY DequeSize OF Item;
+TYPE  BoundedDeque = RECORD
+	dataID : TypeID;     (*-- defined data type *)
+	size   : CARDINAL;   (*-- maximum # of items *)
+	rear   : CARDINAL;   (*-- current # of items *)
+	items  : ItemsArray; (*-- array [1..size] of item *)
+      END (*-- BoundedDeque *);
+
+TYPE  Deque = POINTER TO BoundedDeque;
+
+    (*--------------------*)
+
+
+(*
+13.3.2 Exceptions
+
+dequeError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+dequeError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+13.3.6).
+
+DequeError simply returns the current exception result stored
+in dequeError and is used to determine whether a deque operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   dequeError : Exceptions;
+VAR   handler    : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN dequeError;
+END DequeError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+	theError   : Exceptions (*-- in    *));
+BEGIN
+  dequeError := theError;
+  Raise(DequeComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+13.3.3 Constructors
+
+Create attempts to form a new, empty bounded deque object associated
+with the given data type ID and maximum size.  Only the specified
+number of entries given in theSize are actually allocated to the
+ItemsArray (items).  MacSystem.Allocate returns NIL if it is unable
+to successfully complete the allocation request whereupon the overflow
+exception is raised and the NullDeque returned.  If successful, the
+deque is initialized as follows before returning the new deque:
+* theType is saved for later use by IsEqual,
+* theSize is saved for later checking for deque overflow by Arrive and Assign, and
+* rear is set to the empty deque state.
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+	theSize  : DequeSize (*-- in    *))
+	: Deque     (*-- out   *);
+
+CONST staticSize = SIZE(BoundedDeque) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newDeque : Deque;
+
+BEGIN
+  dequeError := noerr;
+  Allocate(newDeque, staticSize + itemSize * theSize);
+  IF (newDeque = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newDeque^ DO
+      dataID := theType;
+      size   := theSize;
+	  rear   := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newDeque;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theDeque rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullDeque). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedDeque) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theDeque);
+  IF (dequeError = noerr) THEN
+    Deallocate(theDeque, staticSize + itemSize * theDeque^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theDeque's data type, if
+any, and proceeds to free each item in theDeque.  If theDeque is empty
+the loop is not executed as rear will be greater than the minimum
+DequeSize.  Lastly, rear is set to ensure theDeque is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    WITH theDeque^ DO
+	  free := DisposeOf(dataID);
+      FOR index := MIN(DequeSize) TO rear DO
+	free(items[index]);
+      END (*--for*);
+      rear := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theDeque to the target deque, toDeque. An
+undefined source deque raised an exception and leaves the target unchanged.
+If the target deque is undefined, it is created with the same size and
+data type attributes of the source; otherwise the target deque is
+cleared of its presnet contents and its data type is altered to reflect
+that of the source.  If the target deque is capable of containing all
+of the items present in the source, Assign simply copies each item from
+the source to the target afterwards updating the target's rear value.
+Complexity: O(mn).
+*)
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theDeque # toDeque) THEN
+    IF (toDeque = NIL) THEN
+      WITH theDeque^ DO
+	toDeque := Create(dataID, size);
+	  END (*--with*);
+    ELSIF (theDeque^.rear <= toDeque^.size) THEN
+      Clear(toDeque);
+      toDeque^.dataID := theDeque^.dataID;
+	ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (dequeError = noerr) THEN
+      WITH theDeque^ DO
+	    assignment := AssignOf(dataID);
+	FOR index := MIN(DequeSize) TO rear DO
+	toDeque^.items[index] := assignment(items[index]);
+	END (*--for*);
+	toDeque^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to theEnd of theDeque by advancing the rear index
+value and storing theItem at that location.  When the rear of theDeque
+is already at its maximum allowed size the exception overflow is raised
+and theDeque remains unchanged.  Likewise, given an undefined deque
+raises the exception of the same name. When theItem arrives at the
+front of theDeque all other items must be shifted upward in the items
+array to make room for the new item; otherwise, when the arrival occurs
+at the rear of theDeque the effect is identical with that for the
+standard queue. Complexity: Front O(n), Rear O(1).
+*)
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear < size) THEN
+	    CASE theEnd OF
+		  front :
+		    FOR index := rear TO MIN(DequeSize) BY -1 DO
+			  items[index + 1] := items[index];
+			END (*--for*);
+	INC(rear);
+	items[MIN(DequeSize)] := theItem;
+		| back  :
+	INC(rear);
+	items[rear] := theItem;
+		END (*--case*);
+      ELSE
+	RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front or the rear of theDeque depending
+on the value of theEnd.  If the item is departing from the rear of the
+deque it is sufficient to free the item's value and decrement the rear
+index.  Otherwise, if departing from the front of the deque it is
+necessary to shift all other items down one position in the items array
+and deduct one from the rear index.  Before overwriting the item being
+removed, it's value is freed via the disposal routine of theDeque's
+data type.  If theDeque is empty on entry to Depart the underflow
+exception is raised and theDeque is not changed.  When theDeque is not
+defined, the undefined exception is raised.
+Complexity: Front O(n), Rear O(1).
+*)
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear = 0) THEN
+	RaiseErrIn(depart, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+	free(items[MIN(DequeSize)]);
+	FOR index := MIN(DequeSize) + 1 TO rear DO
+	items[index - 1] := items[index];
+	END (*--for*);
+		| back  :
+	free(items[rear]);
+		END (*--case*);
+	DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+(*
+Leave removes theItem from theDeque regardless of its position within
+the deque.  The key to the implementation is the search mechanism for
+theItem.  When theEnd is front the search extends from there towards
+the back, and the reverse when theEnd is back.  If theItem was found
+index will point into the items array at theItem, otherwise index will
+be > rear on a search from the front and zero on a search from the back.
+Complexity: O(n).
+*)
+
+PROCEDURE Leave   (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(leave, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear = 0) THEN
+	RaiseErrIn(leave, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+		    index := MIN(DequeSize);
+		    WHILE (index <= rear) & (items[index] # theItem) DO
+		      INC(index);
+		    END (*-- while*);
+		| back  :
+		    index := rear;
+		    WHILE (index >= MIN(DequeSize)) & (items[index] # theItem) DO
+		      DEC(index);
+		    END (*-- while*);
+		END (*--case*);
+		IF (MIN(DequeSize) <= index) & (index <= rear) THEN
+	free(items[index]);
+	FOR index := index + 1 TO rear DO
+	items[index - 1] := items[index];
+	END (*--for*);
+	DEC(rear);
+		ELSE
+	RaiseErrIn(leave, notfound);
+	END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Leave;
+(*-------------------------*)
+
+
+(*
+13.3.4 Selectors
+
+IsDefined verifies to the best of its ability whether theDeque has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theDeque # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theDeque is in the empty state, as indicated by
+the rear being zero, and False otherwise.  As per the specification
+(section 8.?) undefined deques are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN (theDeque^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right deques for equality, which in this
+context means they contain the same items and the same data type ID. The
+defined size of the deques is not relevant for the equality test.  Both
+deques must be defined and have the same data type ID; if they don not,
+then the exceptions undefined and typeerror are raised, respectively.
+Obviously, deques of different lengths (indicated by the value of rear)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both deques
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them.
+Complexity: O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+VAR   index   : CARDINAL;		(*-- loop index over items *)
+	  compare : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+	  compare := CompareOf(dataID);
+      FOR index := MIN(DequeSize) TO rear DO
+	IF compare(items[index], right^.items[index]) # equal THEN
+	RETURN FALSE;
+	END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+	END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the rear index into the items array which is
+also the length of theDeque. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+SizeOf and TypeOf simply return the size and dataID for the given deque.
+Undefined deques, as always, raise the undefined exception and return
+reasonable values (zero and the NullType, respectively). The complexity
+of both routines is O(1).
+*)
+
+PROCEDURE SizeOf    (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the front of theDeque
+or the NullItem if theDeque is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theDeque^.items[MIN(DequeSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+(*
+RearOf returns the value of the item that is at the rear of theDeque
+or the NullItem if theDeque is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(rearof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(rearof, underflow);
+  ELSE
+    WITH theDeque^ DO
+      RETURN items[rear];
+	END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END RearOf;
+(*-------------------------*)
+
+(*
+EndOf returns the value of the item that is at the given end of theDeque
+(front or rear) or the NullItem if theDeque is undefined or is empty.
+Complexity: O(1).
+*)
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(endof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(endof, underflow);
+  ELSE
+    WITH theDeque^ DO
+      CASE theEnd OF
+	    front : RETURN items[MIN(DequeSize)];
+	  | back  : RETURN items[rear];
+	  END (*--case*);
+	END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END EndOf;
+(*-------------------------*)
+
+(*
+PositionOf returns the number of positions from the given item from the
+front of the deque. If theItem is not present in theDeque then zero
+is returned. Complexity O(n).
+*)
+
+PROCEDURE PositionOf (    theDeque: Deque    (*-- in    *);
+       	       		theItem : Item     (*-- in    *))
+							: CARDINAL (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(positionof, undefined);
+  ELSE
+    WITH theDeque^ DO
+      FOR index := MIN(DequeSize) TO rear DO
+	    IF (theItem = items[index]) THEN
+		  RETURN index;
+		END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+  RETURN 0;
+END PositionOf;
+(*-------------------------*)
+
+
+(*
+13.3.5 Iterators
+
+Both LoopOver and Traverse simply loop through each of the deque items
+passing the item value to theProcess procedure parameter. The direction
+of the iteration is controlled by theEnd parameter and is from the front
+to the rear when theEnd is front and the reverse when theEnd is rear.
+LoopOver may terminate before reaching the opposite end if theProcess
+returns False. Complexity: O(n).
+*)
+
+PROCEDURE LoopOver (    theDeque  : Deque	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theDeque^ DO
+      CASE theEnd OF
+	    front :
+	FOR index := MIN(DequeSize) TO rear DO
+	IF ~theProcess(items[index]) THEN
+	RETURN;
+	END (*--if*);
+	END (*--for*);
+	  | back  :
+	FOR index := rear TO MIN(DequeSize) BY -1 DO
+	IF ~theProcess(items[index]) THEN
+	RETURN;
+	END (*--if*);
+	END (*--for*);
+	  END (*--case*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theDeque  : Deque	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theDeque^ DO
+      CASE theEnd OF
+	    front :
+	FOR index := MIN(DequeSize) TO rear DO
+	theProcess(items[index]);
+	END (*--for*);
+	  | back  :
+	FOR index := rear TO MIN(DequeSize) BY -1 DO
+	theProcess(items[index]);
+	END (*--for*);
+	  END (*--case*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*
+13.3.6 Module Initialization
+
+The module's local variables are initialized to known states.
+dequeError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.
+
+Since a FOR loop control variable is undefined following the loop,
+dequeError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR dequeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(dequeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  dequeError := noerr;
+END DQNBSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSBMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSBMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSBMN.DEF
@@ -0,0 +1,111 @@
+DEFINITION MODULE DQNBSBMN;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Non-Priority Balking Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed implementation.
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+
+TYPE  Deque;
+TYPE  DequeSize = [1..8100];
+TYPE  Location  = (front, back);
+CONST NullDeque = Deque(NIL);
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+CONST ModuleID = 2;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+	theSize  : DequeSize (*-- in    *))
+	: Deque     (*-- out   *);
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Leave   (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE PositionOf (    theDeque: Deque    (*-- in    *);
+       	       		theItem : Item     (*-- in    *))
+							: CARDINAL (*-- out   *);
+
+END DQNBSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSBMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSBMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSBMN.MOD
@@ -0,0 +1,461 @@
+IMPLEMENTATION MODULE DQNBSBMN;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+	Code Size: R-  bytes
+    Component: Monolithic Structures - Deque (Opaque version)
+      Non-Priority Balking Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed implementation.
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, DequeComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+TYPE  ItemsArray   = ARRAY DequeSize OF Item;
+TYPE  BoundedDeque = RECORD
+	dataID : TypeID;     (*-- defined data type *)
+	size   : CARDINAL;   (*-- maximum # of items *)
+	rear   : CARDINAL;   (*-- current # of items *)
+	items  : ItemsArray; (*-- array [1..size] of item *)
+      END (*-- BoundedDeque *);
+
+TYPE  Deque = POINTER TO BoundedDeque;
+
+    (*--------------------*)
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+VAR   dequeError : Exceptions;
+VAR   handler    : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN dequeError;
+END DequeError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+	theError   : Exceptions (*-- in    *));
+BEGIN
+  dequeError := theError;
+  Raise(DequeComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+	theSize  : DequeSize (*-- in    *))
+	: Deque     (*-- out   *);
+
+CONST staticSize = SIZE(BoundedDeque) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newDeque : Deque;
+
+BEGIN
+  dequeError := noerr;
+  Allocate(newDeque, staticSize + itemSize * theSize);
+  IF (newDeque = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newDeque^ DO
+      dataID := theType;
+      size   := theSize;
+	  rear   := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newDeque;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedDeque) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theDeque);
+  IF (dequeError = noerr) THEN
+    Deallocate(theDeque, staticSize + itemSize * theDeque^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    WITH theDeque^ DO
+	  free := DisposeOf(dataID);
+      FOR index := MIN(DequeSize) TO rear DO
+	free(items[index]);
+      END (*--for*);
+      rear := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theDeque # toDeque) THEN
+    IF (toDeque = NIL) THEN
+      WITH theDeque^ DO
+	toDeque := Create(dataID, size);
+	  END (*--with*);
+    ELSIF (theDeque^.rear <= toDeque^.size) THEN
+      Clear(toDeque);
+      toDeque^.dataID := theDeque^.dataID;
+	ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (dequeError = noerr) THEN
+      WITH theDeque^ DO
+	    assignment := AssignOf(dataID);
+	FOR index := MIN(DequeSize) TO rear DO
+	toDeque^.items[index] := assignment(items[index]);
+	END (*--for*);
+	toDeque^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear < size) THEN
+	    CASE theEnd OF
+		  front :
+		    FOR index := rear TO MIN(DequeSize) BY -1 DO
+			  items[index + 1] := items[index];
+			END (*--for*);
+	INC(rear);
+	items[MIN(DequeSize)] := theItem;
+		| back  :
+	INC(rear);
+	items[rear] := theItem;
+		END (*--case*);
+      ELSE
+	RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear = 0) THEN
+	RaiseErrIn(depart, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+	free(items[MIN(DequeSize)]);
+	FOR index := MIN(DequeSize) + 1 TO rear DO
+	items[index - 1] := items[index];
+	END (*--for*);
+		| back  :
+	free(items[rear]);
+		END (*--case*);
+	DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+PROCEDURE Leave   (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(leave, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear = 0) THEN
+	RaiseErrIn(leave, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+		    index := MIN(DequeSize);
+		    WHILE (index <= rear) & (items[index] # theItem) DO
+		      INC(index);
+		    END (*-- while*);
+		| back  :
+		    index := rear;
+		    WHILE (index >= MIN(DequeSize)) & (items[index] # theItem) DO
+		      DEC(index);
+		    END (*-- while*);
+		END (*--case*);
+		IF (MIN(DequeSize) <= index) & (index <= rear) THEN
+	free(items[index]);
+	FOR index := index + 1 TO rear DO
+	items[index - 1] := items[index];
+	END (*--for*);
+	DEC(rear);
+		ELSE
+	RaiseErrIn(leave, notfound);
+	END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Leave;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theDeque # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN (theDeque^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+	  compare : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+	  compare := CompareOf(dataID);
+      FOR index := MIN(DequeSize) TO rear DO
+	IF compare(items[index], right^.items[index]) # equal THEN
+	RETURN FALSE;
+	END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+	END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theDeque^.items[MIN(DequeSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(rearof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(rearof, underflow);
+  ELSE
+    WITH theDeque^ DO
+      RETURN items[rear];
+	END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END RearOf;
+(*-------------------------*)
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(endof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(endof, underflow);
+  ELSE
+    WITH theDeque^ DO
+      CASE theEnd OF
+	    front : RETURN items[MIN(DequeSize)];
+	  | back  : RETURN items[rear];
+	  END (*--case*);
+	END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END EndOf;
+(*-------------------------*)
+
+PROCEDURE PositionOf (    theDeque: Deque    (*-- in    *);
+       	       		theItem : Item     (*-- in    *))
+							: CARDINAL (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(positionof, undefined);
+  ELSE
+    WITH theDeque^ DO
+      FOR index := MIN(DequeSize) TO rear DO
+	    IF (theItem = items[index]) THEN
+		  RETURN index;
+		END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+  RETURN 0;
+END PositionOf;
+(*-------------------------*)
+
+
+BEGIN
+  FOR dequeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(dequeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  dequeError := noerr;
+END DQNBSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSUMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSUMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSUMI.DEF
@@ -0,0 +1,121 @@
+(*
+15.3 Unbounded Balking Deque Interface
+*)
+
+DEFINITION MODULE DQNBSUMI;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Non-Priority Balking Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed implementation.
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+TYPE  Deque;
+TYPE  Location  = (front, back);
+CONST NullDeque = Deque(NIL);
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+CONST ModuleID = 3;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *))
+	: Deque     (*-- out   *);
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Leave   (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE PositionOf (    theDeque: Deque    (*-- in    *);
+       	       		theItem : Item     (*-- in    *))
+							: CARDINAL (*-- out   *);
+
+
+(*---------------------------------*)
+(*--	ITERATORS	--*)
+
+PROCEDURE LoopOver (    theDeque  : Deque	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+PROCEDURE Traverse (    theDeque  : Deque	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+END DQNBSUMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSUMI.MOD
@@ -0,0 +1,785 @@
+(*
+15.3 Unbounded Balking Deque Implementation
+*)
+
+IMPLEMENTATION MODULE DQNBSUMI;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Non-Priority Balking Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed implementation.
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc,
+		AccessProc, LoopAccessProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, DequeComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+15.3.1 Internal Unbounded Deque Representation
+
+For the internal representation of the unbounded deque we shal use a linked list
+of nodes with a header.  The header contains pointers to the front and back nodes of the
+deque and the current length of the deque.  Each node contains the item value, and
+pointers forward and backward to the successor and predecessor nodes respectively.
+By employing a doubly-linked list efficient insertion and removal at either end of
+the deque is facilitated, as is traversal of the deque in either direction.
+By convention, an empty deque will be represented by both the front and back
+pointers being NIL.  Figure 15.2 displays the internal structure graphically.
+
+FIGURE 15.2
+
+Representation Invariants:
+* when the deque is empty both head and tail are NIL
+*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node  = RECORD
+	prev : Link;  (*-- link to prior deque element *)
+	item : Item;  (*-- deque element's data *)
+	next : Link;  (*-- link to next deque element *)
+      END (*-- Node *);
+  
+TYPE  Deque = POINTER TO UnboundedDeque;
+
+TYPE  UnboundedDeque = RECORD
+	dataID : TypeID;    (*-- defined data type *)
+	length : CARDINAL;  (*-- current # of items *)
+	head   : Link;      (*-- link to front of deque *)
+	tail   : Link;      (*-- link to rear of deque *)
+      END (*-- UnboundedDeque *);
+
+    (*--------------------*)
+
+
+(*
+15.3.2 Exceptions
+
+dequeError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+dequeError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+15.3.6).
+
+DequeError simply returns the current exception result stored
+in dequeError and is used to determine whether a deque operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   dequeError : Exceptions;
+VAR   handler    : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN dequeError;
+END DequeError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+	theError   : Exceptions (*-- in    *));
+BEGIN
+  dequeError := theError;
+  Raise(DequeComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+15.3.3 Constructors
+
+Create attempts to form a new, empty bounded deque object associated
+with the given data type ID and maximum size.  Only the specified
+number of entries given in theSize are actually allocated to the
+ItemsArray (items).  MacSystem.Allocate returns NIL if it is unable
+to successfully complete the allocation request whereupon the overflow
+exception is raised and the NullDeque returned.  If successful, the
+deque is initialized as follows before returning the new deque:
+* theType is saved for later use by IsEqual, Clear, and Assign
+* head, tail and length are set to the empty deque state.
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *))
+	: Deque     (*-- out   *);
+
+VAR   newDeque : Deque;
+
+BEGIN
+  Allocate(newDeque, SIZE(UnboundedDeque));
+  IF (newDeque = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newDeque^ DO
+      dataID := theType;
+	  length := 0;
+	  head   := NIL;
+	  tail   := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newDeque;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theDeque rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullDeque). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+BEGIN
+  Clear(theDeque);
+  IF (dequeError = noerr) THEN
+    Deallocate(theDeque, SIZE(theDeque^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theDeque's data type, if
+any, and proceeds to free each item in theDeque.  If theDeque is empty
+the loop is not executed as head will be NIL.  Lastly, tail and length
+are set to ensure theDeque is in the empty state. Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+VAR   oldHead : Link;	(*-- node to be cleared *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    WITH theDeque^ DO
+	  free := DisposeOf(dataID);
+      WHILE (head # NIL) DO
+	oldHead := head;
+	head    := head^.next;
+	free(oldHead^.item);
+	Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      tail   := NIL;
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theDeque to the target deque, toDeque. An
+undefined source deque raises an exception and leaves the target unchanged.
+If the target deque is undefined, it is created with the same data type
+attribute of the source; otherwise the target deque is cleared of its
+present contents and its data type is altered to reflect that of the
+source.  If the source deque is not empty, Assign copies each source node
+to the target using the TailInsert routine from the doubly-linked unbounded
+list module.  TailInsert automatically sets the new node's previous link
+to the last node inserted. In order for this to work correctly last must be
+initialized to NIL.
+Complexity: O(mn), where m is the number of items in the source deque and
+n is the number of items in the target deque.
+*)
+
+PROCEDURE TailInsert(    theNode : Link (*-- inout *);
+	VAR first   : Link (*-- inout *);
+					 VAR last    : Link (*-- inout *));
+BEGIN
+  IF (first = NIL) THEN
+    first := theNode;
+  ELSE
+    last^.next := theNode;
+  END (*--if*);
+  theNode^.prev := last;
+  last := theNode;
+END TailInsert;
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+VAR   index      : Link;       (*-- loop index over source items *)
+	  newNode    : Link;       (*-- new item node for target deque *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theDeque # toDeque) THEN
+    IF (toDeque = NIL) THEN
+      toDeque := Create(theDeque^.dataID);
+    ELSE
+      Clear(toDeque);
+      toDeque^.dataID := theDeque^.dataID;
+    END (*--if*);
+    IF (dequeError = noerr) THEN
+      WITH theDeque^ DO
+	    assignment := AssignOf(dataID);
+	index := head;
+      END (*--with*);
+      WHILE (index # NIL) DO
+	Allocate(newNode, SIZE(Node));
+	    IF (newNode = NIL) THEN
+	      RaiseErrIn(assign, overflow);
+	      RETURN;
+	    END (*--if*);
+	    WITH newNode^ DO
+	item := assignment(index^.item);
+	next := NIL;
+	END (*--with*);
+	WITH toDeque^ DO
+	      TailInsert(newNode, head, tail);
+	END (*--with*);
+	index := index^.next;
+      END (*--while*);
+      toDeque^.length := theDeque^.length;
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to theEnd of theDeque by advancing the rear index
+value and storing theItem at that location.  If the routine is given an
+undefined deque the exception of the same name is raised.
+If, upon entry, the deque is already empty, a new node is attached to
+both the head and tail, regardless of the value of location.  Other-
+wise, when theEnd is the front, a new node is added in the same manner
+as the Insert operation for a doubly-linked list; when location is the back,
+the new node is added to the end of the deque using the TailInsert routine
+for a doubly-linked list. Complexity: O(1).
+*)
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   newNode : Link;
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+	item := theItem;
+	next := NIL;
+		prev := NIL;
+      END (*--with*);
+      WITH theDeque^ DO
+	INC(length);
+	IF (head = NIL) THEN
+	head := newNode;
+		  tail := newNode;
+	ELSIF (theEnd = front) THEN
+		  head^.prev := newNode;
+		  newNode^.next := head;
+		  head := newNode;
+	ELSE
+	tail^.next := newNode;
+		  newNode^.prev := tail;
+		  tail := newNode;
+	END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front or the rear of theDeque depending
+on the value of theEnd.  If the item is departing from the rear of the
+deque it is sufficient to free the item's value and decrement the rear
+index.  Otherwise, if departing from the front of the deque it is
+necessary to shift all other items down one position in the items array
+and deduct one from the rear index.  Before overwriting the item being
+removed, it's value is freed via the disposal routine of theDeque's
+data type.  If theDeque is empty on entry to Depart the underflow
+exception is raised and theDeque is not changed.  When theDeque is not
+defined, the undefined exception is raised.
+Complexity: O(1).
+*)
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   oldNode : Link;	(*-- departing node *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (head = NIL) THEN
+	RaiseErrIn(depart, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+		oldNode := head;
+	head    := head^.next;
+			IF (head # NIL) THEN
+			  head^.prev := NIL;
+			END (*--if*);
+		| back  :
+		oldNode := tail;
+			tail    := tail^.prev;
+			IF (tail # NIL) THEN
+			  tail^.next := NIL;
+			END (*--if*);
+		END (*--case*);
+	free(oldNode^.item);
+	Deallocate(oldNode, SIZE(oldNode^));
+	DEC(length);
+	IF (length = 0) THEN
+		  head := NIL;
+	tail := NIL;
+	END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+(*
+Leave removes theItem from theDeque regardless of its position within
+the deque.  When theEnd is front, the first matching item is removed
+from the deque; conversely, when theEnd is back the last it is the last
+matching item that is removed.  At the end of the search for theItem, index
+points to the node to be removed from the deque or is NIL if theItem is not
+present.
+Complexity: O(n).
+*)
+
+PROCEDURE Leave   (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : Link;	(*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(leave, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (head = NIL) THEN
+	RaiseErrIn(leave, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+		CASE theEnd OF
+		  front:
+		    index := head;
+		    WHILE (index # NIL) & (index^.item # theItem) DO
+		      index := index^.next;
+		    END (*-- while*);
+	    | back :
+		    index := tail;
+		    WHILE (index # NIL) & (index^.item # theItem) DO
+		      index := index^.prev;
+		    END (*-- while*);
+		END (*--case*);
+		IF (index # NIL) THEN
+		  WITH index^ DO
+	free(item);
+		    IF (prev # NIL) THEN
+		      prev^.next := next;
+		    END (*--if*);
+		    IF (next # NIL) THEN
+		      next^.prev := prev;
+		    END (*--if*);
+		  END (*--with*);
+		  IF (index = head) THEN
+		    head := index^.next;
+		  END (*--if*);
+		  IF (index = tail) THEN
+		    tail := index^.prev;
+		  END (*--if*);
+		  Deallocate(index, SIZE(index^));
+	DEC(length);
+		ELSE
+	RaiseErrIn(leave, notfound);
+	END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Leave;
+(*-------------------------*)
+
+
+(*
+15.3.4 Selectors
+
+IsDefined verifies to the best of its ability whether theDeque has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theDeque # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theDeque is in the empty state, as indicated by
+the rear being zero, and False otherwise.  As per the specification
+(section 9.4) undefined deques are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN (theDeque^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right deques for equality, which in this
+context means they contain the same items and the same data type ID. The
+defined size of the deques is not relevant for the equality test.  Both
+deques must be defined and have the same data type ID; if they don not,
+then the exceptions undefined and typeerror are raised, respectively.
+Obviously, deques of different lengths (indicated by the value of rear)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both deques
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them.
+Complexity: O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+VAR   leftIndex  : Link;  (*-- loop index of left deque *)
+      rightIndex : Link;  (*-- loop index of right deque *)
+	  compare    : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+	compare := CompareOf(left^.dataID);
+    leftIndex  := left^.head;
+    rightIndex := right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF (rightIndex = NIL) OR 
+	  	 (compare(leftIndex^.item, rightIndex^.item) # equal) THEN
+	RETURN FALSE;
+      END (*--if*);
+      leftIndex := leftIndex^.next;
+      rightIndex:= rightIndex^.next;
+    END (*--while*);
+    RETURN (rightIndex = NIL);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the length stored in the deque header. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+TypeOf simply returns the dataID for the given deque. Undefined deques,
+as always, raise the undefined exception and return a reasonable value,
+in this case the NullType. Complexity O(1).
+*)
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the front of theDeque
+or the NullItem if theDeque is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theDeque^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theDeque^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+(*
+RearOf returns the value of the item that is at the rear of theDeque
+or the NullItem if theDeque is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(rearof, undefined);
+  ELSIF (theDeque^.tail = NIL) THEN
+    RaiseErrIn(rearof, underflow);
+  ELSE
+    RETURN theDeque^.tail^.item;
+  END (*--if*);
+  RETURN NullItem;
+END RearOf;
+(*-------------------------*)
+
+(*
+EndOf returns the value of the item that is at the given end of theDeque
+(front or rear) or the NullItem if theDeque is undefined or is empty.
+Complexity: O(1).
+*)
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(endof, undefined);
+  ELSIF (theDeque^.head = NIL) THEN
+    RaiseErrIn(endof, underflow);
+  ELSIF (theEnd = front) THEN
+	RETURN theDeque^.head^.item;
+  ELSE
+	RETURN theDeque^.tail^.item;
+  END (*--if*);
+  RETURN NullItem;
+END EndOf;
+(*-------------------------*)
+
+(*
+PositionOf returns the number of positions from the given item to the
+front of the deque where the front is considered position one (1).
+If theItem is not present in theDeque then zero is returned.
+Complexity O(n).
+*)
+
+PROCEDURE PositionOf (    theDeque: Deque    (*-- in    *);
+       	       		theItem : Item     (*-- in    *))
+							: CARDINAL (*-- out   *);
+
+VAR   index : Link;     (*-- loop index over items *)
+      count : CARDINAL; (*-- running value of position *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(positionof, undefined);
+  ELSE
+    count := 1;
+	index := theDeque^.head;
+    WHILE (index # NIL) DO
+	  IF (theItem = index^.item) THEN
+		RETURN count;
+      END (*--if*);
+	  INC(count);
+	  index := index^.next;
+    END (*--while*);
+  END (*--if*);
+  RETURN 0;
+END PositionOf;
+(*-------------------------*)
+
+
+(*
+15.3.5 Iterators
+
+Both LoopOver and Traverse simply loop through each of the deque items
+passing the item value to theProcess procedure parameter. The direction
+of the iteration is controlled by theEnd parameter and is from the front
+to the rear when theEnd is front and the reverse when theEnd is rear.
+LoopOver may terminate before reaching the opposite end if theProcess
+returns False. Complexity: O(n).
+*)
+
+PROCEDURE LoopOver (    theDeque  : Deque	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSIF (theEnd = front) THEN
+	index := theDeque^.head;
+    WHILE (index # NIL) DO
+      IF ~theProcess(index^.item) THEN
+		RETURN;
+	  END (*--if*);
+	  index := index^.next;
+    END (*--while*);
+  ELSIF (theEnd = back) THEN
+	index := theDeque^.tail;
+    WHILE (index # NIL) DO
+      IF ~theProcess(index^.item) THEN
+		RETURN;
+	  END (*--if*);
+	  index := index^.prev;
+    END (*--while*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theDeque  : Deque	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSIF (theEnd = front) THEN
+	index := theDeque^.head;
+    WHILE (index # NIL) DO
+      theProcess(index^.item);
+	  index := index^.next;
+    END (*--while*);
+  ELSIF (theEnd = back) THEN
+	index := theDeque^.tail;
+    WHILE (index # NIL) DO
+      theProcess(index^.item);
+	  index := index^.prev;
+    END (*--while*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*
+15.3.6 Module Initialization
+
+The module's local variables are initialized to known states.
+dequeError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, dequeError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR dequeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(dequeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  dequeError := noerr;
+END DQNBSUMI.
+
+(*
+References
+
+
+[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983, pp. 56-60.
+[2] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+   	Benjamin/Cummings, Menlo Park, CA 1987, pp. 92-93, 142-153.
+[3] K. John Gough, "Writing Generic Utilities in Modula-2", Journal of
+    Pascal, Ada, and Modula-2, Vol. 5(3), (May/June 1986), pp 53-62.
+[4] T.A. Standish, Data Structure Techniques, Chapter 2: Stacks and Queues,
+    Addison-Wesley, Reading, MA 1980, pp. 20-23, 28-32.
+[5] R.S. Wiener and G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons, New York, NY 1985, pp. 247-253
+[6] R.S. Wiener and R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986, pp. 69-71
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSUMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSUMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSUMN.DEF
@@ -0,0 +1,105 @@
+DEFINITION MODULE DQNBSUMN;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Non-Priority Balking Sequential Unbounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+TYPE  Deque;
+TYPE  Location  = (front, back);
+CONST NullDeque = Deque(NIL);
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+CONST ModuleID = 4;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *))
+	: Deque     (*-- out   *);
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Leave   (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE PositionOf (    theDeque: Deque    (*-- in    *);
+       	       		theItem : Item     (*-- in    *))
+							: CARDINAL (*-- out   *);
+
+END DQNBSUMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSUMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSUMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQNBSUMN.MOD
@@ -0,0 +1,524 @@
+IMPLEMENTATION MODULE DQNBSUMN;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Non-Priority Balking Sequential Unbounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, DequeComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node  = RECORD
+	prev : Link;  (*-- link to prior deque element *)
+	item : Item;  (*-- deque element's data *)
+	next : Link;  (*-- link to next deque element *)
+      END (*-- Node *);
+  
+TYPE  Deque = POINTER TO UnboundedDeque;
+
+TYPE  UnboundedDeque = RECORD
+	dataID : TypeID;    (*-- defined data type *)
+	length : CARDINAL;  (*-- current # of items *)
+	head   : Link;      (*-- link to front of deque *)
+	tail   : Link;      (*-- link to rear of deque *)
+      END (*-- UnboundedDeque *);
+
+    (*--------------------*)
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+VAR   dequeError : Exceptions;
+VAR   handler    : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN dequeError;
+END DequeError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+	theError   : Exceptions (*-- in    *));
+BEGIN
+  dequeError := theError;
+  Raise(DequeComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *))
+	: Deque     (*-- out   *);
+
+VAR   newDeque : Deque;
+
+BEGIN
+  Allocate(newDeque, SIZE(UnboundedDeque));
+  IF (newDeque = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newDeque^ DO
+      dataID := theType;
+	  length := 0;
+	  head   := NIL;
+	  tail   := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newDeque;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+BEGIN
+  Clear(theDeque);
+  IF (dequeError = noerr) THEN
+    Deallocate(theDeque, SIZE(theDeque^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+VAR   oldHead : Link;	(*-- node to be cleared *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    WITH theDeque^ DO
+	  free := DisposeOf(dataID);
+      WHILE (head # NIL) DO
+	oldHead := head;
+	head    := head^.next;
+	free(oldHead^.item);
+	Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      tail   := NIL;
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE TailInsert(    theNode : Link (*-- inout *);
+	VAR first   : Link (*-- inout *);
+					 VAR last    : Link (*-- inout *));
+BEGIN
+  IF (first = NIL) THEN
+    first := theNode;
+  ELSE
+    last^.next := theNode;
+  END (*--if*);
+  theNode^.prev := last;
+  last := theNode;
+END TailInsert;
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+VAR   index      : Link;       (*-- loop index over source items *)
+	  newNode    : Link;       (*-- new item node for target deque *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theDeque # toDeque) THEN
+    IF (toDeque = NIL) THEN
+      toDeque := Create(theDeque^.dataID);
+    ELSE
+      Clear(toDeque);
+      toDeque^.dataID := theDeque^.dataID;
+    END (*--if*);
+    IF (dequeError = noerr) THEN
+      WITH theDeque^ DO
+	    assignment := AssignOf(dataID);
+	index := head;
+      END (*--with*);
+      WHILE (index # NIL) DO
+	Allocate(newNode, SIZE(Node));
+	    IF (newNode = NIL) THEN
+	      RaiseErrIn(assign, overflow);
+	      RETURN;
+	    END (*--if*);
+	    WITH newNode^ DO
+	item := assignment(index^.item);
+	next := NIL;
+	END (*--with*);
+	WITH toDeque^ DO
+	      TailInsert(newNode, head, tail);
+	END (*--with*);
+	index := index^.next;
+      END (*--while*);
+      toDeque^.length := theDeque^.length;
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   newNode : Link;
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+	item := theItem;
+	next := NIL;
+		prev := NIL;
+      END (*--with*);
+      WITH theDeque^ DO
+	INC(length);
+	IF (head = NIL) THEN
+	head := newNode;
+		  tail := newNode;
+	ELSIF (theEnd = front) THEN
+		  head^.prev := newNode;
+		  newNode^.next := head;
+		  head := newNode;
+	ELSE
+	tail^.next := newNode;
+		  newNode^.prev := tail;
+		  tail := newNode;
+	END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   oldNode : Link;	(*-- departing node *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (head = NIL) THEN
+	RaiseErrIn(depart, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+		oldNode := head;
+	head    := head^.next;
+			IF (head # NIL) THEN
+			  head^.prev := NIL;
+			END (*--if*);
+		| back  :
+		oldNode := tail;
+			tail    := tail^.prev;
+			IF (tail # NIL) THEN
+			  tail^.next := NIL;
+			END (*--if*);
+		END (*--case*);
+	free(oldNode^.item);
+	Deallocate(oldNode, SIZE(oldNode^));
+	DEC(length);
+	IF (length = 0) THEN
+		  head := NIL;
+	tail := NIL;
+	END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+PROCEDURE Leave   (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : Link;	(*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(leave, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (head = NIL) THEN
+	RaiseErrIn(leave, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+		CASE theEnd OF
+		  front:
+		    index := head;
+		    WHILE (index # NIL) & (index^.item # theItem) DO
+		      index := index^.next;
+		    END (*-- while*);
+	    | back :
+		    index := tail;
+		    WHILE (index # NIL) & (index^.item # theItem) DO
+		      index := index^.prev;
+		    END (*-- while*);
+		END (*--case*);
+		IF (index # NIL) THEN
+		  WITH index^ DO
+	free(item);
+		    IF (prev # NIL) THEN
+		      prev^.next := next;
+		    END (*--if*);
+		    IF (next # NIL) THEN
+		      next^.prev := prev;
+		    END (*--if*);
+		  END (*--with*);
+		  IF (index = head) THEN
+		    head := index^.next;
+		  END (*--if*);
+		  IF (index = tail) THEN
+		    tail := index^.prev;
+		  END (*--if*);
+		  Deallocate(index, SIZE(index^));
+	DEC(length);
+		ELSE
+	RaiseErrIn(leave, notfound);
+	END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Leave;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theDeque # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN (theDeque^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+VAR   leftIndex  : Link;  (*-- loop index of left deque *)
+      rightIndex : Link;  (*-- loop index of right deque *)
+	  compare    : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+	compare := CompareOf(left^.dataID);
+    leftIndex  := left^.head;
+    rightIndex := right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF (rightIndex = NIL) OR 
+	     (compare(leftIndex^.item, rightIndex^.item) # equal) THEN
+	RETURN FALSE;
+      END (*--if*);
+      leftIndex := leftIndex^.next;
+      rightIndex:= rightIndex^.next;
+    END (*--while*);
+    RETURN (rightIndex = NIL);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theDeque^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theDeque^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(rearof, undefined);
+  ELSIF (theDeque^.tail = NIL) THEN
+    RaiseErrIn(rearof, underflow);
+  ELSE
+    RETURN theDeque^.tail^.item;
+  END (*--if*);
+  RETURN NullItem;
+END RearOf;
+(*-------------------------*)
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(endof, undefined);
+  ELSIF (theDeque^.head = NIL) THEN
+    RaiseErrIn(endof, underflow);
+  ELSIF (theEnd = front) THEN
+	RETURN theDeque^.head^.item;
+  ELSE
+	RETURN theDeque^.tail^.item;
+  END (*--if*);
+  RETURN NullItem;
+END EndOf;
+(*-------------------------*)
+
+PROCEDURE PositionOf (    theDeque: Deque    (*-- in    *);
+       	       		theItem : Item     (*-- in    *))
+							: CARDINAL (*-- out   *);
+
+VAR   index : Link;     (*-- loop index over items *)
+      count : CARDINAL; (*-- running value of position *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(positionof, undefined);
+  ELSE
+    count := 1;
+	index := theDeque^.head;
+    WHILE (index # NIL) DO
+	  IF (theItem = index^.item) THEN
+		RETURN count;
+      END (*--if*);
+	  INC(count);
+	  index := index^.next;
+    END (*--while*);
+  END (*--if*);
+  RETURN 0;
+END PositionOf;
+(*-------------------------*)
+
+
+BEGIN
+  FOR dequeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(dequeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  dequeError := noerr;
+END DQNBSUMN.
+
+(*
+References
+
+
+[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983, pp. 56-60.
+[2] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+   	Benjamin/Cummings, Menlo Park, CA 1987, pp. 92-93, 142-153.
+[3] K. John Gough, "Writing Generic Utilities in Modula-2", Journal of
+    Pascal, Ada, and Modula-2, Vol. 5(3), (May/June 1986), pp 53-62.
+[4] T.A. Standish, Data Structure Techniques, Chapter 2: Stacks and Queues,
+    Addison-Wesley, Reading, MA 1980, pp. 20-23, 28-32.
+[5] R.S. Wiener and G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons, New York, NY 1985, pp. 247-253
+[6] R.S. Wiener and R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986, pp. 69-71
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSBMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSBMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSBMI.DEF
@@ -0,0 +1,185 @@
+(*
+16.1 Bounded Priority Balking Deque Interface
+*)
+
+DEFINITION MODULE DQPBSBMI;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Priority Balking Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+(*
+16.1.1 Type Declarations
+
+A deque is declared as the abstract data type, Deque.  In the bounded
+form presented here a deque is limited to a maximum size of 8100
+items.  Since the deque insertion and removal operations, Arrive and
+Depart, may occur at either the front or the back of the deque the
+enumeration Location is declared to represent these choices.
+
+An item's priority is declared as a generic entity, allowing the client
+module to have priorities of any complexity.  All that is needed for
+the priority form of deque is the ability to retrieve an item's priority
+and to compare priorities for the relational ordering between them.
+*)
+
+TYPE  Deque;
+TYPE  DequeSize = [1..8100];
+TYPE  Location  = (front, back);
+CONST NullDeque = Deque(NIL);
+
+TYPE  Priority;
+TYPE  PriorityProc    = PROCEDURE (Item) : Priority;
+TYPE  PriorityCompare = PROCEDURE (Priority, Priority) : Relation;
+
+
+(*
+16.1.2 Exceptions
+
+The ModuleID uniquely identifies this module from all others.
+
+DequeError returns the most recent deque exception, or noerr if the
+last operation was successful.  While SetHandler and GetHandler allow
+assignment and retrieval of exception handling routines for specific
+exceptions.
+*)
+
+CONST ModuleID = 5;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+
+(*
+16.1.3 Constructors
+
+The constructor Create has been changed from the non-priority
+non-balking form of queue to accomodate procedure parameters to (1)
+retrieve the priority for an item, and (2) compare two priorities.
+
+An additional constructor, Leave, has been added to implement the
+actual balking mechanism.  The difference between this version of
+Leave and the queue version is the addition of the parameter theEnd.
+This is done for consistency with the Arrive and Depart operations.
+
+All other constructors remain unchanged from the non-priority
+non-balking form of deque.
+*)
+
+PROCEDURE Create  (    theType    : TypeID	(*-- in    *);
+	theSize    : DequeSize       (*-- in    *);
+					   priorityOf : PriorityProc    (*-- in    *);
+					   comparison : PriorityCompare (*-- in    *))
+	: Deque	(*-- out   *);
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Leave   (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+
+(*
+16.1.4 Selectors
+
+All of the selector interfaces are unchanged from the non-priority
+non-balking form of deque.
+
+An additional selector has been added, PositionOf, that returns the
+number of positions from the given item from the front of the queue. If
+theItem is not present in theDeque then zero is returned.  Note that
+the position is always from the front of the deque as the position
+from the back can be easily calculated by the client.
+*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE PositionOf (    theDeque: Deque    (*-- in    *);
+       	       		theItem : Item     (*-- in    *))
+							: CARDINAL (*-- out   *);
+
+
+(*
+16.1.5 Iterators
+
+The interfaces to both iterators are unchanged from the non-priority
+non-balking form of deque.
+*)
+
+PROCEDURE LoopOver (    theDeque  : Deque	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+PROCEDURE Traverse (    theDeque  : Deque	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+END DQPBSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSBMI.MOD
@@ -0,0 +1,771 @@
+IMPLEMENTATION MODULE DQPBSBMI;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Priority Balking Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM SYSTEM IMPORT
+    (*--Type*) ADDRESS;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc,
+		AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, DequeComponentID;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+13.3.1 Internal Bounded Priority Balking Deque Representation
+
+A dynamically created array of Items is created when a deque
+is created. The front of the deque is always accessible by the
+index [1].  The header record is used to hold the deque size limit (size),
+the current rear index (rear), data type id (dataID), the procedures 
+to retrieve and compare item priorities (priority and compare,
+respectively), and the dynamic array of items (items).
+Items are stored in a linear fashion within the array ordered by priority
+with higher priority items closer to the front of the deque. This means
+that the items are sorted in descending priority order.
+Figure 13.1, below, graphically depicts the internal structure used 
+for the bounded deque:
+
+FIGURE 13.1
+
+Representation Invariants:
+* MIN(DequeSize) <= size <= MAX(DequeSize)
+* 0 <= rear <= size
+* the deque is empty when rear is zero
+* when not empty, the front of the deque is at items[MIN(DequeSize)]
+*)
+
+TYPE  Priority = ADDRESS;  (*-- any 4-byte value will do *)
+
+TYPE  ItemsArray   = ARRAY DequeSize OF Item;
+TYPE  BoundedDeque = RECORD
+	dataID   : TypeID;	(*-- defined data type *)
+		priority : PriorityProc;    (*-- retrieve priority *)
+		compare  : PriorityCompare; (*-- compare priorities *)
+	size     : CARDINAL;	(*-- maximum # of items *)
+	rear     : CARDINAL;	(*-- current # of items *)
+	items    : ItemsArray;      (*-- array [1..size] of item *)
+      END (*-- BoundedDeque *);
+
+TYPE  Deque = POINTER TO BoundedDeque;
+
+    (*--------------------*)
+
+
+(*
+13.3.2 Exceptions
+
+dequeError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+dequeError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+13.3.6).
+
+DequeError simply returns the current exception result stored
+in dequeError and is used to determine whether a deque operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   dequeError : Exceptions;
+VAR   handler    : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN dequeError;
+END DequeError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+	theError   : Exceptions (*-- in    *));
+BEGIN
+  dequeError := theError;
+  Raise(DequeComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+13.3.3 Constructors
+
+Create attempts to form a new, empty bounded deque object associated
+with the given data type ID, maximum size, priority retrieval and
+priority comparison routines.  Only the specified
+number of entries given in theSize are actually allocated to the
+ItemsArray (items).  MacSystem.Allocate returns NIL if it is unable
+to successfully complete the allocation request whereupon the overflow
+exception is raised and the NullDeque returned.  If successful, the
+deque is initialized as follows before returning the new deque:
+* theType is saved for later use by IsEqual,
+* theSize is saved for later checking for deque overflow by Arrive and Assign, and
+* rear is set to the empty deque state.
+* the procedure parameters for priorities are saved for use in Arrive
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType    : TypeID	(*-- in    *);
+	theSize    : DequeSize       (*-- in    *);
+					   priorityOf : PriorityProc    (*-- in    *);
+					   comparison : PriorityCompare (*-- in    *))
+	: Deque	(*-- out   *);
+
+CONST staticSize = SIZE(BoundedDeque) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newDeque : Deque;
+
+BEGIN
+  dequeError := noerr;
+  Allocate(newDeque, staticSize + itemSize * theSize);
+  IF (newDeque = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newDeque^ DO
+      dataID   := theType;
+	  priority := priorityOf;
+	  compare  := comparison;
+      size     := theSize;
+	  rear     := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newDeque;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theDeque rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullDeque). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedDeque) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theDeque);
+  IF (dequeError = noerr) THEN
+    Deallocate(theDeque, staticSize + itemSize * theDeque^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theDeque's data type, if
+any, and proceeds to free each item in theDeque.  If theDeque is empty
+the loop is not executed as rear will be greater than the minimum
+DequeSize.  Lastly, rear is set to ensure theDeque is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    WITH theDeque^ DO
+	  free := DisposeOf(dataID);
+      FOR index := MIN(DequeSize) TO rear DO
+	free(items[index]);
+      END (*--for*);
+      rear := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theDeque to the target deque, toDeque. An
+undefined source deque raised an exception and leaves the target unchanged.
+If the target deque is undefined, it is created with the same size and
+data type attributes of the source; otherwise the target deque is
+cleared of its presnet contents and its data type is altered to reflect
+that of the source.  If the target deque is capable of containing all
+of the items present in the source, Assign simply copies each item from
+the source to the target afterwards updating the target's rear value.
+Complexity: O(mn).
+*)
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theDeque # toDeque) THEN
+    IF (toDeque = NIL) THEN
+      WITH theDeque^ DO
+	toDeque := Create(dataID, size, priority, compare);
+	  END (*--with*);
+    ELSIF (theDeque^.rear <= toDeque^.size) THEN
+      Clear(toDeque);
+      WITH theDeque^ DO
+	toDeque^.dataID   := dataID;
+		toDeque^.priority := priority;
+		toDeque^.compare  := compare;
+	  END (*--with*);
+	ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (dequeError = noerr) THEN
+      WITH theDeque^ DO
+	    assignment := AssignOf(dataID);
+	FOR index := MIN(DequeSize) TO rear DO
+	toDeque^.items[index] := assignment(items[index]);
+	END (*--for*);
+	toDeque^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem into its proper position within the items array based
+on its priority and theEnd which controls how items of like priority
+are ordered relative to one another. 
+
+A precondition is that the array be sorted in descending sequence by
+priority and the corresponding postcondition is the same.
+Also, there may be more than one item with the same priority.
+The algorithm used is a variation on 3.2 Sorted Array Search by Gonnet
+[2, pp. 31-32].  This search goes from the back of the deque towards
+the front shifting items up into higher index positions within the
+items array as it searches for the proper location for the insertion.
+When theItem arrives at the rear of theDeque the search/shift must
+stop when the next item in the array has a priority greater than or equal
+to the given item's priority.  When theItem arrives at the front of
+theDeque the search/shift must stop when the next item in the array
+has a priority greater than the given item's priority.
+
+When the rear of theDeque is already at its maximum allowed size the
+exception overflow is raised and theDeque remains unchanged.  Likewise,
+given an undefined deque raises the exception of the same name.
+Complexity: O(n).
+*)
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      itemPriority : Priority; (*-- theItem's priority *)
+	  priorityOrder: Relation; (*-- ordering between priorities *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear < size) THEN
+	    itemPriority := priority(theItem);
+	    index := rear;
+	INC(rear);
+		LOOP
+		  IF (index > 0) THEN
+		    priorityOrder := compare(priority(items[index]),
+				itemPriority);
+		IF (theEnd = front) THEN
+		      IF (priorityOrder = greater) THEN
+			EXIT (*--loop*);
+			  ELSE
+			    items[index + 1] := items[index];
+			    DEC(index);
+		      END (*--if*);
+			ELSIF (priorityOrder # less) THEN
+		      EXIT (*--loop*);
+			ELSE
+			  items[index + 1] := items[index];
+			  DEC(index);
+		    END (*--if*);
+		  ELSE
+		    EXIT (*--loop*);
+		  END (*--if*);
+		END (*--loop*);
+	items[index + 1] := theItem;
+      ELSE
+	RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front or the rear of theDeque depending
+on the value of theEnd.  If the item is departing from the rear of the
+deque it is sufficient to free the item's value and decrement the rear
+index.  Otherwise, if departing from the front of the deque it is
+necessary to shift all other items down one position in the items array
+and deduct one from the rear index.  Before overwriting the item being
+removed, it's value is freed via the disposal routine of theDeque's
+data type.  If theDeque is empty on entry to Depart the underflow
+exception is raised and theDeque is not changed.  When theDeque is not
+defined, the undefined exception is raised.
+Complexity: Front O(n), Rear O(1).
+*)
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear = 0) THEN
+	RaiseErrIn(depart, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+	free(items[MIN(DequeSize)]);
+	FOR index := MIN(DequeSize) + 1 TO rear DO
+	items[index - 1] := items[index];
+	END (*--for*);
+		| back  :
+	free(items[rear]);
+		END (*--case*);
+	DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+(*
+Leave removes theItem from theDeque regardless of its position within
+the deque.  The key to the implementation is the search mechanism for
+theItem.  When theEnd is front the search extends from there towards
+the back, and the reverse when theEnd is back.  If theItem was found
+index will point into the items array at theItem, otherwise index will
+be > rear on a search from the front and zero on a search from the back.
+Complexity: O(n).
+*)
+
+PROCEDURE Leave   (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(leave, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear = 0) THEN
+	RaiseErrIn(leave, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+		    index := MIN(DequeSize);
+		    WHILE (index <= rear) & (items[index] # theItem) DO
+		      INC(index);
+		    END (*-- while*);
+		| back  :
+		    index := rear;
+		    WHILE (index >= MIN(DequeSize)) & (items[index] # theItem) DO
+		      DEC(index);
+		    END (*-- while*);
+		END (*--case*);
+		IF (MIN(DequeSize) <= index) & (index <= rear) THEN
+	free(items[index]);
+	FOR index := index + 1 TO rear DO
+	items[index - 1] := items[index];
+	END (*--for*);
+	DEC(rear);
+		ELSE
+	RaiseErrIn(leave, notfound);
+	END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Leave;
+(*-------------------------*)
+
+
+(*
+13.3.4 Selectors
+
+IsDefined verifies to the best of its ability whether theDeque has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theDeque # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theDeque is in the empty state, as indicated by
+the rear being zero, and False otherwise.  As per the specification
+(section 8.?) undefined deques are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN (theDeque^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right deques for equality, which in this
+context means they contain the same items and the same data type ID. The
+defined size of the deques is not relevant for the equality test.  Both
+deques must be defined and have the same data type ID; if they don not,
+then the exceptions undefined and typeerror are raised, respectively.
+Obviously, deques of different lengths (indicated by the value of rear)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both deques
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them.
+Complexity: O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+VAR   index   : CARDINAL; (*-- loop index over items *)
+	  compareItems : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+	  compareItems := CompareOf(dataID);
+      FOR index := MIN(DequeSize) TO rear DO
+	IF compareItems(items[index], right^.items[index]) # equal THEN
+	RETURN FALSE;
+	END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+	END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the rear index into the items array which is
+also the length of theDeque. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+SizeOf and TypeOf simply return the size and dataID for the given deque.
+Undefined deques, as always, raise the undefined exception and return
+reasonable values (zero and the NullType, respectively). The complexity
+of both routines is O(1).
+*)
+
+PROCEDURE SizeOf    (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the front of theDeque
+or the NullItem if theDeque is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theDeque^.items[MIN(DequeSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+(*
+RearOf returns the value of the item that is at the rear of theDeque
+or the NullItem if theDeque is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(rearof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(rearof, underflow);
+  ELSE
+    WITH theDeque^ DO
+      RETURN items[rear];
+	END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END RearOf;
+(*-------------------------*)
+
+(*
+EndOf returns the value of the item that is at the given end of theDeque
+(front or rear) or the NullItem if theDeque is undefined or is empty.
+Complexity: O(1).
+*)
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(endof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(endof, underflow);
+  ELSE
+    WITH theDeque^ DO
+      CASE theEnd OF
+	    front : RETURN items[MIN(DequeSize)];
+	  | back  : RETURN items[rear];
+	  END (*--case*);
+	END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END EndOf;
+(*-------------------------*)
+
+(*
+PositionOf returns the number of positions from the given item from the
+front of the deque. If theItem is not present in theDeque then zero
+is returned. Complexity O(n).
+*)
+
+PROCEDURE PositionOf (    theDeque: Deque    (*-- in    *);
+       	       		theItem : Item     (*-- in    *))
+							: CARDINAL (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(positionof, undefined);
+  ELSE
+    WITH theDeque^ DO
+      FOR index := MIN(DequeSize) TO rear DO
+	    IF (theItem = items[index]) THEN
+		  RETURN index;
+		END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+  RETURN 0;
+END PositionOf;
+(*-------------------------*)
+
+
+(*
+13.3.5 Iterators
+
+Both LoopOver and Traverse simply loop through each of the deque items
+passing the item value to theProcess procedure parameter. The direction
+of the iteration is controlled by theEnd parameter and is from the front
+to the rear when theEnd is front and the reverse when theEnd is rear.
+LoopOver may terminate before reaching the opposite end if theProcess
+returns False. Complexity: O(n).
+*)
+
+PROCEDURE LoopOver (    theDeque  : Deque	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theDeque^ DO
+      CASE theEnd OF
+	    front :
+	FOR index := MIN(DequeSize) TO rear DO
+	IF ~theProcess(items[index]) THEN
+	RETURN;
+	END (*--if*);
+	END (*--for*);
+	  | back  :
+	FOR index := rear TO MIN(DequeSize) BY -1 DO
+	IF ~theProcess(items[index]) THEN
+	RETURN;
+	END (*--if*);
+	END (*--for*);
+	  END (*--case*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theDeque  : Deque	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theDeque^ DO
+      CASE theEnd OF
+	    front :
+	FOR index := MIN(DequeSize) TO rear DO
+	theProcess(items[index]);
+	END (*--for*);
+	  | back  :
+	FOR index := rear TO MIN(DequeSize) BY -1 DO
+	theProcess(items[index]);
+	END (*--for*);
+	  END (*--case*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*
+13.3.6 Module Initialization
+
+The module's local variables are initialized to known states.
+dequeError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.
+
+Since a FOR loop control variable is undefined following the loop,
+dequeError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR dequeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(dequeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  dequeError := noerr;
+END DQPBSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSBMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSBMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSBMN.DEF
@@ -0,0 +1,119 @@
+DEFINITION MODULE DQPBSBMN;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Priority Balking Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+TYPE  Deque;
+TYPE  DequeSize = [1..8100];
+TYPE  Location  = (front, back);
+CONST NullDeque = Deque(NIL);
+
+TYPE  Priority;
+TYPE  PriorityProc    = PROCEDURE (Item) : Priority;
+TYPE  PriorityCompare = PROCEDURE (Priority, Priority) : Relation;
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+CONST ModuleID = 6;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType    : TypeID	(*-- in    *);
+	theSize    : DequeSize       (*-- in    *);
+					   priorityOf : PriorityProc    (*-- in    *);
+					   comparison : PriorityCompare (*-- in    *))
+	: Deque	(*-- out   *);
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Leave   (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE PositionOf (    theDeque: Deque    (*-- in    *);
+       	       		theItem : Item     (*-- in    *))
+							: CARDINAL (*-- out   *);
+
+END DQPBSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSBMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSBMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSBMN.MOD
@@ -0,0 +1,492 @@
+IMPLEMENTATION MODULE DQPBSBMN;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Priority Balking Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM SYSTEM IMPORT
+    (*--Type*) ADDRESS;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, DequeComponentID;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+
+TYPE  Priority = ADDRESS;
+
+TYPE  ItemsArray   = ARRAY DequeSize OF Item;
+TYPE  BoundedDeque = RECORD
+	dataID   : TypeID;	(*-- defined data type *)
+		priority : PriorityProc;    (*-- retrieve priority *)
+		compare  : PriorityCompare; (*-- compare priorities *)
+	size     : CARDINAL;	(*-- maximum # of items *)
+	rear     : CARDINAL;	(*-- current # of items *)
+	items    : ItemsArray;      (*-- array [1..size] of item *)
+      END (*-- BoundedDeque *);
+
+TYPE  Deque = POINTER TO BoundedDeque;
+
+    (*--------------------*)
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+VAR   dequeError : Exceptions;
+VAR   handler    : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN dequeError;
+END DequeError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+	theError   : Exceptions (*-- in    *));
+BEGIN
+  dequeError := theError;
+  Raise(DequeComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType    : TypeID	(*-- in    *);
+	theSize    : DequeSize       (*-- in    *);
+					   priorityOf : PriorityProc    (*-- in    *);
+					   comparison : PriorityCompare (*-- in    *))
+	: Deque	(*-- out   *);
+
+CONST staticSize = SIZE(BoundedDeque) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newDeque : Deque;
+
+BEGIN
+  dequeError := noerr;
+  Allocate(newDeque, staticSize + itemSize * theSize);
+  IF (newDeque = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newDeque^ DO
+      dataID   := theType;
+	  priority := priorityOf;
+	  compare  := comparison;
+      size     := theSize;
+	  rear     := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newDeque;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedDeque) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theDeque);
+  IF (dequeError = noerr) THEN
+    Deallocate(theDeque, staticSize + itemSize * theDeque^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    WITH theDeque^ DO
+	  free := DisposeOf(dataID);
+      FOR index := MIN(DequeSize) TO rear DO
+	free(items[index]);
+      END (*--for*);
+      rear := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theDeque # toDeque) THEN
+    IF (toDeque = NIL) THEN
+      WITH theDeque^ DO
+	toDeque := Create(dataID, size, priority, compare);
+	  END (*--with*);
+    ELSIF (theDeque^.rear <= toDeque^.size) THEN
+      Clear(toDeque);
+      WITH theDeque^ DO
+	toDeque^.dataID   := dataID;
+		toDeque^.priority := priority;
+		toDeque^.compare  := compare;
+	  END (*--with*);
+	ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (dequeError = noerr) THEN
+      WITH theDeque^ DO
+	    assignment := AssignOf(dataID);
+	FOR index := MIN(DequeSize) TO rear DO
+	toDeque^.items[index] := assignment(items[index]);
+	END (*--for*);
+	toDeque^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      itemPriority : Priority; (*-- theItem's priority *)
+	  priorityOrder: Relation; (*-- ordering between priorities *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear < size) THEN
+	    itemPriority := priority(theItem);
+	    index := rear;
+	INC(rear);
+		LOOP
+		  IF (index > 0) THEN
+		    priorityOrder := compare(priority(items[index]),
+				itemPriority);
+		IF (theEnd = front) THEN
+		      IF (priorityOrder = greater) THEN
+			EXIT (*--loop*);
+			  ELSE
+			    items[index + 1] := items[index];
+			    DEC(index);
+		      END (*--if*);
+			ELSIF (priorityOrder # less) THEN
+		      EXIT (*--loop*);
+			ELSE
+			  items[index + 1] := items[index];
+			  DEC(index);
+		    END (*--if*);
+		  ELSE
+		    EXIT (*--loop*);
+		  END (*--if*);
+		END (*--loop*);
+	items[index + 1] := theItem;
+      ELSE
+	RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear = 0) THEN
+	RaiseErrIn(depart, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+	free(items[MIN(DequeSize)]);
+	FOR index := MIN(DequeSize) + 1 TO rear DO
+	items[index - 1] := items[index];
+	END (*--for*);
+		| back  :
+	free(items[rear]);
+		END (*--case*);
+	DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+PROCEDURE Leave   (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(leave, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear = 0) THEN
+	RaiseErrIn(leave, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+		    index := MIN(DequeSize);
+		    WHILE (index <= rear) & (items[index] # theItem) DO
+		      INC(index);
+		    END (*-- while*);
+		| back  :
+		    index := rear;
+		    WHILE (index >= MIN(DequeSize)) & (items[index] # theItem) DO
+		      DEC(index);
+		    END (*-- while*);
+		END (*--case*);
+		IF (MIN(DequeSize) <= index) & (index <= rear) THEN
+	free(items[index]);
+	FOR index := index + 1 TO rear DO
+	items[index - 1] := items[index];
+	END (*--for*);
+	DEC(rear);
+		ELSE
+	RaiseErrIn(leave, notfound);
+	END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Leave;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theDeque # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN (theDeque^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+VAR   index   : CARDINAL; (*-- loop index over items *)
+	  compareItems : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+	  compareItems := CompareOf(dataID);
+      FOR index := MIN(DequeSize) TO rear DO
+	IF compareItems(items[index], right^.items[index]) # equal THEN
+	RETURN FALSE;
+	END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+	END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theDeque^.items[MIN(DequeSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(rearof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(rearof, underflow);
+  ELSE
+    WITH theDeque^ DO
+      RETURN items[rear];
+	END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END RearOf;
+(*-------------------------*)
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(endof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(endof, underflow);
+  ELSE
+    WITH theDeque^ DO
+      CASE theEnd OF
+	    front : RETURN items[MIN(DequeSize)];
+	  | back  : RETURN items[rear];
+	  END (*--case*);
+	END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END EndOf;
+(*-------------------------*)
+
+PROCEDURE PositionOf (    theDeque: Deque    (*-- in    *);
+       	       		theItem : Item     (*-- in    *))
+							: CARDINAL (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(positionof, undefined);
+  ELSE
+    WITH theDeque^ DO
+      FOR index := MIN(DequeSize) TO rear DO
+	    IF (theItem = items[index]) THEN
+		  RETURN index;
+		END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+  RETURN 0;
+END PositionOf;
+(*-------------------------*)
+
+
+BEGIN
+  FOR dequeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(dequeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  dequeError := noerr;
+END DQPBSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSUMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSUMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSUMI.DEF
@@ -0,0 +1,180 @@
+(*
+17.1 Unbounded Priority Balking Deque Interface
+*)
+
+DEFINITION MODULE DQPBSUMI;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Priority Balking Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+(*
+17.1.1 Type Declarations
+
+A deque is declared as the abstract data type, Deque.  As insertions and
+removals can occur at either end of a double-ended queue, the enumeration
+type Location defined these options.  A constant representing an undefined
+deque is also provided allowing a simple (in)equality test to be made for
+such objects.
+
+An item's priority is declared as a generic entity, allowing the client
+module to have priorities of any complexity.  All that is needed for
+the priority form of deque is the ability to retrieve an item's priority
+and to compare priorities for the relational ordering between them.
+*)
+
+TYPE  Deque;
+TYPE  Location  = (front, back);
+CONST NullDeque = Deque(NIL);
+
+TYPE  Priority;
+TYPE  PriorityProc    = PROCEDURE (Item) : Priority;
+TYPE  PriorityCompare = PROCEDURE (Priority, Priority) : Relation;
+
+
+(*
+17.1.2 Exceptions
+
+The ModuleID uniquely identifies this module from all others.
+
+DequeError returns the most recent deque exception, or noerr if the
+last operation was successful.  While SetHandler and GetHandler allow
+assignment and retrieval of exception handling routines for specific
+exceptions.
+*)
+
+CONST ModuleID = 7;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+
+(*
+17.1.3 Constructors
+
+The constructor Create has been changed from the non-priority
+non-balking form of queue to accomodate procedure parameters to (1)
+retrieve the priority for an item, and (2) compare two priorities.
+
+An additional constructor, Leave, has been added to implement the
+actual balking mechanism.  The difference between this version of
+Leave and the queue version is the addition of the parameter theEnd.
+This is done for consistency with the Arrive and Depart operations.
+
+All other constructors remain unchanged from the non-priority
+non-balking form of deque.
+*)
+
+PROCEDURE Create  (    theType    : TypeID	(*-- in    *);
+					   priorityOf : PriorityProc    (*-- in    *);
+					   comparison : PriorityCompare (*-- in    *))
+	: Deque	(*-- out   *);
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Leave   (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+
+(*
+17.1.4 Selectors
+
+All of the selector interfaces are unchanged from the non-priority
+non-balking form of deque.
+
+An additional selector has been added, PositionOf, that returns the
+number of positions from the given item to the front of the queue. If
+theItem is not present in theDeque then zero is returned.  Note that
+the position is always from the front of the deque as the position
+from the back can be easily calculated by the client.
+*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE PositionOf (    theDeque: Deque    (*-- in    *);
+       	       		theItem : Item     (*-- in    *))
+							: CARDINAL (*-- out   *);
+
+
+(*
+17.1.5 Iterators
+
+The interfaces to both iterators are unchanged from the non-priority
+non-balking form of deque.
+*)
+
+PROCEDURE LoopOver (    theDeque  : Deque	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+PROCEDURE Traverse (    theDeque  : Deque	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+END DQPBSUMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSUMI.MOD
@@ -0,0 +1,839 @@
+(*
+17.2 Unbounded Priority Balking Deque Implementation
+
+In this section the actual implementation of the above named form of
+deque is presented.
+*)
+
+IMPLEMENTATION MODULE DQPBSUMI;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Priority Balking Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM SYSTEM IMPORT
+    (*--Type*) ADDRESS;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc,
+		AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, DequeComponentID;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+17.2.1 Internal Unbounded Deque Representation
+
+For the internal representation of the unbounded deque we shal use a linked list
+of nodes with a header.  The header contains pointers to the front and back nodes of the
+deque, the current length of the deque, and the procedures to retrieve and compare
+item priorities (priority and compare, respectively).  Each node contains the item value, and
+pointers forward and backward to the successor and predecessor nodes respectively.
+By employing a doubly-linked list efficient insertion and removal at either end of
+the deque is facilitated, as is traversal of the deque in either direction.
+By convention, an empty deque will be represented by both the front and back
+pointers being NIL.  Figure 17.1 displays the internal structure graphically.
+
+FIGURE 17.1
+
+Representation Invariants:
+* when the deque is empty both head and tail are NIL
+* when the deque is not empty, head points to the node containing the item with
+  the highest priority
+* when the deque is not empty, tail points to the node containing the item with
+  the lowest priority
+*)
+
+TYPE  Priority = ADDRESS;
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node  = RECORD
+	prev : Link;  (*-- link to prior deque element *)
+	item : Item;  (*-- deque element's data *)
+	next : Link;  (*-- link to next deque element *)
+      END (*-- Node *);
+  
+TYPE  Deque = POINTER TO UnboundedDeque;
+
+TYPE  UnboundedDeque = RECORD
+	dataID   : TypeID;	(*-- defined data type *)
+		priority : PriorityProc;    (*-- retrieve item priority *)
+		compare  : PriorityCompare; (*-- compare item priorities *)
+	length   : CARDINAL;	(*-- current # of items *)
+	head     : Link;	(*-- link to front of deque *)
+	tail     : Link;	(*-- link to rear of deque *)
+      END (*-- UnboundedDeque *);
+
+    (*--------------------*)
+
+
+(*
+17.2.2 Exceptions
+
+dequeError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+dequeError before any other processing. The handlers array holds the
+current exception handler for the
+possible exceptions that may be raised from within this module.
+Both are initialized by the module initialization (see section
+14.2.6).
+
+DequeError simply returns the current exception result stored
+in dequeError and is used to determine whether a deque operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   dequeError : Exceptions;
+VAR   handler    : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN dequeError;
+END DequeError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+	theError   : Exceptions (*-- in    *));
+BEGIN
+  dequeError := theError;
+  Raise(DequeComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+17.2.3 Constructors
+
+Create attempts to form a new, empty bounded deque object associated
+with the given data type ID, and procedures for retrieval of an item's priority
+and comparison of item priorities.  MacSystem.Allocate returns NIL if unable
+to successfully complete the allocation request whereupon the overflow
+exception is raised and the NullDeque returned.  If successful, the
+deque is initialized as follows before returning the new deque:
+* theType is saved for later use by IsEqual, Clear, and Assign
+* head, tail and length are set to the empty deque state.
+* the procedure parameters for priorities are saved for use in Arrive
+
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType    : TypeID	(*-- in    *);
+					   priorityOf : PriorityProc    (*-- in    *);
+					   comparison : PriorityCompare (*-- in    *))
+	: Deque	(*-- out   *);
+
+VAR   newDeque : Deque;
+
+BEGIN
+  Allocate(newDeque, SIZE(UnboundedDeque));
+  IF (newDeque = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newDeque^ DO
+      dataID   := theType;
+	  priority := priorityOf;
+	  compare  := comparison;
+	  length   := 0;
+	  head     := NIL;
+	  tail     := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newDeque;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theDeque rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullDeque). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+BEGIN
+  Clear(theDeque);
+  IF (dequeError = noerr) THEN
+    Deallocate(theDeque, SIZE(theDeque^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theDeque's data type, if
+any, and proceeds to free each item in theDeque.  If theDeque is empty
+the loop is not executed as head will be NIL.  Lastly, tail and length
+are set to ensure theDeque is in the empty state. Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+VAR   oldHead : Link;	(*-- node to be cleared *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    WITH theDeque^ DO
+	  free := DisposeOf(dataID);
+      WHILE (head # NIL) DO
+	oldHead := head;
+	head    := head^.next;
+	free(oldHead^.item);
+	Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      tail   := NIL;
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theDeque to the target deque, toDeque. An
+undefined source deque raises an exception and leaves the target unchanged.
+If the target deque is undefined, it is created with the same data type
+attribute of the source; otherwise the target deque is cleared of its
+present contents and its data type is altered to reflect that of the
+source.  If the source deque is not empty, Assign copies each source node
+to the target using the TailInsert routine from the doubly-linked unbounded
+list module.  TailInsert automatically sets the new node's previous link
+to the last node inserted. In order for this to work correctly last must be
+initialized to NIL.
+Complexity: O(mn), where m is the number of items in the source deque and
+n is the number of items in the target deque.
+*)
+
+PROCEDURE TailInsert(    theNode : Link (*-- inout *);
+	VAR first   : Link (*-- inout *);
+					 VAR last    : Link (*-- inout *));
+BEGIN
+  IF (first = NIL) THEN
+    first := theNode;
+  ELSE
+    last^.next := theNode;
+  END (*--if*);
+  theNode^.prev := last;
+  last := theNode;
+END TailInsert;
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+VAR   index      : Link;       (*-- loop index over source items *)
+	  newNode    : Link;       (*-- new item node for target deque *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theDeque # toDeque) THEN
+    IF (toDeque = NIL) THEN
+      WITH theDeque^ DO
+	toDeque := Create(dataID, priority, compare);
+	  END (*--with*);
+    ELSE
+      Clear(toDeque);
+      WITH theDeque^ DO
+	toDeque^.dataID   := dataID;
+	    toDeque^.priority := priority;
+	    toDeque^.compare  := compare;
+	  END (*--with*);
+    END (*--if*);
+    IF (dequeError = noerr) THEN
+      WITH theDeque^ DO
+	    assignment := AssignOf(dataID);
+	index := head;
+      END (*--with*);
+      WHILE (index # NIL) DO
+	Allocate(newNode, SIZE(Node));
+	    IF (newNode = NIL) THEN
+	      RaiseErrIn(assign, overflow);
+	      RETURN;
+	    END (*--if*);
+	    WITH newNode^ DO
+	item := assignment(index^.item);
+	next := NIL;
+	END (*--with*);
+	WITH toDeque^ DO
+	      TailInsert(newNode, head, tail);
+	END (*--with*);
+	index := index^.next;
+      END (*--while*);
+      toDeque^.length := theDeque^.length;
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to theEnd of theDeque ordered by theItem's priority.
+If given an undefined deque the exception of the same name is raised and the
+operation is aborted. If, upon entry, the deque is already empty, a new node
+is attached to both the head and tail, regardless of the value of location or
+the priority of the item.  Otherwise, the list of nodes must be searched to
+find the proper location for the item based on its priority. The search begins
+from the front of the deque and progresses towards the back. When items of like
+priority are added, theEnd controls where theItem is located relative to the
+other items already present in the deque.  Figure 17.2 demonstrates how this
+works. When the search terminates, insertion occurs dependent on the following
+conditions:
+  * index = NIL -> insertion at the tail of the deque
+  * index # NIL & index^.prev = NIL -> insertion at the head of the deque
+  * index # NIL & index^.prev # NIL -> insertion in the middle of the deque
+Complexity: O(1).
+*)
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   newNode      : Link;     (*-- new node for theItem *)
+      index	: Link;     (*-- loop index over items *)
+      itemPriority : Priority; (*-- theItem's priority *)
+	  priorityOrder: Relation; (*-- ordering between priorities *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+	item := theItem;
+	next := NIL;
+		prev := NIL;
+      END (*--with*);
+      WITH theDeque^ DO
+	INC(length);
+	    itemPriority := priority(theItem);
+	IF (head = NIL) THEN
+	head := newNode;
+		  tail := newNode;
+		ELSE
+		  index := head;
+		  WHILE (index # NIL) &
+			(compare(itemPriority, priority(index^.item)) = less) DO
+			index := index^.next;
+		  END (*--while*);
+	IF (theEnd = back) THEN
+		    WHILE (index # NIL) &
+			(compare(itemPriority, priority(index^.item)) = equal) DO
+			  index := index^.next;
+		    END (*--while*);
+		  END (*--if*);
+		  IF (index = NIL) THEN
+	tail^.next := newNode;
+		    newNode^.prev := tail;
+		    tail := newNode;
+		  ELSE
+		    WITH newNode^ DO
+			  next := index;
+			  prev := index^.prev;
+			END (*--with*);
+			IF (index^.prev = NIL) THEN
+			  head := newNode;
+			ELSE
+		      index^.prev^.next := newNode;
+			END (*--if*);
+			index^.prev := newNode;
+		  END (*--if*);
+	END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front or the rear of theDeque depending
+on the value of theEnd.  If the item is departing from the rear of the
+deque it is sufficient to free the item's value and decrement the rear
+index.  Otherwise, if departing from the front of the deque it is
+necessary to shift all other items down one position in the items array
+and deduct one from the rear index.  Before overwriting the item being
+removed, it's value is freed via the disposal routine of theDeque's
+data type.  If theDeque is empty on entry to Depart the underflow
+exception is raised and theDeque is not changed.  When theDeque is not
+defined, the undefined exception is raised.
+Complexity: O(1).
+*)
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   oldNode : Link;	(*-- departing node *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (head = NIL) THEN
+	RaiseErrIn(depart, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+		oldNode := head;
+	head    := head^.next;
+			IF (head # NIL) THEN
+			  head^.prev := NIL;
+			END (*--if*);
+		| back  :
+		oldNode := tail;
+			tail    := tail^.prev;
+			IF (tail # NIL) THEN
+			  tail^.next := NIL;
+			END (*--if*);
+		END (*--case*);
+	free(oldNode^.item);
+	Deallocate(oldNode, SIZE(oldNode^));
+	DEC(length);
+	IF (length = 0) THEN
+		  head := NIL;
+	tail := NIL;
+	END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+(*
+Leave removes theItem from theDeque regardless of its position within
+the deque.  When theEnd is front, the first matching item is removed
+from the deque; conversely, when theEnd is back the last it is the last
+matching item that is removed.  At the end of the search for theItem, index
+points to the node to be removed from the deque or is NIL if theItem is not
+present.
+Complexity: O(n).
+*)
+
+PROCEDURE Leave   (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : Link;	(*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(leave, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (head = NIL) THEN
+	RaiseErrIn(leave, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+		CASE theEnd OF
+		  front:
+		    index := head;
+		    WHILE (index # NIL) & (index^.item # theItem) DO
+		      index := index^.next;
+		    END (*-- while*);
+	    | back :
+		    index := tail;
+		    WHILE (index # NIL) & (index^.item # theItem) DO
+		      index := index^.prev;
+		    END (*-- while*);
+		END (*--case*);
+		IF (index # NIL) THEN
+		  WITH index^ DO
+	free(item);
+		    IF (prev # NIL) THEN
+		      prev^.next := next;
+		    END (*--if*);
+		    IF (next # NIL) THEN
+		      next^.prev := prev;
+		    END (*--if*);
+		  END (*--with*);
+		  IF (index = head) THEN
+		    head := index^.next;
+		  END (*--if*);
+		  IF (index = tail) THEN
+		    tail := index^.prev;
+		  END (*--if*);
+		  Deallocate(index, SIZE(index^));
+	DEC(length);
+		ELSE
+	RaiseErrIn(leave, notfound);
+	END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Leave;
+(*-------------------------*)
+
+
+(*
+17.2.4 Selectors
+
+IsDefined verifies to the best of its ability whether theDeque has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theDeque # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theDeque is in the empty state, as indicated by
+the rear being zero, and False otherwise.  As per the specification
+(section 9.?) undefined deques are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN (theDeque^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right deques for equality, which in this
+context means they contain the same items and the same data type ID. The
+defined size of the deques is not relevant for the equality test.  Both
+deques must be defined and have the same data type ID; if they don not,
+then the exceptions undefined and typeerror are raised, respectively.
+Obviously, deques of different lengths (indicated by the value of rear)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both deques
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them.
+Complexity: O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+VAR   leftIndex  : Link;  (*-- loop index of left deque *)
+      rightIndex : Link;  (*-- loop index of right deque *)
+	  compareItems : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+	compareItems := CompareOf(left^.dataID);
+    leftIndex  := left^.head;
+    rightIndex := right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF (rightIndex = NIL) OR 
+	     (compareItems(leftIndex^.item, rightIndex^.item) # equal) THEN
+	RETURN FALSE;
+      END (*--if*);
+      leftIndex := leftIndex^.next;
+      rightIndex:= rightIndex^.next;
+    END (*--while*);
+    RETURN (rightIndex = NIL);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the length stored in the deque header. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+TypeOf simply returns the dataID for the given deque. Undefined deques,
+as always, raise the undefined exception and return a reasonable value,
+in this case the NullType. Complexity O(1).
+*)
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the front of theDeque
+or the NullItem if theDeque is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theDeque^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theDeque^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+(*
+RearOf returns the value of the item that is at the rear of theDeque
+or the NullItem if theDeque is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(rearof, undefined);
+  ELSIF (theDeque^.tail = NIL) THEN
+    RaiseErrIn(rearof, underflow);
+  ELSE
+    RETURN theDeque^.tail^.item;
+  END (*--if*);
+  RETURN NullItem;
+END RearOf;
+(*-------------------------*)
+
+(*
+EndOf returns the value of the item that is at the given end of theDeque
+(front or rear) or the NullItem if theDeque is undefined or is empty.
+Complexity: O(1).
+*)
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(endof, undefined);
+  ELSIF (theDeque^.head = NIL) THEN
+    RaiseErrIn(endof, underflow);
+  ELSIF (theEnd = front) THEN
+	RETURN theDeque^.head^.item;
+  ELSE
+	RETURN theDeque^.tail^.item;
+  END (*--if*);
+  RETURN NullItem;
+END EndOf;
+(*-------------------------*)
+
+(*
+PositionOf returns the number of positions from the given item to the
+front of the deque where the front is considered position one (1).
+If theItem is not present in theDeque then zero is returned.
+Complexity O(n).
+*)
+
+PROCEDURE PositionOf (    theDeque: Deque    (*-- in    *);
+       	       		theItem : Item     (*-- in    *))
+							: CARDINAL (*-- out   *);
+
+VAR   index : Link;     (*-- loop index over items *)
+      count : CARDINAL; (*-- running value of position *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(positionof, undefined);
+  ELSE
+    count := 1;
+	index := theDeque^.head;
+    WHILE (index # NIL) DO
+	  IF (theItem = index^.item) THEN
+		RETURN count;
+      END (*--if*);
+	  INC(count);
+	  index := index^.next;
+    END (*--while*);
+  END (*--if*);
+  RETURN 0;
+END PositionOf;
+(*-------------------------*)
+
+
+(*
+17.2.5 Iterators
+
+Both LoopOver and Traverse simply loop through each of the deque items
+passing the item value to theProcess procedure parameter. The direction
+of the iteration is controlled by theEnd parameter and is from the front
+to the rear when theEnd is front and the reverse when theEnd is rear.
+LoopOver may terminate before reaching the opposite end if theProcess
+returns False. Complexity: O(n).
+*)
+
+PROCEDURE LoopOver (    theDeque  : Deque	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSIF (theEnd = front) THEN
+	index := theDeque^.head;
+    WHILE (index # NIL) DO
+      IF ~theProcess(index^.item) THEN
+		RETURN;
+	  END (*--if*);
+	  index := index^.next;
+    END (*--while*);
+  ELSIF (theEnd = back) THEN
+	index := theDeque^.tail;
+    WHILE (index # NIL) DO
+      IF ~theProcess(index^.item) THEN
+		RETURN;
+	  END (*--if*);
+	  index := index^.prev;
+    END (*--while*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theDeque  : Deque	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSIF (theEnd = front) THEN
+	index := theDeque^.head;
+    WHILE (index # NIL) DO
+      theProcess(index^.item);
+	  index := index^.next;
+    END (*--while*);
+  ELSIF (theEnd = back) THEN
+	index := theDeque^.tail;
+    WHILE (index # NIL) DO
+      theProcess(index^.item);
+	  index := index^.prev;
+    END (*--while*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*
+17.2.6 Module Initialization
+
+The module's local variables are initialized to known states.
+dequeError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, dequeError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR dequeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(dequeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  dequeError := noerr;
+END DQPBSUMI.
+
+(*
+References
+
+
+[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983, pp. 56-60.
+[2] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+   	Benjamin/Cummings, Menlo Park, CA 1987, pp. 92-93, 142-153.
+[3] K. John Gough, "Writing Generic Utilities in Modula-2", Journal of
+    Pascal, Ada, and Modula-2, Vol. 5(3), (May/June 1986), pp 53-62.
+[4] T.A. Standish, Data Structure Techniques, Chapter 2: Stacks and Queues,
+    Addison-Wesley, Reading, MA 1980, pp. 20-23, 28-32.
+[5] R.S. Wiener and G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons, New York, NY 1985, pp. 247-253
+[6] R.S. Wiener and R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986, pp. 69-71
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSUMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSUMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSUMN.DEF
@@ -0,0 +1,114 @@
+DEFINITION MODULE DQPBSUMN;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Priority Balking Sequential Unbounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+TYPE  Deque;
+TYPE  Location  = (front, back);
+CONST NullDeque = Deque(NIL);
+
+TYPE  Priority;
+TYPE  PriorityProc    = PROCEDURE (Item) : Priority;
+TYPE  PriorityCompare = PROCEDURE (Priority, Priority) : Relation;
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+CONST ModuleID = 8;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType    : TypeID	(*-- in    *);
+					   priorityOf : PriorityProc    (*-- in    *);
+					   comparison : PriorityCompare (*-- in    *))
+	: Deque	(*-- out   *);
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Leave   (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE PositionOf (    theDeque: Deque    (*-- in    *);
+       	       		theItem : Item     (*-- in    *))
+							: CARDINAL (*-- out   *);
+
+END DQPBSUMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSUMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSUMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPBSUMN.MOD
@@ -0,0 +1,565 @@
+IMPLEMENTATION MODULE DQPBSUMN;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Priority Balking Sequential Unbounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM SYSTEM IMPORT
+    (*--type*) ADDRESS;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, DequeComponentID;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+TYPE  Priority = ADDRESS;
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node  = RECORD
+	prev : Link;  (*-- link to prior deque element *)
+	item : Item;  (*-- deque element's data *)
+	next : Link;  (*-- link to next deque element *)
+      END (*-- Node *);
+  
+TYPE  Deque = POINTER TO UnboundedDeque;
+
+TYPE  UnboundedDeque = RECORD
+	dataID   : TypeID;	(*-- defined data type *)
+		priority : PriorityProc;    (*-- retrieve item priority *)
+		compare  : PriorityCompare; (*-- compare item priorities *)
+	length   : CARDINAL;	(*-- current # of items *)
+	head     : Link;	(*-- link to front of deque *)
+	tail     : Link;	(*-- link to rear of deque *)
+      END (*-- UnboundedDeque *);
+
+    (*--------------------*)
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+VAR   dequeError : Exceptions;
+VAR   handler    : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN dequeError;
+END DequeError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+	theError   : Exceptions (*-- in    *));
+BEGIN
+  dequeError := theError;
+  Raise(DequeComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType    : TypeID	(*-- in    *);
+					   priorityOf : PriorityProc    (*-- in    *);
+					   comparison : PriorityCompare (*-- in    *))
+	: Deque	(*-- out   *);
+
+VAR   newDeque : Deque;
+
+BEGIN
+  Allocate(newDeque, SIZE(UnboundedDeque));
+  IF (newDeque = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newDeque^ DO
+      dataID   := theType;
+	  priority := priorityOf;
+	  compare  := comparison;
+	  length   := 0;
+	  head     := NIL;
+	  tail     := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newDeque;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+BEGIN
+  Clear(theDeque);
+  IF (dequeError = noerr) THEN
+    Deallocate(theDeque, SIZE(theDeque^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+VAR   oldHead : Link;	(*-- node to be cleared *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    WITH theDeque^ DO
+	  free := DisposeOf(dataID);
+      WHILE (head # NIL) DO
+	oldHead := head;
+	head    := head^.next;
+	free(oldHead^.item);
+	Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      tail   := NIL;
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE TailInsert(    theNode : Link (*-- inout *);
+	VAR first   : Link (*-- inout *);
+					 VAR last    : Link (*-- inout *));
+BEGIN
+  IF (first = NIL) THEN
+    first := theNode;
+  ELSE
+    last^.next := theNode;
+  END (*--if*);
+  theNode^.prev := last;
+  last := theNode;
+END TailInsert;
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+VAR   index      : Link;       (*-- loop index over source items *)
+	  newNode    : Link;       (*-- new item node for target deque *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theDeque # toDeque) THEN
+    IF (toDeque = NIL) THEN
+      WITH theDeque^ DO
+	toDeque := Create(dataID, priority, compare);
+	  END (*--with*);
+    ELSE
+      Clear(toDeque);
+      WITH theDeque^ DO
+	toDeque^.dataID   := dataID;
+	    toDeque^.priority := priority;
+	    toDeque^.compare  := compare;
+	  END (*--with*);
+    END (*--if*);
+    IF (dequeError = noerr) THEN
+      WITH theDeque^ DO
+	    assignment := AssignOf(dataID);
+	index := head;
+      END (*--with*);
+      WHILE (index # NIL) DO
+	Allocate(newNode, SIZE(Node));
+	    IF (newNode = NIL) THEN
+	      RaiseErrIn(assign, overflow);
+	      RETURN;
+	    END (*--if*);
+	    WITH newNode^ DO
+	item := assignment(index^.item);
+	next := NIL;
+	END (*--with*);
+	WITH toDeque^ DO
+	      TailInsert(newNode, head, tail);
+	END (*--with*);
+	index := index^.next;
+      END (*--while*);
+      toDeque^.length := theDeque^.length;
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   newNode      : Link;     (*-- new node for theItem *)
+      index	: Link;     (*-- loop index over items *)
+      itemPriority : Priority; (*-- theItem's priority *)
+	  priorityOrder: Relation; (*-- ordering between priorities *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+	item := theItem;
+	next := NIL;
+		prev := NIL;
+      END (*--with*);
+      WITH theDeque^ DO
+	INC(length);
+	    itemPriority := priority(theItem);
+	IF (head = NIL) THEN
+	head := newNode;
+		  tail := newNode;
+		ELSE
+		  index := head;
+		  WHILE (index # NIL) &
+			(compare(itemPriority, priority(index^.item)) = less) DO
+			index := index^.next;
+		  END (*--while*);
+	IF (theEnd = back) THEN
+		    WHILE (index # NIL) &
+			(compare(itemPriority, priority(index^.item)) = equal) DO
+			  index := index^.next;
+		    END (*--while*);
+		  END (*--if*);
+		  IF (index = NIL) THEN
+	tail^.next := newNode;
+		    newNode^.prev := tail;
+		    tail := newNode;
+		  ELSE
+		    WITH newNode^ DO
+			  next := index;
+			  prev := index^.prev;
+			END (*--with*);
+			IF (index^.prev = NIL) THEN
+			  head := newNode;
+			ELSE
+		      index^.prev^.next := newNode;
+			END (*--if*);
+			index^.prev := newNode;
+		  END (*--if*);
+	END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   oldNode : Link;	(*-- departing node *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (head = NIL) THEN
+	RaiseErrIn(depart, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+		oldNode := head;
+	head    := head^.next;
+			IF (head # NIL) THEN
+			  head^.prev := NIL;
+			END (*--if*);
+		| back  :
+		oldNode := tail;
+			tail    := tail^.prev;
+			IF (tail # NIL) THEN
+			  tail^.next := NIL;
+			END (*--if*);
+		END (*--case*);
+	free(oldNode^.item);
+	Deallocate(oldNode, SIZE(oldNode^));
+	DEC(length);
+	IF (length = 0) THEN
+		  head := NIL;
+	tail := NIL;
+	END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+PROCEDURE Leave   (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : Link;	(*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(leave, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (head = NIL) THEN
+	RaiseErrIn(leave, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+		CASE theEnd OF
+		  front:
+		    index := head;
+		    WHILE (index # NIL) & (index^.item # theItem) DO
+		      index := index^.next;
+		    END (*-- while*);
+	    | back :
+		    index := tail;
+		    WHILE (index # NIL) & (index^.item # theItem) DO
+		      index := index^.prev;
+		    END (*-- while*);
+		END (*--case*);
+		IF (index # NIL) THEN
+		  WITH index^ DO
+	free(item);
+		    IF (prev # NIL) THEN
+		      prev^.next := next;
+		    END (*--if*);
+		    IF (next # NIL) THEN
+		      next^.prev := prev;
+		    END (*--if*);
+		  END (*--with*);
+		  IF (index = head) THEN
+		    head := index^.next;
+		  END (*--if*);
+		  IF (index = tail) THEN
+		    tail := index^.prev;
+		  END (*--if*);
+		  Deallocate(index, SIZE(index^));
+	DEC(length);
+		ELSE
+	RaiseErrIn(leave, notfound);
+	END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Leave;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theDeque # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN (theDeque^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+VAR   leftIndex   : Link;  (*-- loop index of left deque *)
+      rightIndex  : Link;  (*-- loop index of right deque *)
+	  compareItems: CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+	compareItems := CompareOf(left^.dataID);
+    leftIndex  := left^.head;
+    rightIndex := right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF (rightIndex = NIL) OR 
+	     (compareItems(leftIndex^.item, rightIndex^.item) # equal) THEN
+	RETURN FALSE;
+      END (*--if*);
+      leftIndex := leftIndex^.next;
+      rightIndex:= rightIndex^.next;
+    END (*--while*);
+    RETURN (rightIndex = NIL);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theDeque^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theDeque^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(rearof, undefined);
+  ELSIF (theDeque^.tail = NIL) THEN
+    RaiseErrIn(rearof, underflow);
+  ELSE
+    RETURN theDeque^.tail^.item;
+  END (*--if*);
+  RETURN NullItem;
+END RearOf;
+(*-------------------------*)
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(endof, undefined);
+  ELSIF (theDeque^.head = NIL) THEN
+    RaiseErrIn(endof, underflow);
+  ELSIF (theEnd = front) THEN
+	RETURN theDeque^.head^.item;
+  ELSE
+	RETURN theDeque^.tail^.item;
+  END (*--if*);
+  RETURN NullItem;
+END EndOf;
+(*-------------------------*)
+
+PROCEDURE PositionOf (    theDeque: Deque    (*-- in    *);
+       	       		theItem : Item     (*-- in    *))
+							: CARDINAL (*-- out   *);
+
+VAR   index : Link;     (*-- loop index over items *)
+      count : CARDINAL; (*-- running value of position *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(positionof, undefined);
+  ELSE
+    count := 1;
+	index := theDeque^.head;
+    WHILE (index # NIL) DO
+	  IF (theItem = index^.item) THEN
+		RETURN count;
+      END (*--if*);
+	  INC(count);
+	  index := index^.next;
+    END (*--while*);
+  END (*--if*);
+  RETURN 0;
+END PositionOf;
+(*-------------------------*)
+
+
+BEGIN
+  FOR dequeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(dequeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  dequeError := noerr;
+END DQPBSUMN.
+
+(*
+References
+
+
+[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983, pp. 56-60.
+[2] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+   	Benjamin/Cummings, Menlo Park, CA 1987, pp. 92-93, 142-153.
+[3] K. John Gough, "Writing Generic Utilities in Modula-2", Journal of
+    Pascal, Ada, and Modula-2, Vol. 5(3), (May/June 1986), pp 53-62.
+[4] T.A. Standish, Data Structure Techniques, Chapter 2: Stacks and Queues,
+    Addison-Wesley, Reading, MA 1980, pp. 20-23, 28-32.
+[5] R.S. Wiener and G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons, New York, NY 1985, pp. 247-253
+[6] R.S. Wiener and R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986, pp. 69-71
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSBMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSBMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSBMI.DEF
@@ -0,0 +1,162 @@
+DEFINITION MODULE DQPNSBMI;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Priority Non-balking Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+(*
+12.1.1 Type Declarations
+
+A deque is declared as the abstract data type, Deque.  In the bounded
+form presented here a deque is limited to a maximum size of 8100
+items.  Since the deque insertion and removal operations, Arrive and
+Depart, may occur at either the front or the back of the deque the
+enumeration Location is declared to represent these choices.
+
+An item's priority is declared as a generic entity, allowing the client
+module to have priorities of any complexity.  All that is needed for
+the priority form of deque is the ability to retrieve an item's priority
+and to compare priorities for the relational ordering between them.
+*)
+
+TYPE  Deque;
+TYPE  DequeSize = [1..8100];
+TYPE  Location  = (front, back);
+CONST NullDeque = Deque(NIL);
+
+TYPE  Priority;
+TYPE  PriorityProc    = PROCEDURE (Item) : Priority;
+TYPE  PriorityCompare = PROCEDURE (Priority, Priority) : Relation;
+
+
+(*
+12.1.2 Exceptions
+
+The ModuleID uniquely identifies this module from all others.
+
+DequeError returns the most recent deque exception, or noerr if the
+last operation was successful.  While SetHandler and GetHandler allow
+assignment and retrieval of exception handling routines for specific
+exceptions.
+*)
+
+CONST ModuleID = 9;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+
+(*
+12.1.3 Constructors
+
+The constructor Create has been changed from the non-priority
+non-balking form of queue to accomodate procedure parameters to (1)
+retrieve the priority for an item, and (2) compare two priorities.
+
+All other constructors remain unchanged from the non-priority
+non-balking form of deque.
+*)
+
+PROCEDURE Create  (    theType    : TypeID	(*-- in    *);
+	theSize    : DequeSize       (*-- in    *);
+					   priorityOf : PriorityProc    (*-- in    *);
+					   comparison : PriorityCompare (*-- in    *))
+	: Deque	(*-- out   *);
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+
+(*
+12.1.4 Selectors
+
+All of the selector interfaces are unchanged from the non-priority
+non-balking form of deque.
+*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+
+(*
+12.1.5 Iterators
+
+The interfaces to both iterators are unchanged from the non-priority
+non-balking form of deque.
+*)
+
+PROCEDURE LoopOver (    theDeque  : Deque	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+PROCEDURE Traverse (    theDeque  : Deque	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+END DQPNSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSBMI.MOD
@@ -0,0 +1,687 @@
+IMPLEMENTATION MODULE DQPNSBMI;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Priority Non-balking Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM SYSTEM IMPORT
+	(*--type*) ADDRESS;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc,
+		AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, DequeComponentID;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+13.3.1 Internal Bounded Priority Deque Representation
+
+A dynamically created array of Items is created when a deque
+is created. The front of the deque is always accessible by the
+index [1].  The header record is used to hold the deque size limit (size),
+the current rear index (rear), data type id (dataID), the procedures 
+to retrieve and compare item priorities (priority and compare,
+respectively), and the dynamic array of items (items).
+Items are stored in a linear fashion within the array ordered by priority.
+This means items are stored in descending priority order within the array.
+Figure 13.1, below, graphically depicts the internal structure used 
+for the bounded deque:
+
+FIGURE 13.1
+
+Representation Invariants:
+* MIN(DequeSize) <= size <= MAX(DequeSize)
+* 0 <= rear <= size
+* the deque is empty when rear is zero
+* when not empty, the front of the deque is at items[MIN(DequeSize)]
+*)
+
+TYPE  Priority = ADDRESS;
+
+TYPE  ItemsArray   = ARRAY DequeSize OF Item;
+TYPE  BoundedDeque = RECORD
+	dataID   : TypeID;	(*-- defined data type *)
+		priority : PriorityProc;    (*-- retrieve priority *)
+		compare  : PriorityCompare; (*-- compare priorities *)
+	size     : CARDINAL;	(*-- maximum # of items *)
+	rear     : CARDINAL;	(*-- current # of items *)
+	items    : ItemsArray;      (*-- array [1..size] of item *)
+      END (*-- BoundedDeque *);
+
+TYPE  Deque = POINTER TO BoundedDeque;
+
+    (*--------------------*)
+
+
+(*
+13.3.2 Exceptions
+
+dequeError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+dequeError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+13.3.6).
+
+DequeError simply returns the current exception result stored
+in dequeError and is used to determine whether a deque operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   dequeError : Exceptions;
+VAR   handler    : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN dequeError;
+END DequeError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+	theError   : Exceptions (*-- in    *));
+BEGIN
+  dequeError := theError;
+  Raise(DequeComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+13.3.3 Constructors
+
+Create attempts to form a new, empty bounded deque object associated
+with the given data type ID, maximum size, priority retrieval and
+priority comparison routines.  Only the specified
+number of entries given in theSize are actually allocated to the
+ItemsArray (items).  MacSystem.Allocate returns NIL if it is unable
+to successfully complete the allocation request whereupon the overflow
+exception is raised and the NullDeque returned.  If successful, the
+deque is initialized as follows before returning the new deque:
+* theType is saved for later use by IsEqual,
+* theSize is saved for later checking for deque overflow by Arrive and Assign, and
+* rear is set to the empty deque state.
+* the procedure parameters for priorities are saved for use in Arrive
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType    : TypeID	(*-- in    *);
+	theSize    : DequeSize       (*-- in    *);
+					   priorityOf : PriorityProc    (*-- in    *);
+					   comparison : PriorityCompare (*-- in    *))
+	: Deque	(*-- out   *);
+
+CONST staticSize = SIZE(BoundedDeque) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newDeque : Deque;
+
+BEGIN
+  dequeError := noerr;
+  Allocate(newDeque, staticSize + itemSize * theSize);
+  IF (newDeque = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newDeque^ DO
+      dataID   := theType;
+	  priority := priorityOf;
+	  compare  := comparison;
+      size     := theSize;
+	  rear     := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newDeque;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theDeque rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullDeque). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedDeque) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theDeque);
+  IF (dequeError = noerr) THEN
+    Deallocate(theDeque, staticSize + itemSize * theDeque^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theDeque's data type, if
+any, and proceeds to free each item in theDeque.  If theDeque is empty
+the loop is not executed as rear will be greater than the minimum
+DequeSize.  Lastly, rear is set to ensure theDeque is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    WITH theDeque^ DO
+	  free := DisposeOf(dataID);
+      FOR index := MIN(DequeSize) TO rear DO
+	free(items[index]);
+      END (*--for*);
+      rear := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theDeque to the target deque, toDeque. An
+undefined source deque raised an exception and leaves the target unchanged.
+If the target deque is undefined, it is created with the same size and
+data type attributes of the source; otherwise the target deque is
+cleared of its presnet contents and its data type is altered to reflect
+that of the source.  If the target deque is capable of containing all
+of the items present in the source, Assign simply copies each item from
+the source to the target afterwards updating the target's rear value.
+Complexity: O(mn).
+*)
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theDeque # toDeque) THEN
+    IF (toDeque = NIL) THEN
+      WITH theDeque^ DO
+	toDeque := Create(dataID, size, priority, compare);
+	  END (*--with*);
+    ELSIF (theDeque^.rear <= toDeque^.size) THEN
+      Clear(toDeque);
+      WITH theDeque^ DO
+	toDeque^.dataID   := dataID;
+		toDeque^.priority := priority;
+		toDeque^.compare  := compare;
+	  END (*--with*);
+	ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (dequeError = noerr) THEN
+      WITH theDeque^ DO
+	    assignment := AssignOf(dataID);
+	FOR index := MIN(DequeSize) TO rear DO
+	toDeque^.items[index] := assignment(items[index]);
+	END (*--for*);
+	toDeque^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem into its proper position within the items array based
+on its priority and theEnd which controls how items of like priority
+are ordered relative to one another. 
+
+A precondition is that the array be sorted in descending sequence by
+priority and the corresponding postcondition is the same.
+Also, there may be more than one item with the same priority.
+The algorithm used is a variation on 3.2 Sorted Array Search by Gonnet
+[2, pp. 31-32].  This search goes from the back of the deque towards
+the front shifting items up into higher index positions within the
+items array as it searches for the proper location for the insertion.
+When theItem arrives at the rear of theDeque the search/shift must
+stop when the next item in the array has a priority greater than or equal
+to the given item's priority.  When theItem arrives at the front of
+theDeque the search/shift must stop when the next item in the array
+has a priority greater than the given item's priority.
+
+When the rear of theDeque is already at its maximum allowed size the
+exception overflow is raised and theDeque remains unchanged.  Likewise,
+given an undefined deque raises the exception of the same name.
+Complexity: O(n).
+*)
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index	: CARDINAL; (*-- loop index over items *)
+      itemPriority : Priority; (*-- theItem's priority *)
+	  priorityOrder: Relation; (*-- ordering between priorities *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear < size) THEN
+	    itemPriority := priority(theItem);
+	    index := rear;
+	INC(rear);
+		LOOP
+		  IF (index > 0) THEN
+		    priorityOrder := compare(priority(items[index]),
+				itemPriority);
+		IF (theEnd = front) THEN
+		      IF (priorityOrder = greater) THEN
+			EXIT (*--loop*);
+			  ELSE
+			    items[index + 1] := items[index];
+			    DEC(index);
+		      END (*--if*);
+			ELSIF (priorityOrder # less) THEN
+		      EXIT (*--loop*);
+			ELSE
+			  items[index + 1] := items[index];
+			  DEC(index);
+		    END (*--if*);
+		  ELSE
+		    EXIT (*--loop*);
+		  END (*--if*);
+		END (*--loop*);
+	items[index + 1] := theItem;
+      ELSE
+	RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front or the rear of theDeque depending
+on the value of theEnd.  If the item is departing from the rear of the
+deque it is sufficient to free the item's value and decrement the rear
+index.  Otherwise, if departing from the front of the deque it is
+necessary to shift all other items down one position in the items array
+and deduct one from the rear index.  Before overwriting the item being
+removed, it's value is freed via the disposal routine of theDeque's
+data type.  If theDeque is empty on entry to Depart the underflow
+exception is raised and theDeque is not changed.  When theDeque is not
+defined, the undefined exception is raised.
+Complexity: Front O(n), Rear O(1).
+*)
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear = 0) THEN
+	RaiseErrIn(depart, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+	free(items[MIN(DequeSize)]);
+	FOR index := MIN(DequeSize) + 1 TO rear DO
+	items[index - 1] := items[index];
+	END (*--for*);
+		| back  :
+	free(items[rear]);
+		END (*--case*);
+	DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+(*
+13.3.4 Selectors
+
+IsDefined verifies to the best of its ability whether theDeque has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theDeque # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theDeque is in the empty state, as indicated by
+the rear being zero, and False otherwise.  As per the specification
+(section 8.?) undefined deques are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN (theDeque^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right deques for equality, which in this
+context means they contain the same items and the same data type ID. The
+defined size of the deques is not relevant for the equality test.  Both
+deques must be defined and have the same data type ID; if they don not,
+then the exceptions undefined and typeerror are raised, respectively.
+Obviously, deques of different lengths (indicated by the value of rear)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both deques
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them.
+Complexity: O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+	  compareItems : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+	  compareItems := CompareOf(left^.dataID);
+      FOR index := MIN(DequeSize) TO rear DO
+	IF compareItems(items[index], right^.items[index]) # equal THEN
+	RETURN FALSE;
+	END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+	END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the rear index into the items array which is
+also the length of theDeque. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+SizeOf and TypeOf simply return the size and dataID for the given deque.
+Undefined deques, as always, raise the undefined exception and return
+reasonable values (zero and the NullType, respectively). The complexity
+of both routines is O(1).
+*)
+
+PROCEDURE SizeOf    (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the front of theDeque
+or the NullItem if theDeque is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theDeque^.items[MIN(DequeSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+(*
+RearOf returns the value of the item that is at the rear of theDeque
+or the NullItem if theDeque is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(rearof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(rearof, underflow);
+  ELSE
+    WITH theDeque^ DO
+      RETURN items[rear];
+	END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END RearOf;
+(*-------------------------*)
+
+(*
+EndOf returns the value of the item that is at the given end of theDeque
+(front or rear) or the NullItem if theDeque is undefined or is empty.
+Complexity: O(1).
+*)
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(endof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(endof, underflow);
+  ELSE
+    WITH theDeque^ DO
+      CASE theEnd OF
+	    front : RETURN items[MIN(DequeSize)];
+	  | back  : RETURN items[rear];
+	  END (*--case*);
+	END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END EndOf;
+(*-------------------------*)
+
+
+(*
+13.3.5 Iterators
+
+Both LoopOver and Traverse simply loop through each of the deque items
+passing the item value to theProcess procedure parameter. The direction
+of the iteration is controlled by theEnd parameter and is from the front
+to the rear when theEnd is front and the reverse when theEnd is rear.
+LoopOver may terminate before reaching the opposite end if theProcess
+returns False. Complexity: O(n).
+*)
+
+PROCEDURE LoopOver (    theDeque  : Deque	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theDeque^ DO
+      CASE theEnd OF
+	    front :
+	FOR index := MIN(DequeSize) TO rear DO
+	IF ~theProcess(items[index]) THEN
+	RETURN;
+	END (*--if*);
+	END (*--for*);
+	  | back  :
+	FOR index := rear TO MIN(DequeSize) BY -1 DO
+	IF ~theProcess(items[index]) THEN
+	RETURN;
+	END (*--if*);
+	END (*--for*);
+	  END (*--case*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theDeque  : Deque	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theDeque^ DO
+      CASE theEnd OF
+	    front :
+	FOR index := MIN(DequeSize) TO rear DO
+	theProcess(items[index]);
+	END (*--for*);
+	  | back  :
+	FOR index := rear TO MIN(DequeSize) BY -1 DO
+	theProcess(items[index]);
+	END (*--for*);
+	  END (*--case*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*
+13.3.6 Module Initialization
+
+The module's local variables are initialized to known states.
+dequeError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.
+
+Since a FOR loop control variable is undefined following the loop,
+dequeError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR dequeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(dequeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  dequeError := noerr;
+END DQPNSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSBMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSBMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSBMN.DEF
@@ -0,0 +1,111 @@
+DEFINITION MODULE DQPNSBMN;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Priority Non-Balking Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+TYPE  Deque;
+TYPE  DequeSize = [1..8100];
+TYPE  Location  = (front, back);
+CONST NullDeque = Deque(NIL);
+
+TYPE  Priority;
+TYPE  PriorityProc    = PROCEDURE (Item) : Priority;
+TYPE  PriorityCompare = PROCEDURE (Priority, Priority) : Relation;
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+CONST ModuleID = 10;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType    : TypeID	(*-- in    *);
+	theSize    : DequeSize       (*-- in    *);
+					   priorityOf : PriorityProc    (*-- in    *);
+					   comparison : PriorityCompare (*-- in    *))
+	: Deque	(*-- out   *);
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+END DQPNSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSBMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSBMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSBMN.MOD
@@ -0,0 +1,425 @@
+IMPLEMENTATION MODULE DQPNSBMN;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Priority Non-Balking Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM SYSTEM IMPORT
+    (*--type*) ADDRESS;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, DequeComponentID;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+
+TYPE  Priority = ADDRESS;
+
+TYPE  ItemsArray   = ARRAY DequeSize OF Item;
+TYPE  BoundedDeque = RECORD
+	dataID   : TypeID;	(*-- defined data type *)
+		priority : PriorityProc;    (*-- retrieve priority *)
+		compare  : PriorityCompare; (*-- compare priorities *)
+	size     : CARDINAL;	(*-- maximum # of items *)
+	rear     : CARDINAL;	(*-- current # of items *)
+	items    : ItemsArray;      (*-- array [1..size] of item *)
+      END (*-- BoundedDeque *);
+
+TYPE  Deque = POINTER TO BoundedDeque;
+
+    (*--------------------*)
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+VAR   dequeError : Exceptions;
+VAR   handler    : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN dequeError;
+END DequeError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+	theError   : Exceptions (*-- in    *));
+BEGIN
+  dequeError := theError;
+  Raise(DequeComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType    : TypeID	(*-- in    *);
+	theSize    : DequeSize       (*-- in    *);
+					   priorityOf : PriorityProc    (*-- in    *);
+					   comparison : PriorityCompare (*-- in    *))
+	: Deque	(*-- out   *);
+
+CONST staticSize = SIZE(BoundedDeque) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newDeque : Deque;
+
+BEGIN
+  dequeError := noerr;
+  Allocate(newDeque, staticSize + itemSize * theSize);
+  IF (newDeque = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newDeque^ DO
+      dataID   := theType;
+	  priority := priorityOf;
+	  compare  := comparison;
+      size     := theSize;
+	  rear     := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newDeque;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedDeque) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theDeque);
+  IF (dequeError = noerr) THEN
+    Deallocate(theDeque, staticSize + itemSize * theDeque^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    WITH theDeque^ DO
+	  free := DisposeOf(dataID);
+      FOR index := MIN(DequeSize) TO rear DO
+	free(items[index]);
+      END (*--for*);
+      rear := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theDeque # toDeque) THEN
+    IF (toDeque = NIL) THEN
+      WITH theDeque^ DO
+	toDeque := Create(dataID, size, priority, compare);
+	  END (*--with*);
+    ELSIF (theDeque^.rear <= toDeque^.size) THEN
+      Clear(toDeque);
+      WITH theDeque^ DO
+	toDeque^.dataID   := dataID;
+		toDeque^.priority := priority;
+		toDeque^.compare  := compare;
+	  END (*--with*);
+	ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (dequeError = noerr) THEN
+      WITH theDeque^ DO
+	    assignment := AssignOf(dataID);
+	FOR index := MIN(DequeSize) TO rear DO
+	toDeque^.items[index] := assignment(items[index]);
+	END (*--for*);
+	toDeque^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index	: CARDINAL; (*-- loop index over items *)
+      itemPriority : Priority; (*-- theItem's priority *)
+	  priorityOrder: Relation; (*-- ordering between priorities *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear < size) THEN
+	    itemPriority := priority(theItem);
+	    index := rear;
+	INC(rear);
+		LOOP
+		  IF (index > 0) THEN
+		    priorityOrder := compare(priority(items[index]),
+				itemPriority);
+		IF (theEnd = front) THEN
+		      IF (priorityOrder = greater) THEN
+			EXIT (*--loop*);
+			  ELSE
+			    items[index + 1] := items[index];
+			    DEC(index);
+		      END (*--if*);
+			ELSIF (priorityOrder # less) THEN
+		      EXIT (*--loop*);
+			ELSE
+			  items[index + 1] := items[index];
+			  DEC(index);
+		    END (*--if*);
+		  ELSE
+		    EXIT (*--loop*);
+		  END (*--if*);
+		END (*--loop*);
+	items[index + 1] := theItem;
+      ELSE
+	RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear = 0) THEN
+	RaiseErrIn(depart, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+	free(items[MIN(DequeSize)]);
+	FOR index := MIN(DequeSize) + 1 TO rear DO
+	items[index - 1] := items[index];
+	END (*--for*);
+		| back  :
+	free(items[rear]);
+		END (*--case*);
+	DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theDeque # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN (theDeque^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+	  compareItems : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+	  compareItems := CompareOf(dataID);
+      FOR index := MIN(DequeSize) TO rear DO
+	IF compareItems(items[index], right^.items[index]) # equal THEN
+	RETURN FALSE;
+	END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+	END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theDeque^.items[MIN(DequeSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(rearof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(rearof, underflow);
+  ELSE
+    WITH theDeque^ DO
+      RETURN items[rear];
+	END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END RearOf;
+(*-------------------------*)
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(endof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(endof, underflow);
+  ELSE
+    WITH theDeque^ DO
+      CASE theEnd OF
+	    front : RETURN items[MIN(DequeSize)];
+	  | back  : RETURN items[rear];
+	  END (*--case*);
+	END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END EndOf;
+(*-------------------------*)
+
+
+BEGIN
+  FOR dequeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(dequeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  dequeError := noerr;
+END DQPNSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSUMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSUMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSUMI.DEF
@@ -0,0 +1,165 @@
+(*
+17.3 Unbounded Priority Non-Balking Deque Interface
+
+The interface to the non-balking form of priority deque differs only
+slightly from the balking form: the operations Leave and PositionOf
+have been removed.
+*)
+
+DEFINITION MODULE DQPNSUMI;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Priority Non-Balking Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+(*
+17.3.1 Type Declarations
+
+A deque is declared as the abstract data type, Deque.  As insertions and
+removals can occur at either end of a double-ended queue, the enumeration
+type Location defined these options.  A constant representing an undefined
+deque is also provided allowing a simple (in)equality test to be made for
+such objects.
+
+An item's priority is declared as a generic entity, allowing the client
+module to have priorities of any complexity.  All that is needed for
+the priority form of deque is the ability to retrieve an item's priority
+and to compare priorities for the relational ordering between them.
+*)
+
+TYPE  Deque;
+TYPE  Location  = (front, back);
+CONST NullDeque = Deque(NIL);
+
+TYPE  Priority;
+TYPE  PriorityProc    = PROCEDURE (Item) : Priority;
+TYPE  PriorityCompare = PROCEDURE (Priority, Priority) : Relation;
+
+
+(*
+17.3.2 Exceptions
+
+The ModuleID uniquely identifies this module from all others.
+
+DequeError returns the most recent deque exception, or noerr if the
+last operation was successful.  While SetHandler and GetHandler allow
+assignment and retrieval of exception handling routines for specific
+exceptions.
+*)
+
+CONST ModuleID = 11;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+
+(*
+17.3.3 Constructors
+
+The constructor Create has been changed from the non-priority
+non-balking form of queue to accomodate procedure parameters to (1)
+retrieve the priority for an item, and (2) compare two priorities.
+
+All other constructors remain unchanged from the non-priority
+non-balking form of deque.
+*)
+
+PROCEDURE Create  (    theType    : TypeID	(*-- in    *);
+					   priorityOf : PriorityProc    (*-- in    *);
+					   comparison : PriorityCompare (*-- in    *))
+	: Deque	(*-- out   *);
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+
+(*
+17.3.4 Selectors
+
+All of the selector interfaces are unchanged from the non-priority
+non-balking form of deque.
+*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+
+(*
+17.3.5 Iterators
+
+The interfaces to both iterators are unchanged from the non-priority
+non-balking form of deque.
+*)
+
+PROCEDURE LoopOver (    theDeque  : Deque	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+PROCEDURE Traverse (    theDeque  : Deque	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+END DQPNSUMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSUMI.MOD
@@ -0,0 +1,740 @@
+(*
+17.2 Unbounded Priority Non-Balking Deque Implementation
+
+In this section the actual implementation of the above named form of
+deque is presented.
+*)
+
+IMPLEMENTATION MODULE DQPNSUMI;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Priority Non-Balking Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM SYSTEM IMPORT
+    (*--type*) ADDRESS;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc,
+		AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, DequeComponentID;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+17.2.1 Internal Unbounded Deque Representation
+
+For the internal representation of the unbounded deque we shal use a linked list
+of nodes with a header.  The header contains pointers to the front and back nodes of the
+deque, the current length of the deque, and the procedures to retrieve and compare
+item priorities (priority and compare, respectively).  Each node contains the item value, and
+pointers forward and backward to the successor and predecessor nodes respectively.
+By employing a doubly-linked list efficient insertion and removal at either end of
+the deque is facilitated, as is traversal of the deque in either direction.
+By convention, an empty deque will be represented by both the front and back
+pointers being NIL.  Figure 17.1 displays the internal structure graphically.
+
+FIGURE 17.1
+
+Representation Invariants:
+* when the deque is empty both head and tail are NIL
+* when the deque is not empty, head points to the node containing the item with
+  the highest priority
+* when the deque is not empty, tail points to the node containing the item with
+  the lowest priority
+*)
+
+TYPE  Priority = ADDRESS;
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node  = RECORD
+	prev : Link;  (*-- link to prior deque element *)
+	item : Item;  (*-- deque element's data *)
+	next : Link;  (*-- link to next deque element *)
+      END (*-- Node *);
+  
+TYPE  Deque = POINTER TO UnboundedDeque;
+
+TYPE  UnboundedDeque = RECORD
+	dataID   : TypeID;	(*-- defined data type *)
+		priority : PriorityProc;    (*-- retrieve item priority *)
+		compare  : PriorityCompare; (*-- compare item priorities *)
+	length   : CARDINAL;	(*-- current # of items *)
+	head     : Link;	(*-- link to front of deque *)
+	tail     : Link;	(*-- link to rear of deque *)
+      END (*-- UnboundedDeque *);
+
+    (*--------------------*)
+
+
+(*
+17.2.2 Exceptions
+
+dequeError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+dequeError before any other processing. The handlers array holds the
+current exception handler for the
+possible exceptions that may be raised from within this module.
+Both are initialized by the module initialization (see section
+14.2.6).
+
+DequeError simply returns the current exception result stored
+in dequeError and is used to determine whether a deque operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   dequeError : Exceptions;
+VAR   handler    : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN dequeError;
+END DequeError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+	theError   : Exceptions (*-- in    *));
+BEGIN
+  dequeError := theError;
+  Raise(DequeComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+17.2.3 Constructors
+
+Create attempts to form a new, empty bounded deque object associated
+with the given data type ID, and procedures for retrieval of an item's priority
+and comparison of item priorities.  MacSystem.Allocate returns NIL if unable
+to successfully complete the allocation request whereupon the overflow
+exception is raised and the NullDeque returned.  If successful, the
+deque is initialized as follows before returning the new deque:
+* theType is saved for later use by IsEqual, Clear, and Assign
+* head, tail and length are set to the empty deque state.
+* the procedure parameters for priorities are saved for use in Arrive
+
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType    : TypeID	(*-- in    *);
+					   priorityOf : PriorityProc    (*-- in    *);
+					   comparison : PriorityCompare (*-- in    *))
+	: Deque	(*-- out   *);
+
+VAR   newDeque : Deque;
+
+BEGIN
+  Allocate(newDeque, SIZE(UnboundedDeque));
+  IF (newDeque = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newDeque^ DO
+      dataID   := theType;
+	  priority := priorityOf;
+	  compare  := comparison;
+	  length   := 0;
+	  head     := NIL;
+	  tail     := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newDeque;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theDeque rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullDeque). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+BEGIN
+  Clear(theDeque);
+  IF (dequeError = noerr) THEN
+    Deallocate(theDeque, SIZE(theDeque^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theDeque's data type, if
+any, and proceeds to free each item in theDeque.  If theDeque is empty
+the loop is not executed as head will be NIL.  Lastly, tail and length
+are set to ensure theDeque is in the empty state. Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+VAR   oldHead : Link;	(*-- node to be cleared *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    WITH theDeque^ DO
+	  free := DisposeOf(dataID);
+      WHILE (head # NIL) DO
+	oldHead := head;
+	head    := head^.next;
+	free(oldHead^.item);
+	Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      tail   := NIL;
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theDeque to the target deque, toDeque. An
+undefined source deque raises an exception and leaves the target unchanged.
+If the target deque is undefined, it is created with the same data type
+attribute of the source; otherwise the target deque is cleared of its
+present contents and its data type is altered to reflect that of the
+source.  If the source deque is not empty, Assign copies each source node
+to the target using the TailInsert routine from the doubly-linked unbounded
+list module.  TailInsert automatically sets the new node's previous link
+to the last node inserted. In order for this to work correctly last must be
+initialized to NIL.
+Complexity: O(mn), where m is the number of items in the source deque and
+n is the number of items in the target deque.
+*)
+
+PROCEDURE TailInsert(    theNode : Link (*-- inout *);
+	VAR first   : Link (*-- inout *);
+					 VAR last    : Link (*-- inout *));
+BEGIN
+  IF (first = NIL) THEN
+    first := theNode;
+  ELSE
+    last^.next := theNode;
+  END (*--if*);
+  theNode^.prev := last;
+  last := theNode;
+END TailInsert;
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+VAR   index      : Link;       (*-- loop index over source items *)
+	  newNode    : Link;       (*-- new item node for target deque *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theDeque # toDeque) THEN
+    IF (toDeque = NIL) THEN
+      WITH theDeque^ DO
+	toDeque := Create(dataID, priority, compare);
+	  END (*--with*);
+    ELSE
+      Clear(toDeque);
+      WITH theDeque^ DO
+	toDeque^.dataID   := dataID;
+	    toDeque^.priority := priority;
+	    toDeque^.compare  := compare;
+	  END (*--with*);
+    END (*--if*);
+    IF (dequeError = noerr) THEN
+      WITH theDeque^ DO
+	    assignment := AssignOf(dataID);
+	index := head;
+      END (*--with*);
+      WHILE (index # NIL) DO
+	Allocate(newNode, SIZE(Node));
+	    IF (newNode = NIL) THEN
+	      RaiseErrIn(assign, overflow);
+	      RETURN;
+	    END (*--if*);
+	    WITH newNode^ DO
+	item := assignment(index^.item);
+	next := NIL;
+	END (*--with*);
+	WITH toDeque^ DO
+	      TailInsert(newNode, head, tail);
+	END (*--with*);
+	index := index^.next;
+      END (*--while*);
+      toDeque^.length := theDeque^.length;
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to theEnd of theDeque ordered by theItem's priority.
+If given an undefined deque the exception of the same name is raised and the
+operation is aborted. If, upon entry, the deque is already empty, a new node
+is attached to both the head and tail, regardless of the value of location or
+the priority of the item.  Otherwise, the list of nodes must be searched to
+find the proper location for the item based on its priority. The search begins
+from the front of the deque and progresses towards the back. When items of like
+priority are added, theEnd controls where theItem is located relative to the
+other items already present in the deque.  Figure 17.2 demonstrates how this
+works. When the search terminates, insertion occurs dependent on the following
+conditions:
+  * index = NIL -> insertion at the tail of the deque
+  * index # NIL & index^.prev = NIL -> insertion at the head of the deque
+  * index # NIL & index^.prev # NIL -> insertion in the middle of the deque
+Complexity: O(1).
+*)
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   newNode      : Link;     (*-- new node for theItem *)
+      index	: Link;     (*-- loop index over items *)
+      itemPriority : Priority; (*-- theItem's priority *)
+	  priorityOrder: Relation; (*-- ordering between priorities *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+	item := theItem;
+	next := NIL;
+		prev := NIL;
+      END (*--with*);
+      WITH theDeque^ DO
+	INC(length);
+	    itemPriority := priority(theItem);
+	IF (head = NIL) THEN
+	head := newNode;
+		  tail := newNode;
+		ELSE
+		  index := head;
+		  WHILE (index # NIL) &
+			(compare(itemPriority, priority(index^.item)) = less) DO
+			index := index^.next;
+		  END (*--while*);
+	IF (theEnd = back) THEN
+		    WHILE (index # NIL) &
+			(compare(itemPriority, priority(index^.item)) = equal) DO
+			  index := index^.next;
+		    END (*--while*);
+		  END (*--if*);
+		  IF (index = NIL) THEN
+	tail^.next := newNode;
+		    newNode^.prev := tail;
+		    tail := newNode;
+		  ELSE
+		    WITH newNode^ DO
+			  next := index;
+			  prev := index^.prev;
+			END (*--with*);
+			IF (index^.prev = NIL) THEN
+			  head := newNode;
+			ELSE
+		      index^.prev^.next := newNode;
+			END (*--if*);
+			index^.prev := newNode;
+		  END (*--if*);
+	END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front or the rear of theDeque depending
+on the value of theEnd.  If the item is departing from the rear of the
+deque it is sufficient to free the item's value and decrement the rear
+index.  Otherwise, if departing from the front of the deque it is
+necessary to shift all other items down one position in the items array
+and deduct one from the rear index.  Before overwriting the item being
+removed, it's value is freed via the disposal routine of theDeque's
+data type.  If theDeque is empty on entry to Depart the underflow
+exception is raised and theDeque is not changed.  When theDeque is not
+defined, the undefined exception is raised.
+Complexity: O(1).
+*)
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   oldNode : Link;	(*-- departing node *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (head = NIL) THEN
+	RaiseErrIn(depart, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+		oldNode := head;
+	head    := head^.next;
+			IF (head # NIL) THEN
+			  head^.prev := NIL;
+			END (*--if*);
+		| back  :
+		oldNode := tail;
+			tail    := tail^.prev;
+			IF (tail # NIL) THEN
+			  tail^.next := NIL;
+			END (*--if*);
+		END (*--case*);
+	free(oldNode^.item);
+	Deallocate(oldNode, SIZE(oldNode^));
+	DEC(length);
+	IF (length = 0) THEN
+		  head := NIL;
+	tail := NIL;
+	END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+(*
+17.2.4 Selectors
+
+IsDefined verifies to the best of its ability whether theDeque has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theDeque # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theDeque is in the empty state, as indicated by
+the rear being zero, and False otherwise.  As per the specification
+(section 9.?) undefined deques are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN (theDeque^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right deques for equality, which in this
+context means they contain the same items and the same data type ID. The
+defined size of the deques is not relevant for the equality test.  Both
+deques must be defined and have the same data type ID; if they don not,
+then the exceptions undefined and typeerror are raised, respectively.
+Obviously, deques of different lengths (indicated by the value of rear)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both deques
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them.
+Complexity: O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+VAR   leftIndex    : Link;  (*-- loop index of left deque *)
+      rightIndex   : Link;  (*-- loop index of right deque *)
+	  compareItems : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+	compareItems := CompareOf(left^.dataID);
+    leftIndex  := left^.head;
+    rightIndex := right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF (rightIndex = NIL) OR
+	     (compareItems(leftIndex^.item, rightIndex^.item) # equal) THEN
+	RETURN FALSE;
+      END (*--if*);
+      leftIndex := leftIndex^.next;
+      rightIndex:= rightIndex^.next;
+    END (*--while*);
+    RETURN (rightIndex = NIL);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the length stored in the deque header. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+TypeOf simply returns the dataID for the given deque. Undefined deques,
+as always, raise the undefined exception and return a reasonable value,
+in this case the NullType. Complexity O(1).
+*)
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the front of theDeque
+or the NullItem if theDeque is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theDeque^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theDeque^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+(*
+RearOf returns the value of the item that is at the rear of theDeque
+or the NullItem if theDeque is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(rearof, undefined);
+  ELSIF (theDeque^.tail = NIL) THEN
+    RaiseErrIn(rearof, underflow);
+  ELSE
+    RETURN theDeque^.tail^.item;
+  END (*--if*);
+  RETURN NullItem;
+END RearOf;
+(*-------------------------*)
+
+(*
+EndOf returns the value of the item that is at the given end of theDeque
+(front or rear) or the NullItem if theDeque is undefined or is empty.
+Complexity: O(1).
+*)
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(endof, undefined);
+  ELSIF (theDeque^.head = NIL) THEN
+    RaiseErrIn(endof, underflow);
+  ELSIF (theEnd = front) THEN
+	RETURN theDeque^.head^.item;
+  ELSE
+	RETURN theDeque^.tail^.item;
+  END (*--if*);
+  RETURN NullItem;
+END EndOf;
+(*-------------------------*)
+
+
+(*
+17.2.5 Iterators
+
+Both LoopOver and Traverse simply loop through each of the deque items
+passing the item value to theProcess procedure parameter. The direction
+of the iteration is controlled by theEnd parameter and is from the front
+to the rear when theEnd is front and the reverse when theEnd is rear.
+LoopOver may terminate before reaching the opposite end if theProcess
+returns False. Complexity: O(n).
+*)
+
+PROCEDURE LoopOver (    theDeque  : Deque	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSIF (theEnd = front) THEN
+	index := theDeque^.head;
+    WHILE (index # NIL) DO
+      IF ~theProcess(index^.item) THEN
+		RETURN;
+	  END (*--if*);
+	  index := index^.next;
+    END (*--while*);
+  ELSIF (theEnd = back) THEN
+	index := theDeque^.tail;
+    WHILE (index # NIL) DO
+      IF ~theProcess(index^.item) THEN
+		RETURN;
+	  END (*--if*);
+	  index := index^.prev;
+    END (*--while*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theDeque  : Deque	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSIF (theEnd = front) THEN
+	index := theDeque^.head;
+    WHILE (index # NIL) DO
+      theProcess(index^.item);
+	  index := index^.next;
+    END (*--while*);
+  ELSIF (theEnd = back) THEN
+	index := theDeque^.tail;
+    WHILE (index # NIL) DO
+      theProcess(index^.item);
+	  index := index^.prev;
+    END (*--while*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*
+17.2.6 Module Initialization
+
+The module's local variables are initialized to known states.
+dequeError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, dequeError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR dequeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(dequeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  dequeError := noerr;
+END DQPNSUMI.
+
+(*
+References
+
+
+[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983, pp. 56-60.
+[2] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+   	Benjamin/Cummings, Menlo Park, CA 1987, pp. 92-93, 142-153.
+[3] K. John Gough, "Writing Generic Utilities in Modula-2", Journal of
+    Pascal, Ada, and Modula-2, Vol. 5(3), (May/June 1986), pp 53-62.
+[4] T.A. Standish, Data Structure Techniques, Chapter 2: Stacks and Queues,
+    Addison-Wesley, Reading, MA 1980, pp. 20-23, 28-32.
+[5] R.S. Wiener and G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons, New York, NY 1985, pp. 247-253
+[6] R.S. Wiener and R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986, pp. 69-71
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSUMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSUMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSUMN.DEF
@@ -0,0 +1,106 @@
+DEFINITION MODULE DQPNSUMN;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Priority Non-Balking Sequential Unbounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+TYPE  Deque;
+TYPE  Location  = (front, back);
+CONST NullDeque = Deque(NIL);
+
+TYPE  Priority;
+TYPE  PriorityProc    = PROCEDURE (Item) : Priority;
+TYPE  PriorityCompare = PROCEDURE (Priority, Priority) : Relation;
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+CONST ModuleID = 12;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType    : TypeID	(*-- in    *);
+					   priorityOf : PriorityProc    (*-- in    *);
+					   comparison : PriorityCompare (*-- in    *))
+	: Deque	(*-- out   *);
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+END DQPNSUMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSUMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSUMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQPNSUMN.MOD
@@ -0,0 +1,483 @@
+IMPLEMENTATION MODULE DQPNSUMN;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Priority Non-Balking Sequential Unbounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM SYSTEM IMPORT
+	(*--type*) ADDRESS;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, DequeComponentID;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+TYPE  Priority = ADDRESS;
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node  = RECORD
+	prev : Link;  (*-- link to prior deque element *)
+	item : Item;  (*-- deque element's data *)
+	next : Link;  (*-- link to next deque element *)
+      END (*-- Node *);
+  
+TYPE  Deque = POINTER TO UnboundedDeque;
+
+TYPE  UnboundedDeque = RECORD
+	dataID   : TypeID;	(*-- defined data type *)
+		priority : PriorityProc;    (*-- retrieve item priority *)
+		compare  : PriorityCompare; (*-- compare item priorities *)
+	length   : CARDINAL;	(*-- current # of items *)
+	head     : Link;	(*-- link to front of deque *)
+	tail     : Link;	(*-- link to rear of deque *)
+      END (*-- UnboundedDeque *);
+
+    (*--------------------*)
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+VAR   dequeError : Exceptions;
+VAR   handler    : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN dequeError;
+END DequeError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+	theError   : Exceptions (*-- in    *));
+BEGIN
+  dequeError := theError;
+  Raise(DequeComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType    : TypeID	(*-- in    *);
+					   priorityOf : PriorityProc    (*-- in    *);
+					   comparison : PriorityCompare (*-- in    *))
+	: Deque	(*-- out   *);
+
+VAR   newDeque : Deque;
+
+BEGIN
+  Allocate(newDeque, SIZE(UnboundedDeque));
+  IF (newDeque = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newDeque^ DO
+      dataID   := theType;
+	  priority := priorityOf;
+	  compare  := comparison;
+	  length   := 0;
+	  head     := NIL;
+	  tail     := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newDeque;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+BEGIN
+  Clear(theDeque);
+  IF (dequeError = noerr) THEN
+    Deallocate(theDeque, SIZE(theDeque^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+VAR   oldHead : Link;	(*-- node to be cleared *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    WITH theDeque^ DO
+	  free := DisposeOf(dataID);
+      WHILE (head # NIL) DO
+	oldHead := head;
+	head    := head^.next;
+	free(oldHead^.item);
+	Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      tail   := NIL;
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE TailInsert(    theNode : Link (*-- inout *);
+	VAR first   : Link (*-- inout *);
+					 VAR last    : Link (*-- inout *));
+BEGIN
+  IF (first = NIL) THEN
+    first := theNode;
+  ELSE
+    last^.next := theNode;
+  END (*--if*);
+  theNode^.prev := last;
+  last := theNode;
+END TailInsert;
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+VAR   index      : Link;       (*-- loop index over source items *)
+	  newNode    : Link;       (*-- new item node for target deque *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theDeque # toDeque) THEN
+    IF (toDeque = NIL) THEN
+      WITH theDeque^ DO
+	toDeque := Create(dataID, priority, compare);
+	  END (*--with*);
+    ELSE
+      Clear(toDeque);
+      WITH theDeque^ DO
+	toDeque^.dataID   := dataID;
+	    toDeque^.priority := priority;
+	    toDeque^.compare  := compare;
+	  END (*--with*);
+    END (*--if*);
+    IF (dequeError = noerr) THEN
+      WITH theDeque^ DO
+	    assignment := AssignOf(dataID);
+	index := head;
+      END (*--with*);
+      WHILE (index # NIL) DO
+	Allocate(newNode, SIZE(Node));
+	    IF (newNode = NIL) THEN
+	      RaiseErrIn(assign, overflow);
+	      RETURN;
+	    END (*--if*);
+	    WITH newNode^ DO
+	item := assignment(index^.item);
+	next := NIL;
+	END (*--with*);
+	WITH toDeque^ DO
+	      TailInsert(newNode, head, tail);
+	END (*--with*);
+	index := index^.next;
+      END (*--while*);
+      toDeque^.length := theDeque^.length;
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   newNode      : Link;     (*-- new node for theItem *)
+      index	: Link;     (*-- loop index over items *)
+      itemPriority : Priority; (*-- theItem's priority *)
+	  priorityOrder: Relation; (*-- ordering between priorities *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+	item := theItem;
+	next := NIL;
+		prev := NIL;
+      END (*--with*);
+      WITH theDeque^ DO
+	INC(length);
+	    itemPriority := priority(theItem);
+	IF (head = NIL) THEN
+	head := newNode;
+		  tail := newNode;
+		ELSE
+		  index := head;
+		  WHILE (index # NIL) &
+			(compare(itemPriority, priority(index^.item)) = less) DO
+			index := index^.next;
+		  END (*--while*);
+	IF (theEnd = back) THEN
+		    WHILE (index # NIL) &
+			(compare(itemPriority, priority(index^.item)) = equal) DO
+			  index := index^.next;
+		    END (*--while*);
+		  END (*--if*);
+		  IF (index = NIL) THEN
+	tail^.next := newNode;
+		    newNode^.prev := tail;
+		    tail := newNode;
+		  ELSE
+		    WITH newNode^ DO
+			  next := index;
+			  prev := index^.prev;
+			END (*--with*);
+			IF (index^.prev = NIL) THEN
+			  head := newNode;
+			ELSE
+		      index^.prev^.next := newNode;
+			END (*--if*);
+			index^.prev := newNode;
+		  END (*--if*);
+	END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   oldNode : Link;	(*-- departing node *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (head = NIL) THEN
+	RaiseErrIn(depart, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+		oldNode := head;
+	head    := head^.next;
+			IF (head # NIL) THEN
+			  head^.prev := NIL;
+			END (*--if*);
+		| back  :
+		oldNode := tail;
+			tail    := tail^.prev;
+			IF (tail # NIL) THEN
+			  tail^.next := NIL;
+			END (*--if*);
+		END (*--case*);
+	free(oldNode^.item);
+	Deallocate(oldNode, SIZE(oldNode^));
+	DEC(length);
+	IF (length = 0) THEN
+		  head := NIL;
+	tail := NIL;
+	END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theDeque # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN (theDeque^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+VAR   leftIndex    : Link;  (*-- loop index of left deque *)
+      rightIndex   : Link;  (*-- loop index of right deque *)
+	  compareItems : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+	compareItems := CompareOf(left^.dataID);
+    leftIndex  := left^.head;
+    rightIndex := right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF (rightIndex = NIL) OR
+	     (compareItems(leftIndex^.item, rightIndex^.item) # equal) THEN
+	RETURN FALSE;
+      END (*--if*);
+      leftIndex := leftIndex^.next;
+      rightIndex:= rightIndex^.next;
+    END (*--while*);
+    RETURN (rightIndex = NIL);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theDeque^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theDeque^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(rearof, undefined);
+  ELSIF (theDeque^.tail = NIL) THEN
+    RaiseErrIn(rearof, underflow);
+  ELSE
+    RETURN theDeque^.tail^.item;
+  END (*--if*);
+  RETURN NullItem;
+END RearOf;
+(*-------------------------*)
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(endof, undefined);
+  ELSIF (theDeque^.head = NIL) THEN
+    RaiseErrIn(endof, underflow);
+  ELSIF (theEnd = front) THEN
+	RETURN theDeque^.head^.item;
+  ELSE
+	RETURN theDeque^.tail^.item;
+  END (*--if*);
+  RETURN NullItem;
+END EndOf;
+(*-------------------------*)
+
+
+BEGIN
+  FOR dequeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(dequeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  dequeError := noerr;
+END DQPNSUMN.
+
+(*
+References
+
+
+[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983, pp. 56-60.
+[2] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+   	Benjamin/Cummings, Menlo Park, CA 1987, pp. 92-93, 142-153.
+[3] K. John Gough, "Writing Generic Utilities in Modula-2", Journal of
+    Pascal, Ada, and Modula-2, Vol. 5(3), (May/June 1986), pp 53-62.
+[4] T.A. Standish, Data Structure Techniques, Chapter 2: Stacks and Queues,
+    Addison-Wesley, Reading, MA 1980, pp. 20-23, 28-32.
+[5] R.S. Wiener and G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons, New York, NY 1985, pp. 247-253
+[6] R.S. Wiener and R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986, pp. 69-71
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSBMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSBMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSBMI.DEF
@@ -0,0 +1,114 @@
+DEFINITION MODULE DQSBMI;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Non-Priority Non-Balking Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+TYPE  Deque;
+TYPE  DequeSize = [1..8100];
+TYPE  Location  = (front, back);
+CONST NullDeque = Deque(NIL);
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+CONST ModuleID = 13;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+	theSize  : DequeSize (*-- in    *))
+	: Deque     (*-- out   *);
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+
+(*---------------------------------*)
+(*--	ITERATORS	--*)
+
+PROCEDURE LoopOver (    theDeque  : Deque	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+PROCEDURE Traverse (    theDeque  : Deque	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+END DQSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSBMI.MOD
@@ -0,0 +1,639 @@
+IMPLEMENTATION MODULE DQSBMI;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Non-Priority Non-Balking Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc,
+		AccessProc, LoopAccessProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, DequeComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+13.3.1 Internal Bounded Deque Representation
+
+A dynamically created array of Items is created when a deque
+is created. The front of the deque is always accessible by the
+index [1].  The header record is used to hold the deque size limit,
+the current rear index, data type id, and the dynamic array of items.
+Items are stored in a linear fashion within the array.  Figure 9.1,
+below, graphically depicts the internal structure used for the bounded
+deque:
+
+FIGURE 13.1
+
+Representation Invariants:
+* MIN(DequeSize) <= size <= MAX(DequeSize)
+* 0 <= rear <= size
+* the deque is empty when rear is zero
+* when not empty, the front of the deque is at items[MIN(DequeSize)]
+*)
+
+TYPE  ItemsArray   = ARRAY DequeSize OF Item;
+TYPE  BoundedDeque = RECORD
+	dataID : TypeID;     (*-- defined data type *)
+	size   : CARDINAL;   (*-- maximum # of items *)
+	rear   : CARDINAL;   (*-- current # of items *)
+	items  : ItemsArray; (*-- array [1..size] of item *)
+      END (*-- BoundedDeque *);
+
+TYPE  Deque = POINTER TO BoundedDeque;
+
+    (*--------------------*)
+
+
+(*
+13.3.2 Exceptions
+
+dequeError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+dequeError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+13.3.6).
+
+DequeError simply returns the current exception result stored
+in dequeError and is used to determine whether a deque operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   dequeError : Exceptions;
+VAR   handler    : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN dequeError;
+END DequeError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+	theError   : Exceptions (*-- in    *));
+BEGIN
+  dequeError := theError;
+  Raise(DequeComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+13.3.3 Constructors
+
+Create attempts to form a new, empty bounded deque object associated
+with the given data type ID and maximum size.  Only the specified
+number of entries given in theSize are actually allocated to the
+ItemsArray (items).  MacSystem.Allocate returns NIL if it is unable
+to successfully complete the allocation request whereupon the overflow
+exception is raised and the NullDeque returned.  If successful, the
+deque is initialized as follows before returning the new deque:
+* theType is saved for later use by IsEqual,
+* theSize is saved for later checking for deque overflow by Arrive and Assign, and
+* rear is set to the empty deque state.
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+	theSize  : DequeSize (*-- in    *))
+	: Deque     (*-- out   *);
+
+CONST staticSize = SIZE(BoundedDeque) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newDeque : Deque;
+
+BEGIN
+  dequeError := noerr;
+  Allocate(newDeque, staticSize + itemSize * theSize);
+  IF (newDeque = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newDeque^ DO
+      dataID := theType;
+      size   := theSize;
+	  rear   := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newDeque;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theDeque rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullDeque). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedDeque) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theDeque);
+  IF (dequeError = noerr) THEN
+    Deallocate(theDeque, staticSize + itemSize * theDeque^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theDeque's data type, if
+any, and proceeds to free each item in theDeque.  If theDeque is empty
+the loop is not executed as rear will be greater than the minimum
+DequeSize.  Lastly, rear is set to ensure theDeque is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    WITH theDeque^ DO
+	  free := DisposeOf(dataID);
+      FOR index := MIN(DequeSize) TO rear DO
+	free(items[index]);
+      END (*--for*);
+      rear := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theDeque to the target deque, toDeque. An
+undefined source deque raised an exception and leaves the target unchanged.
+If the target deque is undefined, it is created with the same size and
+data type attributes of the source; otherwise the target deque is
+cleared of its present contents and its data type is altered to reflect
+that of the source.  If the target deque is capable of containing all
+of the items present in the source, Assign simply copies each item from
+the source to the target afterwards updating the target's rear value.
+Complexity: O(mn).
+*)
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theDeque # toDeque) THEN
+    IF (toDeque = NIL) THEN
+      WITH theDeque^ DO
+	toDeque := Create(dataID, size);
+	  END (*--with*);
+    ELSIF (theDeque^.rear <= toDeque^.size) THEN
+      Clear(toDeque);
+      toDeque^.dataID := theDeque^.dataID;
+	ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (dequeError = noerr) THEN
+      WITH theDeque^ DO
+	    assignment := AssignOf(dataID);
+	FOR index := MIN(DequeSize) TO rear DO
+	toDeque^.items[index] := assignment(items[index]);
+	END (*--for*);
+	toDeque^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to theEnd of theDeque by advancing the rear index
+value and storing theItem at that location.  When the rear of theDeque
+is already at its maximum allowed size the exception overflow is raised
+and theDeque remains unchanged.  Likewise, given an undefined deque
+raises the exception of the same name. When theItem arrives at the
+front of theDeque all other items must be shifted upward in the items
+array to make room for the new item; otherwise, when the arrival occurs
+at the rear of theDeque the effect is identical with that for the
+standard queue. Complexity: Front O(n), Rear O(1).
+*)
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear < size) THEN
+	    CASE theEnd OF
+		  front :
+		    FOR index := rear TO MIN(DequeSize) BY -1 DO
+			  items[index + 1] := items[index];
+			END (*--for*);
+	INC(rear);
+	items[MIN(DequeSize)] := theItem;
+		| back  :
+	INC(rear);
+	items[rear] := theItem;
+		END (*--case*);
+      ELSE
+	RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front or the rear of theDeque depending
+on the value of theEnd.  If the item is departing from the rear of the
+deque it is sufficient to free the item's value and decrement the rear
+index.  Otherwise, if departing from the front of the deque it is
+necessary to shift all other items down one position in the items array
+and deduct one from the rear index.  Before overwriting the item being
+removed, it's value is freed via the disposal routine of theDeque's
+data type.  If theDeque is empty on entry to Depart the underflow
+exception is raised and theDeque is not changed.  When theDeque is not
+defined, the undefined exception is raised.
+Complexity: Front O(n), Rear O(1).
+*)
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear = 0) THEN
+	RaiseErrIn(depart, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+	free(items[MIN(DequeSize)]);
+	FOR index := MIN(DequeSize) + 1 TO rear DO
+	items[index - 1] := items[index];
+	END (*--for*);
+		| back  :
+	free(items[rear]);
+		END (*--case*);
+	DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+(*
+13.3.4 Selectors
+
+IsDefined verifies to the best of its ability whether theDeque has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theDeque # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theDeque is in the empty state, as indicated by
+the rear being zero, and False otherwise.  As per the specification
+(section 8.?) undefined deques are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN (theDeque^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right deques for equality, which in this
+context means they contain the same items and the same data type ID. The
+defined size of the deques is not relevant for the equality test.  Both
+deques must be defined and have the same data type ID; if they don not,
+then the exceptions undefined and typeerror are raised, respectively.
+Obviously, deques of different lengths (indicated by the value of rear)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both deques
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them.
+Complexity: O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+	  compare : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+	  compare := CompareOf(dataID);
+      FOR index := MIN(DequeSize) TO rear DO
+	IF compare(items[index], right^.items[index]) # equal THEN
+	RETURN FALSE;
+	END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+	END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the rear index into the items array which is
+also the length of theDeque. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+SizeOf and TypeOf simply return the size and dataID for the given deque.
+Undefined deques, as always, raise the undefined exception and return
+reasonable values (zero and the NullType, respectively). The complexity
+of both routines is O(1).
+*)
+
+PROCEDURE SizeOf    (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the front of theDeque
+or the NullItem if theDeque is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theDeque^.items[MIN(DequeSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+(*
+RearOf returns the value of the item that is at the rear of theDeque
+or the NullItem if theDeque is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(rearof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(rearof, underflow);
+  ELSE
+    WITH theDeque^ DO
+      RETURN items[rear];
+	END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END RearOf;
+(*-------------------------*)
+
+(*
+EndOf returns the value of the item that is at the given end of theDeque
+(front or rear) or the NullItem if theDeque is undefined or is empty.
+Complexity: O(1).
+*)
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(endof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(endof, underflow);
+  ELSE
+    WITH theDeque^ DO
+      CASE theEnd OF
+	    front : RETURN items[MIN(DequeSize)];
+	  | back  : RETURN items[rear];
+	  END (*--case*);
+	END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END EndOf;
+(*-------------------------*)
+
+
+(*
+13.3.5 Iterators
+
+Both LoopOver and Traverse simply loop through each of the deque items
+passing the item value to theProcess procedure parameter. The direction
+of the iteration is controlled by theEnd parameter and is from the front
+to the rear when theEnd is front and the reverse when theEnd is rear.
+LoopOver may terminate before reaching the opposite end if theProcess
+returns False. Complexity: O(n).
+*)
+
+PROCEDURE LoopOver (    theDeque  : Deque	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theDeque^ DO
+      CASE theEnd OF
+	    front :
+	FOR index := MIN(DequeSize) TO rear DO
+	IF ~theProcess(items[index]) THEN
+	RETURN;
+	END (*--if*);
+	END (*--for*);
+	  | back  :
+	FOR index := rear TO MIN(DequeSize) BY -1 DO
+	IF ~theProcess(items[index]) THEN
+	RETURN;
+	END (*--if*);
+	END (*--for*);
+	  END (*--case*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theDeque  : Deque	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theDeque^ DO
+      CASE theEnd OF
+	    front :
+	FOR index := MIN(DequeSize) TO rear DO
+	theProcess(items[index]);
+	END (*--for*);
+	  | back  :
+	FOR index := rear TO MIN(DequeSize) BY -1 DO
+	theProcess(items[index]);
+	END (*--for*);
+	  END (*--case*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*
+13.3.6 Module Initialization
+
+The module's local variables are initialized to known states.
+dequeError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.
+
+Since a FOR loop control variable is undefined following the loop,
+dequeError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR dequeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(dequeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  dequeError := noerr;
+END DQSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSBMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSBMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSBMN.DEF
@@ -0,0 +1,102 @@
+DEFINITION MODULE DQSBMN;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Non-Priority Non-Balking Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+TYPE  Deque;
+TYPE  DequeSize = [1..8100];
+TYPE  Location  = (front, back);
+CONST NullDeque = Deque(NIL);
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+CONST ModuleID = 14;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+	theSize  : DequeSize (*-- in    *))
+	: Deque     (*-- out   *);
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+END DQSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSBMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSBMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSBMN.MOD
@@ -0,0 +1,384 @@
+IMPLEMENTATION MODULE DQSBMN;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Non-Priority Non-Balking Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, DequeComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+TYPE  ItemsArray   = ARRAY DequeSize OF Item;
+TYPE  BoundedDeque = RECORD
+	dataID : TypeID;     (*-- defined data type *)
+	size   : CARDINAL;   (*-- maximum # of items *)
+	rear   : CARDINAL;   (*-- current # of items *)
+	items  : ItemsArray; (*-- array [1..size] of item *)
+      END (*-- BoundedDeque *);
+
+TYPE  Deque = POINTER TO BoundedDeque;
+
+    (*--------------------*)
+
+
+VAR   dequeError : Exceptions;
+VAR   handler    : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN dequeError;
+END DequeError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+	theError   : Exceptions (*-- in    *));
+BEGIN
+  dequeError := theError;
+  Raise(DequeComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+	theSize  : DequeSize (*-- in    *))
+	: Deque     (*-- out   *);
+
+CONST staticSize = SIZE(BoundedDeque) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newDeque : Deque;
+
+BEGIN
+  dequeError := noerr;
+  Allocate(newDeque, staticSize + itemSize * theSize);
+  IF (newDeque = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newDeque^ DO
+      dataID := theType;
+      size   := theSize;
+	  rear   := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newDeque;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedDeque) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theDeque);
+  IF (dequeError = noerr) THEN
+    Deallocate(theDeque, staticSize + itemSize * theDeque^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    WITH theDeque^ DO
+	  free := DisposeOf(dataID);
+      FOR index := MIN(DequeSize) TO rear DO
+	free(items[index]);
+      END (*--for*);
+      rear := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theDeque # toDeque) THEN
+    IF (toDeque = NIL) THEN
+      WITH theDeque^ DO
+	toDeque := Create(dataID, size);
+	  END (*--with*);
+    ELSIF (theDeque^.rear <= toDeque^.size) THEN
+      Clear(toDeque);
+      toDeque^.dataID := theDeque^.dataID;
+	ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (dequeError = noerr) THEN
+      WITH theDeque^ DO
+	    assignment := AssignOf(dataID);
+	FOR index := MIN(DequeSize) TO rear DO
+	toDeque^.items[index] := assignment(items[index]);
+	END (*--for*);
+	toDeque^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear < size) THEN
+	    CASE theEnd OF
+		  front :
+		    FOR index := rear TO MIN(DequeSize) BY -1 DO
+			  items[index + 1] := items[index];
+			END (*--for*);
+	INC(rear);
+	items[MIN(DequeSize)] := theItem;
+		| back  :
+	INC(rear);
+	items[rear] := theItem;
+		END (*--case*);
+      ELSE
+	RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (rear = 0) THEN
+	RaiseErrIn(depart, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+	free(items[MIN(DequeSize)]);
+	FOR index := MIN(DequeSize) + 1 TO rear DO
+	items[index - 1] := items[index];
+	END (*--for*);
+		| back  :
+	free(items[rear]);
+		END (*--case*);
+	DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theDeque # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN (theDeque^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+	  compare : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+	  compare := CompareOf(dataID);
+      FOR index := MIN(DequeSize) TO rear DO
+	IF compare(items[index], right^.items[index]) # equal THEN
+	RETURN FALSE;
+	END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+	END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theDeque^.items[MIN(DequeSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(rearof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(rearof, underflow);
+  ELSE
+    WITH theDeque^ DO
+      RETURN items[rear];
+	END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END RearOf;
+(*-------------------------*)
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(endof, undefined);
+  ELSIF (theDeque^.rear = 0) THEN
+    RaiseErrIn(endof, underflow);
+  ELSE
+    WITH theDeque^ DO
+      CASE theEnd OF
+	    front : RETURN items[MIN(DequeSize)];
+	  | back  : RETURN items[rear];
+	  END (*--case*);
+	END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END EndOf;
+(*-------------------------*)
+
+
+BEGIN
+  FOR dequeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(dequeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  dequeError := noerr;
+END DQSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSUMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSUMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSUMI.DEF
@@ -0,0 +1,113 @@
+(*
+14.1 Unbounded Deque Interface
+*)
+
+DEFINITION MODULE DQSUMI;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Non-priority Non-balking Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+TYPE  Deque;
+TYPE  Location  = (front, back);
+CONST NullDeque = Deque(NIL);
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+CONST ModuleID = 15;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *))
+	: Deque     (*-- out   *);
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+
+(*---------------------------------*)
+(*--	ITERATORS	--*)
+
+PROCEDURE LoopOver (    theDeque  : Deque	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+PROCEDURE Traverse (    theDeque  : Deque	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+END DQSUMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSUMI.MOD
@@ -0,0 +1,686 @@
+(*
+14.2 Unbounded Deque Implementation
+*)
+
+IMPLEMENTATION MODULE DQSUMI;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Non-priority Non-balking Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc,
+		AccessProc, LoopAccessProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, DequeComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+14.2.1 Internal Unbounded Deque Representation
+
+For the internal representation of the unbounded deque we shal use a linked list
+of nodes with a header.  The header contains pointers to the front and back nodes of the
+deque and the current length of the deque.  Each node contains the item value, and
+pointers forward and backward to the successor and predecessor nodes respectively.
+By employing a doubly-linked list efficient insertion and removal at either end of
+the deque is facilitated, as is traversal of the deque in either direction.
+By convention, an empty deque will be represented by both the front and back
+pointers being NIL.  Figure 14.1 displays the internal structure graphically.
+
+FIGURE 14.1
+
+Representation Invariants:
+* when the deque is empty both head and tail are NIL
+*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node  = RECORD
+	prev : Link;  (*-- link to prior deque element *)
+	item : Item;  (*-- deque element's data *)
+	next : Link;  (*-- link to next deque element *)
+      END (*-- Node *);
+  
+TYPE  Deque = POINTER TO UnboundedDeque;
+
+TYPE  UnboundedDeque = RECORD
+	dataID : TypeID;    (*-- defined data type *)
+	length : CARDINAL;  (*-- current # of items *)
+	head   : Link;      (*-- link to front of deque *)
+	tail   : Link;      (*-- link to rear of deque *)
+      END (*-- UnboundedDeque *);
+
+    (*--------------------*)
+
+
+(*
+14.2.2 Exceptions
+
+dequeError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+dequeError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+14.2.6).
+
+DequeError simply returns the current exception result stored
+in dequeError and is used to determine whether a deque operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   dequeError : Exceptions;
+VAR   handler    : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN dequeError;
+END DequeError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+	theError   : Exceptions (*-- in    *));
+BEGIN
+  dequeError := theError;
+  Raise(DequeComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+14.2.3 Constructors
+
+Create attempts to form a new, empty bounded deque object associated
+with the given data type ID and maximum size.  Only the specified
+number of entries given in theSize are actually allocated to the
+ItemsArray (items).  MacSystem.Allocate returns NIL if it is unable
+to successfully complete the allocation request whereupon the overflow
+exception is raised and the NullDeque returned.  If successful, the
+deque is initialized as follows before returning the new deque:
+* theType is saved for later use by IsEqual, Clear, and Assign
+* head, tail and length are set to the empty deque state.
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *))
+	: Deque     (*-- out   *);
+
+VAR   newDeque : Deque;
+
+BEGIN
+  Allocate(newDeque, SIZE(UnboundedDeque));
+  IF (newDeque = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newDeque^ DO
+      dataID := theType;
+	  length := 0;
+	  head   := NIL;
+	  tail   := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newDeque;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theDeque rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullDeque). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+BEGIN
+  Clear(theDeque);
+  IF (dequeError = noerr) THEN
+    Deallocate(theDeque, SIZE(theDeque^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theDeque's data type, if
+any, and proceeds to free each item in theDeque.  If theDeque is empty
+the loop is not executed as head will be NIL.  Lastly, tail and length
+are set to ensure theDeque is in the empty state. Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+VAR   oldHead : Link;	(*-- node to be cleared *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    WITH theDeque^ DO
+	  free := DisposeOf(dataID);
+      WHILE (head # NIL) DO
+	oldHead := head;
+	head    := head^.next;
+	free(oldHead^.item);
+	Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      tail   := NIL;
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theDeque to the target deque, toDeque. An
+undefined source deque raises an exception and leaves the target unchanged.
+If the target deque is undefined, it is created with the same data type
+attribute of the source; otherwise the target deque is cleared of its
+present contents and its data type is altered to reflect that of the
+source.  If the source deque is not empty, Assign copies each source node
+to the target using the TailInsert routine from the doubly-linked unbounded
+list module.  TailInsert automatically sets the new node's previous link
+to the last node inserted. In order for this to work correctly last must be
+initialized to NIL.
+Complexity: O(mn), where m is the number of items in the source deque and
+n is the number of items in the target deque.
+*)
+
+PROCEDURE TailInsert(    theNode : Link (*-- inout *);
+	VAR first   : Link (*-- inout *);
+					 VAR last    : Link (*-- inout *));
+BEGIN
+  IF (first = NIL) THEN
+    first := theNode;
+  ELSE
+    last^.next := theNode;
+  END (*--if*);
+  theNode^.prev := last;
+  last := theNode;
+END TailInsert;
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+VAR   index      : Link;       (*-- loop index over source items *)
+	  newNode    : Link;       (*-- new item node for target deque *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theDeque # toDeque) THEN
+    IF (toDeque = NIL) THEN
+      toDeque := Create(theDeque^.dataID);
+    ELSE
+      Clear(toDeque);
+      toDeque^.dataID := theDeque^.dataID;
+    END (*--if*);
+    IF (dequeError = noerr) THEN
+      WITH theDeque^ DO
+	    assignment := AssignOf(dataID);
+	index := head;
+      END (*--with*);
+      WHILE (index # NIL) DO
+	Allocate(newNode, SIZE(Node));
+	    IF (newNode = NIL) THEN
+	      RaiseErrIn(assign, overflow);
+	      RETURN;
+	    END (*--if*);
+	    WITH newNode^ DO
+	item := assignment(index^.item);
+	next := NIL;
+	END (*--with*);
+	WITH toDeque^ DO
+	      TailInsert(newNode, head, tail);
+	END (*--with*);
+	index := index^.next;
+      END (*--while*);
+      toDeque^.length := theDeque^.length;
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to theEnd of theDeque by advancing the rear index
+value and storing theItem at that location.  If the routine is given an
+undefined deque the exception of the same name is raised.
+If, upon entry, the deque is already empty, a new node is attached to
+both the head and tail, regardless of the value of location.  Other-
+wise, when theEnd is the front, a new node is added in the same manner
+as the Insert operation for a doubly-linked list; when location is the back,
+the new node is added to the end of the deque using the TailInsert routine
+for a doubly-linked list. Complexity: O(1).
+*)
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   newNode : Link;
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+	item := theItem;
+	next := NIL;
+		prev := NIL;
+      END (*--with*);
+      WITH theDeque^ DO
+	INC(length);
+	IF (head = NIL) THEN
+	head := newNode;
+		  tail := newNode;
+	ELSIF (theEnd = front) THEN
+		  head^.prev := newNode;
+		  newNode^.next := head;
+		  head := newNode;
+	ELSE
+	tail^.next := newNode;
+		  newNode^.prev := tail;
+		  tail := newNode;
+	END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front or the rear of theDeque depending
+on the value of theEnd.  If the item is departing from the rear of the
+deque it is sufficient to free the item's value and decrement the rear
+index.  Otherwise, if departing from the front of the deque it is
+necessary to shift all other items down one position in the items array
+and deduct one from the rear index.  Before overwriting the item being
+removed, it's value is freed via the disposal routine of theDeque's
+data type.  If theDeque is empty on entry to Depart the underflow
+exception is raised and theDeque is not changed.  When theDeque is not
+defined, the undefined exception is raised.
+Complexity: O(1).
+*)
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   oldNode : Link;	(*-- departing node *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (head = NIL) THEN
+	RaiseErrIn(depart, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+		oldNode := head;
+	head    := head^.next;
+			IF (head # NIL) THEN
+			  head^.prev := NIL;
+			END (*--if*);
+		| back  :
+		oldNode := tail;
+			tail    := tail^.prev;
+			IF (tail # NIL) THEN
+			  tail^.next := NIL;
+			END (*--if*);
+		END (*--case*);
+	free(oldNode^.item);
+	Deallocate(oldNode, SIZE(oldNode^));
+	DEC(length);
+	IF (length = 0) THEN
+		  head := NIL;
+	tail := NIL;
+	END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+(*
+14.2.4 Selectors
+
+IsDefined verifies to the best of its ability whether theDeque has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theDeque # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theDeque is in the empty state, as indicated by
+the rear being zero, and False otherwise.  As per the specification
+(section 9.?) undefined deques are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN (theDeque^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right deques for equality, which in this
+context means they contain the same items and the same data type ID. The
+defined size of the deques is not relevant for the equality test.  Both
+deques must be defined and have the same data type ID; if they don not,
+then the exceptions undefined and typeerror are raised, respectively.
+Obviously, deques of different lengths (indicated by the value of rear)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both deques
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them.
+Complexity: O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+VAR   leftIndex  : Link;  (*-- loop index of left deque *)
+      rightIndex : Link;  (*-- loop index of right deque *)
+	  compare    : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+	compare := CompareOf(left^.dataID);
+    leftIndex  := left^.head;
+    rightIndex := right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF (rightIndex = NIL) OR
+	     (compare(leftIndex^.item, rightIndex^.item) # equal) THEN
+	RETURN FALSE;
+      END (*--if*);
+      leftIndex := leftIndex^.next;
+      rightIndex:= rightIndex^.next;
+    END (*--while*);
+    RETURN (rightIndex = NIL);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the length stored in the deque header. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+TypeOf simply returns the dataID for the given deque. Undefined deques,
+as always, raise the undefined exception and return a reasonable value,
+in this case the NullType. Complexity O(1).
+*)
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the front of theDeque
+or the NullItem if theDeque is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theDeque^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theDeque^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+(*
+RearOf returns the value of the item that is at the rear of theDeque
+or the NullItem if theDeque is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(rearof, undefined);
+  ELSIF (theDeque^.tail = NIL) THEN
+    RaiseErrIn(rearof, underflow);
+  ELSE
+    RETURN theDeque^.tail^.item;
+  END (*--if*);
+  RETURN NullItem;
+END RearOf;
+(*-------------------------*)
+
+(*
+EndOf returns the value of the item that is at the given end of theDeque
+(front or rear) or the NullItem if theDeque is undefined or is empty.
+Complexity: O(1).
+*)
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(endof, undefined);
+  ELSIF (theDeque^.head = NIL) THEN
+    RaiseErrIn(endof, underflow);
+  ELSIF (theEnd = front) THEN
+	RETURN theDeque^.head^.item;
+  ELSE
+	RETURN theDeque^.tail^.item;
+  END (*--if*);
+  RETURN NullItem;
+END EndOf;
+(*-------------------------*)
+
+
+(*
+14.2.5 Iterators
+
+Both LoopOver and Traverse simply loop through each of the deque items
+passing the item value to theProcess procedure parameter. The direction
+of the iteration is controlled by theEnd parameter and is from the front
+to the rear when theEnd is front and the reverse when theEnd is rear.
+LoopOver may terminate before reaching the opposite end if theProcess
+returns False. Complexity: O(n).
+*)
+
+PROCEDURE LoopOver (    theDeque  : Deque	(*-- in    *);
+	theProcess: LoopAccessProc (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSIF (theEnd = front) THEN
+	index := theDeque^.head;
+    WHILE (index # NIL) DO
+      IF ~theProcess(index^.item) THEN
+		RETURN;
+	  END (*--if*);
+	  index := index^.next;
+    END (*--while*);
+  ELSIF (theEnd = back) THEN
+	index := theDeque^.tail;
+    WHILE (index # NIL) DO
+      IF ~theProcess(index^.item) THEN
+		RETURN;
+	  END (*--if*);
+	  index := index^.prev;
+    END (*--while*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theDeque  : Deque	(*-- in    *);
+	theProcess: AccessProc     (*-- in    *);
+						theEnd    : Location       (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSIF (theEnd = front) THEN
+	index := theDeque^.head;
+    WHILE (index # NIL) DO
+      theProcess(index^.item);
+	  index := index^.next;
+    END (*--while*);
+  ELSIF (theEnd = back) THEN
+	index := theDeque^.tail;
+    WHILE (index # NIL) DO
+      theProcess(index^.item);
+	  index := index^.prev;
+    END (*--while*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*
+14.2.6 Module Initialization
+
+The module's local variables are initialized to known states.
+dequeError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, dequeError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR dequeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(dequeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  dequeError := noerr;
+END DQSUMI.
+
+(*
+References
+
+
+[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983, pp. 56-60.
+[2] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+   	Benjamin/Cummings, Menlo Park, CA 1987, pp. 92-93, 142-153.
+[3] K. John Gough, "Writing Generic Utilities in Modula-2", Journal of
+    Pascal, Ada, and Modula-2, Vol. 5(3), (May/June 1986), pp 53-62.
+[4] T.A. Standish, Data Structure Techniques, Chapter 2: Stacks and Queues,
+    Addison-Wesley, Reading, MA 1980, pp. 20-23, 28-32.
+[5] R.S. Wiener and G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons, New York, NY 1985, pp. 247-253
+[6] R.S. Wiener and R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986, pp. 69-71
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSUMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSUMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSUMN.DEF
@@ -0,0 +1,97 @@
+DEFINITION MODULE DQSUMN;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Non-Priority Non-Balking Sequential Unbounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+TYPE  Deque;
+TYPE  Location  = (front, back);
+CONST NullDeque = Deque(NIL);
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+CONST ModuleID = 16;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *))
+	: Deque     (*-- out   *);
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+
+END DQSUMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSUMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSUMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/DQSUMN.MOD
@@ -0,0 +1,443 @@
+IMPLEMENTATION MODULE DQSUMN;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Deque (Opaque version)
+      Non-Priority Non-Balking Sequential Unbounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+	  Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, DequeComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+	(*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node  = RECORD
+	prev : Link;  (*-- link to prior deque element *)
+	item : Item;  (*-- deque element's data *)
+	next : Link;  (*-- link to next deque element *)
+      END (*-- Node *);
+  
+TYPE  Deque = POINTER TO UnboundedDeque;
+
+TYPE  UnboundedDeque = RECORD
+	dataID : TypeID;    (*-- defined data type *)
+	length : CARDINAL;  (*-- current # of items *)
+	head   : Link;      (*-- link to front of deque *)
+	tail   : Link;      (*-- link to rear of deque *)
+      END (*-- UnboundedDeque *);
+
+    (*--------------------*)
+
+
+(*---------------------------------*)
+(*--	EXCEPTIONS	--*)
+
+VAR   dequeError : Exceptions;
+VAR   handler    : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE DequeError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN dequeError;
+END DequeError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+	theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+	theError   : Exceptions (*-- in    *));
+BEGIN
+  dequeError := theError;
+  Raise(DequeComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--	CONSTRUCTORS	--*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *))
+	: Deque     (*-- out   *);
+
+VAR   newDeque : Deque;
+
+BEGIN
+  Allocate(newDeque, SIZE(UnboundedDeque));
+  IF (newDeque = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newDeque^ DO
+      dataID := theType;
+	  length := 0;
+	  head   := NIL;
+	  tail   := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newDeque;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theDeque : Deque     (*-- inout *));
+BEGIN
+  Clear(theDeque);
+  IF (dequeError = noerr) THEN
+    Deallocate(theDeque, SIZE(theDeque^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theDeque : Deque     (*-- inout *));
+
+VAR   oldHead : Link;	(*-- node to be cleared *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    WITH theDeque^ DO
+	  free := DisposeOf(dataID);
+      WHILE (head # NIL) DO
+	oldHead := head;
+	head    := head^.next;
+	free(oldHead^.item);
+	Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      tail   := NIL;
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE TailInsert(    theNode : Link (*-- inout *);
+	VAR first   : Link (*-- inout *);
+					 VAR last    : Link (*-- inout *));
+BEGIN
+  IF (first = NIL) THEN
+    first := theNode;
+  ELSE
+    last^.next := theNode;
+  END (*--if*);
+  theNode^.prev := last;
+  last := theNode;
+END TailInsert;
+
+PROCEDURE Assign  (    theDeque : Deque     (*-- in    *);
+	VAR toDeque  : Deque     (*-- inout *));
+
+VAR   index      : Link;       (*-- loop index over source items *)
+	  newNode    : Link;       (*-- new item node for target deque *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theDeque # toDeque) THEN
+    IF (toDeque = NIL) THEN
+      toDeque := Create(theDeque^.dataID);
+    ELSE
+      Clear(toDeque);
+      toDeque^.dataID := theDeque^.dataID;
+    END (*--if*);
+    IF (dequeError = noerr) THEN
+      WITH theDeque^ DO
+	    assignment := AssignOf(dataID);
+	index := head;
+      END (*--with*);
+      WHILE (index # NIL) DO
+	Allocate(newNode, SIZE(Node));
+	    IF (newNode = NIL) THEN
+	      RaiseErrIn(assign, overflow);
+	      RETURN;
+	    END (*--if*);
+	    WITH newNode^ DO
+	item := assignment(index^.item);
+	next := NIL;
+	END (*--with*);
+	WITH toDeque^ DO
+	      TailInsert(newNode, head, tail);
+	END (*--with*);
+	index := index^.next;
+      END (*--while*);
+      toDeque^.length := theDeque^.length;
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (VAR theDeque : Deque     (*-- inout *);
+       	       	       theItem  : Item      (*-- in    *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   newNode : Link;
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+	item := theItem;
+	next := NIL;
+		prev := NIL;
+      END (*--with*);
+      WITH theDeque^ DO
+	INC(length);
+	IF (head = NIL) THEN
+	head := newNode;
+		  tail := newNode;
+	ELSIF (theEnd = front) THEN
+		  head^.prev := newNode;
+		  newNode^.next := head;
+		  head := newNode;
+	ELSE
+	tail^.next := newNode;
+		  newNode^.prev := tail;
+		  tail := newNode;
+	END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (VAR theDeque : Deque     (*-- inout *);
+					   theEnd   : Location  (*-- in    *));
+
+VAR   oldNode : Link;	(*-- departing node *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theDeque^ DO
+      IF (head = NIL) THEN
+	RaiseErrIn(depart, underflow);
+      ELSE
+	    free := DisposeOf(dataID);
+	    CASE theEnd OF
+		  front :
+		oldNode := head;
+	head    := head^.next;
+			IF (head # NIL) THEN
+			  head^.prev := NIL;
+			END (*--if*);
+		| back  :
+		oldNode := tail;
+			tail    := tail^.prev;
+			IF (tail # NIL) THEN
+			  tail^.next := NIL;
+			END (*--if*);
+		END (*--case*);
+	free(oldNode^.item);
+	Deallocate(oldNode, SIZE(oldNode^));
+	DEC(length);
+	IF (length = 0) THEN
+		  head := NIL;
+	tail := NIL;
+	END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--	SELECTORS	--*)
+
+PROCEDURE IsDefined (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theDeque # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theDeque : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN (theDeque^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Deque    (*-- in    *);
+	right    : Deque    (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+VAR   leftIndex  : Link;  (*-- loop index of left deque *)
+      rightIndex : Link;  (*-- loop index of right deque *)
+	  compare    : CompareProc;	(*-- item comparison routine *)
+
+BEGIN
+  dequeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+	compare := CompareOf(left^.dataID);
+    leftIndex  := left^.head;
+    rightIndex := right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF (rightIndex = NIL) OR 
+	     (compare(leftIndex^.item, rightIndex^.item) # equal) THEN
+	RETURN FALSE;
+      END (*--if*);
+      leftIndex := leftIndex^.next;
+      rightIndex:= rightIndex^.next;
+    END (*--while*);
+    RETURN (rightIndex = NIL);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theDeque : Deque    (*-- in    *))
+	: CARDINAL (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theDeque : Deque    (*-- in    *))
+	: TypeID   (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque # NIL) THEN
+    RETURN theDeque^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theDeque^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theDeque^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+PROCEDURE RearOf    (    theDeque : Deque    (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(rearof, undefined);
+  ELSIF (theDeque^.tail = NIL) THEN
+    RaiseErrIn(rearof, underflow);
+  ELSE
+    RETURN theDeque^.tail^.item;
+  END (*--if*);
+  RETURN NullItem;
+END RearOf;
+(*-------------------------*)
+
+PROCEDURE EndOf     (    theDeque : Deque    (*-- in    *);
+	theEnd   : Location (*-- in    *))
+       	       		: Item     (*-- out   *);
+BEGIN
+  dequeError := noerr;
+  IF (theDeque = NIL) THEN
+    RaiseErrIn(endof, undefined);
+  ELSIF (theDeque^.head = NIL) THEN
+    RaiseErrIn(endof, underflow);
+  ELSIF (theEnd = front) THEN
+	RETURN theDeque^.head^.item;
+  ELSE
+	RETURN theDeque^.tail^.item;
+  END (*--if*);
+  RETURN NullItem;
+END EndOf;
+(*-------------------------*)
+
+
+BEGIN
+  FOR dequeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(dequeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  dequeError := noerr;
+END DQSUMN.
+
+(*
+References
+
+
+[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983, pp. 56-60.
+[2] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+   	Benjamin/Cummings, Menlo Park, CA 1987, pp. 92-93, 142-153.
+[3] K. John Gough, "Writing Generic Utilities in Modula-2", Journal of
+    Pascal, Ada, and Modula-2, Vol. 5(3), (May/June 1986), pp 53-62.
+[4] T.A. Standish, Data Structure Techniques, Chapter 2: Stacks and Queues,
+    Addison-Wesley, Reading, MA 1980, pp. 20-23, 28-32.
+[5] R.S. Wiener and G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons, New York, NY 1985, pp. 247-253
+[6] R.S. Wiener and R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986, pp. 69-71
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/ERRORHAN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/ERRORHAN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/ERRORHAN.DEF
@@ -0,0 +1,68 @@
+DEFINITION MODULE ErrorHandling;
+(*====================================================================
+    Version  : 1.0  Sun, Mar 5, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Standard Error Handling Support Utility
+
+    INTRODUCTION
+    This module provides a general support mechanism for the exceptions
+    declared by the various ADT component modules.
+
+    Having a general error code for all modules allows use of general
+    exception handlers, instead of being restricted to a specific
+    group of data structure modules.  Consistent error reporting is
+    also better supported since the mechanism provided here supports
+    mapping of error values to the strings displayed for the module
+    and operation raising the exception, as well as a description of
+    the exception condition.
+
+    The facilities provided by the module cover these functional areas:
+      (1) translation between local exception enumerations to the
+	  global gneral error code, and the reverse translation;
+      (2) the standard error reporting mechanism;
+      (3) predefined error handlers; and
+      (4) standard exception handler invocation mechanism.
+
+
+    REVISION HISTORY
+    v1.0  Sun, Mar 5, 1989  C. Lins
+      Initial JPI implementation.
+
+    CONSTRUCTORS
+    * Raise in ModuleID, in Operation, in Exception, in HandlerProc
+	Requires: NOTHING
+	Modifies: NOTHING
+	Effects:  Standard exception handler activation routine
+		  1. If the HandlerProc is not ╥NullHandler╙, the
+		     handler is invoked, followed by exiting Raise.
+		     (Assuming the HandlerProc returns).
+		  2. Otherwise, if the default handler is ╥NullHandler╙,
+		     Raise is exited.
+	Signals:  NOTHING
+
+    PROPRIETARY NOTICES
+    "ErrorHandling.DEF" Copyright (C) 1989 Charles A. Lins.
+====================================================================*)
+
+FROM SYSTEM IMPORT (*--Type*) BYTE;
+
+    (*-----------------------*)
+
+TYPE  ModuleNo	  = CARDINAL;
+TYPE  Operation   = BYTE;
+TYPE  Exception   = BYTE;
+
+TYPE  HandlerProc = PROCEDURE (ModuleNo, Operation, Exception);
+CONST NullHandler = NULLPROC;
+
+PROCEDURE ExitOnError	 (    moduleID	 : ModuleNo    (*-- in	  *);
+			      operation  : Operation   (*-- in	  *);
+			      exception  : Exception   (*-- in	  *));
+
+PROCEDURE Raise 	 (    moduleID	 : ModuleNo    (*-- in	  *);
+			      operation  : Operation   (*-- in	  *);
+			      exception  : Exception   (*-- in	  *);
+			      theHandler : HandlerProc (*-- in	  *));
+
+END ErrorHandling.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/ERRORHAN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/ERRORHAN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/ERRORHAN.MOD
@@ -0,0 +1,44 @@
+IMPLEMENTATION MODULE ErrorHandling;
+(*====================================================================
+    Version  : 1.0  Sun, Mar 5, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Code Size: R-  bytes
+    Data Size: 10 bytes
+    Component: Standard Error Handling Support Utility
+
+    INTRODUCTION
+    This module provides a general support mechanism for the exceptions
+    declared by the various ADT component modules.
+
+    REVISION HISTORY
+    v1.0  Sun, Mar 5, 1989  C. Lins
+      Initial JPI implementation.
+
+    PROPRIETARY NOTICES
+    ErrorHandling.MOD Copyright (C) 1989 Charles A. Lins.
+====================================================================*)
+
+FROM SYSTEM IMPORT
+    (*--Type*) BYTE;
+
+
+PROCEDURE ExitOnError	 (    moduleID	 : CARDINAL    (*-- in	  *);
+			      operation  : BYTE        (*-- in	  *);
+			      exception  : BYTE        (*-- in	  *));
+BEGIN
+  HALT;
+END ExitOnError;
+(*----------------------------*)
+
+PROCEDURE Raise 	 (    moduleID	 : CARDINAL    (*-- in	  *);
+			      operation  : BYTE        (*-- in	  *);
+			      exception  : BYTE        (*-- in	  *);
+			      theHandler : HandlerProc (*-- in	  *));
+BEGIN
+  IF (theHandler # NullHandler) THEN
+    theHandler(moduleID, operation, exception);
+  END (*--if*);
+END Raise;
+(*----------------------------*)
+
+END ErrorHandling.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/ITEMS.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/ITEMS.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/ITEMS.DEF
@@ -0,0 +1,238 @@
+DEFINITION MODULE Items;
+(*==============================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Structure - Generic Item Types
+
+    INTRODUCTION
+    This module provides the abstract data type, Item, which has the
+    operations of Assignment (:=), (In)Equality (=,#), Comparison
+    (<,<=,=,#,>=,>), Disposal, and iterator support routines.  Actual
+    routines providing these facilities must be either imported from
+    the predefined ItemOperations module (for the standard types) or
+    be provided by the programmer.
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    INTERFACE DESIGN ISSUES
+    The primary issue is to provide generic facilities.  In order to
+    represent a generic data type one must have available operations
+    equivalent to the standard operations for assignment (:=),
+    (in)equality comparison (=,#) and for ordered data types, the
+    relational operators (<,=,>).  These are the minimum operations
+    that must be available for having a functional data type.
+    The standard Modula-2 facilities for these operations on an
+    opaque type would yield semantics where one would assign and
+    compare the opaque type itself, this typically being a pointer
+    type.  Since we wish to allow non-pointer types as legitimate
+    values for an item, using the standard operators would suffice
+    for this purpose.  But we also allow wish to allow the use of
+    abstract data structures and dynamically allocated variables as
+    items. In this case the standard operators would operate on the
+    ADDRESS of or the POINTER TO the value of an item instead of the
+    value itself.  This is sufficient for (in)equality comparisons,
+    but assignment of pointer types results in sharing of the pointer,
+    not copying of the value.  Furthermore, relational comparisons of
+    < or > are meaningless since we only have the ADDRESS of the value,
+    not the value itself, and Modula-2 does not allow these operations
+    on opaque types anyway.
+
+    REFERENCES
+    [1] K. John Gough, ╥Writing Generic Utilities in Modula-2╙,
+	Journal of Pascal, Ada, and Modula-2, Vol. 5 (3),
+	May/June 1986, pp. 53-62.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved.
+==============================================================*)
+
+FROM Relations IMPORT
+    (*--Type*) Relation, RelOp;
+
+
+(*
+    This module provides support for generic data items.  This is
+    accomplished by providing an opaque type, ╥Item╙, representing an
+    arbitrary data type.  The advantage of this technique is in
+    allowing the creation of modules that can manipulate generic data
+    structures with a minimum of knowledge about the actual data being
+    manipulated.  Thus, a single module is needed to implement specific
+    forms of a data structure. Plus the module need only be concerned
+    with actual implementation issues regarding that structure.  For
+    example, there need be only one unbounded stack module, one bounded
+    stack module, etc.	If necessary, type-specific modules can be built
+    on top of the generic module.  Of course, there are constraints that
+    must be placed on the client module(s) to insure proper usage of a
+    generic item.  These are listed below:
+
+    1. The actual data type mapped to an Item must be compatible with
+       SYSTEM.ADDRESS.	Specifically, the relation SIZE(DataType) <=
+       SIZE(SYSTEM.ADDRESS) must be true.  If this condition is not met,
+       (e.g., a record or array structure), then the client module must
+       use a pointer to the actual data.
+
+    2. Modula-2 supports only a limited number of the standard operations
+       for opaque types.  These are assignment (:=) and the test for
+       (in)equality (=,#).  The relational operators <, <=, >, and >= are
+       not supported for opaque types.	This restriction means that when
+       a generic module requires relational operators, the client module
+       must provide this facility to the generic module.
+*)
+
+
+TYPE  Item;			 (*-- The generic data type *)
+CONST NullItem = Item(NIL); (*-- An empty value for an item *)
+
+
+(*--  CONSTRUCTORS
+
+  * AssignProc (in Item) out Item
+    Defines a generic function procedure type representing the equivalent
+    semantics as the standard Modula-2 assignment operator.  A generic module
+    must have a mechanism for assigning generic items to efficiently implement
+    the standard Assign operation.  For all of the simple data types (CHAR, INTEGER,
+    CARDINAL, etc.) the assignment operator suffices to accomplish this goal.  But
+    for dynamically created items, using := would result in copying pointers to the
+    actual data.  This is undesirable when the intended effect is to make a copy of
+    the data itself.  For this reason, this routine template is provided.
+
+  * DisposeProc (inout Item)
+    Disposal defines a generic procedure type (for which an actual procedure must be
+    provided) that will deallocate any and all dynamically allocated resources that
+    may be associated with a given instance of an Item.  Use of this routine will
+    prevent the creation of dangling pointers (a.k.a. garbage) for items created
+    using NEW or ALLOCATE when these items are released by a generic module.
+
+  * NoAssignProc
+    Defines a procedure ╥constant╙ representing the standard Modula-2
+    assignment operator, :=, which cannot be used as a procedure type
+    parameter.
+
+  * NoDisposeProc
+    Defines a procedure ╥constant╙ representing disposal of items
+    statically allocated on the stack.	This may be used for primitive
+    data items CHAR, INTEGER, etc.  It is more efficient to test for an
+    empty disposal routine rather than forcing the client to provide a
+    disposal routine that does nothing.
+--*)
+
+TYPE  AssignProc  = PROCEDURE (    Item      (*-- in	*))
+				   : Item    (*-- out	*);
+
+TYPE  DisposeProc = PROCEDURE (VAR Item      (*-- inout *));
+
+CONST NoDisposeProc = NULLPROC;
+CONST NoAssignProc  = NULLPROC;
+
+
+(*--  SELECTORS
+
+  * EqualProc  (in Item, in Item) out BOOLEAN
+    A generic function procedure type (for which an actual procedure
+    must be provided) that yields the equivalent semantics as the
+    standard Modula-2 relational operators for simple data types.
+
+  * NoEqualProc
+    Defines a procedure "constant" representing the standard Modula-2
+    equality operator, =, which cannot be used as a procedure type
+    parameter.
+
+--*)
+
+TYPE  EqualProc = PROCEDURE (	 Item	    (*-- in    *),
+				 Item	    (*-- in    *))
+				 : BOOLEAN  (*-- out   *);
+
+CONST NoEqualProc = NULLPROC;
+
+
+(*--
+  * CompareProc (in Item, in Item) out Relation
+    A generic function procedure type (for which an actual procedure
+    must be provided) that yields the equivalent semantics as the
+    standard Modula-2 comparison operator establishing the ordering
+    relationship for simple data types.  A routine of this type
+    attempts to answer the question "What is the ordering relation
+    between the first (or left) operand and the second (or right)
+    operand?"
+
+  * RelationProc (in Item, in Relation, in Item) out Boolean
+    A generic function procedure type (for which an actual procedure
+    must be provided) that yields the equivalent semantics as the
+    standard Modula-2 ordering relations used in comparisons to
+    evaluate the existence of a given ordering relationship between
+    (compatible) data types.  A routine of this type attempts to
+    answer the question "Does the ordering relation between the first
+    (or left) operand and the second (or right) operand match the
+    given relation?"
+
+  * RelOpProc (in Item ,in RelOp, in Item) out Boolean
+    Same as RelationProc above, except that the full set of relational
+    operators are allowed, e.g., <, <=, =, #, >, and >=.
+--*)
+
+TYPE  CompareProc  = PROCEDURE (    Item       (*-- in	  *),
+				    Item       (*-- in	  *))
+				    : Relation (*-- out   *);
+
+TYPE  RelationProc = PROCEDURE (    Item       (*-- in	  *),
+				    Relation   (*-- in	  *),
+				    Item       (*-- in	  *))
+				    : BOOLEAN  (*-- out   *);
+
+TYPE  RelOpProc    = PROCEDURE (    Item       (*-- in	  *),
+				    RelOp      (*-- in	  *),
+				    Item       (*-- in	  *))
+				    : BOOLEAN  (*-- out   *);
+
+
+(*--  ITERATORS
+
+  * AccessProc (in Item)
+    Defines a generic procedure type (for which an actual procedure
+    must be provided) that allows read-only access to a generic item
+    from within the standard iterator operation ╥Traverse╙.
+
+  * ChangeProc (inout Item)
+    Defines a generic procedure type (for which an actual procedure
+    must be provided) that allows read-write access to a generic item
+    from within the standard iterator operation ╥TravChange╙.
+
+  * LoopAccessProc (in Item) out Continue
+    Defines a generic procedure type (for which an actual procedure
+    must be provided) that allows read-only access to a generic item
+    from within the standard iterator operation ╥LoopOver╙.  The actual
+    routine matching this declaration may control continuation of the
+    iteration through the function result ╥Continue╙.
+      * TRUE continues the iteration
+      * FALSE terminates the iteration
+    These two results account for the renaming of the BOOLEAN function
+    result, clarifying the semantic meaning of the result.
+
+  * LoopChangeProc (inout Item) outContinue
+    Defines a generic procedure type (for which an actual procedure
+    must be provided) that allows read-write access to a generic item
+    from within the standard iterator operation ╥LoopChange╙.  The
+    actual routine matching this declaration may control continuation
+    of the iteration through the function result ╥Continue╙.
+      * TRUE continues the iteration
+      * FALSE terminates the iteration
+    These two results account for the renaming of the BOOLEAN function
+    result, clarifying the semantic meaning of the result.
+
+--*)
+
+
+TYPE  AccessProc     = PROCEDURE (    Item	 (*-- in    *));
+TYPE  ChangeProc     = PROCEDURE (VAR Item	 (*-- inout *));
+
+TYPE  Continue	     = BOOLEAN;
+TYPE  LoopAccessProc = PROCEDURE (    Item	 (*-- in    *))
+				      : Continue (*-- out   *);
+TYPE  LoopChangeProc = PROCEDURE (VAR Item	 (*-- inout *))
+				      : Continue (*-- out   *);
+
+END Items.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/ITEMS.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/ITEMS.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/ITEMS.MOD
@@ -0,0 +1,24 @@
+IMPLEMENTATION MODULE Items;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Structure - Generic Item Types
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    IMPLEMENTATION DESIGN NOTES
+    * The actual type for the opaque Item must be defined.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved.
+====================================================================*)
+
+FROM SYSTEM IMPORT
+    (*--Type*) ADDRESS;
+
+TYPE  Item = ADDRESS;
+
+END Items.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/JPISTORA.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/JPISTORA.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/JPISTORA.DEF
@@ -0,0 +1,38 @@
+DEFINITION MODULE JPIStorage; 
+(*====================================================================
+    Version  : 1.0	Sat, Mar 4, 1989	C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Tool - JPI Storage Management Utility for M2SCL
+
+    INTRODUCTION
+    This module provides facilities for allocation and deallocation of
+	dynamic memory.  The routines are compatible with the JPI Storage
+	module. Allocate differs from ALLOCATE in returning NIL
+	if unsuccessful instead of HALTing. Deallocate does nothing if
+	the given pointer is NIL, otherwise NIL is returned.
+
+    REVISION HISTORY
+    v1.00  04 Mar 1989  C. Lins:
+        Initial implementation.
+
+    UNDESIRED EVENTS and EXCEPTIONS
+    * Overflow - Memory allocation failure, insufficient memory.
+
+    INTERFACE DESIGN ISSUES
+    * Interface compatibility with the module Storage.
+====================================================================*)
+
+FROM SYSTEM IMPORT
+    (*--Type*) ADDRESS;
+
+
+    (*-----------------------*)
+    (*     CONSTRUCTORS      *)
+
+PROCEDURE Allocate   (VAR thePointer : ADDRESS  (*--out  *);
+                          theSize    : CARDINAL (*--in   *));
+
+PROCEDURE Deallocate (VAR thePointer : ADDRESS  (*--inout*);
+                          theSize    : CARDINAL (*--in   *));
+
+END JPIStorage.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/JPISTORA.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/JPISTORA.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/JPISTORA.MOD
@@ -0,0 +1,53 @@
+IMPLEMENTATION MODULE JPIStorage; 
+(*====================================================================
+    Version  : 1.0	Sat, Mar 4, 1989	C. Lins
+    Compiler : JPI TopSpeed Modula-2
+	Code Size: R-  bytes
+    Component: Tool - JPI M2SCL Storage Management Utility
+
+    INTRODUCTION
+    This module provides facilities for allocation and deallocation of
+	dynamic memory.  The routines are compatible with the JPI Storage
+	module. Allocate differs from ALLOCATE in returning NIL
+	if unsuccessful instead of HALTing. Deallocate does nothing if
+	the given pointer is NIL, otherwise NIL is returned.
+
+    REVISION HISTORY
+    v1.0	Sat, Mar 4, 1989	C. Lins
+      Initial implementation.
+
+	PROPRIETARY NOTICES
+    JPIStorage.MOD Copyright (C) 1989 Charles A. Lins.
+====================================================================*)
+
+FROM SYSTEM IMPORT
+    (*--Type*) ADDRESS;
+
+FROM Storage IMPORT
+    (*--Proc*) ALLOCATE, DEALLOCATE, Available;
+
+    (*-----------------------*)
+    (*     CONSTRUCTORS      *)
+
+PROCEDURE Allocate   (VAR thePointer : ADDRESS  (*--out  *);
+                          theSize    : CARDINAL (*--in   *));
+BEGIN
+  IF Available(theSize) THEN
+    ALLOCATE(thePointer, theSize);
+  ELSE
+  	thePointer := NIL;
+  END (*--if*);
+END Allocate;
+(*--------------------*)
+
+PROCEDURE Deallocate (VAR thePointer : ADDRESS  (*--inout*);
+                          theSize    : CARDINAL (*--in   *));
+BEGIN
+  IF (thePointer # NIL) THEN
+    DEALLOCATE(thePointer, theSize);
+	thePointer := NIL;
+  END (*--if*);
+END Deallocate;
+(*--------------------*)
+
+END JPIStorage.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/QENUM.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/QENUM.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/QENUM.DEF
@@ -0,0 +1,47 @@
+DEFINITION MODULE QEnum;
+(*===========================================================
+    Version  : 1.00  03 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tool - Queue/Deque Enumerations Utility
+
+    REVISION HISTORY
+    v1.00  03 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+CONST ComponentID      = 1280;  (*-- must be a multiple of 256 *)
+CONST DequeComponentID = 1536;  (*-- must be a multiple of 256 *)
+
+TYPE  Operations = (modinit,
+
+                    create, destroy, clear, assign,
+                    arrive, depart, leave,
+
+                    isdefined, isempty, isequal, lengthof,
+                    sizeof, typeof, frontof, rearof, endof,
+                    positionof,
+
+                    loopover, traverse,
+
+                    seize, release
+                   );
+
+TYPE  Constructors = [ create    .. leave ];
+TYPE  Selectors    = [ isdefined .. positionof ];
+TYPE  Iterators    = [ loopover  .. traverse ];
+
+
+TYPE  Exceptions = (noerr,
+                    initfailed,
+                    notfound,
+                    overflow,
+                    typeerror,
+                    underflow,
+                    undefined
+                   );
+
+TYPE  ExceptionSet = SET OF Exceptions;
+
+END QEnum.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/QENUM.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/QENUM.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/QENUM.MOD
@@ -0,0 +1,3 @@
+IMPLEMENTATION MODULE QEnum;
+
+END QEnum.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/RELATION.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/RELATION.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/RELATION.DEF
@@ -0,0 +1,65 @@
+DEFINITION MODULE Relations;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Tool - Relational Operators Utility
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    INTRODUCTION
+    This module provides definitions for the standard Modula-2 relations
+    and relational operators, along with routines for mapping one type to
+    the other, deriving the NOT of a relational operator, and testing for
+    a given relational operator implying that another relational operator
+    is also true.
+
+    PROPRIETARY NOTICES
+    "Relations.DEF" Copyright (C) 1989 Charles A. Lins.
+====================================================================*)
+
+(*
+    Relation defines the minimum set of relational operators from which all
+    others may be derived.  The following equivalent notations should be noted:
+	# -> NOT EqualTo
+	<= -> NOT GreaterThan
+	>= -> NOT LessThan.
+
+    RelOp defines the standard Modula-2 relational operators.
+*)
+
+TYPE  Relation = (		(*-- Ordering Relations *)
+		  less, 	(*-- <	less than	*)
+		  equal,	(*-- =	equal to	*)
+		  greater,	(*-- >	greater than	*)
+		  incomparable	(*-- ?	failure result	*)
+		 );
+
+TYPE  RelOp    = (		(*-- Relational Operators	 *)
+		  lt,		(*-- <	less than		 *)
+		  le,		(*-- <=	less than or equal to	 *)
+		  eq,		(*-- =	equal to		 *)
+		  ne,		(*-- #	not equal to		 *)
+		  gt,		(*-- >	greater than		 *)
+		  ge,		(*-- >=	greater than or equal to *)
+		  unordered	(*-- ?	failure result		 *)
+		 );
+
+
+PROCEDURE RelToRelOp (	  theRelation: Relation (*-- in    *))
+				     : RelOp	(*-- out   *);
+
+PROCEDURE RelOpToRel (	  theRelOp   : RelOp	(*-- in    *))
+				     : Relation (*-- out   *);
+
+    (*-----------------------*)
+
+PROCEDURE NotRelOpOf (	  theRelOp   : RelOp	(*-- in    *))
+				     : RelOp	(*-- out   *);
+
+PROCEDURE AImpliesB  (	  left	     : RelOp	(*-- in    *);
+			  right      : RelOp	(*-- in    *))
+				     : BOOLEAN	(*-- out   *);
+
+END Relations.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/RELATION.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/RELATION.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/RELATION.MOD
@@ -0,0 +1,126 @@
+IMPLEMENTATION MODULE Relations;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Tool - Relational Operators Utility
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    INTRODUCTION
+    This module provides definitions for the standard Modula-2 relations
+    and relational operators, along with routines for mapping one type to
+    the other, deriving the NOT of a relational operator, and testing for
+    a given relational operator implying that another relational operator
+    is also true.
+
+    LOCAL DATA TYPES
+    * RelSet	 Defines a set of relational operators.
+
+    LOCAL VARIABLES
+    * relMap
+	Mapping array of relational operators to a RelSet. It is used by the
+	relational expression routines to easily determine whether the result
+	from a comparison routine meeting the expression relation.
+
+		   Set of
+		  Relations
+	  Index    Mapping
+	  ╤╤╤╤╤   ╤╤╤╤╤╤╤╤╤
+	    <=	  {<=, <, =}
+	    <	  {<=, <, #}
+	    =	  {<=, =, >=}
+	    #	  {<, #, >}
+	    >	  {#, >, >=}
+	    >=	  {=, >, >=}
+	    ?	  {}
+
+    * NOTRelation
+	Mapping of relational operators to the opposite operator, i.e., = τ #.
+
+    INITIALIZATION ROUTINES
+    * InitRelMapping:  Initialize the mapping array relMap.
+    * InitNOTMapping:  Initialize the mapping array NOTRelation.
+
+    PROPRIETARY NOTICES
+    Relations.MOD, by C. Lins, Copyright (C) 1989 Charles A. Lins.
+====================================================================*)
+
+
+VAR   mapToRelOp : ARRAY Relation OF RelOp;
+
+PROCEDURE RelToRelOp (	  theRelation: Relation (*-- in    *))
+				     : RelOp	(*-- out   *);
+BEGIN
+  RETURN mapToRelOp [ theRelation ];
+END RelToRelOp;
+(*----------------------------*)
+
+
+VAR   mapRelation: ARRAY RelOp OF Relation;
+
+PROCEDURE RelOpToRel (	  theRelOp   : RelOp	(*-- in    *))
+				     : Relation (*-- out   *);
+BEGIN
+  RETURN mapRelation [ theRelOp ];
+END RelOpToRel;
+(*----------------------------*)
+
+
+VAR   notRelOp : ARRAY RelOp OF RelOp;
+
+PROCEDURE NotRelOpOf (	  theRelOp   : RelOp	(*-- in    *))
+				     : RelOp	(*-- out   *);
+BEGIN
+  RETURN notRelOp [ theRelOp ];
+END NotRelOpOf;
+(*----------------------------*)
+
+
+TYPE  RelSet = SET OF RelOp;
+VAR   relMap : ARRAY RelOp OF RelSet;
+
+PROCEDURE AImpliesB  (	  left	     : RelOp	(*-- in    *);
+			  right      : RelOp	(*-- in    *))
+				     : BOOLEAN	(*-- out   *);
+BEGIN
+  RETURN left IN relMap [ right ];
+END AImpliesB;
+(*----------------------------*)
+
+
+(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
+(*   MODULE INITIALIZATION    *)
+
+BEGIN
+  relMap [ lt ] := RelSet {le, lt, ne};
+  relMap [ le ] := RelSet {le, lt, eq};
+  relMap [ eq ] := RelSet {le, eq, ge};
+  relMap [ ne ] := RelSet {lt, ne, gt};
+  relMap [ gt ] := RelSet {ge, gt, ne};
+  relMap [ ge ] := RelSet {eq, ge, gt};
+  relMap [ unordered ] := RelSet {};
+
+  notRelOp [ lt ] := ge;
+  notRelOp [ le ] := gt;
+  notRelOp [ eq ] := ne;
+  notRelOp [ ne ] := eq;
+  notRelOp [ gt ] := le;
+  notRelOp [ ge ] := lt;
+  notRelOp [ unordered ] := unordered;
+
+  mapToRelOp  [ less	] := lt;
+  mapToRelOp  [ equal	] := eq;
+  mapToRelOp  [ greater ] := gt;
+  mapToRelOp  [incomparable] := unordered;
+
+  mapRelation [ lt ] := less;
+  mapRelation [ le ] := incomparable;
+  mapRelation [ eq ] := equal;
+  mapRelation [ ne ] := incomparable;
+  mapRelation [ gt ] := greater;
+  mapRelation [ ge ] := incomparable;
+  mapRelation [ unordered ] := incomparable;
+END Relations.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/TYPEMANA.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/TYPEMANA.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/TYPEMANA.DEF
@@ -0,0 +1,71 @@
+DEFINITION MODULE TypeManager;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Tool - Dynamic Type Management Utility
+
+    INTRODUCTION
+    This module provides facilities for defining generic item types
+    and associating assignment, comparison and disposal routines with
+    that type.
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved.
+====================================================================*)
+
+FROM  Items  IMPORT
+    (*--Type*) AssignProc, CompareProc, DisposeProc;
+
+    (*-----------------------*)
+
+TYPE  TypeID;
+TYPE  TypeName = ARRAY [0 .. 15] OF CHAR;
+
+CONST NullType = TypeID(NIL);
+
+
+    (*-----------------------*)
+    (*	   CONSTRUCTORS      *)
+
+CONST NoCompareProc = NULLPROC;
+
+PROCEDURE Create    (	 theName    : TypeName	  (*-- in    *);
+			 assignment : AssignProc  (*-- in    *);
+			 comparison : CompareProc (*-- in    *);
+			 deallocate : DisposeProc (*-- in    *))
+				    : TypeID	  (*-- out   *);
+
+PROCEDURE CharTypeID	 () : TypeID   (*-- out   *);
+PROCEDURE IntegerTypeID  () : TypeID   (*-- out   *);
+PROCEDURE CardinalTypeID () : TypeID   (*-- out   *);
+PROCEDURE LongIntTypeID  () : TypeID   (*-- out   *);
+PROCEDURE LongCardTypeID () : TypeID   (*-- out   *);
+PROCEDURE RealTypeID	 () : TypeID   (*-- out   *);
+
+    (*-----------------------*)
+    (*	    SELECTORS	     *)
+
+PROCEDURE NameOf    (	 theType : TypeID      (*-- in	  *);
+		     VAR theName : TypeName    (*-- out   *));
+
+PROCEDURE AssignOf  (	 theType : TypeID      (*-- in	  *))
+				 : AssignProc  (*-- out   *);
+
+PROCEDURE CompareOf (	 theType : TypeID      (*-- in	  *))
+				 : CompareProc (*-- out   *);
+
+PROCEDURE DisposeOf (	 theType : TypeID      (*-- in	  *))
+				 : DisposeProc (*-- out   *);
+
+PROCEDURE AttributesOf (    theType    : TypeID      (*-- in	*);
+			VAR theName    : TypeName    (*-- out	*);
+			VAR assignment : AssignProc  (*-- out	*);
+			VAR comparison : CompareProc (*-- out	*);
+			VAR deallocate : DisposeProc (*-- out	*));
+
+END TypeManager.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/TYPEMANA.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/TYPEMANA.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/DeQueues/TYPEMANA.MOD
@@ -0,0 +1,209 @@
+IMPLEMENTATION MODULE TypeManager;
+(*====================================================================
+    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Tool - Dynamic Type Management Utility
+
+    REVISION HISTORY
+    v1.0  Sat, Mar 4, 1989  C. Lins
+      Initial JPI implementation.
+
+    Proprietary Notices
+      Copyright (C) 1989 Charles A. Lins. All rights reserved.
+====================================================================*)
+
+FROM SYSTEM IMPORT
+    (*--Proc*) ADR;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate;
+
+FROM Items IMPORT
+    (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM ItemOperations IMPORT
+    (*--Proc*) AssignItem, CharCompare, IntegerCompare, CardinalCompare,
+	       LongIntCompare, LongCardCompare, RealCompare;
+
+    (*-----------------------*)
+
+TYPE  TypeID   = POINTER TO TypeNode;
+TYPE  TypeNode = RECORD
+	name	: TypeName;    (*-- Name for this type *)
+	assign	: AssignProc;  (*-- Assignment routine *)
+	compare : CompareProc; (*-- Comparison routine *)
+	dispose : DisposeProc; (*-- Item Disposal routine *)
+      END (*-- TypeNode *);
+
+
+    (*-----------------------*)
+
+TYPE  SimpleTypes = (chars, ints, cards, longints, longcards, reals);
+VAR   basicTypes  : ARRAY SimpleTypes OF TypeNode;
+
+
+    (*-----------------------*)
+
+PROCEDURE NullDispose (VAR theItem : Item (*-- inout *));
+BEGIN
+END NullDispose;
+(*----------------------------*)
+
+
+    (*-----------------------*)
+    (*	   CONSTRUCTORS      *)
+
+PROCEDURE Build     (	 theName    : TypeName	  (*-- in    *);
+			 assignment : AssignProc  (*-- in    *);
+			 comparison : CompareProc (*-- in    *);
+			 deallocate : DisposeProc (*-- in    *);
+		     VAR theTypeNode: TypeNode	  (*-- out   *));
+BEGIN
+  WITH theTypeNode DO
+    name    := theName;
+    assign  := assignment;
+    compare := comparison;
+    dispose := deallocate;
+  END (*--with*);
+END Build;
+(*----------------------------*)
+
+PROCEDURE Create    (	 theName    : TypeName	  (*-- in    *);
+			 assignment : AssignProc  (*-- in    *);
+			 comparison : CompareProc (*-- in    *);
+			 deallocate : DisposeProc (*-- in    *))
+				    : TypeID	  (*-- out   *);
+
+VAR   newType : TypeID;
+
+BEGIN
+  Allocate(newType, SIZE(TypeNode));
+  IF (newType # NullType) THEN
+    Build(theName, assignment, comparison, deallocate, newType^);
+  END (*--if*);
+  RETURN newType;
+END Create;
+(*----------------------------*)
+
+PROCEDURE CharTypeID	 () : TypeID   (*-- out   *);
+BEGIN
+  RETURN ADR(basicTypes[chars]);
+END CharTypeID;
+(*----------------------------*)
+
+PROCEDURE IntegerTypeID  () : TypeID   (*-- out   *);
+BEGIN
+  RETURN ADR(basicTypes[ints]);
+END IntegerTypeID;
+(*----------------------------*)
+
+PROCEDURE CardinalTypeID () : TypeID   (*-- out   *);
+BEGIN
+  RETURN ADR(basicTypes[cards]);
+END CardinalTypeID;
+(*----------------------------*)
+
+PROCEDURE LongIntTypeID  () : TypeID   (*-- out   *);
+BEGIN
+  RETURN ADR(basicTypes[longints]);
+END LongIntTypeID;
+(*----------------------------*)
+
+PROCEDURE LongCardTypeID () : TypeID   (*-- out   *);
+BEGIN
+  RETURN ADR(basicTypes[longcards]);
+END LongCardTypeID;
+(*----------------------------*)
+
+PROCEDURE RealTypeID	 () : TypeID   (*-- out   *);
+BEGIN
+  RETURN ADR(basicTypes[reals]);
+END RealTypeID;
+(*----------------------------*)
+
+
+    (*-----------------------*)
+    (*	    SELECTORS	     *)
+
+PROCEDURE NameOf    (	 theType : TypeID      (*-- in	  *);
+		     VAR theName : TypeName    (*-- out   *));
+BEGIN
+  IF (theType = NullType) THEN
+    theName := "";
+  ELSE
+    theName := theType^.name;
+  END (*--if*);
+END NameOf;
+(*----------------------------*)
+
+PROCEDURE AssignOf  (	 theType : TypeID      (*-- in	  *))
+				 : AssignProc  (*-- out   *);
+BEGIN
+  IF (theType = NullType) THEN
+    RETURN AssignItem;
+  END (*--if*);
+  RETURN theType^.assign;
+END AssignOf;
+(*----------------------------*)
+
+PROCEDURE CompareOf (	 theType : TypeID      (*-- in	  *))
+				 : CompareProc (*-- out   *);
+BEGIN
+  IF (theType = NullType) THEN
+    RETURN NoCompareProc;
+  END (*--if*);
+  RETURN theType^.compare;
+END CompareOf;
+(*----------------------------*)
+
+PROCEDURE DisposeOf (	 theType : TypeID      (*-- in	  *))
+				 : DisposeProc (*-- out   *);
+BEGIN
+  IF (theType = NullType) THEN
+    RETURN NullDispose;
+  END (*--if*);
+  RETURN theType^.dispose;
+END DisposeOf;
+(*----------------------------*)
+
+PROCEDURE AttributesOf (    theType    : TypeID      (*-- in	*);
+			VAR theName    : TypeName    (*-- out	*);
+			VAR assignment : AssignProc  (*-- out	*);
+			VAR comparison : CompareProc (*-- out	*);
+			VAR deallocate : DisposeProc (*-- out	*));
+BEGIN
+  IF (theType = NullType) THEN
+    theName    := "";
+    assignment := AssignItem;
+    comparison := NoCompareProc;
+    deallocate := NullDispose;
+  ELSE
+    WITH theType^ DO
+      theName	 := name;
+      assignment := assign;
+      comparison := compare;
+      deallocate := dispose;
+    END (*--with*);
+  END (*--if*);
+END AttributesOf;
+(*----------------------------*)
+
+
+(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
+(*~~ MODULE INITIALIZATION  ~~*)
+
+BEGIN
+  Build("CHAR",     AssignItem,  CharCompare,
+		    NullDispose, basicTypes[chars]);
+  Build("INTEGER",  AssignItem,  IntegerCompare,
+		    NullDispose, basicTypes[ints]);
+  Build("CARDINAL", AssignItem,  CardinalCompare,
+		    NullDispose, basicTypes[cards]);
+  Build("LONGINT",  AssignItem,  LongIntCompare,
+		    NullDispose, basicTypes[longints]);
+  Build("LONGCARD", AssignItem,  LongCardCompare,
+		    NullDispose, basicTypes[longcards]);
+  Build("REAL",     AssignItem,  RealCompare,
+		    NullDispose, basicTypes[reals]);
+END TypeManager.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBM.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBM.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBM.DEF
@@ -0,0 +1,212 @@
+(*
+7.1 Doubly-Linked Bounded List Interface
+
+Below is the equivalent interface for the doubly-linked bounded
+list.
+*)
+
+DEFINITION MODULE ListDBM;
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Polylithic Structures - List
+	Doubly-Linked Bounded Managed
+
+    The Abstraction
+    This module provides the List ADT for generic Items.
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+	(C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM ListEnum IMPORT
+    (*--Type*) Exceptions;
+
+    (*-----------------------*)
+
+(*
+7.1.1 Type Declarations
+
+The reader may remember from the bounded structures in Volume 1
+it was sufficient to modify the Create operation to include a
+parameter specifying the structure's desired maximum size.  And
+to allow the client to easily retrieve this limit, the selector
+SizeOf was also added as a convenience.  This approach could be
+taken for bounded lists as well resulting in each list created
+being associated with its own pool of nodes.  This is not necessarily
+bad, but potentially would be very wasteful of space since the
+pools (and the nodes resident there) could not be shared by all
+bounded lists of the same type.  
+
+The approach taken for the bounded list is in addition to the
+abstract type List, the abstract type Pool is exported along
+with a subrange representing the limits on the size of a node
+pool.  Now the client can create a number of Pools and associate
+Lists with a given pool.  The only constraint is that a List may
+not draw nodes from more than a single pool and all operations
+must identify the pool on which to operate.
+
+List cannot be declared opaque and then in the 
+implementation defined as a CARDINAL (at least in the TML Modula-2
+compiler); for this reason transparent export is used.  Furthermore,
+the pool size is restricted to a greater extent than in the
+singly-linked list due to compiler constraints on the size of
+arrays.  The constant NullList is used to terminate a sequence
+of links, either forward or backward.
+*)
+
+TYPE  Pool;
+TYPE  PoolSize = [1 .. 4000];
+
+TYPE  List     = CARDINAL;
+CONST NullList = 0;
+
+
+(*
+7.1.2 Exceptions
+
+The ModuleID uniquely identifies this module.  ListError returns
+the result code from the most recently invoked list operation.
+GetHandler and SetHandler allow assignment and retrieval,
+respectively, of exception handlers for specific exceptions.
+
+The undefined exception is associated with the type Pool, and the
+listisnull exception used to identify invalid operations on an
+empty list.  Overflow is raised when attempting to expand a list
+and there are no more nodes left in the pool.
+*)
+
+CONST ModuleID = 1;
+
+PROCEDURE ListError   ()	: Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+	theHandler: HandlerProc (*-- in    *));
+
+
+(*
+7.1.3 Constructors
+
+InitPool attempts to construct a node pool of the given size and
+FreePool releases the existing node pool.  In the list operations
+the internal state of the pool may change as a result of the operation
+but the actual value for the pool itself does not change; this is
+why thePool is labeled as inout without an accompanying VAR.
+
+Create retrieves a node from the given pool, raising overflow and
+returning the NullList if the node pool is already full.  It is
+equivalent to the routine GetNode seen in Pascal texts.
+
+Destroy returns theList node to the node pool and is equivalent
+to the routine FreeNode seen in Pascal texts.
+
+Definitions for the other constructors was given in Section 3.3,
+under Constructor Operations.
+*)
+
+PROCEDURE InitPool  (    theSize : PoolSize (*-- in    *))
+	: Pool     (*-- out   *);
+
+PROCEDURE FreePool  (    thePool : Pool     (*-- inout *));
+
+
+PROCEDURE Create    (    thePool : Pool     (*-- inout *))
+	: List     (*-- out   *);
+
+PROCEDURE Destroy   (    thePool : Pool     (*-- inout *);
+	VAR theList : List     (*-- inout *));
+
+PROCEDURE Clear     (    thePool : Pool     (*-- inout *);
+	VAR theList : List     (*-- inout *));
+
+PROCEDURE Assign    (    thePool : Pool     (*-- inout *);
+	theList : List     (*-- in    *);
+	VAR toList  : List     (*-- inout *));
+
+PROCEDURE SetItem   (    thePool : Pool     (*-- inout *);
+	theList : List     (*-- inout *);
+	theItem : Item     (*-- in    *));
+
+PROCEDURE SetNext   (    thePool : Pool     (*-- inout *);
+	theList : List     (*-- inout *);
+	newNext : List     (*-- in    *));
+
+PROCEDURE SetPrev   (    thePool : Pool     (*-- inout *);
+	theList : List     (*-- inout *);
+	newPrev : List     (*-- in    *));
+
+PROCEDURE SetList   (    thePool : Pool     (*-- inout *);
+	theItem : Item     (*-- in    *))
+	: List     (*-- out   *);
+
+PROCEDURE Insert    (    thePool : Pool     (*-- inout *);
+	theItem : Item     (*-- in    *);
+	VAR theList : List     (*-- inout *));
+
+
+(*
+7.1.4 Selectors
+
+The selectors have all been modified from the unbounded form to
+accept thePool parameter.  IsDefined has been added to test whether
+a given pool variable has been initialized.
+Definitions for the other selectors was given in Section 3.4,
+under Selector Operations.  All list selectors have a complexity
+of O(1) except for IsEqual which is O(Min(m,n)) and LengthOf which
+is O(n).
+*)
+
+PROCEDURE IsDefined (    thePool : Pool     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    thePool : Pool     (*-- in    *);
+	left    : List     (*-- in    *);
+	right   : List     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE GetNext   (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: List     (*-- out   *);
+
+PROCEDURE GetPrev   (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: List     (*-- out   *);
+
+PROCEDURE GetItem   (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: Item     (*-- out   *);
+
+END ListDBM.
+
+(*
+
+References
+
+[1] Aho, Hopcroft, and Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading MA 1983.
+[2] G. Booch, Software Components with Ada, Structures, Tools, and Subsystems,
+    Benjamin/Cummings, Menlo Park, CA 1987.
+[3] D. Knuth, The Art of Computer Programming, Volume 1, Fundamental
+    Algorithms, Addison-Wesley, Reading MA 1973.
+[4] R. Wiener and R. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY, 1986, pg. 198.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBM.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBM.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBM.MOD
@@ -0,0 +1,694 @@
+(*
+7.2 Doubly-Linked Bounded List Implementation
+
+Presented here is the implementation to the doubly-linked bounded
+list abstraction built using the same ideas applied in the
+singly-linked form.
+*)
+
+IMPLEMENTATION MODULE ListDBM;
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Polylithic Structures - List
+	Doubly-Linked Bounded Managed
+
+    The Abstraction
+    This module provides the List ADT for generic Items.
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+	(C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, Raise, ExitOnError;
+
+FROM ListEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+    (*-----------------------*)
+
+(*
+7.2.1 Internal Doubly-linked Bounded List Representation
+
+FIGURE 7.1
+
+A list is a recursive data structure defined as either:
+
+* an empty list (e.g., NIL), or
+* the chain of an item and a list.
+
+We shall model this structure directly with the chain of items
+being represented by a Node containing the item itself and a
+link to the next item in the list.  Then a list becomes a
+pointer to a Node.  Since we are drawing nodes from a pool, the
+pointers become indexes into the pool of nodes.  The pool itself,
+shown above in figure 7.1, uses a singly-linked list as there
+is no need to traverse the nodes backward.
+
+Representation Invariants:
+* an empty list is represented by NIL
+* the first non-empty node has a prev pointer of NIL
+* the last non-empty node has a next pointer of NIL
+
+Unfortunately, this does not allow us to manage the structure's
+data type as was the case for all of Volume 1 and the non-list
+modules in this volume.  The consequence is that the programmer
+must exercise greater discipline when using the module.
+*)
+
+TYPE  Node = RECORD
+	prev : List; (*-- Next node backward *)
+	item : Item; (*-- Data for the node *)
+	next : List; (*-- Next node forward *)
+      END (*-- Node *);
+
+TYPE  NodeHeap = ARRAY PoolSize OF Node;
+TYPE  NodePool = RECORD
+	free  : List;
+		size  : PoolSize;
+		nodes : NodeHeap;
+      END (*-- NodePool *);
+
+TYPE  Pool = POINTER TO NodePool;
+
+    (*--------------------*)
+
+(*
+7.2.2 Exceptions
+
+The listError variable holds the exception result from each
+operation and ListError simply returns this value.  It is
+initialized to noerr in section 7.2.6 Module Initialization.
+Each list operation, other than IsDefined, reinitializes
+listError to noerr as its first statement.  RaiseErrIn is
+used to assign an actual exception value to listError when
+a list operation raises an exception.
+
+handlers is an array of exception handling routines invoked
+when an exception is raised.  Each exception is initialized to
+ExitOnError other than noerr which is set to the NullHandler
+in section 7.2.6 Module Initialization.  GetHandler and
+SetHandler allow assignment and retrieval, respectively, of
+the exception handlers for specific exceptions.
+*)
+
+VAR   listError : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE ListError   ()	: Exceptions  (*-- out   *);
+BEGIN
+  RETURN listError;
+END ListError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+	theHandler: HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := theHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn  (    theRoutine: Operations  (*-- in    *);
+	theError  : Exceptions  (*-- in    *));
+BEGIN
+  listError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+(*
+7.2.3 Pool Constructors
+
+InitPool attempts to allocate a node pool of the given size and
+link all of its nodes together into the free list, (which is
+singly-linked).  We use the variable sized array allocation
+technique presented in the bounded component modules of Volume
+1.  Complexity: O(s) where s is the size of the node pool.
+*)
+
+PROCEDURE InitPool  (    theSize : PoolSize (*-- in    *))
+	: Pool     (*-- out   *);
+
+CONST baseSize = SIZE(NodePool) - SIZE(NodeHeap);
+CONST nodeSize = SIZE(Node);
+
+VAR   index   : List; (*-- loop index for building free list *)
+      newPool : Pool; (*-- new node pool being initialized *)
+
+BEGIN
+  listError := noerr;
+  Allocate(newPool, baseSize + nodeSize * theSize);
+  IF (newPool = NIL) THEN
+    RaiseErrIn(modinit, initfailed);
+  ELSE
+	WITH newPool^ DO
+	  FOR index := theSize - 1 TO MIN(PoolSize) BY -1 DO
+	    WITH nodes[index] DO
+	      prev := NullList;
+		  next := index + 1;
+		END (*--with*);
+	  END (*--while*);
+	  WITH nodes[theSize] DO
+	    prev := NullList;
+	    next := NullList;
+	  END (*--with*);
+	  free := MIN(PoolSize);
+	  size := theSize;
+	 END (*--with*);
+  END (*--if*);
+  RETURN newPool;
+END InitPool;
+(*--------------------*)
+
+(*
+FreePool simply needs to return the storage originally
+allocated to the pool back to the heap.  The routine
+MacSystem.Deallocate automatically releases the proper
+amount of storage and so does not have a size parameter as
+does SYSTEM.DEALLOCATE.  Complexity: O(1).
+*)
+
+PROCEDURE FreePool  (    thePool : Pool     (*-- inout *));
+
+CONST baseSize = SIZE(NodePool) - SIZE(NodeHeap);
+CONST nodeSize = SIZE(Node);
+
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(modinit, undefined);
+  ELSE
+    Deallocate(thePool, baseSize + nodeSize * thePool^.size);
+  END (*--if*);
+END FreePool;
+(*--------------------*)
+
+
+(*
+7.2.4 List Constructors
+
+Create retrieves a node from the given pool, raising overflow and
+returning the NullList if the node pool is already full.  It is
+equivalent to the routine GetNode seen in Pascal texts.
+Complexity: O(1).
+*)
+
+PROCEDURE Create    (    thePool : Pool     (*-- inout *))
+	: List     (*-- out   *);
+
+VAR   newNode : List;
+
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(create, undefined);
+    RETURN NullList;
+  END (*--if*);
+  WITH thePool^ DO
+    newNode := free;
+	IF (free = NullList) THEN
+	  RaiseErrIn(create, overflow);
+	ELSE
+	  free := nodes[free].next;
+	END (*--if*);
+  END (*--with*);
+  RETURN newNode;
+END Create;
+(*--------------------*)
+
+(*
+Destroy returns theList node to the node pool and is equivalent
+to the routine FreeNode seen in Pascal texts.  The given list
+node is simply added to the front of the available free list.
+Complexity O(1).
+*)
+
+PROCEDURE Destroy   (    thePool : Pool     (*-- inout *);
+	VAR theList : List     (*-- inout *));
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(destroy, undefined);
+  ELSE
+    WITH thePool^ DO
+	  nodes[theList].next := free;
+	  free := theList;
+    END (*--with*);
+	theList := NullList;
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+(*
+Clear proceeds over each node and simply returns it to the pool's
+free list. Complexity O(n).
+*)
+
+PROCEDURE Clear     (    thePool : Pool     (*-- inout *);
+	VAR theList : List     (*-- inout *));
+
+VAR   theNode : List; (*-- List node to be deallocated *)
+
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH thePool^ DO
+      WHILE (theList # NullList) DO
+	theNode := theList;
+	theList := nodes[theList].next;
+	    nodes[theNode].next := free;
+	    free := theNode;
+      END (*--while*);
+    END (*--with*);
+	theList := NullList;
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+(*
+Assign copies the source list to the target list.  If the
+two lists are the same, in other words point to the sam
+node, the routine simply exits as the target already is
+equal to the source.  Otherwise, the target list is cleared
+of its present contents.  If the source list is not empty
+the routine copies each node to the target using the TailInsert
+routine from algorithm 4.2.2 in Gonnet [3, pg. 137].
+Complexity: O(n).
+*)
+
+PROCEDURE Assign    (    thePool : Pool     (*-- inout *);
+	theList : List     (*-- in    *);
+	VAR toList  : List     (*-- inout *));
+
+VAR   newNode : List; (*-- new node from source to target *)
+      last    : List; (*-- last node inserted into target *)
+
+  PROCEDURE TailInsert (    theNode : List (*-- in    *);
+	VAR first   : List (*-- inout *);
+					    VAR last    : List (*-- inout *));
+  BEGIN
+    IF (first = NullList) THEN
+      first := theNode;
+    ELSE
+      thePool^.nodes[theNode].prev := last;
+      thePool^.nodes[last].next := theNode;
+    END (*--if*);
+    last := theNode;
+  END TailInsert;
+
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theList # toList) THEN
+    Clear(thePool, toList);
+    last := NullList;
+    WITH thePool^ DO
+      WHILE (theList # NullList) DO
+	    IF (free = NullList) THEN
+	      RETURN;
+	    END (*--if*);
+	newNode := free;
+	    free := nodes[free].next;
+
+	    WITH nodes[newNode] DO
+	      item := nodes[theList].item;
+	      next := NullList;
+	    END (*--with*);
+
+	    TailInsert(newNode, toList, last);
+	    theList := nodes[theList].next;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+(*
+SetItem takes the given list node and assigns theItem as its
+data item value.  SetNext simply links the given node to the
+next node given, while SetPrev links the given node to its
+predecessor.  An exception is raised in these routines if
+theList is empty.
+Complexity: O(1)
+*)
+
+PROCEDURE SetItem   (    thePool : Pool     (*-- inout *);
+	theList : List     (*-- inout *);
+	theItem : Item     (*-- in    *));
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(setitem, undefined);
+  ELSIF (theList = NullList) THEN
+    RaiseErrIn(setitem, listisnull);
+  ELSE
+    thePool^.nodes[theList].item := theItem;
+  END (*--if*);
+END SetItem;
+(*--------------------*)
+
+PROCEDURE SetNext   (    thePool : Pool     (*-- inout *);
+	theList : List     (*-- inout *);
+	newNext : List     (*-- in    *));
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(setnext, undefined);
+  ELSIF (theList = NullList) THEN
+    RaiseErrIn(setnext, listisnull);
+  ELSE
+    thePool^.nodes[theList].next := newNext;
+  END (*--if*);
+END SetNext;
+(*--------------------*)
+
+PROCEDURE SetPrev   (    thePool : Pool     (*-- inout *);
+	theList : List     (*-- inout *);
+	newPrev : List     (*-- in    *));
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(setnext, undefined);
+  ELSIF (theList = NullList) THEN
+    RaiseErrIn(setnext, listisnull);
+  ELSE
+    thePool^.nodes[theList].prev := newPrev;
+  END (*--if*);
+END SetPrev;
+(*--------------------*)
+
+(*
+SetList constructs a list of length one out of the given item.
+If the free list is empty the overflow exception is raised
+and the NullList returned,
+otherwise the top node is taken off the free list and the new
+list node is updated with the item value and null previous and
+next links.
+Complexity: O(1).
+*)
+
+PROCEDURE SetList   (    thePool : Pool     (*-- inout *);
+	theItem : Item     (*-- in    *))
+	: List     (*-- out   *);
+
+VAR   newList : List;
+
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(setlist, undefined);
+  ELSIF (thePool^.free = NullList) THEN
+    RaiseErrIn(setlist, overflow);
+  ELSE
+    WITH thePool^ DO
+      newList := free;
+	  free    := nodes[free].next;
+      WITH nodes[newList] DO
+	    item := theItem;
+	    next := NullList;
+	    prev := NullList;
+	  END (*--with*);
+	END (*--with*);
+	RETURN newList;
+  END (*--if*);
+  RETURN NullList;
+END SetList;
+(*--------------------*)
+
+(*
+Insert simply adds theItem to the front of theList by allocating
+a new list node from the given node pool and linking its next
+pointer to theList (which may be the NullList) and prev pointer
+to the NullList as theItem is now at the front of theList. A
+final detail is to ensure that theList's prev pointer is updated
+to the new list node.
+Complexity: O(1).
+*)
+
+PROCEDURE Insert    (    thePool : Pool     (*-- inout *);
+	theItem : Item     (*-- in    *);
+	VAR theList : List     (*-- inout *));
+
+VAR   newList : List; (*-- new list node for theItem *)
+
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(insert, undefined);
+  ELSIF (thePool^.free = NullList) THEN
+    RaiseErrIn(insert, overflow);
+  ELSE
+    WITH thePool^ DO
+      newList := free;
+	  free    := nodes[free].next;
+      WITH nodes[newList] DO
+	    item := theItem;
+		IF (theList = NullList) THEN
+		  prev := NullList;
+		ELSE
+		  prev := nodes[theList].prev;
+		END (*--if*);
+	    next := theList;
+	  END (*--with*);
+	  IF (theList # NullList) & (nodes[theList].prev # NullList) THEN
+	    nodes[nodes[theList].prev].next := newList;
+	  END (*--if*);
+	  IF (theList # NullList) THEN
+	    nodes[theList].prev := newList;
+	  END (*--if*);
+	  theList := newList;
+	END (*--with*);
+  END (*--if*);
+END Insert;
+(*--------------------*)
+
+
+(*
+7.2.5 Selectors
+
+IsDefined returns true if thePool appears to point to something,
+(i.e., not be NIL) and false otherwise.
+Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    thePool : Pool     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (thePool # NIL);
+END IsDefined;
+(*--------------------*)
+
+(*
+IsEmpty returns True if theList is in the empty state, as indicated by
+the list being equal to the null list, and False otherwise.  
+Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  listError := noerr;
+  RETURN (theList = NullList);
+END IsEmpty;
+(*--------------------*)
+
+(*
+IsEqual compares the left and right list for equality, which in this
+context means they contain the same items.  The algorithm simply loops
+over each of the items in both lists returning false immediately upon
+encountering an inequality, and returning true if and only if every
+item is the same between them. This condition is detected by
+both list pointers being the null list at the end of the loop.
+Complexity: O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    thePool : Pool     (*-- in    *);
+	left    : List     (*-- in    *);
+	right   : List     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+	RETURN FALSE;
+  ELSE
+    WITH thePool^ DO
+      WHILE (left # NullList) & (right # NullList) DO
+	IF (nodes[left].item # nodes[right].item) THEN
+	      RETURN FALSE;
+	    END (*--if*);
+	    left  := nodes[left].next;
+	    right := nodes[right].next;
+      END (*--while*);
+      RETURN (left = right) & (right = NullList);
+    END (*--with*);
+  END (*--if*);
+END IsEqual;
+(*--------------------*)
+
+(*
+LengthOf simply loops over the links of the list counting
+the number of list nodes it finds. Complexity: O(n).
+*)
+
+PROCEDURE LengthOf  (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+VAR   length : CARDINAL; (*-- Running count of items *)
+
+BEGIN
+  listError := noerr;
+  length    := 0;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(lengthof, undefined);
+  ELSE
+    WITH thePool^ DO
+      WHILE (theList # NullList) DO
+	    INC(length);
+	    theList := nodes[theList].next;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+  RETURN length;
+END LengthOf;
+(*--------------------*)
+
+(*
+GetNext simply returns the link to the next list node, or if
+given an empty list the listisnull exception is raised and the
+null list is returned.  If thePool itself is invalid the undefined
+exception is raised and the null item is returned.
+Complexity: O(1).
+*)
+
+PROCEDURE GetNext   (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: List     (*-- out   *);
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(getnext, undefined);
+    RETURN NullList;
+  ELSIF (theList = NullList) THEN
+    RaiseErrIn(getnext, listisnull);
+    RETURN NullList;
+  END (*--if*);
+  RETURN thePool^.nodes[theList].next;
+END GetNext;
+(*--------------------*)
+
+(*
+GetPrev simply returns the link to the previous list node, or if
+given an empty list the listisnull exception is raised and the
+null list is returned.  If thePool itself is invalid the undefined
+exception is raised and the null item is returned.
+Complexity: O(1).
+*)
+
+PROCEDURE GetPrev   (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: List     (*-- out   *);
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(getprev, undefined);
+    RETURN NullList;
+  ELSIF (theList = NullList) THEN
+    RaiseErrIn(getprev, listisnull);
+    RETURN NullList;
+  END (*--if*);
+  RETURN thePool^.nodes[theList].prev;
+END GetPrev;
+(*--------------------*)
+
+(*
+GetItem simply returns the item of the given list node, or if
+given an empty list the listisnull exception is raised and the
+null item is returned.  If thePool itself is invalid the undefined
+exception is raised and the null item is returned.
+Complexity: O(1).
+*)
+
+PROCEDURE GetItem   (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: Item     (*-- out   *);
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(getitem, undefined);
+    RETURN NullItem;
+  ELSIF (theList = NullList) THEN
+    RaiseErrIn(getitem, listisnull);
+    RETURN NullItem;
+  END (*--if*);
+  RETURN thePool^.nodes[theList].item;
+END GetItem;
+(*--------------------*)
+
+(*
+7.2.6 Module Initialization
+
+The module's local variables are initialized to known states.
+listError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.
+
+Since a FOR loop control variable is undefined following the loop,
+listError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR listError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(listError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  listError := noerr;
+END ListDBM.
+
+(*
+
+References
+
+[1] Aho, Hopcroft, and Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading MA 1983.
+[2] G. Booch, Software Components with Ada, Structures, Tools, and Subsystems,
+    Benjamin/Cummings, Menlo Park, CA 1987.
+[3] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Addison-Wesley, London England 1984.
+[4] D. Knuth, The Art of Computer Programming, Volume 1, Fundamental
+    Algorithms, Addison-Wesley, Reading MA 1973.
+[5] R. Wiener and R. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY, 1986, pg. 198.
+[6] N. Wirth, Algorithms and Data Structures, Prentice-Hall,
+    Englewood Cliffs, NJ 1986.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBMS.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBMS.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBMS.DEF
@@ -0,0 +1,116 @@
+(*
+Sequential Doubly-linked List Search Utilities - Interface
+
+In this section are provided several utility routines implementing
+search algorithms on doubly-linked unbounded lists.
+*)
+
+DEFINITION MODULE ListDBMSearch; 
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tools - Structure Utility - Doubly-linked List Search
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation.
+	(C) Copyright 1989 Charles A. Lins
+=============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc;
+
+FROM ListDBM IMPORT
+    (*--Type*) List, Pool;
+
+    (*--------------------*)
+
+TYPE  SuccessProc  = PROCEDURE (Item);
+TYPE  FailureProc  = PROCEDURE (Item);
+
+    (*--------------------*)
+
+(*
+PrimarySearch
+
+Searches theList for the first occurance of theItem with the required
+key.  This is called the primary key search.  It is assumed that the
+item comparison routine knows how to extract the key from the items
+if necessary.  If the search succeeds then the found procedure parameter
+is invoked, otherwise the notfound routine is called.  The list is
+assumed to be unordered.
+*)
+
+PROCEDURE PrimarySearch (    theItem   : Item	(*-- in    *);
+	theList   : List	(*-- in    *);
+	thePool   : Pool	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+
+(*
+SecondarySearch
+
+Searches theList for every occurance of theItem with the required
+key.  This is called the secondary key search.  It is assumed that the
+item comparison routine knows how to extract the key from the items
+if necessary.  Each time the search succeeds the found procedure parameter
+is invoked.  The list is assumed to be unordered.
+*)
+
+PROCEDURE SecondarySearch (    theItem   : Item	(*-- in    *);
+	theList   : List	(*-- in    *);
+	thePool   : Pool	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *));
+
+
+(*
+Self-organizing Sequential Search - MoveToFront
+
+This routine is essentially the primary key search modified to apply
+a heuristic for improving the list ordering.  When a key is found,
+theItem is moved to the front of the list.  The idea is that the
+access distribution of items in the list is unequal, and therefore,
+the most frequently accessed items should be closer to the front.
+For a sophisticated analysis comparing self-organizing heuristics
+see reference [1].
+*)
+
+PROCEDURE MoveToFront (    theItem   : Item	(*-- in    *);
+	VAR theList   : List	(*-- inout *);
+	thePool   : Pool	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+
+(*
+Self-organizing Sequential Search - Transpose
+
+Instead of moving the found item to the front of the list, the Transpose
+heuristic moves the item one position closer to the front by swapping
+positions with its predecessor.
+*)
+
+PROCEDURE Transpose (    theItem   : Item	(*-- in    *);
+	VAR theList   : List	(*-- inout *);
+	thePool   : Pool	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+END ListDBMSearch.
+
+(*
+
+References
+
+[1] J.L. Bentley and C.C. McGeoch, Worst-Case Analyses of
+    Self-Organizing Sequential Search Heuristics,
+	Carnegie-Mellon University, 1983.
+[2] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Searching Algorithms, Addison-Wesley, London 1984,
+	pp. 23-30.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBMS.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBMS.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBMS.MOD
@@ -0,0 +1,202 @@
+(*
+Doubly-linked List Sequential Search Utilities - Implementation
+
+Presented below are the implementation details of our sequential search
+algorithms for the doubly-linked bounded list.
+*)
+
+IMPLEMENTATION MODULE ListDBMSearch; 
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tools - Structure Utility - Doubly-linked List Search
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation.
+	(C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc;
+
+FROM ListDBM IMPORT
+    (*--Type*) List, Pool, NullList,
+    (*--Proc*) GetNext, GetItem, IsEmpty, SetNext, SetItem,
+			   GetPrev, SetPrev;
+
+    (*--------------------*)
+
+(*
+PrimarySearch
+
+Our primary key search routine has been optimized using the LOOP construct
+instead of a WHILE statement to avoid multiple calls to IsEmpty,
+GetItem, and keysEqual at the end of the routine when determining
+success or failure. (See reference [2]).
+*)
+
+PROCEDURE PrimarySearch (    theItem   : Item	(*-- in    *);
+	theList   : List	(*-- in    *);
+	thePool   : Pool	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+BEGIN
+  LOOP 
+    IF IsEmpty(thePool, theList) THEN
+      notFound(theItem);
+      EXIT (*--loop*);
+    ELSIF (keysEqual(GetItem(thePool, theList), theItem) = equal) THEN
+      found(theItem);
+      EXIT (*--loop*);
+    END (*--if*);
+    theList := GetNext(thePool, theList);
+  END (*--loop*);
+END PrimarySearch;
+(*-------------------------*)
+
+(*
+SecondarySearch
+
+Where the primary key search stops after the finding the first occurance
+of theItem, the secondary key search continues to the end of the list
+in order to find all occurances of theItem.  Therefore, the complexity
+is O(n).
+*)
+
+PROCEDURE SecondarySearch (    theItem   : Item	(*-- in    *);
+	theList   : List	(*-- in    *);
+	thePool   : Pool	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *));
+BEGIN
+  WHILE ~IsEmpty(thePool, theList) DO
+    IF keysEqual(GetItem(thePool, theList), theItem) = equal THEN
+      found(theItem);
+    END (*--if*);
+    theList := GetNext(thePool, theList);
+  END (*--while*);
+END SecondarySearch;
+(*-------------------------*)
+
+(*
+Self-organizing Sequential Search - MoveToFront
+
+The algorithm first takes care of the special cases where the list is
+empty or when the item is already at the front of the list. Then if it
+is necessary to scan the list, the routine does so remembering the last
+node examined in case theItem is found it can be easily moved to the
+front without searching for the node's predecessor.
+*)
+
+PROCEDURE MoveToFront (    theItem   : Item	(*-- in    *);
+	VAR theList   : List	(*-- inout *);
+	thePool   : Pool	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+VAR   index : List; (*-- loop index over the nodes of the list *)
+      next  : List; (*-- link to next node from the last node *)
+	  succ	: List; (*-- successor to indexes' successor *)
+
+BEGIN
+  IF IsEmpty(thePool, theList) THEN
+    notFound(theItem);
+  ELSIF keysEqual(theItem, GetItem(thePool, theList)) = equal THEN
+    found(theItem);
+  ELSE
+    index := theList;
+	LOOP
+	  next := GetNext(thePool, index);
+	  IF IsEmpty(thePool, next) THEN
+	notFound(theItem);
+	    EXIT (*--loop*);
+      ELSIF keysEqual(theItem, GetItem(thePool, next)) = equal THEN
+		
+		(*-- unlink found node from the list *)
+		succ := GetNext(thePool, next);
+		SetNext(thePool, index, succ);
+		IF ~IsEmpty(thePool, succ) THEN
+		  SetPrev(thePool, succ, index);
+		END (*--if*);
+		
+		(*-- relink found node at front of the list *)
+		SetPrev(thePool, next, NullList);
+	SetNext(thePool, next, theList);
+		SetPrev(thePool, theList, next);
+		
+		(*-- return found node as the new front *)
+	theList := next;
+	found(theItem);
+	EXIT (*--loop*);
+      END (*--if*);
+	  index := next;
+    END (*--loop*);
+  END (*--if*);
+END MoveToFront;
+(*-------------------------*)
+
+(*
+Self-organizing Sequential Search - Transpose
+
+The transpose hueristic is similar to the Move-To-Front method, above,
+except when theItem is found it is moved only one position forward in
+the list.  Here, theItem is used as a temporary when moving the value
+forward in the list.  For a Pascal version of this algorithm using arrays
+see Gonnet [2].
+*)
+
+PROCEDURE Transpose (    theItem   : Item	(*-- in    *);
+	VAR theList   : List	(*-- inout *);
+	thePool   : Pool	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+VAR   index : List; (*-- node being examined *)
+	  prev  : List; (*-- previous node *)
+	  data  : Item;
+
+BEGIN
+  IF IsEmpty(thePool, theList) THEN
+    notFound(theItem);
+  ELSIF keysEqual(theItem, GetItem(thePool, theList)) = equal THEN
+    found(theItem);
+  ELSE
+    index := theList;
+	LOOP
+	  index := GetNext(thePool, index);
+	  IF IsEmpty(thePool, index) THEN
+	notFound(theItem);
+	    EXIT (*--loop*);
+      ELSIF keysEqual(theItem, GetItem(thePool, index)) = equal THEN
+		data := GetItem(thePool, index);
+	    prev := GetPrev(thePool, index);
+	SetItem(thePool, index, GetItem(thePool, prev));
+		SetItem(thePool, prev, data);
+	found(theItem);
+	EXIT (*--loop*);
+      END (*--if*);
+    END (*--loop*);
+  END (*--if*);
+END Transpose;
+(*-------------------------*)
+
+END ListDBMSearch.
+
+(*
+
+References
+
+[1] J.L. Bentley and C.C. McGeoch, Worst-Case Analyses of
+    Self-Organizing Sequential Search Heuristics,
+	Carnegie-Mellon University, 1983.
+[2] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Searching Algorithms, Addison-Wesley, London 1984,
+	pp. 23-30.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBMT.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBMT.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBMT.DEF
@@ -0,0 +1,105 @@
+(*
+Doubly-Linked List Utilities - Interface
+
+In this section is provided a list utilities module for doubly-linked
+unbounded lists.  The routines implement such useful list operations as:
+
+Constructors
+∙ constructing a list from an array of items (Construct and Build),
+∙ merging two lists
+∙ inserting an item to the end of a list (AddToTail),
+
+Selectors
+∙ retrieving the link to the last item of a list (LastOf),
+*)
+
+DEFINITION MODULE ListDBMTools; 
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tools - Structure Utility - Doubly-Linked List
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation.
+	(C) Copyright 1989 Charles A. Lins
+=============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ListDBM IMPORT
+    (*--Type*) List, Pool;
+
+    (*--------------------*)
+
+TYPE  Position     = CARDINAL;
+CONST NullPosition = 0;
+
+
+    (*--------------------*)
+
+(*
+Constructors
+
+Construct builds a list from an array of Items.  If theList is not
+empty it is cleared of its contents before the construction commences.
+Build is similar except that only the first n items (numItems) are used to
+construct the list.
+
+AddToTail adds theItem to the end of theList.  Complexity: O(n).
+
+Split divides theList into two lists at theItem.  If theItem is not present
+in theList then the toList is unchanged.
+*)
+
+PROCEDURE Construct (    theItems : ARRAY OF Item (*-- in    *);
+	VAR theList  : List	(*-- inout *);
+					     thePool  : Pool		  (*-- in    *));
+
+PROCEDURE Build     (    theItems : ARRAY OF Item (*-- in    *);
+	numItems : CARDINAL      (*-- in    *);
+	VAR theList  : List	(*-- inout *);
+					     thePool  : Pool		  (*-- in    *));
+
+PROCEDURE AddToTail (    theItem  : Item	(*-- in    *);
+	VAR theList  : List	(*-- inout *);
+					     thePool  : Pool		  (*-- in    *));
+
+PROCEDURE Split     (VAR theList  : List	(*-- inout *);
+	theItem  : Item	(*-- in    *);
+	VAR toList   : List	(*-- inout *);
+					     thePool  : Pool		  (*-- in    *));
+
+
+(*
+Selectors
+
+LastOf returns the list containing the last item of theList or the NullList
+if theList is empty.
+
+PositionOf searches for theItem in theList returning theItem's position such
+that:
+	Position = 1 when theItem is at the front of theList,
+	Position = LengthOf(theList) when theItem is at the end of theList, and
+	Position = 0 when theItem is not present within theList.
+
+LocationOf returns a list beginning with the item at theIndex in theList.  If
+theList does not have such a positionthe NullList is returned.
+*)
+
+PROCEDURE LastOf     (    thePool : Pool     (*-- in    *);
+					      theList : List	 (*-- in    *))
+	: List     (*-- out   *);
+
+PROCEDURE PositionOf (    theItem : Item     (*-- in    *);
+	theList : List     (*-- in    *);
+					      thePool : Pool	 (*-- in    *))
+							: Position (*-- out   *);
+
+PROCEDURE LocationOf (    theIndex: Position (*-- in    *);
+	theList : List     (*-- in    *);
+					      thePool : Pool	 (*-- in    *))
+							: List     (*-- out   *);
+
+END ListDBMTools.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBMT.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBMT.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDBMT.MOD
@@ -0,0 +1,246 @@
+(*
+Doubly-linked List Utilities - Implementation
+
+*)
+
+IMPLEMENTATION MODULE ListDBMTools; 
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tools - Structure Utility - Doubly-Linked List
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation.
+	(C) Copyright 1989 Charles A. Lins
+=============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ListDBM IMPORT
+    (*--Type*) List, Pool, NullList,
+	(*--Proc*) IsEmpty, GetNext, GetItem, SetNext, SetList,
+		Clear, Assign, Insert, GetPrev, SetPrev;
+
+    (*--------------------*)
+
+(*
+Constructors
+
+Construct first clears theList, if necessary, and then loops over theItems
+in reverse order adding each item to the front of theList.
+*)
+
+PROCEDURE Construct (    theItems : ARRAY OF Item (*-- in    *);
+	VAR theList  : List	(*-- inout *);
+					     thePool  : Pool		  (*-- in    *));
+
+VAR   index : INTEGER; (*-- loop index over items array *)
+
+BEGIN
+  IF ~IsEmpty(thePool, theList) THEN
+    Clear(thePool, theList);
+  END (*--if*);
+  FOR index := HIGH(theItems) TO 0 BY -1 DO
+  	Insert(thePool, theItems[index], theList);
+  END (*--for*);
+END Construct;
+(*-------------------------*)
+
+(*
+Build is quite similar to Construct, above, in traversing theItems in
+reverse order appending items to the front of theList. The difference
+is that only the first numItems are used to form the list.  If numItems
+is greater than the actual number of items in theItems array, only those
+items truly present are inserted.
+Complexity: O(n) where n is the number of items inserted.
+*)
+
+PROCEDURE Build     (    theItems : ARRAY OF Item (*-- in    *);
+	numItems : CARDINAL      (*-- in    *);
+	VAR theList  : List	(*-- inout *);
+					     thePool  : Pool		  (*-- in    *));
+
+VAR   index : INTEGER; (*-- loop index over items array *)
+
+BEGIN
+  IF ~IsEmpty(thePool, theList) THEN
+    Clear(thePool, theList);
+  END (*--if*);
+  IF (numItems > VAL(CARDINAL, HIGH(theItems) + 1)) THEN
+    numItems := HIGH(theItems) + 1;
+  END (*--if*);
+  FOR index := VAL(INTEGER, numItems) - 1 TO 0 BY -1 DO
+  	Insert(thePool, theItems[index], theList);
+  END (*--for*);
+END Build;
+(*-------------------------*)
+
+(*
+AddToTail inserts theItem at the end of theList.  The routine first
+takes care of the trivial case where theList is empty.  Then it proceeds
+to scan theList for the last item.  Once this has been found, a new list
+(of length one) is created for the item, and the last node is linked to
+the new list.  Note: once the last node has been found, next is no longer
+needed and is therefore used as a temporary to create the new list for
+theItem.
+Complexity: O(n).
+*)
+
+PROCEDURE AddToTail (    theItem  : Item	(*-- in    *);
+	VAR theList  : List	(*-- inout *);
+					     thePool  : Pool		  (*-- in    *));
+
+VAR   last : List; (*-- last list node examined *)
+      next : List; (*-- link from last node to next node *) 
+
+BEGIN
+  IF IsEmpty(thePool, theList) THEN
+    theList := SetList(thePool, theItem);
+  ELSE
+    last := theList;
+    LOOP
+      next := GetNext(thePool, last);
+	  IF IsEmpty(thePool, next) THEN
+	    EXIT (*--loop*);
+	  END (*--if*);
+	  last := next;
+    END (*--loop*);
+    next := SetList(thePool, theItem);
+    SetNext(thePool, last, next);
+    SetPrev(thePool, next, last);
+  END (*--if*);
+END AddToTail;
+(*-------------------------*)
+
+(*
+Split searches theList maintaining a link to the previous node examined.
+When theItem is found at the front of theList, the toList becomes theList
+and theList becomes the empty list.  Otherwise, theList is truncated at
+the previous node examined, and the toList becomes a list beginning with
+theItem.
+*)
+
+PROCEDURE Split     (VAR theList  : List	(*-- inout *);
+	theItem  : Item	(*-- in    *);
+	VAR toList   : List	(*-- inout *);
+					     thePool  : Pool		  (*-- in    *));
+
+VAR   last  : List; (*-- last list node examined *)
+	  prev  : List;
+
+BEGIN
+  last  := theList;
+  LOOP
+	IF IsEmpty(thePool, last) THEN
+	  EXIT (*--loop*);
+    ELSIF (theItem = GetItem(thePool, last)) THEN
+	  Clear(thePool, toList);
+	  IF (GetPrev(thePool, last) = NullList) THEN
+	    theList := NullList;
+	  ELSE
+	  	prev := GetPrev(thePool, last);
+	    SetNext(thePool, prev, NullList);
+	  END (*--if*);
+	  toList := last;
+	  SetPrev(thePool, toList, NullList);
+	  EXIT (*--loop*);
+	ELSE
+      last  := GetNext(thePool, last);
+	END (*--if*);
+  END (*--loop*);
+END Split;
+(*-------------------------*)
+
+
+(*
+Selectors
+
+LastOf simply scans theList looking for the last list node and
+returns the node containing the last item. If theList is empty,
+the NullList if returned.
+*)
+
+PROCEDURE LastOf     (    thePool : Pool     (*-- in    *);
+					      theList : List	 (*-- in    *))
+	: List     (*-- out   *);
+
+VAR   last : List; (*-- last list node examined *)
+      next : List; (*-- link from last node to next node *) 
+
+BEGIN
+  IF IsEmpty(thePool, theList) THEN
+    RETURN NullList;
+  END (*--if*);
+  last := theList;
+  LOOP
+    next := GetNext(thePool, last);
+	IF IsEmpty(thePool, next) THEN
+	  EXIT (*--loop*);
+	END (*--if*);
+	last := next;
+  END (*--loop*);
+  RETURN last;
+END LastOf;
+(*-------------------------*)
+
+(*
+PositionOf does a linear search of theList looking for theItem keeping a
+running count of the index position.  If theItem is not found in theList then
+the NullList is returned otherwise the index position at which theItem is
+found is returned.
+*)
+
+PROCEDURE PositionOf (    theItem : Item     (*-- in    *);
+	theList : List     (*-- in    *);
+					      thePool : Pool	 (*-- in    *))
+							: Position (*-- out   *);
+
+VAR   index : Position; (*-- running index into theList *)
+
+BEGIN
+  index := 1;
+  WHILE ~IsEmpty(thePool, theList) DO
+    IF (theItem = GetItem(thePool, theList)) THEN
+	  RETURN index;
+	END (*--if*);
+    INC(index);
+	theList := GetNext(thePool, theList);
+  END (*--while*);
+  RETURN NullPosition;
+END PositionOf;
+(*-------------------------*)
+
+(*
+LocationOf is the inverse of PositionOf given above.  The routine first takes
+care of the trivial case in which it is given an empty list by returning an
+empty list.  theList parameter is used as a local variable to access each of
+the list nodes and if theIndex position exists within theList the link to
+that list is returned.  If theList ever becomes empty during the loop the
+routine can be certain that theIndex position does not exist.
+*)
+
+PROCEDURE LocationOf (    theIndex: Position (*-- in    *);
+	theList : List     (*-- in    *);
+					      thePool : Pool	 (*-- in    *))
+							: List     (*-- out   *);
+
+VAR   index : Position; (*-- running index into theList *)
+
+BEGIN
+  IF IsEmpty(thePool, theList) THEN
+    RETURN NullList;
+  ELSE
+    FOR index := 2 TO theIndex DO
+	  theList := GetNext(thePool, theList);
+	  IF IsEmpty(thePool, theList) THEN
+	    RETURN NullList;
+      END (*--if*);
+	END (*--for*);
+	RETURN theList;
+  END (*--if*);
+END LocationOf;
+(*-------------------------*)
+
+END ListDBMTools.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUM.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUM.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUM.DEF
@@ -0,0 +1,147 @@
+(*
+5.1 Doubly-Linked Unbounded List Interface
+
+The interface to the doubly-linked unbounded list directly
+models the abstract list operations covered in chapter 3.  Unlike
+the components from Volume 1 the list modules do not concern
+themselves with the data type of the objects or items manipulated.
+The reasons for this are (1) the low level of the operations provided,
+and (2) implementation efficiency, which is discussed in greater
+detail in the implementation module.
+*)
+
+DEFINITION MODULE ListDUM;
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Polylithic Structures - List
+	Doubly-Linked Unbounded Managed
+
+    The Abstraction
+    This module provides the List ADT for generic Items.
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+	(C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM ListEnum IMPORT
+    (*--Type*) Exceptions;
+
+    (*-----------------------*)
+
+(*
+5.1.1 Type Declarations
+
+The abstract type List is exported along with a constant representing
+the empty list.  NullList is also used to terminate a sequence of
+links.
+*)
+
+TYPE  List;
+CONST NullList = List(NIL);
+
+
+(*
+5.1.2 Exceptions
+
+The ModuleID uniquely identifies this module.  ListError returns
+the result code from the most recently invoked list operation.
+GetHandler and SetHandler allow assignment and retrieval,
+respectively, of exception handlers for specific exceptions.
+*)
+
+CONST ModuleID = 2;
+
+PROCEDURE ListError   ()	: Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+	theHandler: HandlerProc (*-- in    *));
+
+
+(*
+5.1.3 Constructors
+
+Create simply returns the NullList and Destroy is equivalent to
+Clear.  Neither is necessary for this particular implementation
+but are included for compatability and consistency with the other
+components.  Definitions for the other constructors was given
+in Section 3.3, under Constructor Operations.
+*)
+
+PROCEDURE Create    ()	: List  (*-- out   *);
+
+PROCEDURE Destroy   (VAR theList : List (*-- inout *));
+
+PROCEDURE Clear     (VAR theList : List (*-- inout *));
+
+PROCEDURE Assign    (    theList : List (*-- in    *);
+	VAR toList  : List (*-- inout *));
+
+PROCEDURE SetItem   (    theList : List (*-- inout *);
+	theItem : Item (*-- in    *));
+
+PROCEDURE SetNext   (    theList : List (*-- inout *);
+	newNext : List (*-- in    *));
+
+PROCEDURE SetPrev   (    theList : List (*-- inout *);
+	newPrev : List (*-- in    *));
+
+PROCEDURE SetList   (    theItem : Item (*-- in    *))
+	: List (*-- out   *);
+
+PROCEDURE Insert    (    theItem : Item (*-- in    *);
+	VAR theList : List (*-- inout *));
+
+
+(*
+5.1.4 Selectors
+
+In this list module, IsEmpty serves the function of IsDefined.
+Definitions for the other selectors was given in Section 3.4,
+under Selector Operations.  All of the selectors have a complexity
+of O(1) except for IsEqual which is O(Min(m,n)) and LengthOf which
+is O(n).
+*)
+
+PROCEDURE IsEmpty   (    theList : List     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left    : List     (*-- in    *);
+	right   : List     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theList : List     (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE GetNext   (    theList : List     (*-- in    *))
+	: List     (*-- out   *);
+
+PROCEDURE GetPrev   (    theList : List     (*-- in    *))
+	: List     (*-- out   *);
+
+PROCEDURE GetItem   (    theList : List     (*-- in    *))
+	: Item     (*-- out   *);
+
+END ListDUM.
+
+(*
+
+References
+[1] G. Booch, Software Components with Ada, Structures, Tools, and Subsystems,
+    Benjamin/Cummings, Menlo Park, CA 1987.
+[2] D. Knuth, The Art of Computer Programming, Volume 1, Fundamental
+    Algorithms, Addison-Wesley, Reading, MA 1973.
+[3] R. Sincovec and R. Wiener, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986, pg. 198.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUM.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUM.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUM.MOD
@@ -0,0 +1,500 @@
+(*
+5.2 Doubly-Linked Unbounded List Implementation
+
+Below, the implementation of the doubly-linked unbounded list
+is proffered.
+*)
+
+IMPLEMENTATION MODULE ListDUM;
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Polylithic Structures - List
+	Doubly-Linked Unbounded Managed
+
+    The Abstraction
+    This module provides the List ADT for generic Items.
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+
+    (C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, Raise, ExitOnError;
+
+FROM ListEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+    (*-----------------------*)
+
+(*
+5.2.1 Internal Doubly-linked Unbounded List Representation
+
+A list is a recursive data structure defined as either:
+
+* an empty list (e.g., NIL), or
+* the chain of an item and a list.
+
+We shall model this structure directly with the chain of items
+being represented by a Node containing the item itself and a
+link to the next and previous items in the list.  Then a list
+becomes a pointer to a Node.
+
+FIGURE 5.1
+
+Representation Invariants:
+* an empty list is represented by NIL
+* the first non-empty node has a prev pointer of NIL
+* the last non-empty node has a next pointer of NIL
+
+Unfortunately, this does not allow us to manage the structure's
+data type as was the case for all of Volume 1 and the non-list
+modules in this volume.  The consequence is that the programmer
+must exercise greater discipline when using the module.
+*)
+
+TYPE  List = POINTER TO Node;
+TYPE  Node = RECORD
+	prev : List; (*-- Next node backward *)
+	item : Item; (*-- Data for the node *)
+	next : List; (*-- Next node forward *)
+      END (*-- Node *);
+
+    (*--------------------*)
+
+(*
+5.2.2 Exceptions
+
+The listError variable holds the exception result from each
+operation and ListError simply returns this value.  It is
+initialized to noerr in section 5.2.5 Module Initialization.
+Each list operation reinitializes listError to noerr as its
+first statement.  RaiseErrIn is used to assign an actual
+exception value to listError when a list operation raises
+an exception.
+
+handlers is an array of exception handling routines invoked
+when an exception is raised.  Each exception is initialized to
+ExitOnError other than noerr which is set to the NullHandler
+in section 5.2.5 Module Initialization.  GetHandler and
+SetHandler allow assignment and retrieval, respectively, of
+the exception handlers for specific exceptions.
+*)
+
+VAR   listError : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE ListError   ()	: Exceptions  (*-- out   *);
+BEGIN
+  RETURN listError;
+END ListError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+	theHandler: HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := theHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn  (    theRoutine: Operations  (*-- in    *);
+	theError  : Exceptions  (*-- in    *));
+BEGIN
+  listError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+(*
+5.2.3 Constructors
+
+Create simply returns the NullList which is our representation
+of an empty list.  Data type is not managed by this list
+implementation in the interests of simplicity. Complexity: O(1).
+*)
+
+PROCEDURE Create    () : List	(*-- out   *);
+BEGIN
+  listError := noerr;
+  RETURN NullList;
+END Create;
+(*--------------------*)
+
+(*
+Destroy simply clears the list which also destroys it.
+Complexity: O(n).
+*)
+
+PROCEDURE Destroy   (VAR theList : List (*-- inout *));
+BEGIN
+  Clear(theList);
+END Destroy;
+(*--------------------*)
+
+(*
+Clear proceeds over each node and simply deallocates it.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear     (VAR theList : List (*-- inout *));
+
+VAR   theNode : List; (*-- List node to be deallocated *)
+
+BEGIN
+  listError := noerr;
+  WHILE (theList # NullList) DO
+    theNode := theList;
+    theList := theList^.next;
+    Deallocate(theNode, SIZE(theNode^));
+  END (*--while*);
+END Clear;
+(*--------------------*)
+
+(*
+Assign copies the source list to the target list.  If the
+two lists are the same, in other words point to the same
+node, the routine simply exits as the target already is
+equal to the source.  Otherwise, the target list is cleared
+of its present contents.  If the source list is not empty
+the routine copies each node to the target using the TailInsert
+routine which is a variation on that given in algorithm
+4.2.2 in Gonnet [2, pg. 137].  TailInsert automatically sets
+the new node's previous link to the last node inserted. In
+order for this to work correctly last must be initialized to
+the NullList (NIL).
+Complexity: O(n).
+*)
+
+PROCEDURE TailInsert(VAR theNode : List (*-- inout *);
+	VAR first   : List (*-- inout *);
+					 VAR last    : List (*-- inout *));
+BEGIN
+  IF (first = NullList) THEN
+    first := theNode;
+  ELSE
+    last^.next := theNode;
+  END (*--if*);
+  theNode^.prev := last;
+  last := theNode;
+END TailInsert;
+
+PROCEDURE Assign    (    theList : List (*-- in    *);
+	VAR toList  : List (*-- inout *));
+
+VAR   newNode : List; (*-- new node from source to target *)
+      last    : List; (*-- last node inserted into target *)
+
+BEGIN
+  IF (theList # toList) THEN
+    Clear(toList);
+    last := NullList;
+    WHILE (theList # NullList) DO
+      Allocate(newNode, SIZE(Node));
+	  IF (newNode = NullList) THEN
+	    RaiseErrIn(assign, overflow);
+	    RETURN;
+	  END (*--if*);
+
+	  WITH newNode^ DO
+	    item := theList^.item;
+	    next := NullList;
+	  END (*--with*);
+
+	  TailInsert(newNode, toList, last);
+	  theList := theList^.next;
+    END (*--while*);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+(*
+SetItem takes the given list node and assigns theItem as its
+data item value.  SetNext simply links the given node to the
+next node given, while SetPrev similarly links the node to the
+previous node given.
+In all three routines, if theList is empty an exception is raised.
+Similarly, all three routines have a time complexity of O(1).
+*)
+
+PROCEDURE SetItem   (    theList : List (*-- inout *);
+	theItem : Item (*-- in    *));
+BEGIN
+  listError := noerr;
+  IF (theList = NullList) THEN
+    RaiseErrIn(setitem, listisnull);
+  ELSE
+    theList^.item := theItem;
+  END (*--if*);
+END SetItem;
+(*--------------------*)
+
+PROCEDURE SetNext   (    theList : List (*-- inout *);
+	newNext : List (*-- in    *));
+BEGIN
+  listError := noerr;
+  IF (theList = NullList) THEN
+    RaiseErrIn(setnext, listisnull);
+  ELSE
+    theList^.next := newNext;
+  END (*--if*);
+END SetNext;
+(*--------------------*)
+
+PROCEDURE SetPrev   (    theList : List (*-- inout *);
+	newPrev : List (*-- in    *));
+BEGIN
+  listError := noerr;
+  IF (theList = NullList) THEN
+    RaiseErrIn(setprev, listisnull);
+  ELSE
+    theList^.prev := newPrev;
+  END (*--if*);
+END SetPrev;
+(*--------------------*)
+
+(*
+Insert simply adds theItem to the front of theList by allocating
+a new list node and linking its next pointer to theList (which
+may be the NullList).  Before theList's previous pointer is linked to
+the new node, if a node preceeds theList then its next link
+must also be updated to account for the new list node as well.
+Complexity: O(1).
+*)
+
+PROCEDURE Insert    (    theItem : Item (*-- in    *);
+	VAR theList : List (*-- inout *));
+
+VAR   newList : List; (*-- new list node for theItem *)
+
+BEGIN
+  listError := noerr;
+  Allocate(newList, SIZE(Node));
+  IF (newList = NullList) THEN
+    RaiseErrIn(insert, overflow);
+  ELSE
+    WITH newList^ DO
+	  IF (theList = NullList) THEN
+	    prev := NullList;
+	  ELSE
+	    prev := theList^.prev;
+	  END (*--if*);
+	  item := theItem;
+	  next := theList;
+	END (*--with*);
+	IF (theList # NullList) & (theList^.prev # NullList) THEN
+	  theList^.prev^.next := newList;
+    END (*--if*);
+	IF (theList # NullList) THEN
+	  theList^.prev := newList;
+    END (*--if*);
+    theList := newList;
+  END (*--if*);
+END Insert;
+(*--------------------*)
+
+(*
+SetList constructs a list of length one out of the given item.
+If a list node cannot be allocated from the heap the overflow
+exception is raised and the NullList returned.
+Complexity O(1).
+*)
+
+PROCEDURE SetList   (    theItem : Item (*-- in    *))
+	: List (*-- out   *);
+
+VAR   newList : List;
+
+BEGIN
+  listError := noerr;
+  Allocate(newList, SIZE(Node));
+  IF (newList = NullList) THEN
+    RaiseErrIn(setlist, overflow);
+  ELSE
+    WITH newList^ DO
+	  item := theItem;
+	  next := NullList;
+	  prev := NullList;
+	END (*--with*);
+  END (*--if*);
+  RETURN newList;
+END SetList;
+(*--------------------*)
+
+
+(*
+5.2.4 Selectors
+
+IsEmpty returns True if theList is in the empty state, as indicated by
+the list being equal to the null list, and False otherwise.  
+Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theList : List     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  listError := noerr;
+  RETURN (theList = NullList);
+END IsEmpty;
+(*--------------------*)
+
+(*
+IsEqual compares the left and right list for equality, which in this
+context means they contain the same items.  The algorithm simply loops
+over each of the items in both lists returning false immediately upon
+encountering an inequality, and returning true if and only if every
+item is the same between them. This condition is detected by
+both list pointers being the null list at the end of the loop.
+Complexity: O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left    : List     (*-- in    *);
+	right   : List     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  listError := noerr;
+  WHILE (left # NullList) & (right # NullList) DO
+    IF (left^.item # right^.item) THEN
+	  RETURN FALSE;
+	END (*--if*);
+	left  := left^.next;
+	right := right^.next;
+  END (*--while*);
+  RETURN (left = right) & (right = NullList);
+END IsEqual;
+(*--------------------*)
+
+(*
+LengthOf simply loops over the links of the list counting
+the number of list nodes it finds. Complexity: O(n).
+*)
+
+PROCEDURE LengthOf  (    theList : List     (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+VAR   length : CARDINAL; (*-- Running count of items *)
+
+BEGIN
+  listError := noerr;
+  length    := 0;
+  WHILE (theList # NullList) DO
+	INC(length);
+	theList := theList^.next;
+  END (*--while*);
+  RETURN length;
+END LengthOf;
+(*--------------------*)
+
+(*
+GetNext simply returns the link to the next list node, or if
+given an empty list the listisnull exception is raised and the
+null list is returned.  Complexity: O(1).
+*)
+
+PROCEDURE GetNext   (    theList : List     (*-- in    *))
+	: List     (*-- out   *);
+BEGIN
+  listError := noerr;
+  IF (theList = NullList) THEN
+    RaiseErrIn(getnext, listisnull);
+    RETURN NullList;
+  END (*--if*);
+  RETURN theList^.next;
+END GetNext;
+(*--------------------*)
+
+(*
+GetPrev simply returns the link to the previous list node, or if
+given an empty list the listisnull exception is raised and the
+null list is returned.  Complexity: O(1).
+*)
+
+PROCEDURE GetPrev   (    theList : List     (*-- in    *))
+	: List     (*-- out   *);
+BEGIN
+  listError := noerr;
+  IF (theList = NullList) THEN
+    RaiseErrIn(getprev, listisnull);
+    RETURN NullList;
+  END (*--if*);
+  RETURN theList^.prev;
+END GetPrev;
+(*--------------------*)
+
+(*
+GetItem simply returns the item of the given list node, or if
+given an empty list the listisnull exception is raised and the
+null item is returned.  Complexity: O(1).
+*)
+
+PROCEDURE GetItem   (    theList : List     (*-- in    *))
+	: Item     (*-- out   *);
+BEGIN
+  listError := noerr;
+  IF (theList = NullList) THEN
+    RaiseErrIn(getitem, listisnull);
+    RETURN NullItem;
+  END (*--if*);
+  RETURN theList^.item;
+END GetItem;
+(*--------------------*)
+
+
+(*
+5.2.5 Module Initialization
+
+The module's local variables are initialized to known states.
+listError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.
+
+Since a FOR loop control variable is undefined following the loop,
+listError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR listError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(listError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  listError := noerr;
+END ListDUM.
+
+(*
+
+References
+[1] G. Booch, Software Components with Ada, Structures, Tools, and Subsystems,
+    Benjamin/Cummings, Menlo Park, CA 1987.
+[2] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Addison-Wesley, London England 1984.
+[3] D. Knuth, The Art of Computer Programming, Volume 1, Fundamental
+    Algorithms, Addison-Wesley, Reading, MA 1973.
+[4] R. Wiener and R. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986, pg. 198.
+[5] N. Wirth, Algorithms and Data Structures, Prentice-Hall,
+    Englewood Cliffs, NJ 1986.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUMS.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUMS.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUMS.DEF
@@ -0,0 +1,112 @@
+(*
+Sequential Doubly-linked List Search Utilities - Interface
+
+In this section are provided several utility routines implementing
+search algorithms on doubly-linked unbounded lists.
+*)
+
+DEFINITION MODULE ListDUMSearch; 
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tools - Structure Utility - Doubly-linked List Search
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation.
+	(C) Copyright 1989 Charles A. Lins
+=============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc;
+
+FROM ListDUM IMPORT
+    (*--Type*) List;
+
+    (*--------------------*)
+
+TYPE  SuccessProc  = PROCEDURE (Item);
+TYPE  FailureProc  = PROCEDURE (Item);
+
+    (*--------------------*)
+
+(*
+PrimarySearch
+
+Searches theList for the first occurance of theItem with the required
+key.  This is called the primary key search.  It is assumed that the
+item comparison routine knows how to extract the key from the items
+if necessary.  If the search succeeds then the found procedure parameter
+is invoked, otherwise the notfound routine is called.  The list is
+assumed to be unordered.
+*)
+
+PROCEDURE PrimarySearch (    theItem   : Item	(*-- in    *);
+	theList   : List	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+
+(*
+SecondarySearch
+
+Searches theList for every occurance of theItem with the required
+key.  This is called the secondary key search.  It is assumed that the
+item comparison routine knows how to extract the key from the items
+if necessary.  Each time the search succeeds the found procedure parameter
+is invoked.  The list is assumed to be unordered.
+*)
+
+PROCEDURE SecondarySearch (    theItem   : Item	(*-- in    *);
+	theList   : List	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *));
+
+
+(*
+Self-organizing Sequential Search - MoveToFront
+
+This routine is essentially the primary key search modified to apply
+a heuristic for improving the list ordering.  When a key is found,
+theItem is moved to the front of the list.  The idea is that the
+access distribution of items in the list is unequal, and therefore,
+the most frequently accessed items should be closer to the front.
+For a sophisticated analysis comparing self-organizing heuristics
+see reference [1].
+*)
+
+PROCEDURE MoveToFront (    theItem   : Item	(*-- in    *);
+	VAR theList   : List	(*-- inout *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+
+(*
+Self-organizing Sequential Search - Transpose
+
+Instead of moving the found item to the front of the list, the Transpose
+heuristic moves the item one position closer to the front by swapping
+positions with its predecessor.
+*)
+
+PROCEDURE Transpose (    theItem   : Item	(*-- in    *);
+	VAR theList   : List	(*-- inout *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+END ListDUMSearch.
+
+(*
+
+References
+
+[1] J.L. Bentley and C.C. McGeoch, Worst-Case Analyses of
+    Self-Organizing Sequential Search Heuristics,
+	Carnegie-Mellon University, 1983.
+[2] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Searching Algorithms, Addison-Wesley, London 1984,
+	pp. 23-30.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUMS.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUMS.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUMS.MOD
@@ -0,0 +1,197 @@
+(*
+Doubly-linked List Sequential Search Utilities - Implementation
+
+Presented below are the implementation details of our sequential search
+algorithms for the doubly-linked unbounded list.
+*)
+
+IMPLEMENTATION MODULE ListDUMSearch; 
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tools - Structure Utility - Doubly-linked List Search
+	Code Size: R-  bytes
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation.
+	(C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc;
+
+FROM ListDUM IMPORT
+    (*--Type*) List, NullList,
+    (*--Proc*) GetNext, GetItem, IsEmpty, SetNext, SetItem,
+			   GetPrev, SetPrev;
+
+    (*--------------------*)
+
+(*
+PrimarySearch
+
+Our primary key search routine has been optimized using the LOOP construct
+instead of a WHILE statement to avoid multiple calls to IsEmpty,
+GetItem, and keysEqual at the end of the routine when determining
+success or failure. (See reference [2]).
+*)
+
+PROCEDURE PrimarySearch (    theItem   : Item	(*-- in    *);
+	theList   : List	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+BEGIN
+  LOOP 
+    IF IsEmpty(theList) THEN
+      notFound(theItem);
+      EXIT (*--loop*);
+    ELSIF (keysEqual(GetItem(theList), theItem) = equal) THEN
+      found(theItem);
+      EXIT (*--loop*);
+    END (*--if*);
+    theList := GetNext(theList);
+  END (*--loop*);
+END PrimarySearch;
+(*-------------------------*)
+
+(*
+SecondarySearch
+
+Where the primary key search stops after the finding the first occurance
+of theItem, the secondary key search continues to the end of the list
+in order to find all occurances of theItem.  Therefore, the complexity
+is O(n).
+*)
+
+PROCEDURE SecondarySearch (    theItem   : Item	(*-- in    *);
+	theList   : List	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *));
+BEGIN
+  WHILE ~IsEmpty(theList) DO
+    IF keysEqual(GetItem(theList), theItem) = equal THEN
+      found(theItem);
+    END (*--if*);
+    theList := GetNext(theList);
+  END (*--while*);
+END SecondarySearch;
+(*-------------------------*)
+
+(*
+Self-organizing Sequential Search - MoveToFront
+
+The algorithm first takes care of the special cases where the list is
+empty or when the item is already at the front of the list. Then if it
+is necessary to scan the list, the routine does so remembering the last
+node examined in case theItem is found it can be easily moved to the
+front without searching for the node's predecessor.
+*)
+
+PROCEDURE MoveToFront (    theItem   : Item	(*-- in    *);
+	VAR theList   : List	(*-- inout *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+VAR   index : List; (*-- loop index over the nodes of the list *)
+      next  : List; (*-- link to next node from the last node *)
+	  succ	: List; (*-- successor to found node *)
+
+BEGIN
+  IF IsEmpty(theList) THEN
+    notFound(theItem);
+  ELSIF keysEqual(theItem, GetItem(theList)) = equal THEN
+    found(theItem);
+  ELSE
+    index := theList;
+	LOOP
+	  next := GetNext(index);
+	  IF IsEmpty(next) THEN
+	notFound(theItem);
+	    EXIT (*--loop*);
+      ELSIF keysEqual(theItem, GetItem(next)) = equal THEN
+		
+		(*-- unlink found node from the list *)
+		succ := GetNext(next);
+		SetNext(index, succ);
+		IF ~IsEmpty(succ) THEN
+		  SetPrev(succ, index);
+		END (*--if*);
+		
+		(*-- relink found node at front of the list *)
+		SetPrev(next, NullList);
+	SetNext(next, theList);
+		SetPrev(theList, next);
+		
+		(*-- return found node as the new front *)
+	theList := next;
+	found(theItem);
+	EXIT (*--loop*);
+      END (*--if*);
+	  index := next;
+    END (*--loop*);
+  END (*--if*);
+END MoveToFront;
+(*-------------------------*)
+
+(*
+Self-organizing Sequential Search - Transpose
+
+The transpose hueristic is similar to the Move-To-Front method, above,
+except when theItem is found it is moved only one position forward in
+the list.  Here, theItem is used as a temporary when moving the value
+forward in the list.  For a Pascal version of this algorithm using arrays
+see Gonnet [2].
+*)
+
+PROCEDURE Transpose (    theItem   : Item	(*-- in    *);
+	VAR theList   : List	(*-- inout *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+VAR   index : List; (*-- node being examined *)
+	  prev  : List;
+
+BEGIN
+  IF IsEmpty(theList) THEN
+    notFound(theItem);
+  ELSIF keysEqual(theItem, GetItem(theList)) = equal THEN
+    found(theItem);
+  ELSE
+    index := theList;
+	LOOP
+	  index := GetNext(index);
+	  IF IsEmpty(index) THEN
+	notFound(theItem);
+	    EXIT (*--loop*);
+      ELSIF keysEqual(theItem, GetItem(index)) = equal THEN
+	    prev := GetPrev(index);
+	SetItem(index, GetItem(prev));
+		SetItem(prev, theItem);
+	found(theItem);
+	EXIT (*--loop*);
+      END (*--if*);
+    END (*--loop*);
+  END (*--if*);
+END Transpose;
+(*-------------------------*)
+
+END ListDUMSearch.
+
+(*
+
+References
+
+[1] J.L. Bentley and C.C. McGeoch, Worst-Case Analyses of
+    Self-Organizing Sequential Search Heuristics,
+	Carnegie-Mellon University, 1983.
+[2] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Searching Algorithms, Addison-Wesley, London 1984,
+	pp. 23-30.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUMT.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUMT.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUMT.DEF
@@ -0,0 +1,97 @@
+(*
+Doubly-Linked List Utilities - Interface
+
+In this section is provided a list utilities module for doubly-linked
+unbounded lists.  The routines implement such useful list operations as:
+
+Constructors
+∙ constructing a list from an array of items (Construct and Build),
+∙ inserting an item to the end of a list (AddToTail),
+
+Selectors
+∙ retrieving the link to the last item of a list (LastOf),
+*)
+
+DEFINITION MODULE ListDUMTools; 
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tools - Structure Utility - Doubly-Linked List
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation.
+	(C) Copyright 1989 Charles A. Lins
+=============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ListDUM IMPORT
+    (*--Type*) List;
+
+    (*--------------------*)
+
+TYPE  Position     = CARDINAL;
+CONST NullPosition = 0;
+
+
+    (*--------------------*)
+
+(*
+Constructors
+
+Construct builds a list from an array of Items.  If theList is not
+empty it is cleared of its contents before the construction commences.
+Build is similar except that only the first n items (numItems) are used to
+construct the list.
+
+AddToTail adds theItem to the end of theList.  Complexity: O(n).
+
+Split divides theList into two lists at theItem.  If theItem is not present
+in theList then the toList is unchanged.
+*)
+
+PROCEDURE Construct (    theItems : ARRAY OF Item (*-- in    *);
+	VAR theList  : List	(*-- inout *));
+
+PROCEDURE Build     (    theItems : ARRAY OF Item (*-- in    *);
+	numItems : CARDINAL      (*-- in    *);
+	VAR theList  : List	(*-- inout *));
+
+PROCEDURE AddToTail (    theItem  : Item	(*-- in    *);
+	VAR theList  : List	(*-- inout *));
+
+PROCEDURE Split     (VAR theList  : List	(*-- inout *);
+	theItem  : Item	(*-- in    *);
+	VAR toList   : List	(*-- inout *));
+
+
+(*
+Selectors
+
+LastOf returns the list containing the last item of theList or the NullList
+if theList is empty.
+
+PositionOf searches for theItem in theList returning theItem's position such
+that:
+	Position = 1 when theItem is at the front of theList,
+	Position = LengthOf(theList) when theItem is at the end of theList, and
+	Position = 0 when theItem is not present within theList.
+
+LocationOf returns a list beginning with the item at theIndex in theList.  If
+theList does not have such a positionthe NullList is returned.
+*)
+
+PROCEDURE LastOf     (    theList : List     (*-- in    *))
+	: List     (*-- out   *);
+
+PROCEDURE PositionOf (    theItem : Item     (*-- in    *);
+	theList : List     (*-- in    *))
+							: Position (*-- out   *);
+
+PROCEDURE LocationOf (    theIndex: Position (*-- in    *);
+	theList : List     (*-- in    *))
+							: List     (*-- out   *);
+
+END ListDUMTools.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUMT.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUMT.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTDUMT.MOD
@@ -0,0 +1,237 @@
+(*
+Doubly-linked List Utilities - Implementation
+
+*)
+
+IMPLEMENTATION MODULE ListDUMTools; 
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tools - Structure Utility - Doubly-Linked List
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation.
+	(C) Copyright 1989 Charles A. Lins
+=============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ListDUM IMPORT
+    (*--Type*) List, NullList,
+	(*--Proc*) IsEmpty, GetNext, GetItem, SetNext, SetList,
+		Clear, Assign, Insert, GetPrev, SetPrev;
+
+    (*--------------------*)
+
+(*
+Constructors
+
+Construct first clears theList, if necessary, and then loops over theItems
+in reverse order adding each item to the front of theList.
+*)
+
+PROCEDURE Construct (    theItems : ARRAY OF Item (*-- in    *);
+	VAR theList  : List	(*-- inout *));
+
+VAR   index : INTEGER; (*-- loop index over items array *)
+
+BEGIN
+  IF ~IsEmpty(theList) THEN
+    Clear(theList);
+  END (*--if*);
+  FOR index := HIGH(theItems) TO 0 BY -1 DO
+  	Insert(theItems[index], theList);
+  END (*--for*);
+END Construct;
+(*-------------------------*)
+
+(*
+Build is quite similar to Construct, above, in traversing theItems in
+reverse order appending items to the front of theList. The difference
+is that only the first numItems are used to form the list.  If numItems
+is greater than the actual number of items in theItems array, only those
+items truly present are inserted.
+Complexity: O(n) where n is the number of items inserted.
+*)
+
+PROCEDURE Build     (    theItems : ARRAY OF Item (*-- in    *);
+	numItems : CARDINAL      (*-- in    *);
+	VAR theList  : List	(*-- inout *));
+
+VAR   index : INTEGER; (*-- loop index over items array *)
+
+BEGIN
+  IF ~IsEmpty(theList) THEN
+    Clear(theList);
+  END (*--if*);
+  IF (numItems > VAL(CARDINAL, HIGH(theItems) + 1)) THEN
+    numItems := HIGH(theItems) + 1;
+  END (*--if*);
+  FOR index := VAL(INTEGER, numItems) - 1 TO 0 BY -1 DO
+  	Insert(theItems[index], theList);
+  END (*--for*);
+END Build;
+(*-------------------------*)
+
+(*
+AddToTail inserts theItem at the end of theList.  The routine first
+takes care of the trivial case where theList is empty.  Then it proceeds
+to scan theList for the last item.  Once this has been found, a new list
+(of length one) is created for the item, and the last node is linked to
+the new list.  Note: once the last node has been found, next is no longer
+needed and is therefore used as a temporary to create the new list for
+theItem.
+Complexity: O(n).
+*)
+
+PROCEDURE AddToTail (    theItem  : Item	(*-- in    *);
+	VAR theList  : List	(*-- inout *));
+
+VAR   last : List; (*-- last list node examined *)
+      next : List; (*-- link from last node to next node *) 
+
+BEGIN
+  IF IsEmpty(theList) THEN
+    theList := SetList(theItem);
+  ELSE
+    last := theList;
+    LOOP
+      next := GetNext(last);
+	  IF IsEmpty(next) THEN
+	    EXIT (*--loop*);
+	  END (*--if*);
+	  last := next;
+    END (*--loop*);
+    next := SetList(theItem);
+    SetNext(last, next);
+    SetPrev(next, last);
+  END (*--if*);
+END AddToTail;
+(*-------------------------*)
+
+(*
+Split searches theList maintaining a link to the previous node examined.
+When theItem is found at the front of theList, the toList becomes theList
+and theList becomes the empty list.  Otherwise, theList is truncated at
+the previous node examined, and the toList becomes a list beginning with
+theItem.
+*)
+
+PROCEDURE Split     (VAR theList  : List	(*-- inout *);
+	theItem  : Item	(*-- in    *);
+	VAR toList   : List	(*-- inout *));
+
+VAR   last  : List; (*-- last list node examined *)
+
+BEGIN
+  last  := theList;
+  LOOP
+	IF IsEmpty(last) THEN
+	  EXIT (*--loop*);
+    ELSIF (theItem = GetItem(last)) THEN
+	  Clear(toList);
+	  IF (GetPrev(last) = NullList) THEN
+	    theList := NullList;
+	  ELSE
+	    SetNext(GetPrev(last), NullList);
+	  END (*--if*);
+	  toList := last;
+	  SetPrev(toList, NullList);
+	  EXIT (*--loop*);
+	ELSE
+      last  := GetNext(last);
+	END (*--if*);
+  END (*--loop*);
+END Split;
+(*-------------------------*)
+
+
+(*
+Selectors
+
+LastOf simply scans theList looking for the last list node and
+returns the node containing the last item. If theList is empty,
+the NullList if returned.
+*)
+
+PROCEDURE LastOf    (    theList : List  (*-- in    *))
+	: List  (*-- out   *);
+
+VAR   last : List; (*-- last list node examined *)
+      next : List; (*-- link from last node to next node *) 
+
+BEGIN
+  IF IsEmpty(theList) THEN
+    RETURN NullList;
+  END (*--if*);
+  last := theList;
+  LOOP
+    next := GetNext(last);
+	IF IsEmpty(next) THEN
+	  EXIT (*--loop*);
+	END (*--if*);
+	last := next;
+  END (*--loop*);
+  RETURN last;
+END LastOf;
+(*-------------------------*)
+
+(*
+PositionOf does a linear search of theList looking for theItem keeping a
+running count of the index position.  If theItem is not found in theList then
+the NullList is returned otherwise the index position at which theItem is
+found is returned.
+*)
+
+PROCEDURE PositionOf (    theItem : Item     (*-- in    *);
+	theList : List     (*-- in    *))
+							: Position (*-- out   *);
+
+VAR   index : Position; (*-- running index into theList *)
+
+BEGIN
+  index := 1;
+  WHILE ~IsEmpty(theList) DO
+    IF (theItem = GetItem(theList)) THEN
+	  RETURN index;
+	END (*--if*);
+    INC(index);
+	theList := GetNext(theList);
+  END (*--while*);
+  RETURN NullPosition;
+END PositionOf;
+(*-------------------------*)
+
+(*
+LocationOf is the inverse of PositionOf given above.  The routine first takes
+care of the trivial case in which it is given an empty list by returning an
+empty list.  theList parameter is used as a local variable to access each of
+the list nodes and if theIndex position exists within theList the link to
+that list is returned.  If theList ever becomes empty during the loop the
+routine can be certain that theIndex position does not exist.
+*)
+
+PROCEDURE LocationOf (    theIndex: Position (*-- in    *);
+	theList : List     (*-- in    *))
+							: List     (*-- out   *);
+
+VAR   index : Position; (*-- running index into theList *)
+
+BEGIN
+  IF IsEmpty(theList) THEN
+    RETURN NullList;
+  ELSE
+    FOR index := 2 TO theIndex DO
+	  theList := GetNext(theList);
+	  IF IsEmpty(theList) THEN
+	    RETURN NullList;
+      END (*--if*);
+	END (*--for*);
+	RETURN theList;
+  END (*--if*);
+END LocationOf;
+(*-------------------------*)
+
+END ListDUMTools.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTENUM.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTENUM.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTENUM.DEF
@@ -0,0 +1,47 @@
+(*
+4.1 List Enumerations
+
+This module provides definitions for list operations and
+exceptions for both singly-linked and doubly-linked lists.
+*)
+
+DEFINITION MODULE ListEnum; 
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tool - List Structure Enumerations Utility
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins:
+	Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+CONST ComponentID = 256 * 7;	(*-- must be a multiple of 256 *)
+
+TYPE  Operations = (modinit,
+
+	create, destroy, clear, assign,
+	setitem, setnext, setprev, insert,
+	setlist,
+
+	isdefined, isempty, isequal, lengthof,
+	getitem, getnext, getprev
+	);
+
+TYPE  Constructors = Operations [ create .. setlist ];
+TYPE  Selectors    = Operations [ isdefined .. getprev ];
+
+
+    (*-----------------------*)
+
+TYPE  Exceptions = (noerr,
+	initfailed,
+	listisnull,
+	overflow,
+					undefined
+	);
+
+TYPE  ExceptionSet = SET OF Exceptions;
+
+END ListEnum.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTENUM.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTENUM.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTENUM.MOD
@@ -0,0 +1,3 @@
+IMPLEMENTATION MODULE ListEnum;
+
+END ListEnum.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBM.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBM.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBM.DEF
@@ -0,0 +1,206 @@
+(*
+6.1 Singly-Linked Bounded List Interface
+
+Presented below is the interface to the singly-linked bounded
+list for generic Items, which for reasons discussed shortly is
+somewhat different from that of the unbounded list.  Like the
+unbounded list, the bounded list also does not concern
+itself with the data type of the objects or items manipulated.
+*)
+
+DEFINITION MODULE ListSBM;
+
+(*
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Polylithic Structures - List
+	Singly-Linked Bounded Managed
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+	(C) Copyright 1989 Charles A. Lins
+*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM ListEnum IMPORT
+    (*--Type*) Exceptions;
+
+    (*-----------------------*)
+
+(*
+6.1.1 Type Declarations
+
+The reader may remember from the bounded structures in Volume 1
+it was sufficient to modify the unbounded form of the Create
+operation to include a
+parameter specifying the structure's desired maximum size.  And
+to allow the client to easily retrieve this limit, the selector
+SizeOf was also added as a convenience.  This approach could be
+taken for bounded lists as well resulting in each list created
+being associated with its own pool of nodes.  This is not necessarily
+bad, but potentially would be very wasteful of space since the
+pools (and the nodes resident there) could not be shared by all
+bounded lists of the same type.
+
+The approach taken for the bounded list is in addition to the
+abstract type List, the abstract type Pool is exported along
+with a subrange representing the limits on the size of a node
+pool.  Now the client can create a number of Pools and associate
+Lists with a given pool.  The only constraint is that a List may
+not draw nodes from more than a single pool and all operations
+must identify the pool on which to operate.  The maximum size of
+a pool is limited to 5400 nodes due to constraints imposed by the
+TML Modula-2 compiler on the size of arrays.
+
+List cannot be declared opaque and then in the 
+implementation defined as a CARDINAL (at least in the TML Modula-2
+compiler); for this reason transparent export is used.  The constant
+NullList is used to terminate a sequence of links.
+*)
+
+TYPE  Pool;
+TYPE  PoolSize = [1 .. 5400];
+
+TYPE  List     = CARDINAL;
+CONST NullList = 0;
+
+
+(*
+6.1.2 Exceptions
+
+The ModuleID uniquely identifies this module.  ListError returns
+the result code from the most recently invoked list operation.
+GetHandler and SetHandler allow assignment and retrieval,
+respectively, of exception handlers for specific exceptions.
+
+The undefined exception is associated with the type Pool, and the
+listisnull exception used to identify invalid operations on an
+empty list.  Overflow is raised when attempting to expand a list
+and there are no more nodes left in the pool.
+*)
+
+CONST ModuleID = 3;
+
+PROCEDURE ListError   ()	: Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    theError  : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    theError  : Exceptions  (*-- in    *);
+	theHandler: HandlerProc (*-- in    *));
+
+
+(*
+6.1.3 Constructors
+
+InitPool attempts to construct a node pool of the given size and
+FreePool releases the existing node pool.  In the list operations
+the internal state of the pool may change as a result of the operation
+but the actual value for the pool itself does not change; this is
+why thePool is labeled as inout without an accompanying VAR.
+
+Create retrieves a node from the given pool, raising overflow and
+returning the NullList if the node pool is already full.  It is
+equivalent to the routine GetNode seen in Pascal texts.
+
+Destroy returns theList node to the node pool and is equivalent
+to the routine FreeNode seen in Pascal texts.
+
+Definitions for the other constructors was given in Section 3.3,
+under Constructor Operations.
+*)
+
+PROCEDURE InitPool  (    theSize : PoolSize (*-- in    *))
+	: Pool     (*-- out   *);
+
+PROCEDURE FreePool  (    thePool : Pool     (*-- inout *));
+
+
+PROCEDURE Create    (    thePool : Pool     (*-- inout *))
+	: List     (*-- out   *);
+
+PROCEDURE Destroy   (    thePool : Pool     (*-- inout *);
+	VAR theList : List     (*-- inout *));
+
+PROCEDURE Clear     (    thePool : Pool     (*-- inout *);
+	VAR theList : List     (*-- inout *));
+
+PROCEDURE Assign    (    thePool : Pool     (*-- inout *);
+	theList : List     (*-- in    *);
+	VAR toList  : List     (*-- inout *));
+
+PROCEDURE SetItem   (    thePool : Pool     (*-- inout *);
+	theList : List     (*-- inout *);
+	theItem : Item     (*-- in    *));
+
+PROCEDURE SetNext   (    thePool : Pool     (*-- inout *);
+	theList : List     (*-- inout *);
+	newNext : List     (*-- in    *));
+
+PROCEDURE SetList   (    thePool : Pool     (*-- inout *);
+	theItem : Item     (*-- in    *))
+	: List     (*-- out   *);
+
+PROCEDURE Insert    (    thePool : Pool     (*-- inout *);
+	theItem : Item     (*-- in    *);
+	VAR theList : List     (*-- inout *));
+
+
+(*
+6.1.4 Selectors
+
+The selectors have all been modified from the unbounded form to
+accept thePool parameter.  IsDefined has been added to test whether
+a given pool variable has been initialized through the InitPool
+operation.
+Definitions for the other selectors was given in Section 3.4,
+under Selector Operations.  All list selectors have a complexity
+of O(1) except for IsEqual which is O(Min(m,n)) and LengthOf which
+is O(n).
+*)
+
+PROCEDURE IsDefined (    thePool : Pool     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    thePool : Pool     (*-- in    *);
+	left    : List     (*-- in    *);
+	right   : List     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE GetNext   (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: List     (*-- out   *);
+
+PROCEDURE GetItem   (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: Item     (*-- out   *);
+
+END ListSBM.
+
+(*
+
+References
+
+[1] Aho, Hopcroft, and Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading MA 1983.
+[2] G. Booch, Software Components with Ada, Structures, Tools, and Subsystems,
+    Benjamin/Cummings, Menlo Park, CA 1987.
+[3] D. Knuth, The Art of Computer Programming, Volume 1, Fundamental
+    Algorithms, Addison-Wesley, Reading MA 1973.
+[4] R. Wiener and R. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY, 1986, pg. 198.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBM.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBM.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBM.MOD
@@ -0,0 +1,624 @@
+(*
+6.2 Singly-Linked Bounded List Implementation
+
+Now that the interface to the bounded list and the rationale
+behind it has been covered we can move on to discuss the actual;
+implementation details.
+*)
+
+IMPLEMENTATION MODULE ListSBM;
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Polylithic Structures - List
+	Singly-Linked Bounded Managed
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+	(C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, Raise, ExitOnError;
+
+FROM ListEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+    (*-----------------------*)
+
+(*
+6.2.1 Internal Singly-linked Bounded List Representation
+
+FIGURE 6.1
+
+A list is a recursive data structure defined as either:
+
+* an empty list (e.g., NIL), or
+* the chain of an item and a list.
+
+We shall model this structure directly with the chain of items
+being represented by a Node containing the item itself and a
+link to the next item in the list.  Then a list becomes a
+pointer to a Node.  Since we are drawing nodes from a pool, the
+pointers become indexes into the pool of nodes.  The pool itself,
+shown above in figure 6.1, uses a singly-linked list as there
+is no need to traverse the nodes backward.
+
+Representation Invariants:
+* an empty list is represented by NIL
+* the last non-empty node has a next pointer of NIL
+
+Unfortunately, this does not allow us to manage the structure's
+data type as was the case for all of Volume 1 and the non-list
+modules in this volume.  The consequence is that the programmer
+must exercise greater discipline when using the module.
+*)
+
+TYPE  Node = RECORD
+	item : Item; (*-- Data for the node *)
+	next : List; (*-- Next node forward *)
+      END (*-- Node *);
+
+TYPE  NodeHeap = ARRAY PoolSize OF Node;
+TYPE  NodePool = RECORD
+	free  : List;
+		size  : PoolSize;
+		nodes : NodeHeap;
+      END (*-- NodePool *);
+
+TYPE  Pool = POINTER TO NodePool;
+
+    (*--------------------*)
+
+(*
+6.2.2 Exceptions
+
+The listError variable holds the exception result from each
+operation and ListError simply returns this value.  It is
+initialized to noerr in section 6.2.6 Module Initialization.
+Each list operation, other than IsDefined, reinitializes
+listError to noerr as its first statement.  RaiseErrIn is
+used to assign an actual exception value to listError when
+a list operation raises an exception.
+
+handlers is an array of exception handling routines invoked
+when an exception is raised.  Each exception is initialized to
+ExitOnError other than noerr which is set to the NullHandler
+in section 6.2.6 Module Initialization.  GetHandler and
+SetHandler allow assignment and retrieval, respectively, of
+the exception handlers for specific exceptions.
+*)
+
+VAR   listError : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE ListError   ()	: Exceptions  (*-- out   *);
+BEGIN
+  RETURN listError;
+END ListError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+	theHandler: HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := theHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn  (    theRoutine: Operations  (*-- in    *);
+	theError  : Exceptions  (*-- in    *));
+BEGIN
+  listError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+(*
+6.2.3 Pool Constructors
+
+
+InitPool attempts to allocate a node pool of the given size and
+link all of its nodes together into the free list, (which is
+singly-linked).  We use the variable sized array allocation
+technique presented in the bounded component modules of Volume
+1.  Complexity: O(s) where s is the size of the node pool.
+*)
+
+PROCEDURE InitPool  (    theSize : PoolSize (*-- in    *))
+	: Pool     (*-- out   *);
+
+CONST baseSize = SIZE(NodePool) - SIZE(NodeHeap);
+CONST nodeSize = SIZE(Node);
+
+VAR   index   : List; (*-- loop index for building free list *)
+      newPool : Pool; (*-- new node pool being initialized *)
+
+BEGIN
+  listError := noerr;
+  Allocate(newPool, baseSize + nodeSize * theSize);
+  IF (newPool = NIL) THEN
+    RaiseErrIn(modinit, initfailed);
+  ELSE
+	WITH newPool^ DO
+	  FOR index := theSize - 1 TO MIN(PoolSize) BY -1 DO
+		nodes[index].next := index + 1;
+	  END (*--while*);
+	  nodes[theSize].next := 0;
+	  free := MIN(PoolSize);
+	  size := theSize;
+	 END (*--with*);
+  END (*--if*);
+  RETURN newPool;
+END InitPool;
+(*--------------------*)
+
+(*
+FreePool simply needs to return the storage originally
+allocated to the pool back to the heap.  Complexity: O(1).
+*)
+
+PROCEDURE FreePool  (    thePool : Pool     (*-- inout *));
+
+CONST baseSize = SIZE(NodePool) - SIZE(NodeHeap);
+CONST nodeSize = SIZE(Node);
+
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(modinit, undefined);
+  ELSE
+    Deallocate(thePool, baseSize + nodeSize * thePool^.size);
+  END (*--if*);
+END FreePool;
+(*--------------------*)
+
+
+(*
+6.2.4 List Constructors
+
+Create retrieves a node from the given pool, raising overflow and
+returning the NullList if the node pool is already full.  It is
+equivalent to the routine GetNode seen in Pascal texts.
+Complexity: O(1).
+*)
+
+PROCEDURE Create    (    thePool : Pool     (*-- inout *))
+	: List     (*-- out   *);
+
+VAR   newNode : List;
+
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(create, undefined);
+    RETURN NullList;
+  END (*--if*);
+  WITH thePool^ DO
+    newNode := free;
+	IF (free = NullList) THEN
+	  RaiseErrIn(create, overflow);
+	ELSE
+	  free := nodes[free].next;
+	END (*--if*);
+  END (*--with*);
+  RETURN newNode;
+END Create;
+(*--------------------*)
+
+(*
+Destroy returns theList node to the node pool and is equivalent
+to the routine FreeNode seen in Pascal texts.  The given list
+node is simply added to the front of the available free list.
+Complexity: O(1).
+*)
+
+PROCEDURE Destroy   (    thePool : Pool     (*-- inout *);
+	VAR theList : List     (*-- inout *));
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(destroy, undefined);
+  ELSE
+    WITH thePool^ DO
+	  nodes[theList].next := free;
+	  free := theList;
+    END (*--with*);
+  END (*--if*);
+END Destroy;
+(*--------------------*)
+
+(*
+Clear proceeds over each node and simply returns it to the pool's
+free list. Complexity O(n).
+*)
+
+PROCEDURE Clear     (    thePool : Pool     (*-- inout *);
+	VAR theList : List     (*-- inout *));
+
+VAR   theNode : List; (*-- List node to be deallocated *)
+
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH thePool^ DO
+      WHILE (theList # NullList) DO
+	theNode := theList;
+	theList := nodes[theList].next;
+	    nodes[theNode].next := free;
+	    free := theNode;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+END Clear;
+(*--------------------*)
+
+(*
+Assign copies the source list to the target list.  If the
+two lists are the same, in other words point to the sam
+node, the routine simply exits as the target already is
+equal to the source.  Otherwise, the target list is cleared
+of its present contents.  If the source list is not empty
+the routine copies each node to the target using the TailInsert
+routine from algorithm 4.2.2 in Gonnet [3, pg. 137].
+Complexity: O(n).
+*)
+
+PROCEDURE Assign    (    thePool : Pool     (*-- inout *);
+	theList : List     (*-- in    *);
+	VAR toList  : List     (*-- inout *));
+
+VAR   newNode : List; (*-- new node from source to target *)
+      last    : List; (*-- last node inserted into target *)
+
+  PROCEDURE TailInsert (    theNode : List (*-- in    *);
+	                    VAR first   : List (*-- inout *);
+                        VAR last    : List (*-- inout *));
+  BEGIN
+    IF (first = NullList) THEN
+      first := theNode;
+    ELSE
+      thePool^.nodes[last].next := theNode;
+    END (*--if*);
+    last := theNode;
+  END TailInsert;
+
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theList # toList) THEN
+    Clear(thePool, toList);
+    last := NullList;
+    WITH thePool^ DO
+      WHILE (theList # NullList) DO
+	    IF (free = NullList) THEN
+	      RETURN;
+	    END (*--if*);
+	newNode := free;
+	    free := nodes[free].next;
+
+	    WITH nodes[newNode] DO
+	      item := nodes[theList].item;
+	      next := NullList;
+	    END (*--with*);
+
+	    TailInsert(newNode, toList, last);
+	    theList := nodes[theList].next;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+(*
+SetItem takes the given list node and assigns theItem as its
+data item value.  SetNext simply links the given node to the
+next node given.  An exception is raised in both routines if
+theList is empty.
+Complexity: O(1)
+*)
+
+PROCEDURE SetItem   (    thePool : Pool     (*-- inout *);
+	theList : List     (*-- inout *);
+	theItem : Item     (*-- in    *));
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(setitem, undefined);
+  ELSIF (theList = NullList) THEN
+    RaiseErrIn(setitem, listisnull);
+  ELSE
+    thePool^.nodes[theList].item := theItem;
+  END (*--if*);
+END SetItem;
+(*--------------------*)
+
+PROCEDURE SetNext   (    thePool : Pool     (*-- inout *);
+	theList : List     (*-- inout *);
+	newNext : List     (*-- in    *));
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(setnext, undefined);
+  ELSIF (theList = NullList) THEN
+    RaiseErrIn(setnext, listisnull);
+  ELSE
+    thePool^.nodes[theList].next := newNext;
+  END (*--if*);
+END SetNext;
+(*--------------------*)
+
+(*
+SetList constructs a list of length one out of the given item.
+If the free list is empty the overflow exception is raised
+and the NullList returned,
+otherwise the top node is taken off the free list and the new
+list node is updated with the item value and null previous and
+next links.
+Complexity: O(1).
+*)
+
+PROCEDURE SetList   (    thePool : Pool     (*-- inout *);
+	theItem : Item     (*-- in    *))
+	: List     (*-- out   *);
+
+VAR   newList : List;
+
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(setlist, undefined);
+  ELSIF (thePool^.free = NullList) THEN
+    RaiseErrIn(setlist, overflow);
+  ELSE
+    WITH thePool^ DO
+      newList := free;
+	  free    := nodes[free].next;
+      WITH nodes[newList] DO
+	    item := theItem;
+	    next := NullList;
+	  END (*--with*);
+	END (*--with*);
+	RETURN newList;
+  END (*--if*);
+  RETURN NullList;
+END SetList;
+(*--------------------*)
+
+(*
+Insert simply adds theItem to the front of theList by allocating
+a new list node from the given node pool and linking its next
+pointer to theList (which may be the NullList).
+Complexity: O(1).
+*)
+
+PROCEDURE Insert    (    thePool : Pool     (*-- inout *);
+	theItem : Item     (*-- in    *);
+	VAR theList : List     (*-- inout *));
+
+VAR   newList : List; (*-- new list node for theItem *)
+
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(insert, undefined);
+  ELSIF (thePool^.free = NullList) THEN
+    RaiseErrIn(insert, overflow);
+  ELSE
+    WITH thePool^ DO
+      newList := free;
+	  free    := nodes[free].next;
+      WITH nodes[newList] DO
+	    item := theItem;
+	    next := theList;
+	  END (*--with*);
+	  theList := newList;
+	END (*--with*);
+  END (*--if*);
+END Insert;
+(*--------------------*)
+
+
+(*
+6.2.5 Selectors
+
+IsDefined returns true if thePool appears to point to something,
+(i.e., not be NIL) and false otherwise.
+Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    thePool : Pool     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN (thePool # NIL);
+END IsDefined;
+(*--------------------*)
+
+(*
+IsEmpty returns True if theList is in the empty state, as indicated by
+the list being equal to the null list, and False otherwise.  
+Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  listError := noerr;
+  RETURN (theList = NullList);
+END IsEmpty;
+(*--------------------*)
+
+(*
+IsEqual compares the left and right list for equality, which in this
+context means they contain the same items.  The algorithm simply loops
+over each of the items in both lists returning false immediately upon
+encountering an inequality, and returning true if and only if every
+item is the same between them. This condition is detected by
+both list pointers being the null list at the end of the loop.
+Complexity: O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    thePool : Pool     (*-- in    *);
+	left    : List     (*-- in    *);
+	right   : List     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+	RETURN FALSE;
+  ELSE
+    WITH thePool^ DO
+      WHILE (left # NullList) & (right # NullList) DO
+	IF (nodes[left].item # nodes[right].item) THEN
+	      RETURN FALSE;
+	    END (*--if*);
+	    left  := nodes[left].next;
+	    right := nodes[right].next;
+      END (*--while*);
+      RETURN (left = right) & (right = NullList);
+    END (*--with*);
+  END (*--if*);
+END IsEqual;
+(*--------------------*)
+
+(*
+LengthOf simply loops over the links of the list counting
+the number of list nodes it finds. Complexity: O(n).
+*)
+
+PROCEDURE LengthOf  (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+VAR   length : CARDINAL; (*-- Running count of items *)
+
+BEGIN
+  listError := noerr;
+  length    := 0;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(lengthof, undefined);
+  ELSE
+    WITH thePool^ DO
+      WHILE (theList # NullList) DO
+	    INC(length);
+	    theList := nodes[theList].next;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+  RETURN length;
+END LengthOf;
+(*--------------------*)
+
+(*
+GetNext simply returns the link to the next list node, or if
+given an empty list the listisnull exception is raised and the
+null list is returned.  If thePool itself is invalid the undefined
+exception is raised and the null item is returned.
+Complexity: O(1).
+*)
+
+PROCEDURE GetNext   (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: List     (*-- out   *);
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(getnext, undefined);
+    RETURN NullList;
+  ELSIF (theList = NullList) THEN
+    RaiseErrIn(getnext, listisnull);
+    RETURN NullList;
+  END (*--if*);
+  RETURN thePool^.nodes[theList].next;
+END GetNext;
+(*--------------------*)
+
+(*
+GetItem simply returns the item of the given list node, or if
+given an empty list the listisnull exception is raised and the
+null item is returned.  If thePool itself is invalid the undefined
+exception is raised and the null item is returned.
+Complexity: O(1).
+*)
+
+PROCEDURE GetItem   (    thePool : Pool     (*-- in    *);
+	theList : List     (*-- in    *))
+	: Item     (*-- out   *);
+BEGIN
+  listError := noerr;
+  IF (thePool = NIL) THEN
+    RaiseErrIn(getitem, undefined);
+    RETURN NullItem;
+  ELSIF (theList = NullList) THEN
+    RaiseErrIn(getitem, listisnull);
+    RETURN NullItem;
+  END (*--if*);
+  RETURN thePool^.nodes[theList].item;
+END GetItem;
+(*--------------------*)
+
+
+(*
+6.2.6 Module Initialization
+
+The module's local variables are initialized to known states.
+listError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.
+
+Since a FOR loop control variable is undefined following the loop,
+listError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR listError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(listError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  listError := noerr;
+END ListSBM.
+
+(*
+
+References
+
+[1] Aho, Hopcroft, and Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading MA 1983.
+[2] G. Booch, Software Components with Ada, Structures, Tools, and Subsystems,
+    Benjamin/Cummings, Menlo Park, CA 1987.
+[3] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Addison-Wesley, London England 1984.
+[4] D. Knuth, The Art of Computer Programming, Volume 1, Fundamental
+    Algorithms, Addison-Wesley, Reading MA 1973.
+[5] R. Wiener and R. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY, 1986, pg. 198.
+[6] N. Wirth, Algorithms and Data Structures, Prentice-Hall,
+    Englewood Cliffs, NJ 1986.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBMS.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBMS.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBMS.DEF
@@ -0,0 +1,110 @@
+DEFINITION MODULE ListSBMSearch; 
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tools - Structure Utility - Single List Search
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation.
+
+	(C) Copyright 1989 Charles A. Lins
+=============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc;
+
+FROM ListSBM IMPORT
+    (*--Type*) List, Pool;
+
+    (*--------------------*)
+
+TYPE  SuccessProc  = PROCEDURE (Item);
+TYPE  FailureProc  = PROCEDURE (Item);
+
+    (*--------------------*)
+
+(*
+PrimarySearch
+
+Searches theList for the first occurance of theItem with the required
+key.  This is called the primary key search.  It is assumed that the
+item comparison routine knows how to extract the key from the items
+if necessary.  If the search succeeds then the found procedure parameter
+is invoked, otherwise the notfound routine is called.  The list is
+assumed to be unordered.
+*)
+
+PROCEDURE PrimarySearch (    theItem   : Item	(*-- in    *);
+	theList   : List	(*-- in    *);
+	thePool   : Pool	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+
+(*
+SecondarySearch
+
+Searches theList for every occurance of theItem with the required
+key.  This is called the secondary key search.  It is assumed that the
+item comparison routine knows how to extract the key from the items
+if necessary.  Each time the search succeeds the found procedure parameter
+is invoked.  The list is assumed to be unordered.
+*)
+
+PROCEDURE SecondarySearch (    theItem   : Item	(*-- in    *);
+	theList   : List	(*-- in    *);
+	thePool   : Pool	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *));
+
+
+(*
+Self-organizing Sequential Search - MoveToFront
+
+This routine is essentially the primary key search modified to apply
+a heuristic for improving the list ordering.  When a key is found,
+theItem is moved to the front of the list.  The idea is that the
+access distribution of items in the list is unequal, and therefore,
+the most frequently accessed items should be closer to the front.
+For a sophisticated analysis comparing self-organizing heuristics
+see reference [1].
+*)
+
+PROCEDURE MoveToFront (    theItem   : Item	(*-- in    *);
+	VAR theList   : List	(*-- inout *);
+	thePool   : Pool	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+
+(*
+Self-organizing Sequential Search - Transpose
+
+Instead of moving the found item to the front of the list, the Transpose
+heuristic moves the item one position closer to the front by swapping
+positions with its predecessor.
+*)
+
+PROCEDURE Transpose (    theItem   : Item	(*-- in    *);
+	VAR theList   : List	(*-- inout *);
+	thePool   : Pool	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+END ListSBMSearch.
+
+(*
+
+References
+
+[1] J.L. Bentley and C.C. McGeoch, Worst-Case Analyses of
+    Self-Organizing Sequential Search Heuristics,
+	Carnegie-Mellon University, 1983.
+[2] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Searching Algorithms, Addison-Wesley, London 1984,
+	pp. 23-30.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBMS.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBMS.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBMS.MOD
@@ -0,0 +1,182 @@
+IMPLEMENTATION MODULE ListSBMSearch; 
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tools - Structure Utility - Single List Search
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation.
+
+	(C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc;
+
+FROM ListSBM IMPORT
+    (*--Type*) List, Pool,
+    (*--Proc*) GetNext, GetItem, IsEmpty, SetNext, SetItem;
+
+    (*--------------------*)
+
+(*
+PrimarySearch
+
+Our primary key search routine has been optimized using the LOOP construct
+instead of a WHILE statement to avoid multiple calls to IsEmpty,
+GetItem, and keysEqual at the end of the routine when determining
+success or failure. (See reference [2]).
+*)
+
+PROCEDURE PrimarySearch (    theItem   : Item	(*-- in    *);
+	theList   : List	(*-- in    *);
+	thePool   : Pool	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+BEGIN
+  LOOP 
+    IF IsEmpty(thePool, theList) THEN
+      notFound(theItem);
+      EXIT (*--loop*);
+    ELSIF (keysEqual(GetItem(thePool, theList), theItem) = equal) THEN
+      found(theItem);
+      EXIT (*--loop*);
+    END (*--if*);
+    theList := GetNext(thePool, theList);
+  END (*--loop*);
+END PrimarySearch;
+(*-------------------------*)
+
+(*
+SecondarySearch
+
+Where the primary key search stops after the finding the first occurance
+of theItem, the secondary key search continues to the end of the list
+in order to find all occurances of theItem.  Therefore, the complexity
+is O(n).
+*)
+
+PROCEDURE SecondarySearch (    theItem   : Item	(*-- in    *);
+	theList   : List	(*-- in    *);
+	thePool   : Pool	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *));
+BEGIN
+  WHILE ~IsEmpty(thePool, theList) DO
+    IF keysEqual(GetItem(thePool, theList), theItem) = equal THEN
+      found(theItem);
+    END (*--if*);
+    theList := GetNext(thePool, theList);
+  END (*--while*);
+END SecondarySearch;
+(*-------------------------*)
+
+(*
+Self-organizing Sequential Search - MoveToFront
+
+The algorithm first takes care of the special cases where the list is
+empty or when the item is already at the front of the list. Then if it
+is necessary to scan the list, the routine does so remembering the last
+node examined in case theItem is found it can be easily moved to the
+front without searching for the node's predecessor.
+*)
+
+PROCEDURE MoveToFront (    theItem   : Item	(*-- in    *);
+	VAR theList   : List	(*-- inout *);
+	thePool   : Pool	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+VAR   last : List; (*-- last node examined *)
+      next : List; (*-- link to next node from the last node *)
+      temp : List; (*-- temporary for swapping three links *)
+
+BEGIN
+  IF IsEmpty(thePool, theList) THEN
+    notFound(theItem);
+  ELSIF keysEqual(theItem, GetItem(thePool, theList)) = equal THEN
+    found(theItem);
+  ELSE
+    last := theList;
+	LOOP
+	  next := GetNext(thePool, last);
+	  IF IsEmpty(thePool, next) THEN
+	notFound(theItem);
+	    EXIT (*--loop*);
+      ELSIF keysEqual(theItem, GetItem(thePool, next)) = equal THEN
+	temp    := theList;
+	theList := next;
+	SetNext(thePool, last, GetNext(thePool, next));
+	SetNext(thePool, theList, temp);
+	found(theItem);
+	EXIT (*--loop*);
+      END (*--if*);
+	  last := next;
+    END (*--loop*);
+  END (*--if*);
+END MoveToFront;
+(*-------------------------*)
+
+(*
+Self-organizing Sequential Search - Transpose
+
+The transpose hueristic is similar to the Move-To-Front method, above,
+except when theItem is found it is moved only one position forward in
+the list.  Here, theItem is used as a temporary when moving the value
+forward in the list.  For a Pascal version of this algorithm using arrays
+see Gonnet [2].
+*)
+
+PROCEDURE Transpose (    theItem   : Item	(*-- in    *);
+	VAR theList   : List	(*-- inout *);
+	thePool   : Pool	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+VAR   last : List; (*-- last node examined *)
+      next : List; (*-- link to next node from the last node *)
+
+BEGIN
+  IF IsEmpty(thePool, theList) THEN
+    notFound(theItem);
+  ELSIF keysEqual(theItem, GetItem(thePool, theList)) = equal THEN
+    found(theItem);
+  ELSE
+    last := theList;
+	LOOP
+	  next := GetNext(thePool, last);
+	  IF IsEmpty(thePool, next) THEN
+	notFound(theItem);
+	    EXIT (*--loop*);
+      ELSIF keysEqual(theItem, GetItem(thePool, next)) = equal THEN
+	SetItem(thePool, next, GetItem(thePool, last));
+		SetItem(thePool, last, theItem);
+	found(theItem);
+	EXIT (*--loop*);
+      END (*--if*);
+	  last := next;
+    END (*--loop*);
+  END (*--if*);
+END Transpose;
+(*-------------------------*)
+
+END ListSBMSearch.
+
+(*
+
+References
+
+[1] J.L. Bentley and C.C. McGeoch, Worst-Case Analyses of
+    Self-Organizing Sequential Search Heuristics,
+	Carnegie-Mellon University, 1983.
+[2] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Searching Algorithms, Addison-Wesley, London 1984,
+	pp. 23-30.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBMT.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBMT.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBMT.DEF
@@ -0,0 +1,107 @@
+DEFINITION MODULE ListSBMTools; 
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tools - Structure Utility - Singly-Linked List
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation.
+
+	(C) Copyright 1989 Charles A. Lins
+=============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ListSBM IMPORT
+    (*--Type*) List, Pool;
+
+    (*--------------------*)
+
+TYPE  Position     = CARDINAL;
+CONST NullPosition = 0;
+
+
+    (*--------------------*)
+
+(*
+Constructors
+
+Construct builds a list from an array of Items.  If theList is not
+empty it is cleared of its contents before the construction commences.
+Build is similar except that only the first n items (numItems) are used to
+construct the list.
+
+AddToTail adds theItem to the end of theList.  Complexity: O(n).
+
+Split divides theList into two lists at theItem.  If theItem is not present
+in theList then the toList is unchanged.
+*)
+
+PROCEDURE Construct (    theItems : ARRAY OF Item (*-- in    *);
+	VAR theList  : List	(*-- inout *);
+					     thePool  : Pool		  (*-- inout *));
+
+PROCEDURE Build     (    theItems : ARRAY OF Item (*-- in    *);
+	numItems : CARDINAL      (*-- in    *);
+	VAR theList  : List	(*-- inout *);
+					     thePool  : Pool		  (*-- inout *));
+
+PROCEDURE AddToTail (    theItem  : Item	(*-- in    *);
+	VAR theList  : List	(*-- inout *);
+					     thePool  : Pool		  (*-- inout *));
+
+PROCEDURE Split     (VAR theList  : List	(*-- inout *);
+	theItem  : Item	(*-- in    *);
+	VAR toList   : List	(*-- inout *);
+					     thePool  : Pool		  (*-- inout *));
+
+
+(*
+Selectors
+
+LastOf returns the list containing the last item of theList or the NullList
+if theList is empty.
+
+PositionOf searches for theItem in theList returning theItem's position such
+that:
+	Position = 1 when theItem is at the front of theList,
+	Position = LengthOf(theList) when theItem is at the end of theList, and
+	Position = 0 when theItem is not present within theList.
+
+LocationOf returns a list beginning with the item at theIndex in theList.  If
+theList does not have such a positionthe NullList is returned.
+*)
+
+PROCEDURE LastOf     (    thePool : Pool	 (*-- in    *);
+						  theList : List     (*-- in    *))
+	: List     (*-- out   *);
+
+PROCEDURE PositionOf (    theItem : Item     (*-- in    *);
+	theList : List     (*-- in    *);
+						  thePool : Pool     (*-- in    *))
+							: Position (*-- out   *);
+
+PROCEDURE LocationOf (    theIndex: Position (*-- in    *);
+	theList : List     (*-- in    *);
+						  thePool : Pool     (*-- in    *))
+							: List     (*-- out   *);
+
+END ListSBMTools.
+
+(*
+
+References
+
+[1]  A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983
+[2] G. Booch, Software Components with Ada Structures, Tools, and Subsystems,
+	Benjamin/Cummings, Menlo Park, CA 1987
+[3] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Addison-Wesley, London England 1984
+[4]	D. Knuth, The Art of Computer Programming, Volume 1, Fundamental Algorithms,
+    Addison-Wesley, Reading, MA 1973
+[5]	N. Wirth, Algorithms and Data Structures, Prentice-Hall, Englewood
+    Cliffs, NJ 1986
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBMT.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBMT.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSBMT.MOD
@@ -0,0 +1,257 @@
+IMPLEMENTATION MODULE ListSBMTools; 
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tools - Structure Utility - Singly-Linked List
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation.
+
+	(C) Copyright 1989 Charles A. Lins
+=============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ListSBM IMPORT
+    (*--Type*) List, Pool, NullList,
+	(*--Proc*) IsEmpty, GetNext, GetItem, SetNext, SetList,
+		Clear, Assign, Insert;
+
+    (*--------------------*)
+
+(*
+Constructors
+
+Construct first clears theList, if necessary, and then loops over theItems
+in reverse order adding each item to the front of theList.
+*)
+
+PROCEDURE Construct (    theItems : ARRAY OF Item (*-- in    *);
+	VAR theList  : List	(*-- inout *);
+					     thePool  : Pool		  (*-- inout *));
+
+VAR   index : INTEGER; (*-- loop index over items array *)
+
+BEGIN
+  IF ~IsEmpty(thePool, theList) THEN
+    Clear(thePool, theList);
+  END (*--if*);
+  FOR index := HIGH(theItems) TO 0 BY -1 DO
+  	Insert(thePool, theItems[index], theList);
+  END (*--for*);
+END Construct;
+(*-------------------------*)
+
+(*
+Build is quite similar to Construct, above, in traversing theItems in
+reverse order appending items to the front of theList. The difference
+is that only the first numItems are used to form the list.  If numItems
+is greater than the actual number of items in theItems array, only those
+items truly present are inserted.
+Complexity: O(n) where n is the number of items inserted.
+*)
+
+PROCEDURE Build     (    theItems : ARRAY OF Item (*-- in    *);
+	numItems : CARDINAL      (*-- in    *);
+	VAR theList  : List	(*-- inout *);
+					     thePool  : Pool		  (*-- inout *));
+
+VAR   index : INTEGER; (*-- loop index over items array *)
+
+BEGIN
+  IF ~IsEmpty(thePool, theList) THEN
+    Clear(thePool, theList);
+  END (*--if*);
+  IF (numItems > VAL(CARDINAL, HIGH(theItems) + 1)) THEN
+    numItems := HIGH(theItems) + 1;
+  END (*--if*);
+  FOR index := VAL(INTEGER, numItems) - 1 TO 0 BY -1 DO
+  	Insert(thePool, theItems[index], theList);
+  END (*--for*);
+END Build;
+(*-------------------------*)
+
+(*
+AddToTail inserts theItem at the end of theList.  The routine first
+takes care of the trivial case where theList is empty.  Then it proceeds
+to scan theList for the last item.  Once this has been found, a new list
+(of length one) is created for the item, and the last node is linked to
+the new list.  Note: once the last node has been found, next is no longer
+needed and is therefore used as a temporary to create the new list for
+theItem.
+Complexity: O(n).
+*)
+
+PROCEDURE AddToTail (    theItem  : Item	(*-- in    *);
+	VAR theList  : List	(*-- inout *);
+					     thePool  : Pool		  (*-- inout *));
+
+VAR   last : List; (*-- last list node examined *)
+      next : List; (*-- link from last node to next node *) 
+
+BEGIN
+  IF IsEmpty(thePool, theList) THEN
+    theList := SetList(thePool, theItem);
+  ELSE
+    last := theList;
+    LOOP
+      next := GetNext(thePool, last);
+	  IF IsEmpty(thePool, next) THEN
+	    EXIT (*--loop*);
+	  END (*--if*);
+	  last := next;
+    END (*--loop*);
+    next := SetList(thePool, theItem);
+    SetNext(thePool, last, next);
+  END (*--if*);
+END AddToTail;
+(*-------------------------*)
+
+(*
+Split searches theList maintaining a link to the previous node examined.
+When theItem is found at the front of theList, the toList becomes theList
+and theList becomes the empty list.  Otherwise, theList is truncated at
+the previous node examined, and the toList becomes a list beginning with
+theItem.
+*)
+
+PROCEDURE Split     (VAR theList  : List	(*-- inout *);
+	theItem  : Item	(*-- in    *);
+	VAR toList   : List	(*-- inout *);
+					     thePool  : Pool		  (*-- inout *));
+
+VAR   last  : List; (*-- last list node examined *)
+      prior : List; (*-- link from last node to prior node examined *) 
+
+BEGIN
+  last  := theList;
+  prior := NullList;
+  LOOP
+	IF IsEmpty(thePool, last) THEN
+	  EXIT (*--loop*);
+    ELSIF (theItem = GetItem(thePool, last)) THEN
+	  Clear(thePool, toList);
+	  IF (prior = NullList) THEN
+	    theList := NullList;
+	  ELSE
+	    SetNext(thePool, prior, NullList);
+	  END (*--if*);
+	  toList := last;
+	  EXIT (*--loop*);
+	ELSE
+	  prior := last;
+      last  := GetNext(thePool, last);
+	END (*--if*);
+  END (*--loop*);
+END Split;
+(*-------------------------*)
+
+
+(*
+Selectors
+
+LastOf simply scans theList looking for the last list node and
+returns the node containing the last item. If theList is empty,
+the NullList if returned.
+*)
+
+PROCEDURE LastOf     (    thePool : Pool	 (*-- in    *);
+						  theList : List     (*-- in    *))
+	: List     (*-- out   *);
+
+VAR   last : List; (*-- last list node examined *)
+      next : List; (*-- link from last node to next node *) 
+
+BEGIN
+  IF IsEmpty(thePool, theList) THEN
+    RETURN NullList;
+  END (*--if*);
+  last := theList;
+  LOOP
+    next := GetNext(thePool, last);
+	IF IsEmpty(thePool, next) THEN
+	  EXIT (*--loop*);
+	END (*--if*);
+	last := next;
+  END (*--loop*);
+  RETURN last;
+END LastOf;
+(*-------------------------*)
+
+(*
+PositionOf does a linear search of theList looking for theItem keeping a
+running count of the index position.  If theItem is not found in theList then
+the NullList is returned otherwise the index position at which theItem is
+found is returned.
+*)
+
+PROCEDURE PositionOf (    theItem : Item     (*-- in    *);
+	theList : List     (*-- in    *);
+						  thePool : Pool     (*-- in    *))
+							: Position (*-- out   *);
+
+VAR   index : Position; (*-- running index into theList *)
+
+BEGIN
+  index := 1;
+  WHILE ~IsEmpty(thePool, theList) DO
+    IF (theItem = GetItem(thePool, theList)) THEN
+	  RETURN index;
+	END (*--if*);
+    INC(index);
+	theList := GetNext(thePool, theList);
+  END (*--while*);
+  RETURN NullPosition;
+END PositionOf;
+(*-------------------------*)
+
+(*
+LocationOf is the inverse of PositionOf given above.  The routine first takes
+care of the trivial case in which it is given an empty list by returning an
+empty list.  theList parameter is used as a local variable to access each of
+the list nodes and if theIndex position exists within theList the link to
+that list is returned.  If theList ever becomes empty during the loop the
+routine can be certain that theIndex position does not exist.
+*)
+
+PROCEDURE LocationOf (    theIndex: Position (*-- in    *);
+	theList : List     (*-- in    *);
+						  thePool : Pool     (*-- in    *))
+							: List     (*-- out   *);
+
+VAR   index : Position; (*-- running index into theList *)
+
+BEGIN
+  IF IsEmpty(thePool, theList) THEN
+    RETURN NullList;
+  ELSE
+    FOR index := 2 TO theIndex DO
+	  theList := GetNext(thePool, theList);
+	  IF IsEmpty(thePool, theList) THEN
+	    RETURN NullList;
+      END (*--if*);
+	END (*--for*);
+	RETURN theList;
+  END (*--if*);
+END LocationOf;
+(*-------------------------*)
+
+END ListSBMTools.
+
+(*
+
+References
+
+[1]  A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983
+[2] G. Booch, Software Components with Ada Structures, Tools, and Subsystems,
+	Benjamin/Cummings, Menlo Park, CA 1987
+[3] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Addison-Wesley, London England 1984
+[4]	D. Knuth, The Art of Computer Programming, Volume 1, Fundamental Algorithms,
+    Addison-Wesley, Reading, MA 1973
+[5]	N. Wirth, Algorithms and Data Structures, Prentice-Hall, Englewood
+    Cliffs, NJ 1986
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUM.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUM.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUM.DEF
@@ -0,0 +1,141 @@
+(*
+4.2 Singly-Linked Unbounded List Interface
+
+The interface to the singly-linked unbounded list directly
+models the abstract list operations covered in chapter 3.  Unlike
+the components from Volume 1 the list modules do not concern
+themselves with the data type of the objects or items manipulated.
+The reasons for this are (1) the low level of the operations provided,
+and (2) implementation efficiency, which is discussed in greater
+detail in the implementation module.
+*)
+
+DEFINITION MODULE ListSUM;
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Polylithic Structures - List
+	Singly-Linked Unbounded Managed
+
+    The Abstraction
+    This module provides the List ADT for generic Items.
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+	(C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM ListEnum IMPORT
+    (*--Type*) Exceptions;
+
+    (*-----------------------*)
+
+(*
+4.2.1 Type Declarations
+
+The abstract type List is exported along with a constant representing
+the empty list.  NullList is also used to terminate a sequence of
+links.
+*)
+
+TYPE  List;
+CONST NullList = List(NIL);
+
+
+(*
+4.2.2 Exceptions
+
+The ModuleID uniquely identifies this module.  ListError returns
+the result code from the most recently invoked list operation.
+GetHandler and SetHandler allow assignment and retrieval,
+respectively, of exception handlers for specific exceptions.
+*)
+
+CONST ModuleID = 4;
+
+PROCEDURE ListError   ()	: Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+	theHandler: HandlerProc (*-- in    *));
+
+
+(*
+4.2.3 Constructors
+
+Create simply returns the NullList and Destroy is equivalent to
+Clear.  Neither is necessary for this particular implementation
+but are included for compatability and consistency with the other
+components.  Definitions for the other constructors was given
+in Section 3.3, under Constructor Operations.
+*)
+
+PROCEDURE Create    ()	: List  (*-- out   *);
+
+PROCEDURE Destroy   (VAR theList : List (*-- inout *));
+
+PROCEDURE Clear     (VAR theList : List (*-- inout *));
+
+PROCEDURE Assign    (    theList : List (*-- in    *);
+	VAR toList  : List (*-- inout *));
+
+PROCEDURE SetItem   (    theList : List (*-- inout *);
+	theItem : Item (*-- in    *));
+
+PROCEDURE SetNext   (    theList : List (*-- inout *);
+	newNext : List (*-- in    *));
+
+PROCEDURE SetList   (    theItem : Item (*-- in    *))
+	: List (*-- out   *);
+
+PROCEDURE Insert    (    theItem : Item (*-- in    *);
+	VAR theList : List (*-- inout *));
+
+
+(*
+4.2.4 Selectors
+
+In this list module, IsEmpty serves the function of IsDefined.
+Definitions for the other selectors was given in Section 3.4,
+under Selector Operations.  All of the selectors have a complexity
+of O(1) except for IsEqual which is O(Min(m,n)) and LengthOf which
+is O(n).
+*)
+
+PROCEDURE IsEmpty   (    theList : List     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left    : List     (*-- in    *);
+	right   : List     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theList : List     (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+PROCEDURE GetNext   (    theList : List     (*-- in    *))
+	: List     (*-- out   *);
+
+PROCEDURE GetItem   (    theList : List     (*-- in    *))
+	: Item     (*-- out   *);
+
+END ListSUM.
+
+(*
+
+References
+[1] G. Booch, Software Components with Ada, Structures, Tools, and Subsystems,
+    Benjamin/Cummings, Menlo Park, CA 1987.
+[2] D. Knuth, The Art of Computer Programming, Volume 1, Fundamental
+    Algorithms, Addison-Wesley, Reading, MA 1973.
+[3] R. Sincovec and R. Wiener, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986, pg. 198.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUM.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUM.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUM.MOD
@@ -0,0 +1,447 @@
+(*
+4.3 Singly-Linked Unbounded List Implementation
+
+*)
+
+IMPLEMENTATION MODULE ListSUM;
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Polylithic Structures - List
+	Singly-Linked Unbounded Managed
+
+    The Abstraction
+    This module provides the List ADT for generic Items.
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation for TopSpeed Modula-2.
+	(C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) NullHandler, Raise, ExitOnError;
+
+FROM ListEnum IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+    (*-----------------------*)
+
+(*
+4.3.1 Internal Singly-linked Unbounded List Representation
+
+A list is a recursive data structure defined as either:
+
+* an empty list (e.g., NIL), or
+* the chain of an item and a list.
+
+We shall model this structure directly with the chain of items
+being represented by a Node containing the item itself and a
+link to the next item in the list.  Then a list becomes a
+pointer to a Node.
+
+FIGURE 4.1
+
+Representation Invariants:
+* an empty list is represented by NIL
+* the last non-empty node has a next pointer of NIL
+
+Unfortunately, this does not allow us to manage the structure's
+data type as was the case for all of Volume 1 and the non-list
+modules in this volume.  From the type declaration below, it can
+be seen that we would require a header node and every time that
+we extracted a portion of a list would necessitate duplicating
+this header information.  The consequence is that the programmer
+must exercise greater discipline when using the module.
+*)
+
+TYPE  List = POINTER TO Node;
+TYPE  Node = RECORD
+	item : Item; (*-- Data for the node *)
+	next : List; (*-- Next node forward *)
+      END (*-- Node *);
+
+    (*--------------------*)
+
+(*
+4.3.2 Exceptions
+
+The listError variable holds the exception result from each
+operation and ListError simply returns this value.  It is
+initialized to noerr in section 4.3.5 Module Initialization.
+Each list operation reinitializes listError to noerr as its
+first statement.  RaiseErrIn is used to assign an actual
+exception value to listError when a list operation raises an
+exception.
+
+handlers is an array of exception handling routines invoked
+when an exception is raised.  Each exception is initialized to
+ExitOnError other than noerr which is set to the NullHandler
+in section 4.3.5 Module Initialization.  GetHandler and
+SetHandler allow assignment and retrieval, respectively, of
+the exception handlers for specific exceptions.
+*)
+
+VAR   listError : Exceptions;
+VAR   handlers  : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE ListError   ()	: Exceptions  (*-- out   *);
+BEGIN
+  RETURN listError;
+END ListError;
+(*--------------------*)
+
+PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
+	: HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[ofError];
+END GetHandler;
+(*--------------------*)
+
+PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
+	theHandler: HandlerProc (*-- in    *));
+BEGIN
+  handlers[ofError] := theHandler;
+END SetHandler;
+(*--------------------*)
+
+PROCEDURE RaiseErrIn  (    theRoutine: Operations  (*-- in    *);
+	theError  : Exceptions  (*-- in    *));
+BEGIN
+  listError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*--------------------*)
+
+
+(*
+4.3.3 Constructors
+
+Create simply returns the NullList which is our representation
+of an empty list.  Data type is not managed by this list
+implementation in the interests of simplicity. Complexity: O(1).
+*)
+
+PROCEDURE Create    () : List	(*-- out   *);
+BEGIN
+  listError := noerr;
+  RETURN NullList;
+END Create;
+(*--------------------*)
+
+(*
+Destroy simply clears the list which also destroys it.
+Complexity: O(n).
+*)
+
+PROCEDURE Destroy   (VAR theList : List (*-- inout *));
+BEGIN
+  Clear(theList);
+END Destroy;
+(*--------------------*)
+
+(*
+Clear proceeds over each node and simply deallocates it.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear     (VAR theList : List (*-- inout *));
+
+VAR   theNode : List; (*-- List node to be deallocated *)
+
+BEGIN
+  listError := noerr;
+  WHILE (theList # NullList) DO
+    theNode := theList;
+    theList := theList^.next;
+    Deallocate(theNode, SIZE(theNode^));
+  END (*--while*);
+END Clear;
+(*--------------------*)
+
+(*
+Assign copies the source list to the target list.  If the
+two lists are the same, in other words point to the same
+node, the routine simply exits as the target already is
+equal to the source.  Otherwise, the target list is cleared
+of its present contents.  If the source list is not empty
+the routine copies each node to the target using the TailInsert
+routine from algorithm 4.2.2 in Gonnet [2, pg. 137].
+Complexity: O(n).
+*)
+
+PROCEDURE TailInsert(    theNode : List (*-- in    *);
+	VAR first   : List (*-- inout *);
+					 VAR last    : List (*-- inout *));
+BEGIN
+  IF (first = NullList) THEN
+    first := theNode;
+  ELSE
+    last^.next := theNode;
+  END (*--if*);
+  last := theNode;
+END TailInsert;
+
+PROCEDURE Assign    (    theList : List (*-- in    *);
+	VAR toList  : List (*-- inout *));
+
+VAR   newNode : List; (*-- new node from source to target *)
+      last    : List; (*-- last node inserted into target *)
+
+BEGIN
+  IF (theList # toList) THEN
+    Clear(toList);
+    last := NIL;
+    WHILE (theList # NullList) DO
+      Allocate(newNode, SIZE(Node));
+	  IF (newNode = NullList) THEN
+	    RaiseErrIn(assign, overflow);
+	    RETURN;
+	  END (*--if*);
+
+	  WITH newNode^ DO
+	    item := theList^.item;
+	    next := NullList;
+	  END (*--with*);
+
+	  TailInsert(newNode, toList, last);
+	  theList := theList^.next;
+    END (*--while*);
+  END (*--if*);
+END Assign;
+(*--------------------*)
+
+(*
+SetItem takes the given list node and assigns theItem as its
+data item value.  SetNext simply links the given node to the
+next node given.  An exception is raised in both routines if
+theList is empty.  Both routines are complexity O(1).
+*)
+
+PROCEDURE SetItem   (    theList : List (*-- inout *);
+	theItem : Item (*-- in    *));
+BEGIN
+  listError := noerr;
+  IF (theList = NullList) THEN
+    RaiseErrIn(setitem, listisnull);
+  ELSE
+    theList^.item := theItem;
+  END (*--if*);
+END SetItem;
+(*--------------------*)
+
+PROCEDURE SetNext   (    theList : List (*-- inout *);
+	newNext : List (*-- in    *));
+BEGIN
+  listError := noerr;
+  IF (theList = NullList) THEN
+    RaiseErrIn(setnext, listisnull);
+  ELSE
+    theList^.next := newNext;
+  END (*--if*);
+END SetNext;
+(*--------------------*)
+
+(*
+Insert simply adds theItem to the front of theList by allocating
+a new list node and linking its next pointer to theList (which
+may be the NullList).
+Complexity: O(1).
+*)
+
+PROCEDURE Insert    (    theItem : Item (*-- in    *);
+	VAR theList : List (*-- inout *));
+
+VAR   newList : List; (*-- new list node for theItem *)
+
+BEGIN
+  listError := noerr;
+  Allocate(newList, SIZE(Node));
+  IF (newList = NullList) THEN
+    RaiseErrIn(insert, overflow);
+  ELSE
+    WITH newList^ DO
+	  item := theItem;
+	  next := theList;
+	END (*--with*);
+    theList := newList;
+  END (*--if*);
+END Insert;
+(*--------------------*)
+
+(*
+SetList constructs a list of length one out of the given item
+and returns it if successful; otherwise the NullList is returned.
+Complexity: O(1).
+*)
+
+PROCEDURE SetList   (    theItem : Item (*-- in    *))
+	: List (*-- out   *);
+
+VAR   newList : List;
+
+BEGIN
+  listError := noerr;
+  Allocate(newList, SIZE(Node));
+  IF (newList = NullList) THEN
+    RaiseErrIn(setlist, overflow);
+  ELSE
+    WITH newList^ DO
+	  item := theItem;
+	  next := NullList;
+	END (*--with*);
+  END (*--if*);
+  RETURN newList;
+END SetList;
+(*--------------------*)
+
+
+(*
+4.3.4 Selectors
+
+IsEmpty returns True if theList is in the empty state, as indicated by
+the list being equal to the null list, and False otherwise.  
+Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theList : List     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  listError := noerr;
+  RETURN (theList = NullList);
+END IsEmpty;
+(*--------------------*)
+
+(*
+IsEqual compares the left and right list for equality, which in this
+context means they contain the same items.  The algorithm simply loops
+over each of the items in both lists returning false immediately upon
+encountering an inequality, and returning true if and only if every
+item is the same between them. This condition is detected by
+both list pointers being the null list at the end of the loop.
+Complexity: O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left    : List     (*-- in    *);
+	right   : List     (*-- in    *))
+	: BOOLEAN  (*-- out   *);
+BEGIN
+  listError := noerr;
+  WHILE (left # NullList) & (right # NullList) DO
+    IF (left^.item # right^.item) THEN
+	  RETURN FALSE;
+	END (*--if*);
+	left  := left^.next;
+	right := right^.next;
+  END (*--while*);
+  RETURN (left = right) & (right = NullList);
+END IsEqual;
+(*--------------------*)
+
+(*
+LengthOf simply loops over the links of the list counting
+the number of list nodes it finds. Complexity: O(n).
+*)
+
+PROCEDURE LengthOf  (    theList : List     (*-- in    *))
+	: CARDINAL (*-- out   *);
+
+VAR   length : CARDINAL; (*-- Running count of items *)
+
+BEGIN
+  listError := noerr;
+  length    := 0;
+  WHILE (theList # NullList) DO
+	INC(length);
+	theList := theList^.next;
+  END (*--while*);
+  RETURN length;
+END LengthOf;
+(*--------------------*)
+
+(*
+GetNext simply returns the link to the next list node, or if
+given an empty list the listisnull exception is raised and the
+null list is returned.  Complexity: O(1).
+*)
+
+PROCEDURE GetNext   (    theList : List     (*-- in    *))
+	: List     (*-- out   *);
+BEGIN
+  listError := noerr;
+  IF (theList = NullList) THEN
+    RaiseErrIn(getnext, listisnull);
+    RETURN NullList;
+  END (*--if*);
+  RETURN theList^.next;
+END GetNext;
+(*--------------------*)
+
+(*
+GetItem simply returns the item of the given list node, or if
+given an empty list the listisnull exception is raised and the
+null item is returned.  Complexity: O(1).
+*)
+
+PROCEDURE GetItem   (    theList : List     (*-- in    *))
+	: Item     (*-- out   *);
+BEGIN
+  listError := noerr;
+  IF (theList = NullList) THEN
+    RaiseErrIn(getitem, listisnull);
+    RETURN NullItem;
+  END (*--if*);
+  RETURN theList^.item;
+END GetItem;
+(*--------------------*)
+
+
+(*
+4.3.5 Module Initialization
+
+The module's local variables are initialized to known states.
+listError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.
+
+Since a FOR loop control variable is undefined following the loop,
+listError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR listError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(listError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  listError := noerr;
+END ListSUM.
+
+(*
+
+References
+[1] G. Booch, Software Components with Ada, Structures, Tools, and Subsystems,
+    Benjamin/Cummings, Menlo Park, CA 1987.
+[2] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Addison-Wesley, London England 1984.
+[3] D. Knuth, The Art of Computer Programming, Volume 1, Fundamental
+    Algorithms, Addison-Wesley, Reading, MA 1973.
+[4] R. Wiener and R. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986, pg. 198.
+[5] N. Wirth, Algorithms and Data Structures, Prentice-Hall,
+    Englewood Cliffs, NJ 1986.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUMS.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUMS.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUMS.DEF
@@ -0,0 +1,114 @@
+(*
+8.1 Sequential Search Utilities - Interface
+
+In this section are provided several utility routines implementing
+search algorithms on singly-linked unbounded lists.
+The reader should find it trivial to generate equivalent modules
+for the other list structures.
+*)
+
+DEFINITION MODULE ListSUMSearch; 
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Component: Tools - Structure Utility - Single List Search
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation.
+	(C) Copyright 1989 Charles A. Lins
+=============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc;
+
+FROM ListSUM IMPORT
+    (*--Type*) List;
+
+    (*--------------------*)
+
+TYPE  SuccessProc  = PROCEDURE (Item);
+TYPE  FailureProc  = PROCEDURE (Item);
+
+    (*--------------------*)
+
+(*
+8.1.1 PrimarySearch
+
+Searches theList for the first occurance of theItem with the required
+key.  This is called the primary key search.  It is assumed that the
+item comparison routine knows how to extract the key from the items
+if necessary.  If the search succeeds then the found procedure parameter
+is invoked, otherwise the notfound routine is called.  The list is
+assumed to be unordered.
+*)
+
+PROCEDURE PrimarySearch (    theItem   : Item	(*-- in    *);
+	theList   : List	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+
+(*
+8.1.2 SecondarySearch
+
+Searches theList for every occurance of theItem with the required
+key.  This is called the secondary key search.  It is assumed that the
+item comparison routine knows how to extract the key from the items
+if necessary.  Each time the search succeeds the found procedure parameter
+is invoked.  The list is assumed to be unordered.
+*)
+
+PROCEDURE SecondarySearch (    theItem   : Item	(*-- in    *);
+	theList   : List	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *));
+
+
+(*
+8.1.3 Self-organizing Sequential Search - MoveToFront
+
+This routine is essentially the primary key search modified to apply
+a heuristic for improving the list ordering.  When a key is found,
+theItem is moved to the front of the list.  The idea is that the
+access distribution of items in the list is unequal, and therefore,
+the most frequently accessed items should be closer to the front.
+For a sophisticated analysis comparing self-organizing heuristics
+see reference [1].
+*)
+
+PROCEDURE MoveToFront (    theItem   : Item	(*-- in    *);
+	VAR theList   : List	(*-- inout *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+
+(*
+8.1.4 Self-organizing Sequential Search - Transpose
+
+Instead of moving the found item to the front of the list, the Transpose
+heuristic moves the item one position closer to the front by swapping
+positions with its predecessor.
+*)
+
+PROCEDURE Transpose (    theItem   : Item	(*-- in    *);
+	VAR theList   : List	(*-- inout *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+END ListSUMSearch.
+
+(*
+
+References
+
+[1] J.L. Bentley and C.C. McGeoch, Worst-Case Analyses of
+    Self-Organizing Sequential Search Heuristics,
+	Carnegie-Mellon University, 1983.
+[2] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Searching Algorithms, Addison-Wesley, London 1984,
+	pp. 23-30.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUMS.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUMS.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUMS.MOD
@@ -0,0 +1,184 @@
+(*
+8.2 Sequential Search Utilities - Implementation
+
+Presented below are the implementation details of our sequential search
+algorithms for the singly-linked unbounded list.
+*)
+
+IMPLEMENTATION MODULE ListSUMSearch; 
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Component: Tools - Structure Utility - Single List Search
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial implementation.
+	(C) Copyright 1989 Charles A. Lins
+==========================================================*)
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM Items IMPORT
+    (*--Type*) Item, CompareProc;
+
+FROM ListSUM IMPORT
+    (*--Type*) List,
+    (*--Proc*) GetNext, GetItem, IsEmpty, SetNext, SetItem;
+
+    (*--------------------*)
+
+(*
+8.2.1 PrimarySearch
+
+Our primary key search routine has been optimized using the LOOP construct
+instead of a WHILE statement to avoid multiple calls to IsEmpty,
+GetItem, and keysEqual at the end of the routine when determining
+success or failure. (See reference [2]).
+*)
+
+PROCEDURE PrimarySearch (    theItem   : Item	(*-- in    *);
+	theList   : List	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+BEGIN
+  LOOP 
+    IF IsEmpty(theList) THEN
+      notFound(theItem);
+      EXIT (*--loop*);
+    ELSIF (keysEqual(GetItem(theList), theItem) = equal) THEN
+      found(theItem);
+      EXIT (*--loop*);
+    END (*--if*);
+    theList := GetNext(theList);
+  END (*--loop*);
+END PrimarySearch;
+(*-------------------------*)
+
+(*
+8.2.2 SecondarySearch
+
+Where the primary key search stops after the finding the first occurance
+of theItem, the secondary key search continues to the end of the list
+in order to find all occurances of theItem.  Therefore, the complexity
+is O(n).
+*)
+
+PROCEDURE SecondarySearch (    theItem   : Item	(*-- in    *);
+	theList   : List	(*-- in    *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *));
+BEGIN
+  WHILE ~IsEmpty(theList) DO
+    IF keysEqual(GetItem(theList), theItem) = equal THEN
+      found(theItem);
+    END (*--if*);
+    theList := GetNext(theList);
+  END (*--while*);
+END SecondarySearch;
+(*-------------------------*)
+
+(*
+8.2.3 Self-organizing Sequential Search - MoveToFront
+
+The algorithm first takes care of the special cases where the list is
+empty or when the item is already at the front of the list. Then if it
+is necessary to scan the list, the routine does so remembering the last
+node examined in case theItem is found it can be easily moved to the
+front without searching for the node's predecessor.
+*)
+
+PROCEDURE MoveToFront (    theItem   : Item	(*-- in    *);
+	VAR theList   : List	(*-- inout *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+VAR   last : List; (*-- last node examined *)
+      next : List; (*-- link to next node from the last node *)
+      temp : List; (*-- temporary for swapping three links *)
+
+BEGIN
+  IF IsEmpty(theList) THEN
+    notFound(theItem);
+  ELSIF keysEqual(theItem, GetItem(theList)) = equal THEN
+    found(theItem);
+  ELSE
+    last := theList;
+	LOOP
+	  next := GetNext(last);
+	  IF IsEmpty(next) THEN
+	notFound(theItem);
+	    EXIT (*--loop*);
+      ELSIF keysEqual(theItem, GetItem(next)) = equal THEN
+	temp    := theList;
+	theList := next;
+	SetNext(last, GetNext(next));
+	SetNext(theList, temp);
+	found(theItem);
+	EXIT (*--loop*);
+      END (*--if*);
+	  last := next;
+    END (*--loop*);
+  END (*--if*);
+END MoveToFront;
+(*-------------------------*)
+
+(*
+8.2.4 Self-organizing Sequential Search - Transpose
+
+The transpose hueristic is similar to the Move-To-Front method, above,
+except when theItem is found it is moved only one position forward in
+the list.  Here, theItem is used as a temporary when moving the value
+forward in the list.  For a Pascal version of this algorithm using arrays
+see Gonnet [2].
+*)
+
+PROCEDURE Transpose (    theItem   : Item	(*-- in    *);
+	VAR theList   : List	(*-- inout *);
+	keysEqual : CompareProc (*-- in    *);
+	found     : SuccessProc (*-- in    *);
+	notFound  : FailureProc (*-- in    *));
+
+VAR   last : List; (*-- last node examined *)
+      next : List; (*-- link to next node from the last node *)
+
+BEGIN
+  IF IsEmpty(theList) THEN
+    notFound(theItem);
+  ELSIF keysEqual(theItem, GetItem(theList)) = equal THEN
+    found(theItem);
+  ELSE
+    last := theList;
+	LOOP
+	  next := GetNext(last);
+	  IF IsEmpty(next) THEN
+	notFound(theItem);
+	    EXIT (*--loop*);
+      ELSIF keysEqual(theItem, GetItem(next)) = equal THEN
+	SetItem(next, GetItem(last));
+		SetItem(last, theItem);
+	found(theItem);
+	EXIT (*--loop*);
+      END (*--if*);
+	  last := next;
+    END (*--loop*);
+  END (*--if*);
+END Transpose;
+(*-------------------------*)
+
+END ListSUMSearch.
+
+(*
+
+References
+
+[1] J.L. Bentley and C.C. McGeoch, Worst-Case Analyses of
+    Self-Organizing Sequential Search Heuristics,
+	Carnegie-Mellon University, 1983.
+[2] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Searching Algorithms, Addison-Wesley, London 1984,
+	pp. 23-30.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUMT.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUMT.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUMT.DEF
@@ -0,0 +1,123 @@
+(*
+8.3 List Utilities - Interface
+
+In this section is provided a list utilities module for singly-linked
+unbounded lists.  The routines implement such useful list operations as:
+
+Constructors
+∙ constructing a list from an array of items (Construct and Build),
+∙ inserting an item or a list to the end of a list (AddToTail and Append),
+
+Selectors
+∙ retrieving the link to the last item of a list (LastOf),
+
+The reader should find it trivial to generate equivalent modules
+for the other list structures and adding other list operations to those
+given here.
+*)
+
+DEFINITION MODULE ListSUMTools; 
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tools - Structure Utility - Singly-Linked List
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+=============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ListSUM IMPORT
+    (*--Type*) List;
+
+    (*--------------------*)
+
+(*
+8.3.1 Type Declarations
+
+Position 
+*)
+
+TYPE  Position     = CARDINAL;
+CONST NullPosition = 0;
+
+
+    (*--------------------*)
+
+(*
+8.3.2 Constructors
+
+Construct builds a list from an array of Items.  If theList is not
+empty it is cleared of its contents before the construction commences.
+Build is similar except that only the first n items (numItems) are used to
+construct the list.
+
+AddToTail adds theItem to the end of theList.  Complexity: O(n).
+
+Split divides theList into two lists at theItem.  If theItem is not present
+in theList then the toList is unchanged.
+*)
+
+PROCEDURE Construct (    theItems : ARRAY OF Item (*-- in    *);
+	VAR theList  : List	(*-- inout *));
+
+PROCEDURE Build     (    theItems : ARRAY OF Item (*-- in    *);
+	numItems : CARDINAL      (*-- in    *);
+	VAR theList  : List	(*-- inout *));
+
+PROCEDURE AddToTail (    theItem  : Item	(*-- in    *);
+	VAR theList  : List	(*-- inout *));
+
+PROCEDURE Split     (VAR theList  : List	(*-- inout *);
+	theItem  : Item	(*-- in    *);
+	VAR toList   : List	(*-- inout *));
+
+
+(*
+8.3.3 Selectors
+
+LastOf returns the list containing the last item of theList or the NullList
+if theList is empty.
+
+PositionOf searches for theItem in theList returning theItem's position such
+that:
+	Position = 1 when theItem is at the front of theList,
+	Position = LengthOf(theList) when theItem is at the end of theList, and
+	Position = 0 when theItem is not present within theList.
+
+LocationOf returns a list beginning with the item at theIndex in theList.  If
+theList does not have such a positionthe NullList is returned.
+*)
+
+PROCEDURE LastOf     (    theList : List     (*-- in    *))
+	: List     (*-- out   *);
+
+PROCEDURE PositionOf (    theItem : Item     (*-- in    *);
+	theList : List     (*-- in    *))
+							: Position (*-- out   *);
+
+PROCEDURE LocationOf (    theIndex: Position (*-- in    *);
+	theList : List     (*-- in    *))
+							: List     (*-- out   *);
+
+END ListSUMTools.
+
+(*
+
+References
+
+[]  A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983
+[1] G. Booch, Software Components with Ada Structures, Tools, and Subsystems,
+	Benjamin/Cummings, Menlo Park, CA 1987
+[2] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Addison-Wesley, London England 1984
+[]	D. Knuth, The Art of Computer Programming, Volume 1, Fundamental Algorithms,
+    Addison-Wesley, Reading, MA 1973
+[]	N. Wirth, Algorithms and Data Structures, Prentice-Hall, Englewood
+    Cliffs, NJ 1986
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUMT.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUMT.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/LISTS/LISTSUMT.MOD
@@ -0,0 +1,254 @@
+(*
+8.4 List Utilities - Implementation
+
+*)
+
+IMPLEMENTATION MODULE ListSUMTools; 
+(*==========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tools - Structure Utility - Singly-Linked List
+
+    Revision History
+    v1.00  18 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+	(C) Copyright 1989 Charles A. Lins
+=============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM ListSUM IMPORT
+    (*--Type*) List, NullList,
+	(*--Proc*) IsEmpty, GetNext, GetItem, SetNext, SetList,
+		Clear, Assign, Insert;
+
+    (*--------------------*)
+
+(*
+8.4.1 Constructors
+
+Construct first clears theList, if necessary, and then loops over theItems
+in reverse order adding each item to the front of theList.
+*)
+
+PROCEDURE Construct (    theItems : ARRAY OF Item (*-- in    *);
+	VAR theList  : List	(*-- inout *));
+
+VAR   index : INTEGER; (*-- loop index over items array *)
+
+BEGIN
+  IF ~IsEmpty(theList) THEN
+    Clear(theList);
+  END (*--if*);
+  FOR index := HIGH(theItems) TO 0 BY -1 DO
+  	Insert(theItems[index], theList);
+  END (*--for*);
+END Construct;
+(*-------------------------*)
+
+(*
+Build is quite similar to Construct, above, in traversing theItems in
+reverse order appending items to the front of theList. The difference
+is that only the first numItems are used to form the list.  If numItems
+is greater than the actual number of items in theItems array, only those
+items truly present are inserted.
+Complexity: O(n) where n is the number of items inserted.
+*)
+
+PROCEDURE Build     (    theItems : ARRAY OF Item (*-- in    *);
+	numItems : CARDINAL      (*-- in    *);
+	VAR theList  : List	(*-- inout *));
+
+VAR   index : INTEGER; (*-- loop index over items array *)
+
+BEGIN
+  IF ~IsEmpty(theList) THEN
+    Clear(theList);
+  END (*--if*);
+  IF (numItems > VAL(CARDINAL, HIGH(theItems) + 1)) THEN
+    numItems := HIGH(theItems) + 1;
+  END (*--if*);
+  FOR index := VAL(INTEGER, numItems) - 1 TO 0 BY -1 DO
+  	Insert(theItems[index], theList);
+  END (*--for*);
+END Build;
+(*-------------------------*)
+
+(*
+AddToTail inserts theItem at the end of theList.  The routine first
+takes care of the trivial case where theList is empty.  Then it proceeds
+to scan theList for the last item.  Once this has been found, a new list
+(of length one) is created for the item, and the last node is linked to
+the new list.  Note: once the last node has been found, next is no longer
+needed and is therefore used as a temporary to create the new list for
+theItem.
+Complexity: O(n).
+*)
+
+PROCEDURE AddToTail (    theItem  : Item	(*-- in    *);
+	VAR theList  : List	(*-- inout *));
+
+VAR   last : List; (*-- last list node examined *)
+      next : List; (*-- link from last node to next node *) 
+
+BEGIN
+  IF IsEmpty(theList) THEN
+    theList := SetList(theItem);
+  ELSE
+    last := theList;
+    LOOP
+      next := GetNext(last);
+	  IF IsEmpty(next) THEN
+	    EXIT (*--loop*);
+	  END (*--if*);
+	  last := next;
+    END (*--loop*);
+    next := SetList(theItem);
+    SetNext(last, next);
+  END (*--if*);
+END AddToTail;
+(*-------------------------*)
+
+(*
+Split searches theList maintaining a link to the previous node examined.
+When theItem is found at the front of theList, the toList becomes theList
+and theList becomes the empty list.  Otherwise, theList is truncated at
+the previous node examined, and the toList becomes a list beginning with
+theItem.
+*)
+
+PROCEDURE Split     (VAR theList  : List	(*-- inout *);
+	theItem  : Item	(*-- in    *);
+	VAR toList   : List	(*-- inout *));
+
+VAR   last  : List; (*-- last list node examined *)
+      prior : List; (*-- link from last node to prior node examined *) 
+
+BEGIN
+  last  := theList;
+  prior := NullList;
+  LOOP
+	IF IsEmpty(last) THEN
+	  EXIT (*--loop*);
+    ELSIF (theItem = GetItem(last)) THEN
+	  Clear(toList);
+	  IF (prior = NullList) THEN
+	    theList := NullList;
+	  ELSE
+	    SetNext(prior, NullList);
+	  END (*--if*);
+	  toList := last;
+	  EXIT (*--loop*);
+	ELSE
+	  prior := last;
+      last  := GetNext(last);
+	END (*--if*);
+  END (*--loop*);
+END Split;
+(*-------------------------*)
+
+
+(*
+8.4.2 Selectors
+
+LastOf simply scans theList looking for the last list node and
+returns the node containing the last item. If theList is empty,
+the NullList if returned.
+*)
+
+PROCEDURE LastOf    (    theList : List  (*-- in    *))
+	: List  (*-- out   *);
+
+VAR   last : List; (*-- last list node examined *)
+      next : List; (*-- link from last node to next node *) 
+
+BEGIN
+  IF IsEmpty(theList) THEN
+    RETURN NullList;
+  END (*--if*);
+  last := theList;
+  LOOP
+    next := GetNext(last);
+	IF IsEmpty(next) THEN
+	  EXIT (*--loop*);
+	END (*--if*);
+	last := next;
+  END (*--loop*);
+  RETURN last;
+END LastOf;
+(*-------------------------*)
+
+(*
+PositionOf does a linear search of theList looking for theItem keeping a
+running count of the index position.  If theItem is not found in theList then
+the NullList is returned otherwise the index position at which theItem is
+found is returned.
+*)
+
+PROCEDURE PositionOf (    theItem : Item     (*-- in    *);
+	theList : List     (*-- in    *))
+							: Position (*-- out   *);
+
+VAR   index : Position; (*-- running index into theList *)
+
+BEGIN
+  index := 1;
+  WHILE ~IsEmpty(theList) DO
+    IF (theItem = GetItem(theList)) THEN
+	  RETURN index;
+	END (*--if*);
+    INC(index);
+	theList := GetNext(theList);
+  END (*--while*);
+  RETURN NullPosition;
+END PositionOf;
+(*-------------------------*)
+
+(*
+LocationOf is the inverse of PositionOf given above.  The routine first takes
+care of the trivial case in which it is given an empty list by returning an
+empty list.  theList parameter is used as a local variable to access each of
+the list nodes and if theIndex position exists within theList the link to
+that list is returned.  If theList ever becomes empty during the loop the
+routine can be certain that theIndex position does not exist.
+*)
+
+PROCEDURE LocationOf (    theIndex: Position (*-- in    *);
+	theList : List     (*-- in    *))
+							: List     (*-- out   *);
+
+VAR   index : Position; (*-- running index into theList *)
+
+BEGIN
+  IF IsEmpty(theList) THEN
+    RETURN NullList;
+  ELSE
+    FOR index := 2 TO theIndex DO
+	  theList := GetNext(theList);
+	  IF IsEmpty(theList) THEN
+	    RETURN NullList;
+      END (*--if*);
+	END (*--for*);
+	RETURN theList;
+  END (*--if*);
+END LocationOf;
+(*-------------------------*)
+
+END ListSUMTools.
+
+(*
+
+References
+
+[1]  A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983
+[2] G. Booch, Software Components with Ada Structures, Tools, and Subsystems,
+	Benjamin/Cummings, Menlo Park, CA 1987
+[3] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Addison-Wesley, London England 1984
+[4]	D. Knuth, The Art of Computer Programming, Volume 1, Fundamental Algorithms,
+    Addison-Wesley, Reading, MA 1973
+[5]	N. Wirth, Algorithms and Data Structures, Prentice-Hall, Englewood
+    Cliffs, NJ 1986
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QENUM.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QENUM.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QENUM.DEF
@@ -0,0 +1,47 @@
+DEFINITION MODULE QEnum;
+(*===========================================================
+    Version  : 1.00  03 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Tool - Queue/Deque Enumerations Utility
+
+    REVISION HISTORY
+    v1.00  03 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+CONST ComponentID      = 1280;  (*-- must be a multiple of 256 *)
+CONST DequeComponentID = 1536;  (*-- must be a multiple of 256 *)
+
+TYPE  Operations = (modinit,
+
+                    create, destroy, clear, assign,
+                    arrive, depart, leave,
+
+                    isdefined, isempty, isequal, lengthof,
+                    sizeof, typeof, frontof, rearof, endof,
+                    positionof,
+
+                    loopover, traverse,
+
+                    seize, release
+                   );
+
+TYPE  Constructors = [ create    .. leave ];
+TYPE  Selectors    = [ isdefined .. positionof ];
+TYPE  Iterators    = [ loopover  .. traverse ];
+
+
+TYPE  Exceptions = (noerr,
+                    initfailed,
+                    notfound,
+                    overflow,
+                    typeerror,
+                    underflow,
+                    undefined
+                   );
+
+TYPE  ExceptionSet = SET OF Exceptions;
+
+END QEnum.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QENUM.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QENUM.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QENUM.MOD
@@ -0,0 +1,3 @@
+IMPLEMENTATION MODULE QEnum;
+
+END QEnum.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSBMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSBMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSBMI.DEF
@@ -0,0 +1,145 @@
+DEFINITION MODULE QNBSBMI;
+(*===========================================================
+    Version  : 1.00  04 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Balking Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  04 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+(*
+12.1.1 Type Declarations
+
+A queue is declared as the abstract data type, Queue.  In the bounded
+form presented here a queue is limited to a maximum size of 8100
+items.
+*)
+
+TYPE  Queue;
+TYPE  QueueSize = [1..8100];
+CONST NullQueue = Queue(NIL);
+
+
+(*
+12.1.2 Exceptions
+
+The ModuleID uniquely identifies this module from all others.
+
+QueueError returns the most recent queue exception, or noerr if the
+last operation was successful.  While SetHandler and GetHandler allow
+assignment and retrieval of exception handling routines for specific
+exceptions.
+*)
+
+CONST ModuleID = 1;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+(*
+12.1.3 Constructors
+
+An additional constructor, Leave, has been added to implement the
+actual balking mechanism.
+
+All other constructors remain unchanged from the non-priority
+non-balking form of queue.
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+                       theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Leave   (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+
+(*
+12.1.4 Selectors
+
+All of the selector interfaces are unchanged from the non-priority
+non-balking form of queue.
+
+An additional selector has been added, PositionOf, that returns the
+number of positions from the given item to the front of the queue. If
+theItem is not present in theQueue then zero is returned.
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+PROCEDURE PositionOf (    theQueue: Queue    (*-- in    *);
+                          theItem : Item     (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+
+(*
+12.1.5 Iterators
+
+The interfaces to both iterators are unchanged from the non-priority
+non-balking form of queue.
+*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+END QNBSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSBMI.MOD
@@ -0,0 +1,621 @@
+IMPLEMENTATION MODULE QNBSBMI;
+(*==============================================================
+    Version  : 1.00  04 May 1989   C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Balking Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  04 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc,
+               AccessProc, LoopAccessProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+12.2.1 Internal Bounded Balking Non-Priority Queue Representation
+
+A dynamically created array of Items is created when a priority queue
+is created. The front of the queue is always accessible by the
+index [1].  The header record is used to hold the queue size limit (size),
+the current back index (rear), data type id (dataID),
+and the dynamic array of items.  Items are stored in a linear fashion
+within the array ordered by arrivaland departure.  Figure 12.1, below,
+graphically depicts the internal structure used for the bounded priority
+queue:
+
+FIGURE 12.1
+
+Representation Invariants:
+Ñ MIN(QueueSize) <= size <= MAX(QueueSize)
+Ñ 0 <=rear <= size
+Ñ the queue is empty when rear is zero
+Ñ when not empty, the front of the queue is at items[MIN(QueueSize)]
+*)
+
+TYPE  ItemsArray   = ARRAY QueueSize OF Item;
+TYPE  BoundedQueue = RECORD
+        dataID   : TypeID;          (*-- defined data type *)
+        size     : QueueSize;       (*-- maximum # of items *)
+        rear     : CARDINAL;        (*-- current # of items *)
+        items    : ItemsArray;      (*-- array [1..size] of item *)
+      END (*-- BoundedQueue *);
+
+TYPE  Queue = POINTER TO BoundedQueue;
+
+    (*--------------------*)
+
+
+(*
+12.2.2 Exceptions
+
+queueError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+queueError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+12.2.6).
+
+QueueError simply returns the current exception result stored
+in queueError and is used to determine whether a queue operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+12.2.3 Constructors
+
+Create attempts to form a new, empty bounded queue object associated
+with the given data type ID and maximum size.  Only the specified
+number of entries given in theSize are actually allocated to the
+ItemsArray (items).  MacSystem.Allocate returns NIL if it is unable
+to successfully complete the allocation request whereupon the overflow
+exception is raised and the NullQueue returned.  If successful, the
+queue is initialized as follows before returning the new queue:
+Ñ theType is saved for later use by IsEqual,
+Ñ theSize is saved for later checking for queue overflow by Arrive and Assign, and
+Ñ rear is set to the empty queue state.
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+                       theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, staticSize + itemSize * theSize);
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID   := theType;
+      size     := theSize;
+      rear     := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theQueue rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullQueue). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, staticSize + itemSize * theQueue^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theQueue's data type, if
+any, and proceeds to free each item in theQueue.  If theQueue is empty
+the loop is not executed as rear will be greater than the minimum
+QueueSize.  Lastly, rear is set to ensure theQueue is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      FOR index := MIN(QueueSize) TO rear DO
+        free(items[index]);
+      END (*--for*);
+      rear := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theQueue to the target queue, toQueue. An
+undefined source queue raised an exception and leaves the target unchanged.
+If the target queue is undefined, it is created with the same size and
+data type attributes of the source; otherwise the target queue is
+cleared of its presnet contents and its data type is altered to reflect
+that of the source.  If the target queue is capable of containing all
+of the items present in the source, Assign simply copies each item from
+the source to the target afterwards updating the target's rear value.
+Complexity: O(n).
+*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(dataID, size);
+      END (*--with*);
+    ELSIF (theQueue^.rear <= toQueue^.size) THEN
+      Clear(toQueue);
+      WITH theQueue^ DO
+        toQueue^.dataID   := dataID;
+      END (*--with*);
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (queueError = noerr) THEN
+      WITH theQueue^ DO
+        assignment := AssignOf(dataID);
+        FOR index := MIN(QueueSize) TO rear DO
+          toQueue^.items[index] := assignment(items[index]);
+        END (*--for*);
+        toQueue^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to the end of the queue.
+When the rear of theQueue
+is already at its maximum allowed size the exception overflow is raised
+and theQueue remains unchanged.  Likewise, given an undefined queue
+raises the exception of the same name. Complexity: O(1).
+*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear < size) THEN
+        INC(rear);
+        items[rear] := theItem;
+      ELSE
+        RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front of theQueue by shifting all items
+down one position in the items array and deducting one from the rear
+index.  Before overwriting the item being removed, it's value is
+freed via the disposal routine of theQueue's data type.  If theQueue
+is empty on entry to Depart the underflow exception is raised and
+theQueue is not changed.  When theQueue is not defined, the undefined
+exception is raised. Complexity: O(n).
+*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear = 0) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        free := DisposeOf(dataID);
+        free(items[MIN(QueueSize)]);
+        FOR index := MIN(QueueSize) + 1 TO rear DO
+          items[index - 1] := items[index];
+        END (*--for*);
+        DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+(*
+Leave removes theItem from the Queue regardless of its position within
+the queue.  Complexity: O(n).
+*)
+
+PROCEDURE Leave   (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(leave, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear = 0) THEN
+        RaiseErrIn(leave, underflow);
+      ELSE
+        free := DisposeOf(dataID);
+        index := MIN(QueueSize);
+        WHILE (index <= rear) & (items[index] # theItem) DO
+          INC(index);
+        END (*-- while*);
+        IF (index <= rear) THEN
+          free(items[index]);
+          FOR index := index + 1 TO rear DO
+            items[index - 1] := items[index];
+          END (*--for*);
+          DEC(rear);
+        ELSE
+          RaiseErrIn(leave, notfound);
+        END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Leave;
+(*-------------------------*)
+
+
+(*
+12.2.4 Selectors
+
+IsDefined verifies to the best of its ability whether theQueue has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theQueue is in the empty state, as indicated by
+the rear being zero, and False otherwise.  As per the specification
+(section 8.?) undefined queues are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right queues for equality, which in this
+context means they contain the same items and the same data type ID. The
+defined size of the queues is not relevant for the equality test.  Both
+queues must be defined and have the same data type ID; if they don not,
+then the exceptions undefined and typeerror are raised, respectively.
+Obviously, queues of different lengths (indicated by the value of rear)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both queues
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them. Complexity: O(n).
+*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      compare : CompareProc;    (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+      compare := CompareOf(dataID);
+      FOR index := MIN(QueueSize) TO rear DO
+        IF compare(items[index], right^.items[index]) # equal THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the rear index into the items array which is
+also the length of theQueue. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+SizeOf and TypeOf simply return the size and dataID for the given queue.
+Undefined queues, as always, raise the undefined exception and return
+reasonable values (zero and the NullType, respectively). The complexity
+of both routines is O(1).
+*)
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the front of theQueue or
+the NullItem if theQueue is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.items[MIN(QueueSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+(*
+PositionOf returns the number of positions from the given item to the
+front of the queue. If theItem is not present in theQueue then zero
+is returned. Complexity O(n).
+*)
+
+PROCEDURE PositionOf (    theQueue: Queue    (*-- in    *);
+                          theItem : Item     (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(positionof, undefined);
+  ELSE
+    WITH theQueue^ DO
+      FOR index := MIN(QueueSize) TO rear DO
+        IF (theItem = items[index]) THEN
+          RETURN index;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+  RETURN 0;
+END PositionOf;
+(*-------------------------*)
+
+
+(*
+12.2.5 Iterators
+
+Both LoopOver and Traverse simply loop through each of the queue items
+from the front to the rear passing the item value to theProcess
+procedure parameter.  LoopOver may terminate before reaching the rear
+if theProcess returns False. Complexity: O(n).
+*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theQueue^ DO
+      FOR index := MIN(QueueSize) TO rear DO
+        IF ~theProcess(items[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theQueue^ DO
+      FOR index := MIN(QueueSize) TO rear DO
+        theProcess(items[index]);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*
+12.2.6 Module Initialization
+
+The module's local variables are initialized to known states.
+queueError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.
+
+Since a FOR loop control variable is undefined following the loop,
+queueError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QNBSBMI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSBMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSBMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSBMN.DEF
@@ -0,0 +1,98 @@
+DEFINITION MODULE QNBSBMN;
+(*===========================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-Priority Balking Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins:
+      Initial TopSpeed implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+
+TYPE  Queue;
+TYPE  QueueSize = [1..8100];
+CONST NullQueue = Queue(NIL);
+
+
+    (*--------------------*)
+
+CONST ModuleID = 2;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+    (*--------------------*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+                       theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Leave   (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+
+    (*--------------------*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+PROCEDURE PositionOf (    theQueue: Queue    (*-- in    *);
+                          theItem : Item     (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+END QNBSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSBMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSBMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSBMN.MOD
@@ -0,0 +1,501 @@
+IMPLEMENTATION MODULE QNBSBMN;
+(*==============================================================
+    Version  : 1.00  16 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-Priority Balking Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  16 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+
+TYPE  ItemsArray   = ARRAY QueueSize OF Item;
+TYPE  BoundedQueue = RECORD
+        dataID   : TypeID;          (*-- defined data type *)
+        size     : QueueSize;       (*-- maximum # of items *)
+        rear     : CARDINAL;        (*-- current # of items *)
+        items    : ItemsArray;      (*-- array [1..size] of item *)
+      END (*-- BoundedQueue *);
+
+TYPE  Queue = POINTER TO BoundedQueue;
+
+    (*--------------------*)
+
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+    (*--------------------*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+                       theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, staticSize + itemSize * theSize);
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID   := theType;
+      size     := theSize;
+      rear     := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theQueue rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullQueue). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, staticSize + itemSize * theQueue^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theQueue's data type, if
+any, and proceeds to free each item in theQueue.  If theQueue is empty
+the loop is not executed as rear will be greater than the minimum
+QueueSize.  Lastly, rear is set to ensure theQueue is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      FOR index := MIN(QueueSize) TO rear DO
+        free(items[index]);
+      END (*--for*);
+      rear := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theQueue to the target queue, toQueue. An
+undefined source queue raised an exception and leaves the target unchanged.
+If the target queue is undefined, it is created with the same size and
+data type attributes of the source; otherwise the target queue is
+cleared of its presnet contents and its data type is altered to reflect
+that of the source.  If the target queue is capable of containing all
+of the items present in the source, Assign simply copies each item from
+the source to the target afterwards updating the target's rear value.
+Complexity: O(n).
+*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(dataID, size);
+      END (*--with*);
+    ELSIF (theQueue^.rear <= toQueue^.size) THEN
+      Clear(toQueue);
+      WITH theQueue^ DO
+        toQueue^.dataID   := dataID;
+      END (*--with*);
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (queueError = noerr) THEN
+      WITH theQueue^ DO
+        assignment := AssignOf(dataID);
+        FOR index := MIN(QueueSize) TO rear DO
+          toQueue^.items[index] := assignment(items[index]);
+        END (*--for*);
+        toQueue^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to the end of the queue.
+When the rear of theQueue
+is already at its maximum allowed size the exception overflow is raised
+and theQueue remains unchanged.  Likewise, given an undefined queue
+raises the exception of the same name. Complexity: O(1).
+*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear < size) THEN
+        INC(rear);
+        items[rear] := theItem;
+      ELSE
+        RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front of theQueue by shifting all items
+down one position in the items array and deducting one from the rear
+index.  Before overwriting the item being removed, it's value is
+freed via the disposal routine of theQueue's data type.  If theQueue
+is empty on entry to Depart the underflow exception is raised and
+theQueue is not changed.  When theQueue is not defined, the undefined
+exception is raised. Complexity: O(n).
+*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear = 0) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        free := DisposeOf(dataID);
+        free(items[MIN(QueueSize)]);
+        FOR index := MIN(QueueSize) + 1 TO rear DO
+          items[index - 1] := items[index];
+        END (*--for*);
+        DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+(*
+Leave removes theItem from the Queue regardless of its position within
+the queue.  Complexity: O(n).
+*)
+
+PROCEDURE Leave   (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(leave, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear = 0) THEN
+        RaiseErrIn(leave, underflow);
+      ELSE
+        free := DisposeOf(dataID);
+        index := MIN(QueueSize);
+        WHILE (index <= rear) & (items[index] # theItem) DO
+          INC(index);
+        END (*-- while*);
+        IF (index <= rear) THEN
+          free(items[index]);
+          FOR index := index + 1 TO rear DO
+            items[index - 1] := items[index];
+          END (*--for*);
+          DEC(rear);
+        ELSE
+          RaiseErrIn(leave, notfound);
+        END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Leave;
+(*-------------------------*)
+
+
+(*
+12.2.4 Selectors
+
+IsDefined verifies to the best of its ability whether theQueue has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theQueue is in the empty state, as indicated by
+the rear being zero, and False otherwise.  As per the specification
+(section 9.4) undefined queues are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right queues for equality, which in this
+context means they contain the same items and the same data type ID. The
+defined size of the queues is not relevant for the equality test.  Both
+queues must be defined and have the same data type ID; if they don not,
+then the exceptions undefined and typeerror are raised, respectively.
+Obviously, queues of different lengths (indicated by the value of rear)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both queues
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them. Complexity: O(n).
+*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      compare : CompareProc;    (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+      compare := CompareOf(dataID);
+      FOR index := MIN(QueueSize) TO rear DO
+        IF compare(items[index], right^.items[index]) # equal THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the rear index into the items array which is
+also the length of theQueue. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+SizeOf and TypeOf simply return the size and dataID for the given queue.
+Undefined queues, as always, raise the undefined exception and return
+reasonable values (zero and the NullType, respectively). The complexity
+of both routines is O(1).
+*)
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the front of theQueue or
+the NullItem if theQueue is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.items[MIN(QueueSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+(*
+PositionOf returns the number of positions from the given item to the
+front of the queue. If theItem is not present in theQueue then zero
+is returned. Complexity O(n).
+*)
+
+PROCEDURE PositionOf (    theQueue: Queue    (*-- in    *);
+                          theItem : Item     (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(positionof, undefined);
+  ELSE
+    WITH theQueue^ DO
+      FOR index := MIN(QueueSize) TO rear DO
+        IF (theItem = items[index]) THEN
+          RETURN index;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+  RETURN 0;
+END PositionOf;
+(*-------------------------*)
+
+
+(*
+Module Initialization
+*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QNBSBMN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSUMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSUMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSUMI.DEF
@@ -0,0 +1,129 @@
+DEFINITION MODULE QNBSUMI;
+(*===========================================================
+    Version  : 1.00  04 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Balking Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  04 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+(*
+10.3.1 Type Declarations
+
+A queue is declared as the abstract data type, Queue.
+*)
+
+TYPE  Queue;
+CONST NullQueue = Queue(NIL);
+
+
+(*
+10.3.2 Exceptions
+
+The ModuleID uniquely identifies this module from all others.
+
+QueueError returns the most recent queue exception, or noerr if the
+last operation was successful.  While SetHandler and GetHandler allow
+assignment and retrieval of exception handling routines for specific
+exceptions.
+*)
+
+CONST ModuleID = 3;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+(*
+10.3.3 Constructors
+
+Leave removes theItem from the Queue regardless of its position.
+Complexity: O(n).
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *))
+                                : Queue     (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Leave   (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+
+(*
+10.3.4 Selectors
+
+PositionOf returns the number of positions from the given item to the
+front of the queue. If theItem is not present in theQueue then zero
+is returned. Complexity O(n).
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+PROCEDURE PositionOf (    theQueue: Queue    (*-- in    *);
+                          theItem : Item     (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+
+(*
+10.3.5 Iterators
+*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+END QNBSUMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSUMI.MOD
@@ -0,0 +1,682 @@
+IMPLEMENTATION MODULE QNBSUMI;
+(*==============================================================
+    Version  : 1.00  04 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Balking Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  04 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc,
+               AccessProc, LoopAccessProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+10.4.1 Internal Unbounded Queue Representation
+
+Uses a linked list of nodes with a header, containing pointers
+to the front and the back.  The second pointer isn't absolutely
+necessary.  To add an item to the queue, the list could be
+traversed from the front until the end is reachedand then the
+item added.  For efficiency reasons, the back pointer is used
+so items can be added directly, making the traversal unnecessary.
+Instead of O(n) time complexity, insertion is O(1).
+    
+By convention, an empty queue will be represented by both the
+front and back pointers being NIL.
+
+Figure 10.2,
+below, graphically depicts the internal structure used for the
+unbounded queue:
+
+FIGURE 10.2
+
+Representation Invariants:
+Ñ when head = NIL then tail = NIL
+Ñ head points to the first node in the list of queue nodes
+Ñ tail points to the last node in the list of queue nodes
+*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD
+        item : Item; (*-- item data *)
+        next : Link; (*-- link to next node *)
+      END (*-- Node *);
+
+TYPE  UnboundedQueue = RECORD
+        dataID : TypeID;     (*-- defined data type *)
+        length : CARDINAL;   (*-- current # of items *)
+        head   : Link;       (*-- pointer to first item *)
+        tail   : Link;       (*-- pointer to last item *)
+      END (*-- UnboundedQueue *);
+
+TYPE  Queue = POINTER TO UnboundedQueue;
+
+    (*--------------------*)
+
+
+(*
+10.4.2 Exceptions
+
+queueError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+queueError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+10.4.6).
+
+QueueError simply returns the current exception result stored
+in queueError and is used to determine whether a queue operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+10.4.3 Constructors
+
+Create attempts to form a new, empty unbounded queue object associated
+with the given data type ID.  MacSystem.Allocate returns NIL if it is
+unable to successfully complete the allocation request whereupon the
+overflow exception is raised and the NullQueue returned.
+If successful, the
+queue is initialized as follows before returning the new queue:
+Ñ theType is saved for later use by IsEqual,
+Ñ the head and tail links are set to the empty queue state (NIL),
+Ñ the current length is set to the empty queue state (zero).
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *))
+                                : Queue     (*-- out   *);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, SIZE(UnboundedQueue));
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID := theType;
+      length := 0;
+      head   := NIL;
+      tail   := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theQueue rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullQueue). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, SIZE(theQueue^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theQueue's data type, if
+any, and proceeds to free each item in theQueue.  If theQueue is empty
+the loop is not executed as head already be NIL.  Lastly, tail and
+length are set to ensure theQueue is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- item node to deallocate *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      WHILE (head # NIL) DO
+        oldHead := head;
+        head    := head^.next;
+        free(oldHead^.item);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      tail   := NIL;
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theQueue to the target queue, toQueue. An
+undefined source queue raises an exception and leaves the target unchanged.
+If the target queue is undefined, it is created with the same
+data type attribute of the source; otherwise the target queue is
+cleared of its present contents and its data type is altered to reflect
+that of the source.  Essentially, Assign traverses the links of the
+source queue copying items to new nodes created in the target queue.
+If a new node cannot be allocated the overflow exception is raised and
+the routine is aborted.
+Complexity: O(n).
+*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   fromIndex  : Link;       (*-- loop index over source nodes *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      toQueue := Create(theQueue^.dataID);
+    ELSE
+      Clear(toQueue);
+      toQueue^.dataID := theQueue^.dataID;
+    END (*--if*);
+    IF (queueError = noerr) & (theQueue^.head # NIL) THEN
+      assignment := AssignOf(theQueue^.dataID);
+      Allocate(toQueue^.head, SIZE(Node));
+      IF (toQueue^.head = NIL) THEN
+        RaiseErrIn(assign, overflow);
+      ELSE
+        WITH toQueue^ DO
+          WITH head^ DO
+            item := assignment(theQueue^.head^.item);
+            next := NIL;
+          END (*--with*);
+          fromIndex := theQueue^.head;
+          tail := head;
+          WHILE (fromIndex^.next # NIL) DO
+            fromIndex := fromIndex^.next;
+            WITH tail^ DO
+              Allocate(next, SIZE(Node));
+              IF (next = NIL) THEN
+                RaiseErrIn(assign, overflow);
+                RETURN;
+              END (*--if*);
+              next^.item := assignment(fromIndex^.item);
+              next^.next := NIL;
+            END (*--with*);
+            tail := tail^.next;
+          END (*--while*);
+          length := theQueue^.length;
+        END (*--with*);
+      END (*--if*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to the rear of theQueue by first allocating a new
+node, storing theItem in that node and then update the links head
+and tail, and the queue length. Note that tail will always point to
+the new node upon successful completion of the routine.
+When the node cannot be allocated the exception overflow is raised
+and theQueue remains unchanged.  Likewise, given an undefined queue
+raises the exception of the same name. Complexity: O(1).
+*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   newNode : Link; (*-- temporary for new node *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+        item := theItem;
+        next := NIL;
+      END (*--with*);
+      WITH theQueue^ DO
+        INC(length);
+        IF (head = NIL) THEN
+          head := newNode;
+        ELSE
+          tail^.next := newNode;
+        END (*--if*);
+        tail := newNode;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front of theQueue by relinking the
+successor to the current queue head as the new head.  The departing
+item is freed via the disposal routine of theQueue's data type before
+actually releasing the old head node itself.
+
+If theQueue is empty on entry to Depart the underflow exception is
+raised and theQueue is not changed.  When theQueue is not defined,
+the undefined exception is raised. Complexity: O(1).
+*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- original head, departing *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (tail = NIL) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        oldHead := head;
+        head    := head^.next;
+        IF (head = NIL) THEN
+          tail := NIL;
+        END (*--if*);
+        DEC(length);
+        free := DisposeOf(dataID);
+        free(oldHead^.item);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+(*
+Leave removes theItem from the Queue regardless of its position within
+the queue.  Complexity: O(n).
+*)
+
+PROCEDURE Leave   (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   index : Link;        (*-- loop index over items *)
+      prior : Link;        (*-- to leaving node *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(leave, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (tail = NIL) THEN
+        RaiseErrIn(leave, underflow);
+      ELSE
+        free  := DisposeOf(dataID);
+        index := theQueue^.head;
+        prior := NIL;
+        WHILE (index # NIL) & (index^.item # theItem) DO
+          prior := index;
+          index := index^.next;
+        END (*-- while*);
+        IF (index # NIL) THEN
+          IF (prior = NIL) THEN
+            head := index^.next;
+          ELSE
+            prior^.next := index^.next;
+          END (*--if*);
+          IF (tail = index) THEN
+            tail := prior;
+          END (*--if*);
+          DEC(length);
+          free(index^.item);
+          Deallocate(index, SIZE(index^));
+        ELSE
+          RaiseErrIn(leave, notfound);
+        END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Leave;
+(*-------------------------*)
+
+
+(*
+10.4.4 Selectors
+
+IsDefined verifies to the best of its ability whether theQueue has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theQueue is in the empty state, as indicated by
+the head being NIL, and False otherwise.  As per the specification
+(section 8.?) undefined queues are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right queues for equality, which in this
+context means they contain the same items and the same data type ID.
+Both queues must be defined and have the same data type ID; if they 
+do not, then the exceptions undefined and typeerror are raised,
+respectively.
+Obviously, queues of different lengths (indicated by the lengths)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both queues
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them. Note that
+because the lengths are equal, both index links will become NIL
+simultaneously.
+Complexity: O(n).
+*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- loop index over left items *)
+      rightIndex: Link; (*-- loop index over right items *)
+      compare : CompareProc;    (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+    compare := CompareOf(left^.dataID);
+    leftIndex := left^.head;
+    rightIndex:= right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF compare(leftIndex^.item, rightIndex^.item) # equal THEN
+        RETURN FALSE;
+      END (*--if*);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    END (*--while*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the length of theQueue. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+TypeOf simply returns the dataID for the given queue.
+Undefined queues, as always, raise the undefined exception and return
+a reasonable value (the NullType). Complexity: O(1).
+*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the head of theQueue or
+the NullItem if theQueue is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+(*
+PositionOf returns the number of positions from the given item to the
+front of the queue. If theItem is not present in theQueue then zero
+is returned. Complexity O(n).
+*)
+
+PROCEDURE PositionOf (    theQueue: Queue    (*-- in    *);
+                          theItem : Item     (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+VAR   index : Link;     (*-- loop index over items *)
+      count : CARDINAL; (*-- running value of position *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(positionof, undefined);
+  ELSE
+    count := 1;
+    index := theQueue^.head;
+    WHILE (index # NIL) DO
+      IF (theItem = index^.item) THEN
+        RETURN count;
+      END (*--if*);
+      INC(count);
+      index := index^.next;
+    END (*--while*);
+  END (*--if*);
+  RETURN 0;
+END PositionOf;
+(*-------------------------*)
+
+
+(*
+10.4.5 Iterators
+
+Both LoopOver and Traverse simply loop through each of the queue items
+from the head to the tail passing the item value to theProcess
+procedure parameter.  LoopOver may terminate before reaching the tail
+if theProcess returns False. Complexity: O(n).
+*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theQueue^ DO
+      index := head;
+      WHILE (index # NIL) DO
+        IF ~theProcess(index^.item) THEN
+          RETURN;
+        END (*--if*);
+        index := index^.next;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theQueue^ DO
+      index := head;
+      WHILE (index # NIL) DO
+        theProcess(index^.item);
+        index := index^.next;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*
+10.4.6 Module Initialization
+
+The module's local variables are initialized to known states.
+queueError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.
+
+Since a FOR loop control variable is undefined following the loop,
+queueError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QNBSUMI.
+
+(* References
+[4] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley 1983, pp. 56-60.
+[3] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+    Benjamin/Cummings 1987, pp. 92-93, 142-153.
+[6] K. John Gough, ╥Writing Generic Utilities in Modula-2╙, Journal of
+    Pascal, Ada, and Modula-2, Vol. 5, No. 3, May/June 1986, pp 53-62.
+[5] T.A. Standish, Data Structure Techniques, Chapter 2: Stacks and Queues,
+    Addison-Wesley 1980, pp. 20-23, 28-32.
+[1] R.S. Wiener & G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons 1985,pp. 247-253
+[2] R.S. Wiener & R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons 1986, pp. 69-71
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSUMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSUMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSUMN.DEF
@@ -0,0 +1,122 @@
+(*
+11.5 Balking Unbounded Queue
+*)
+
+DEFINITION MODULE QNBSUMN;
+(*===========================================================
+    Version  : 1.00  04 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-Priority Balking Sequential Unbounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  04 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+(*
+11.5.1 Type Declarations
+
+A queue is declared as the abstract data type, Queue.
+*)
+
+TYPE  Queue;
+CONST NullQueue = Queue(NIL);
+
+
+(*
+11.5.2 Exceptions
+
+The ModuleID uniquely identifies this module from all others.
+
+QueueError returns the most recent queue exception, or noerr if the
+last operation was successful.  While SetHandler and GetHandler allow
+assignment and retrieval of exception handling routines for specific
+exceptions.
+*)
+
+CONST ModuleID = 4;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+(*
+11.5.3 Constructors
+
+Leave removes theItem from the Queue regardless of its position.
+Complexity: O(n).
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *))
+                                : Queue     (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Leave   (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+
+(*
+11.5.4 Selectors
+
+PositionOf returns the number of positions from the given item to the
+front of the queue. If theItem is not present in theQueue then zero
+is returned. Complexity O(n).
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+PROCEDURE PositionOf (    theQueue: Queue    (*-- in    *);
+                          theItem : Item     (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+END QNBSUMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSUMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSUMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QNBSUMN.MOD
@@ -0,0 +1,633 @@
+(*
+11.6 Balking Unbounded Queue
+*)
+
+IMPLEMENTATION MODULE QNBSUMN;
+(*==============================================================
+    Version  : 1.00  04 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-Priority Balking Sequential Unbounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  03 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+11.6.1 Internal Unbounded Queue Representation
+
+Uses a linked list of nodes with a header, containing pointers
+to the front and the back.  The second pointer isn't absolutely
+necessary.  To add an item to the queue, the list could be
+traversed from the front until the end is reachedand then the
+item added.  For efficiency reasons, the back pointer is used
+so items can be added directly, making the traversal unnecessary.
+Instead of O(n) time complexity, insertion is O(1).
+    
+By convention, an empty queue will be represented by both the
+front and back pointers being NIL.
+
+Figure 11.3,
+below, graphically depicts the internal structure used for the
+unbounded queue:
+
+FIGURE 11.3
+
+Representation Invariants:
+Ñ when head = NIL then tail = NIL
+Ñ head points to the first node in the list of queue nodes
+Ñ tail points to the last node in the list of queue nodes
+*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD
+        item : Item; (*-- item data *)
+        next : Link; (*-- link to next node *)
+      END (*-- Node *);
+
+TYPE  UnboundedQueue = RECORD
+        dataID : TypeID;     (*-- defined data type *)
+        length : CARDINAL;   (*-- current # of items *)
+        head   : Link;       (*-- pointer to first item *)
+        tail   : Link;       (*-- pointer to last item *)
+      END (*-- UnboundedQueue *);
+
+TYPE  Queue = POINTER TO UnboundedQueue;
+
+    (*--------------------*)
+
+
+(*
+11.6.2 Exceptions
+
+queueError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+queueError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+11.6.5).
+
+QueueError simply returns the current exception result stored
+in queueError and is used to determine whether a queue operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+11.6.3 Constructors
+
+Create attempts to form a new, empty unbounded queue object associated
+with the given data type ID.  MacSystem.Allocate returns NIL if it is
+unable to successfully complete the allocation request whereupon the
+overflow exception is raised and the NullQueue returned.
+If successful, the
+queue is initialized as follows before returning the new queue:
+Ñ theType is saved for later use by IsEqual,
+Ñ the head and tail links are set to the empty queue state (NIL),
+Ñ the current length is set to the empty queue state (zero).
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *))
+                                : Queue     (*-- out   *);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, SIZE(UnboundedQueue));
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID := theType;
+      length := 0;
+      head   := NIL;
+      tail   := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theQueue rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullQueue). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, SIZE(theQueue^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theQueue's data type, if
+any, and proceeds to free each item in theQueue.  If theQueue is empty
+the loop is not executed as head already be NIL.  Lastly, tail and
+length are set to ensure theQueue is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- item node to deallocate *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      WHILE (head # NIL) DO
+        oldHead := head;
+        head    := head^.next;
+        free(oldHead^.item);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      tail   := NIL;
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theQueue to the target queue, toQueue. An
+undefined source queue raises an exception and leaves the target unchanged.
+If the target queue is undefined, it is created with the same
+data type attribute of the source; otherwise the target queue is
+cleared of its present contents and its data type is altered to reflect
+that of the source.  Essentially, Assign traverses the links of the
+source queue copying items to new nodes created in the target queue.
+If a new node cannot be allocated the overflow exception is raised and
+the routine is aborted.
+Complexity: O(n).
+*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   fromIndex  : Link;       (*-- loop index over source nodes *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      toQueue := Create(theQueue^.dataID);
+    ELSE
+      Clear(toQueue);
+      toQueue^.dataID := theQueue^.dataID;
+    END (*--if*);
+    IF (queueError = noerr) & (theQueue^.head # NIL) THEN
+      assignment := AssignOf(theQueue^.dataID);
+      Allocate(toQueue^.head, SIZE(Node));
+      IF (toQueue^.head = NIL) THEN
+        RaiseErrIn(assign, overflow);
+      ELSE
+        WITH toQueue^ DO
+          WITH head^ DO
+            item := assignment(theQueue^.head^.item);
+            next := NIL;
+          END (*--with*);
+          fromIndex := theQueue^.head;
+          tail := head;
+          WHILE (fromIndex^.next # NIL) DO
+            fromIndex := fromIndex^.next;
+            WITH tail^ DO
+              Allocate(next, SIZE(Node));
+              IF (next = NIL) THEN
+                RaiseErrIn(assign, overflow);
+                RETURN;
+              END (*--if*);
+              next^.item := assignment(fromIndex^.item);
+              next^.next := NIL;
+            END (*--with*);
+            tail := tail^.next;
+          END (*--while*);
+          length := theQueue^.length;
+        END (*--with*);
+      END (*--if*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to the rear of theQueue by first allocating a new
+node, storing theItem in that node and then update the links head
+and tail, and the queue length. Note that tail will always point to
+the new node upon successful completion of the routine.
+When the node cannot be allocated the exception overflow is raised
+and theQueue remains unchanged.  Likewise, given an undefined queue
+raises the exception of the same name. Complexity: O(1).
+*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   newNode : Link; (*-- temporary for new node *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+        item := theItem;
+        next := NIL;
+      END (*--with*);
+      WITH theQueue^ DO
+        INC(length);
+        IF (head = NIL) THEN
+          head := newNode;
+        ELSE
+          tail^.next := newNode;
+        END (*--if*);
+        tail := newNode;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front of theQueue by relinking the
+successor to the current queue head as the new head.  The departing
+item is freed via the disposal routine of theQueue's data type before
+actually releasing the old head node itself.
+
+If theQueue is empty on entry to Depart the underflow exception is
+raised and theQueue is not changed.  When theQueue is not defined,
+the undefined exception is raised. Complexity: O(1).
+*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- original head, departing *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (tail = NIL) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        oldHead := head;
+        head    := head^.next;
+        IF (head = NIL) THEN
+          tail := NIL;
+        END (*--if*);
+        DEC(length);
+        free := DisposeOf(dataID);
+        free(oldHead^.item);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+(*
+Leave removes theItem from the Queue regardless of its position within
+the queue.  Complexity: O(n).
+*)
+
+PROCEDURE Leave   (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   index : Link;        (*-- loop index over items *)
+      prior : Link;        (*-- to leaving node *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(leave, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (tail = NIL) THEN
+        RaiseErrIn(leave, underflow);
+      ELSE
+        free  := DisposeOf(dataID);
+        index := theQueue^.head;
+        prior := NIL;
+        WHILE (index # NIL) & (index^.item # theItem) DO
+          prior := index;
+          index := index^.next;
+        END (*-- while*);
+        IF (index # NIL) THEN
+          IF (prior = NIL) THEN
+            head := index^.next;
+          ELSE
+            prior^.next := index^.next;
+          END (*--if*);
+          IF (tail = index) THEN
+            tail := prior;
+          END (*--if*);
+          DEC(length);
+          free(index^.item);
+          Deallocate(index, SIZE(index^));
+        ELSE
+          RaiseErrIn(leave, notfound);
+        END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Leave;
+(*-------------------------*)
+
+
+(*
+11.6.4 Selectors
+
+IsDefined verifies to the best of its ability whether theQueue has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theQueue is in the empty state, as indicated by
+the head being NIL, and False otherwise.  As per the specification
+(section 9.4) undefined queues are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right queues for equality, which in this
+context means they contain the same items and the same data type ID.
+Both queues must be defined and have the same data type ID; if they 
+do not, then the exceptions undefined and typeerror are raised,
+respectively.
+Obviously, queues of different lengths (indicated by the lengths)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both queues
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them. Note that
+because the lengths are equal, both index links will become NIL
+simultaneously.
+Complexity: O(n).
+*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- loop index over left items *)
+      rightIndex: Link; (*-- loop index over right items *)
+      compare : CompareProc;    (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+    compare := CompareOf(left^.dataID);
+    leftIndex := left^.head;
+    rightIndex:= right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF compare(leftIndex^.item, rightIndex^.item) # equal THEN
+        RETURN FALSE;
+      END (*--if*);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    END (*--while*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the length of theQueue. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+TypeOf simply returns the dataID for the given queue.
+Undefined queues, as always, raise the undefined exception and return
+a reasonable value (the NullType). Complexity: O(1).
+*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the head of theQueue or
+the NullItem if theQueue is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+(*
+PositionOf returns the number of positions from the given item to the
+front of the queue. If theItem is not present in theQueue then zero
+is returned. Complexity O(n).
+*)
+
+PROCEDURE PositionOf (    theQueue: Queue    (*-- in    *);
+                          theItem : Item     (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+VAR   index : Link;     (*-- loop index over items *)
+      count : CARDINAL; (*-- running value of position *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(positionof, undefined);
+  ELSE
+    count := 1;
+    index := theQueue^.head;
+    WHILE (index # NIL) DO
+      IF (theItem = index^.item) THEN
+        RETURN count;
+      END (*--if*);
+      INC(count);
+      index := index^.next;
+    END (*--while*);
+  END (*--if*);
+  RETURN 0;
+END PositionOf;
+(*-------------------------*)
+
+
+(*
+11.6.5 Module Initialization
+
+The module's local variables are initialized to known states.
+queueError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.
+
+Since a FOR loop control variable is undefined following the loop,
+queueError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QNBSUMN.
+
+(*
+References
+
+[4] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley 1983, pp. 56-60.
+[3] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+    Benjamin/Cummings 1987, pp. 92-93, 142-153.
+[6] K. John Gough, ╥Writing Generic Utilities in Modula-2╙, Journal of
+    Pascal, Ada, and Modula-2, Vol. 5, No. 3, May/June 1986, pp 53-62.
+[5] T.A. Standish, Data Structure Techniques, Chapter 2: Stacks and Queues,
+    Addison-Wesley 1980, pp. 20-23, 28-32.
+[1] R.S. Wiener & G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons 1985,pp. 247-253
+[2] R.S. Wiener & R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons 1986, pp. 69-71
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSBMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSBMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSBMI.DEF
@@ -0,0 +1,164 @@
+DEFINITION MODULE QPBSBMI;
+(*===========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Priority Balking Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+(*
+12.1.1 Type Declarations
+
+
+A queue is declared as the abstract data type, Queue.  In the bounded
+form presented here a queue is limited to a maximum size of 8100
+items.
+
+An item's priority is declared as a generic entity, allowing the client
+module to have priorities of any complexity.  All that is needed for
+the priority form of queue is the ability to retrieve an item's priority
+and to compare priorities for the relational ordering between them.
+*)
+
+TYPE  Queue;
+TYPE  QueueSize = [1..8100];
+CONST NullQueue = Queue(NIL);
+
+TYPE  Priority;
+TYPE  PriorityProc    = PROCEDURE (Item) : Priority;
+TYPE  PriorityCompare = PROCEDURE (Priority, Priority) : Relation;
+
+
+(*
+12.1.2 Exceptions
+
+The ModuleID uniquely identifies this module from all others.
+
+QueueError returns the most recent queue exception, or noerr if the
+last operation was successful.  While SetHandler and GetHandler allow
+assignment and retrieval of exception handling routines for specific
+exceptions.
+*)
+
+CONST ModuleID = 5;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+(*
+12.1.3 Constructors
+
+The constructor Create has been changed from the non-priority
+non-balking form of queue to accomodate procedure parameters to (1)
+retrieve the priority for an item, and (2) compare two priorities.
+
+An additional constructor, Leave, has been added to implement the
+actual balking mechanism.
+
+All other constructors remain unchanged from the non-priority
+non-balking form of queue.
+*)
+
+PROCEDURE Create  (    theType    : TypeID          (*-- in    *);
+                       theSize    : QueueSize       (*-- in    *);
+                       priorityOf : PriorityProc    (*-- in    *);
+                       comparison : PriorityCompare (*-- in    *))
+                                  : Queue           (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Leave   (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+
+(*
+12.1.4 Selectors
+
+All of the selector interfaces are unchanged from the non-priority
+non-balking form of queue.
+
+An additional selector has been added, PositionOf, that returns the
+number of positions from the given item to the front of the queue. If
+theItem is not present in theQueue then zero is returned.
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+PROCEDURE PositionOf (    theQueue: Queue    (*-- in    *);
+                          theItem : Item     (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+
+(*
+12.1.5 Iterators
+
+The interfaces to both iterators are unchanged from the non-priority
+non-balking form of queue.
+*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+END QPBSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSBMI.MOD
@@ -0,0 +1,658 @@
+IMPLEMENTATION MODULE QPBSBMI;
+(*==============================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Priority Balking Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM SYSTEM IMPORT
+    (*--type*) ADDRESS;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc,
+               AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+12.2.1 Internal Bounded Balking Priority Queue Representation
+
+A dynamically created array of Items is created when a priority queue
+is created. The front of the queue is always accessible by the
+index [1].  The header record is used to hold the queue size limit (size),
+the current back index (rear), data type id (dataID), the procedures to
+retrieve and compare item priorities (priority and compare, respectively),
+and the dynamic array of items.  Items are stored in a linear fashion
+within the array ordered by priority.  Figure 12.1, below,
+graphically depicts the internal structure used for the bounded priority
+queue:
+
+FIGURE 12.1
+
+Representation Invariants:
+Ñ MIN(QueueSize) <= size <= MAX(QueueSize)
+Ñ 0 <= rear <= size
+Ñ the queue is empty when rear is zero
+Ñ when not empty, the front of the queue is at items[MIN(QueueSize)]
+Ñ when not empty, priority(items[1]) │ priority(items[2]) and so on
+*)
+
+TYPE  Priority = ADDRESS; (*-- any 4-byte pointer type will do *)
+TYPE  ItemsArray   = ARRAY QueueSize OF Item;
+TYPE  BoundedQueue = RECORD
+        dataID   : TypeID;          (*-- defined data type *)
+        priority : PriorityProc;    (*-- retrieve priority *)
+        compare  : PriorityCompare; (*-- compare priorities *)
+        size     : QueueSize;       (*-- maximum # of items *)
+        rear     : CARDINAL;        (*-- current # of items *)
+        items    : ItemsArray;      (*-- array [1..size] of item *)
+      END (*-- BoundedQueue *);
+
+TYPE  Queue = POINTER TO BoundedQueue;
+
+    (*--------------------*)
+
+
+(*
+12.2.2 Exceptions
+
+queueError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+queueError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+12.2.6).
+
+QueueError simply returns the current exception result stored
+in queueError and is used to determine whether a queue operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+12.2.3 Constructors
+
+Create attempts to form a new, empty bounded queue object associated
+with the given data type ID, maximum size, priority retrieval and
+priority comparison routines.  Only the specified
+number of entries given in theSize are actually allocated to the
+ItemsArray (items).  MacSystem.Allocate returns NIL if it is unable
+to successfully complete the allocation request whereupon the overflow
+exception is raised and the NullQueue returned.  If successful, the
+queue is initialized as follows before returning the new queue:
+Ñ theType is saved for later use by IsEqual,
+Ñ theSize is saved for later checking for queue overflow by Arrive and Assign, and
+Ñ rear is set to the empty queue state.
+Ñ the procedure parameters for priorities are saved for use in Arrive
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType    : TypeID          (*-- in    *);
+                       theSize    : QueueSize       (*-- in    *);
+                       priorityOf : PriorityProc    (*-- in    *);
+                       comparison : PriorityCompare (*-- in    *))
+                                  : Queue           (*-- out   *);
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, staticSize + itemSize * theSize);
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID   := theType;
+      priority := priorityOf;
+      compare  := comparison;
+      size     := theSize;
+      rear     := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theQueue rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullQueue). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, staticSize + itemSize * theQueue^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theQueue's data type, if
+any, and proceeds to free each item in theQueue.  If theQueue is empty
+the loop is not executed as rear will be greater than the minimum
+QueueSize.  Lastly, rear is set to ensure theQueue is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      FOR index := MIN(QueueSize) TO rear DO
+        free(items[index]);
+      END (*--for*);
+      rear := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theQueue to the target queue, toQueue. An
+undefined source queue raised an exception and leaves the target unchanged.
+If the target queue is undefined, it is created with the same size and
+data type attributes of the source; otherwise the target queue is
+cleared of its presnet contents and its data type is altered to reflect
+that of the source.  If the target queue is capable of containing all
+of the items present in the source, Assign simply copies each item from
+the source to the target afterwards updating the target's rear value.
+Complexity: O(n).
+*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(dataID, size, priority, compare);
+      END (*--with*);
+    ELSIF (theQueue^.rear <= toQueue^.size) THEN
+      Clear(toQueue);
+      WITH theQueue^ DO
+        toQueue^.dataID   := dataID;
+        toQueue^.priority := priority;
+        toQueue^.compare  := compare;
+      END (*--with*);
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (queueError = noerr) THEN
+      WITH theQueue^ DO
+        assignment := AssignOf(dataID);
+        FOR index := MIN(QueueSize) TO rear DO
+          toQueue^.items[index] := assignment(items[index]);
+        END (*--for*);
+        toQueue^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem into its proper position within the items array based
+on its priority.  A precondition is that the array be sorted in
+descending sequence by priority and the corresponding postcondition is
+the same.  Also, there may be more than one item with the same priority.
+A variant of algorithm 3.2 Sorted Array Search by Gonnet [2, pp. 31-32]
+is used.
+When the rear of theQueue
+is already at its maximum allowed size the exception overflow is raised
+and theQueue remains unchanged.  Likewise, given an undefined queue
+raises the exception of the same name. Complexity: O(n).
+*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   index        : CARDINAL; (*-- loop index over items *)
+      itemPriority : Priority; (*-- item's priority - retrieved once *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear < size) THEN
+        itemPriority := priority(theItem);
+        index := rear;
+        INC(rear);
+        WHILE (index > 0) &
+              (compare(priority(items[index]), itemPriority) = less) DO
+          items[index + 1] := items[index];
+          DEC(index);
+        END (*--while*);
+        items[index + 1] := theItem;
+      ELSE
+        RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front of theQueue by shifting all items
+down one position in the items array and deducting one from the rear
+index.  Before overwriting the item being removed, it's value is
+freed via the disposal routine of theQueue's data type.  If theQueue
+is empty on entry to Depart the underflow exception is raised and
+theQueue is not changed.  When theQueue is not defined, the undefined
+exception is raised. Complexity: O(n).
+*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear = 0) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        free := DisposeOf(dataID);
+        free(items[MIN(QueueSize)]);
+        FOR index := MIN(QueueSize) + 1 TO rear DO
+          items[index - 1] := items[index];
+        END (*--for*);
+        DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+(*
+Leave removes theItem from the Queue regardless of its position within
+the queue.  Complexity: O(n).
+*)
+
+PROCEDURE Leave   (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(leave, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear = 0) THEN
+        RaiseErrIn(leave, underflow);
+      ELSE
+        free := DisposeOf(dataID);
+        index := MIN(QueueSize);
+        WHILE (index <= rear) & (items[index] # theItem) DO
+          INC(index);
+        END (*-- while*);
+        IF (index <= rear) THEN
+          free(items[index]);
+          FOR index := index + 1 TO rear DO
+            items[index - 1] := items[index];
+          END (*--for*);
+          DEC(rear);
+        ELSE
+          RaiseErrIn(leave, notfound);
+        END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Leave;
+(*-------------------------*)
+
+
+(*
+12.2.4 Selectors
+
+IsDefined verifies to the best of its ability whether theQueue has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theQueue is in the empty state, as indicated by
+the rear being zero, and False otherwise.  As per the specification
+(section 8.?) undefined queues are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right queues for equality, which in this
+context means they contain the same items and the same data type ID. The
+defined size of the queues is not relevant for the equality test.  Both
+queues must be defined and have the same data type ID; if they don not,
+then the exceptions undefined and typeerror are raised, respectively.
+Obviously, queues of different lengths (indicated by the value of rear)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both queues
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them. Complexity: O(n).
+*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      compareItems : CompareProc;   (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+      compareItems := CompareOf(left^.dataID);
+      FOR index := MIN(QueueSize) TO rear DO
+        IF compareItems(items[index], right^.items[index]) # equal THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the rear index into the items array which is
+also the length of theQueue. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+SizeOf and TypeOf simply return the size and dataID for the given queue.
+Undefined queues, as always, raise the undefined exception and return
+reasonable values (zero and the NullType, respectively). The complexity
+of both routines is O(1).
+*)
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the front of theQueue or
+the NullItem if theQueue is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.items[MIN(QueueSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+(*
+PositionOf returns the number of positions from the given item to the
+front of the queue. If theItem is not present in theQueue then zero
+is returned.
+*)
+
+PROCEDURE PositionOf (    theQueue: Queue    (*-- in    *);
+                          theItem : Item     (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(positionof, undefined);
+  ELSE
+    WITH theQueue^ DO
+      FOR index := MIN(QueueSize) TO rear DO
+        IF (theItem = items[index]) THEN
+          RETURN index;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+  RETURN 0;
+END PositionOf;
+(*-------------------------*)
+
+
+(*
+12.2.5 Iterators
+
+Both LoopOver and Traverse simply loop through each of the queue items
+from the front to the rear passing the item value to theProcess
+procedure parameter.  LoopOver may terminate before reaching the rear
+if theProcess returns False. Complexity: O(n).
+*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theQueue^ DO
+      FOR index := MIN(QueueSize) TO rear DO
+        IF ~theProcess(items[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theQueue^ DO
+      FOR index := MIN(QueueSize) TO rear DO
+        theProcess(items[index]);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*
+12.2.6 Module Initialization
+
+The module's local variables are initialized to known states.
+queueError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.
+
+Since a FOR loop control variable is undefined following the loop,
+queueError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QPBSBMI.
+
+
+(*
+References
+
+[1] Booch
+[2] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Addison-Wesley, London England, 1984.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSBMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSBMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSBMN.DEF
@@ -0,0 +1,106 @@
+DEFINITION MODULE QPBSBMN;
+(*===========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Priority Balking Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+TYPE  Queue;
+TYPE  QueueSize = [1..8100];
+CONST NullQueue = Queue(NIL);
+
+TYPE  Priority;
+TYPE  PriorityProc    = PROCEDURE (Item) : Priority;
+TYPE  PriorityCompare = PROCEDURE (Priority, Priority) : Relation;
+
+
+    (*--------------------*)
+
+CONST ModuleID = 6;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+    (*--------------------*)
+
+PROCEDURE Create  (    theType    : TypeID          (*-- in    *);
+                       theSize    : QueueSize       (*-- in    *);
+                       priorityOf : PriorityProc    (*-- in    *);
+                       comparison : PriorityCompare (*-- in    *))
+                                  : Queue           (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Leave   (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+
+    (*--------------------*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+PROCEDURE PositionOf (    theQueue: Queue    (*-- in    *);
+                          theItem : Item     (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+END QPBSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSBMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSBMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSBMN.MOD
@@ -0,0 +1,415 @@
+IMPLEMENTATION MODULE QPBSBMN;
+(*==============================================================
+    Version  : 1.02  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Priority Balking Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM SYSTEM IMPORT
+    (*--type*) ADDRESS;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+
+TYPE  Priority = ADDRESS;
+TYPE  ItemsArray   = ARRAY QueueSize OF Item;
+TYPE  BoundedQueue = RECORD
+        dataID   : TypeID;          (*-- defined data type *)
+        priority : PriorityProc;    (*-- retrieve priority *)
+        compare  : PriorityCompare; (*-- compare priorities *)
+        size     : QueueSize;       (*-- maximum # of items *)
+        rear     : CARDINAL;        (*-- current # of items *)
+        items    : ItemsArray;      (*-- array [1..size] of item *)
+      END (*-- BoundedQueue *);
+
+TYPE  Queue = POINTER TO BoundedQueue;
+
+    (*--------------------*)
+
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+PROCEDURE Create  (    theType    : TypeID          (*-- in    *);
+                       theSize    : QueueSize       (*-- in    *);
+                       priorityOf : PriorityProc    (*-- in    *);
+                       comparison : PriorityCompare (*-- in    *))
+                                  : Queue           (*-- out   *);
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, staticSize + itemSize * theSize);
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID   := theType;
+      priority := priorityOf;
+      compare  := comparison;
+      size     := theSize;
+      rear     := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, staticSize + itemSize * theQueue^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      FOR index := MIN(QueueSize) TO rear DO
+        free(items[index]);
+      END (*--for*);
+      rear := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(dataID, size, priority, compare);
+      END (*--with*);
+    ELSIF (theQueue^.rear <= toQueue^.size) THEN
+      Clear(toQueue);
+      WITH theQueue^ DO
+        toQueue^.dataID   := dataID;
+        toQueue^.priority := priority;
+        toQueue^.compare  := compare;
+      END (*--with*);
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (queueError = noerr) THEN
+      WITH theQueue^ DO
+        assignment := AssignOf(dataID);
+        FOR index := MIN(QueueSize) TO rear DO
+          toQueue^.items[index] := assignment(items[index]);
+        END (*--for*);
+        toQueue^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   index        : CARDINAL; (*-- loop index over items *)
+      itemPriority : Priority; (*-- item's priority - retrieved once *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear < size) THEN
+        itemPriority := priority(theItem);
+        index := rear;
+        INC(rear);
+        WHILE (index > 0) &
+              (compare(priority(items[index]), itemPriority) = less) DO
+          items[index + 1] := items[index];
+          DEC(index);
+        END (*--while*);
+        items[index + 1] := theItem;
+      ELSE
+        RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear = 0) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        free := DisposeOf(dataID);
+        free(items[MIN(QueueSize)]);
+        FOR index := MIN(QueueSize) + 1 TO rear DO
+          items[index - 1] := items[index];
+        END (*--for*);
+        DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+PROCEDURE Leave   (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(leave, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear = 0) THEN
+        RaiseErrIn(leave, underflow);
+      ELSE
+        free := DisposeOf(dataID);
+        index := MIN(QueueSize);
+        WHILE (index <= rear) & (items[index] # theItem) DO
+          INC(index);
+        END (*-- while*);
+        IF (index <= rear) THEN
+          free(items[index]);
+          FOR index := index + 1 TO rear DO
+            items[index - 1] := items[index];
+          END (*--for*);
+          DEC(rear);
+        ELSE
+          RaiseErrIn(leave, notfound);
+        END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Leave;
+(*-------------------------*)
+
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      compareItems : CompareProc;   (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+      compareItems := CompareOf(dataID);
+      FOR index := MIN(QueueSize) TO rear DO
+        IF compareItems(items[index], right^.items[index]) # equal THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.items[MIN(QueueSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+PROCEDURE PositionOf (    theQueue: Queue    (*-- in    *);
+                          theItem : Item     (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(positionof, undefined);
+  ELSE
+    WITH theQueue^ DO
+      FOR index := MIN(QueueSize) TO rear DO
+        IF (theItem = items[index]) THEN
+          RETURN index;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+  RETURN 0;
+END PositionOf;
+(*-------------------------*)
+
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QPBSBMN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSUMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSUMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSUMI.DEF
@@ -0,0 +1,148 @@
+DEFINITION MODULE QPBSUMI;
+(*===========================================================
+    Version  : 1.00  04 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Priority Balking Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  04 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+(*
+11.3.1 Type Declarations
+
+A queue is declared as the abstract data type, Queue.
+
+An item's priority is declared as a generic entity, allowing the client
+module to have priorities of any complexity.  All that is needed for
+the priority form of queue is the ability to retrieve an item's priority
+and to compare priorities for the relational ordering between them.
+*)
+
+TYPE  Queue;
+CONST NullQueue = Queue(NIL);
+
+TYPE  Priority;
+TYPE  PriorityProc    = PROCEDURE (Item) : Priority;
+TYPE  PriorityCompare = PROCEDURE (Priority, Priority) : Relation;
+
+
+(*
+11.3.2 Exceptions
+
+The ModuleID uniquely identifies this module from all others.
+
+QueueError returns the most recent queue exception, or noerr if the
+last operation was successful.  While SetHandler and GetHandler allow
+assignment and retrieval of exception handling routines for specific
+exceptions.
+*)
+
+CONST ModuleID = 7;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+(*
+11.3.3 Constructors
+
+Only the constructor Create has been changed from the non-priority
+form of queue to accomodate procedure parameters to (1) retrieve the
+priority for an item, and (2) compare two priorities.  All other
+constructors remain unchanged.
+
+Leave removes theItem from the Queue regardless of its position.
+Complexity: O(n).
+*)
+
+PROCEDURE Create  (    theType    : TypeID          (*-- in    *);
+                       priorityOf : PriorityProc    (*-- in    *);
+                       comparison : PriorityCompare (*-- in    *))
+                                  : Queue           (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Leave   (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+
+(*
+11.3.4 Selectors
+
+PositionOf returns the number of positions from the given item to the
+front of the queue. If theItem is not present in theQueue then zero
+is returned. Complexity O(n).
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+PROCEDURE PositionOf (    theQueue: Queue    (*-- in    *);
+                          theItem : Item     (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+
+(*
+11.3.5 Iterators
+*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+END QPBSUMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSUMI.MOD
@@ -0,0 +1,710 @@
+IMPLEMENTATION MODULE QPBSUMI;
+(*==============================================================
+    Version  : 1.00  04 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Priority Balking Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  00 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM SYSTEM IMPORT
+    (*--type*) ADDRESS;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc,
+               AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+11.4.1 Internal Unbounded Queue Representation
+
+Uses a linked list of nodes with a header, containing a pointer
+to the front node.  The second pointer, back, used in the non-priority
+form of queue is even less necessary here.  This is because insertion
+no longer always occurs at the end of the queue but now may occur
+anywhere within the queue which means we must traverse the list of
+nodes regardless.
+    
+By convention, an empty queue will be represented by the front
+pointer being NIL.
+
+Figure 11.2,
+below, graphically depicts the internal structure used for the
+unbounded priority queue:
+
+FIGURE 11.2
+
+Representation Invariants:
+Ñ when queue is empty then head = NIL
+Ñ head points to the first node in the list of queue nodes, i.e., the
+  node containing the item with the highest priority
+*)
+
+TYPE  Priority = ADDRESS;
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD
+        item : Item; (*-- item data *)
+        next : Link; (*-- link to next node *)
+      END (*-- Node *);
+
+TYPE  UnboundedQueue = RECORD
+        dataID   : TypeID;          (*-- defined data type *)
+        priority : PriorityProc;    (*-- priority retrieval routine *)
+        compare  : PriorityCompare; (*-- priority comparison routine *)
+        length   : CARDINAL;        (*-- current # of items *)
+        head     : Link;            (*-- pointer to first item *)
+      END (*-- UnboundedQueue *);
+
+TYPE  Queue = POINTER TO UnboundedQueue;
+
+    (*--------------------*)
+
+
+(*
+11.4.2 Exceptions
+
+queueError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+queueError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+11.4.6).
+
+QueueError simply returns the current exception result stored
+in queueError and is used to determine whether a queue operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+11.4.3 Constructors
+
+Create attempts to form a new, empty unbounded queue object associated
+with the given data type ID.  MacSystem.Allocate returns NIL if it is
+unable to successfully complete the allocation request whereupon the
+overflow exception is raised and the NullQueue returned.
+If successful, the
+queue is initialized as follows before returning the new queue:
+Ñ theType is saved for later use by IsEqual,
+Ñ the head link is set to the empty queue state (NIL),
+Ñ the current length is set to the empty queue state (zero),
+Ñ the priority retrieval and comparison routines are saved for later
+  used by Arrive.
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType    : TypeID          (*-- in    *);
+                       priorityOf : PriorityProc    (*-- in    *);
+                       comparison : PriorityCompare (*-- in    *))
+                                  : Queue           (*-- out   *);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, SIZE(UnboundedQueue));
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID   := theType;
+      priority := priorityOf;
+      compare  := comparison;
+      length   := 0;
+      head     := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theQueue rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullQueue). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, SIZE(theQueue^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theQueue's data type, if
+any, and proceeds to free each item in theQueue.  If theQueue is empty
+the loop is not executed as head already be NIL.  Lastly, tail and
+length are set to ensure theQueue is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- item node to deallocate *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      WHILE (head # NIL) DO
+        oldHead := head;
+        head    := head^.next;
+        free(oldHead^.item);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theQueue to the target queue, toQueue. An
+undefined source queue raises an exception and leaves the target unchanged.
+If the target queue is undefined, it is created with the same
+data type attribute of the source; otherwise the target queue is
+cleared of its present contents and its data type is altered to reflect
+that of the source.  Essentially, Assign traverses the links of the
+source queue copying items to new nodes created in the target queue.
+If a new node cannot be allocated the overflow exception is raised and
+the routine is aborted.
+Complexity: O(n).
+*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   fromIndex  : Link;       (*-- loop index over source nodes *)
+      tail       : Link;       (*-- to last node added *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(dataID, priority, compare);
+      END (*--with*);
+    ELSE
+      Clear(toQueue);
+      WITH theQueue^ DO
+        toQueue^.dataID   := dataID;
+        toQueue^.priority := priority;
+        toQueue^.compare  := compare;
+      END (*--with*);
+    END (*--if*);
+    IF (queueError = noerr) & (theQueue^.head # NIL) THEN
+      assignment := AssignOf(theQueue^.dataID);
+      Allocate(toQueue^.head, SIZE(Node));
+      IF (toQueue^.head = NIL) THEN
+        RaiseErrIn(assign, overflow);
+      ELSE
+        WITH toQueue^ DO
+          WITH head^ DO
+            item := assignment(theQueue^.head^.item);
+            next := NIL;
+          END (*--with*);
+          fromIndex := theQueue^.head;
+          tail := head;
+          WHILE (fromIndex^.next # NIL) DO
+            fromIndex := fromIndex^.next;
+            WITH tail^ DO
+              Allocate(next, SIZE(Node));
+              IF (next = NIL) THEN
+                RaiseErrIn(assign, overflow);
+                RETURN;
+              END (*--if*);
+              next^.item := assignment(fromIndex^.item);
+              next^.next := NIL;
+            END (*--with*);
+            tail := tail^.next;
+          END (*--while*);
+          length := theQueue^.length;
+        END (*--with*);
+      END (*--if*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to the rear of theQueue by first allocating a new
+node, storing theItem in that node and inserting the new node into
+its proper position within the queue, and updating the queue length.
+The key step is the insertion into its proper position.  The algorithm
+used here is 5.1.1 Sorted List Insertion from Gonnet [, pg. 270].
+When the node cannot be allocated the exception overflow is raised
+and theQueue remains unchanged.  Likewise, given an undefined queue
+raises the exception of the same name. Complexity: O(n).
+*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   newNode      : Link;     (*-- temporary for new node *)
+      index        : Link;     (*-- loop search index over nodes *)
+      itemPriority : Priority; (*-- new Item's priority *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+        item := theItem;
+        next := NIL;
+      END (*--with*);
+      WITH theQueue^ DO
+        itemPriority := priority(theItem);
+        INC(length);
+        IF (head = NIL) THEN
+          head := newNode;
+        ELSIF compare(priority(head^.item), itemPriority) = less THEN
+          newNode^.next := head;
+          head := newNode;
+        ELSE
+          index := head;
+          WHILE (index^.next # NIL) DO
+            IF compare(priority(index^.next^.item),
+                       itemPriority) = less THEN
+              newNode^.next := index^.next;
+              index^.next   := newNode;
+              RETURN;
+            END (*--if*);
+            index := index^.next;
+          END (*--while*);
+          index^.next := newNode;
+        END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front of theQueue by relinking the
+successor to the current queue head as the new head.  The departing
+item is freed via the disposal routine of theQueue's data type before
+actually releasing the old head node itself.
+
+If theQueue is empty on entry to Depart the underflow exception is
+raised and theQueue is not changed.  When theQueue is not defined,
+the undefined exception is raised. Complexity: O(1).
+*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- original head, departing *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (head = NIL) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        oldHead := head;
+        head    := head^.next;
+        DEC(length);
+        free := DisposeOf(dataID);
+        free(oldHead^.item);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+(*
+Leave removes theItem from the Queue regardless of its position within
+the queue.  Complexity: O(n).
+*)
+
+PROCEDURE Leave   (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   index : Link;        (*-- loop index over items *)
+      prior : Link;        (*-- to leaving node *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(leave, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (head = NIL) THEN
+        RaiseErrIn(leave, underflow);
+      ELSE
+        free  := DisposeOf(dataID);
+        index := theQueue^.head;
+        prior := NIL;
+        WHILE (index # NIL) & (index^.item # theItem) DO
+          prior := index;
+          index := index^.next;
+        END (*-- while*);
+        IF (index # NIL) THEN
+          IF (prior = NIL) THEN
+            head := index^.next;
+          ELSE
+            prior^.next := index^.next;
+          END (*--if*);
+          DEC(length);
+          free(index^.item);
+          Deallocate(index, SIZE(index^));
+        ELSE
+          RaiseErrIn(leave, notfound);
+        END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Leave;
+(*-------------------------*)
+
+
+(*
+11.4.4 Selectors
+
+IsDefined verifies to the best of its ability whether theQueue has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theQueue is in the empty state, as indicated by
+the head being NIL, and False otherwise.  As per the specification
+(section 9.?) undefined queues are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right queues for equality, which in this
+context means they contain the same items and the same data type ID.
+Both queues must be defined and have the same data type ID; if they 
+do not, then the exceptions undefined and typeerror are raised,
+respectively.
+Obviously, queues of different lengths (indicated by the lengths)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both queues
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them. Note that
+because the lengths are equal, both index links will become NIL
+simultaneously.
+Complexity: O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- loop index over left items *)
+      rightIndex: Link; (*-- loop index over right items *)
+      compareItems : CompareProc;   (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+    compareItems := CompareOf(left^.dataID);
+    leftIndex := left^.head;
+    rightIndex:= right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF compareItems(leftIndex^.item, rightIndex^.item) # equal THEN
+        RETURN FALSE;
+      END (*--if*);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    END (*--while*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the length of theQueue. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+TypeOf simply returns the dataID for the given queue.
+Undefined queues, as always, raise the undefined exception and return
+a reasonable value (the NullType). Complexity: O(1).
+*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the head of theQueue or
+the NullItem if theQueue is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+(*
+PositionOf returns the number of positions from the given item to the
+front of the queue. If theItem is not present in theQueue then zero
+is returned. Complexity O(n).
+*)
+
+PROCEDURE PositionOf (    theQueue: Queue    (*-- in    *);
+                          theItem : Item     (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+VAR   index : Link;     (*-- loop index over items *)
+      count : CARDINAL; (*-- running value of position *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(positionof, undefined);
+  ELSE
+    count := 1;
+    index := theQueue^.head;
+    WHILE (index # NIL) DO
+      IF (theItem = index^.item) THEN
+        RETURN count;
+      END (*--if*);
+      INC(count);
+      index := index^.next;
+    END (*--while*);
+  END (*--if*);
+  RETURN 0;
+END PositionOf;
+(*-------------------------*)
+
+
+(*
+11.4.5 Iterators
+
+Both LoopOver and Traverse simply loop through each of the queue items
+from the head to the tail passing the item value to theProcess
+procedure parameter.  LoopOver may terminate before reaching the tail
+if theProcess returns False. Complexity: O(n).
+*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theQueue^ DO
+      index := head;
+      WHILE (index # NIL) DO
+        IF ~theProcess(index^.item) THEN
+          RETURN;
+        END (*--if*);
+        index := index^.next;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theQueue^ DO
+      index := head;
+      WHILE (index # NIL) DO
+        theProcess(index^.item);
+        index := index^.next;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*
+11.4.6 Module Initialization
+
+The module's local variables are initialized to known states.
+queueError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.
+
+Since a FOR loop control variable is undefined following the loop,
+queueError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QPBSUMI.
+
+(* References
+[4] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading MA, 1983, pp. 56-60.
+[3] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+    Benjamin/Cummings 1987, pp. 92-93, 142-153.
+[]  G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Addison-Wesley, London England 1984.
+[6] K. John Gough, ╥Writing Generic Utilities in Modula-2╙, Journal of
+    Pascal, Ada, and Modula-2, Vol. 5, No. 3, May/June 1986, pp 53-62.
+[5] T.A. Standish, Data Structure Techniques, Chapter 2: Stacks and Queues,
+    Addison-Wesley 1980, pp. 20-23, 28-32.
+[1] R.S. Wiener & G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons 1985,pp. 247-253
+[2] R.S. Wiener & R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons 1986, pp. 69-71
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSUMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSUMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSUMN.DEF
@@ -0,0 +1,101 @@
+DEFINITION MODULE QPBSUMN;
+(*===========================================================
+    Version  : 1.00  04 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Priority Balking Sequential Unbounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  04 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+TYPE  Queue;
+CONST NullQueue = Queue(NIL);
+
+TYPE  Priority;
+TYPE  PriorityProc    = PROCEDURE (Item) : Priority;
+TYPE  PriorityCompare = PROCEDURE (Priority, Priority) : Relation;
+
+    (*--------------------*)
+
+
+CONST ModuleID = 8;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+    (*--------------------*)
+
+PROCEDURE Create  (    theType    : TypeID          (*-- in    *);
+                       priorityOf : PriorityProc    (*-- in    *);
+                       comparison : PriorityCompare (*-- in    *))
+                                  : Queue           (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Leave   (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+
+    (*--------------------*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+PROCEDURE PositionOf (    theQueue: Queue    (*-- in    *);
+                          theItem : Item     (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+END QPBSUMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSUMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSUMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPBSUMN.MOD
@@ -0,0 +1,597 @@
+IMPLEMENTATION MODULE QPBSUMN;
+(*==============================================================
+    Version  : 1.00  04 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Priority Balking Sequential Unbounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  04 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM SYSTEM IMPORT
+    (*--type*) ADDRESS;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+TYPE  Priority = ADDRESS;
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD
+        item : Item; (*-- item data *)
+        next : Link; (*-- link to next node *)
+      END (*-- Node *);
+
+TYPE  UnboundedQueue = RECORD
+        dataID   : TypeID;          (*-- defined data type *)
+        priority : PriorityProc;    (*-- priority retrieval routine *)
+        compare  : PriorityCompare; (*-- priority comparison routine *)
+        length   : CARDINAL;        (*-- current # of items *)
+        head     : Link;            (*-- pointer to first item *)
+      END (*-- UnboundedQueue *);
+
+TYPE  Queue = POINTER TO UnboundedQueue;
+
+
+    (*--------------------*)
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+13.?.1 Constructors
+
+Create attempts to form a new, empty unbounded queue object associated
+with the given data type ID.  MacSystem.Allocate returns NIL if it is
+unable to successfully complete the allocation request whereupon the
+overflow exception is raised and the NullQueue returned.
+If successful, the
+queue is initialized as follows before returning the new queue:
+Ñ theType is saved for later use by IsEqual,
+Ñ the head link is set to the empty queue state (NIL),
+Ñ the current length is set to the empty queue state (zero),
+Ñ the priority retrieval and comparison routines are saved for later
+  used by Arrive.
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType    : TypeID          (*-- in    *);
+                       priorityOf : PriorityProc    (*-- in    *);
+                       comparison : PriorityCompare (*-- in    *))
+                                  : Queue           (*-- out   *);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, SIZE(UnboundedQueue));
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID   := theType;
+      priority := priorityOf;
+      compare  := comparison;
+      length   := 0;
+      head     := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theQueue rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullQueue). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, SIZE(theQueue^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theQueue's data type, if
+any, and proceeds to free each item in theQueue.  If theQueue is empty
+the loop is not executed as head already be NIL.  Lastly, tail and
+length are set to ensure theQueue is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- item node to deallocate *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      WHILE (head # NIL) DO
+        oldHead := head;
+        head    := head^.next;
+        free(oldHead^.item);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theQueue to the target queue, toQueue. An
+undefined source queue raises an exception and leaves the target unchanged.
+If the target queue is undefined, it is created with the same
+data type attribute of the source; otherwise the target queue is
+cleared of its present contents and its data type is altered to reflect
+that of the source.  Essentially, Assign traverses the links of the
+source queue copying items to new nodes created in the target queue.
+If a new node cannot be allocated the overflow exception is raised and
+the routine is aborted.
+Complexity: O(n).
+*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   fromIndex  : Link;       (*-- loop index over source nodes *)
+      tail       : Link;       (*-- to last node added *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(dataID, priority, compare);
+      END (*--with*);
+    ELSE
+      Clear(toQueue);
+      WITH theQueue^ DO
+        toQueue^.dataID   := dataID;
+        toQueue^.priority := priority;
+        toQueue^.compare  := compare;
+      END (*--with*);
+    END (*--if*);
+    IF (queueError = noerr) & (theQueue^.head # NIL) THEN
+      assignment := AssignOf(theQueue^.dataID);
+      Allocate(toQueue^.head, SIZE(Node));
+      IF (toQueue^.head = NIL) THEN
+        RaiseErrIn(assign, overflow);
+      ELSE
+        WITH toQueue^ DO
+          WITH head^ DO
+            item := assignment(theQueue^.head^.item);
+            next := NIL;
+          END (*--with*);
+          fromIndex := theQueue^.head;
+          tail := head;
+          WHILE (fromIndex^.next # NIL) DO
+            fromIndex := fromIndex^.next;
+            WITH tail^ DO
+              Allocate(next, SIZE(Node));
+              IF (next = NIL) THEN
+                RaiseErrIn(assign, overflow);
+                RETURN;
+              END (*--if*);
+              next^.item := assignment(fromIndex^.item);
+              next^.next := NIL;
+            END (*--with*);
+            tail := tail^.next;
+          END (*--while*);
+          length := theQueue^.length;
+        END (*--with*);
+      END (*--if*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to the rear of theQueue by first allocating a new
+node, storing theItem in that node and inserting the new node into
+its proper position within the queue, and updating the queue length.
+The key step is the insertion into its proper position.  The algorithm
+used here is 5.1.1 Sorted List Insertion from Gonnet [3, pg. 270].
+When the node cannot be allocated the exception overflow is raised
+and theQueue remains unchanged.  Likewise, given an undefined queue
+raises the exception of the same name. Complexity: O(n).
+*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   newNode      : Link;     (*-- temporary for new node *)
+      index        : Link;     (*-- loop search index over nodes *)
+      itemPriority : Priority; (*-- new Item's priority *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+        item := theItem;
+        next := NIL;
+      END (*--with*);
+      WITH theQueue^ DO
+        itemPriority := priority(theItem);
+        INC(length);
+        IF (head = NIL) THEN
+          head := newNode;
+        ELSIF compare(priority(head^.item), itemPriority) = less THEN
+          newNode^.next := head;
+          head := newNode;
+        ELSE
+          index := head;
+          WHILE (index^.next # NIL) DO
+            IF compare(priority(index^.next^.item),
+                       itemPriority) = less THEN
+              newNode^.next := index^.next;
+              index^.next   := newNode;
+              RETURN;
+            END (*--if*);
+            index := index^.next;
+          END (*--while*);
+          index^.next := newNode;
+        END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front of theQueue by relinking the
+successor to the current queue head as the new head.  The departing
+item is freed via the disposal routine of theQueue's data type before
+actually releasing the old head node itself.
+
+If theQueue is empty on entry to Depart the underflow exception is
+raised and theQueue is not changed.  When theQueue is not defined,
+the undefined exception is raised. Complexity: O(1).
+*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- original head, departing *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (head = NIL) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        oldHead := head;
+        head    := head^.next;
+        DEC(length);
+        free := DisposeOf(dataID);
+        free(oldHead^.item);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+(*
+Leave removes theItem from the Queue regardless of its position within
+the queue.  Complexity: O(n).
+*)
+
+PROCEDURE Leave   (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   index : Link;        (*-- loop index over items *)
+      prior : Link;        (*-- to leaving node *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(leave, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (head = NIL) THEN
+        RaiseErrIn(leave, underflow);
+      ELSE
+        free  := DisposeOf(dataID);
+        index := theQueue^.head;
+        prior := NIL;
+        WHILE (index # NIL) & (index^.item # theItem) DO
+          prior := index;
+          index := index^.next;
+        END (*-- while*);
+        IF (index # NIL) THEN
+          IF (prior = NIL) THEN
+            head := index^.next;
+          ELSE
+            prior^.next := index^.next;
+          END (*--if*);
+          DEC(length);
+          free(index^.item);
+          Deallocate(index, SIZE(index^));
+        ELSE
+          RaiseErrIn(leave, notfound);
+        END (*--if*);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Leave;
+(*-------------------------*)
+
+
+(*
+13.?.2 Selectors
+
+IsDefined verifies to the best of its ability whether theQueue has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theQueue is in the empty state, as indicated by
+the head being NIL, and False otherwise.  As per the specification
+(section 9.4) undefined queues are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right queues for equality, which in this
+context means they contain the same items and the same data type ID.
+Both queues must be defined and have the same data type ID; if they 
+do not, then the exceptions undefined and typeerror are raised,
+respectively.
+Obviously, queues of different lengths (indicated by the lengths)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both queues
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them. Note that
+because the lengths are equal, both index links will become NIL
+simultaneously.
+Complexity: O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- loop index over left items *)
+      rightIndex: Link; (*-- loop index over right items *)
+      compareItems : CompareProc;   (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+    compareItems := CompareOf(left^.dataID);
+    leftIndex := left^.head;
+    rightIndex:= right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF compareItems(leftIndex^.item, rightIndex^.item) # equal THEN
+        RETURN FALSE;
+      END (*--if*);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    END (*--while*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the length of theQueue. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+TypeOf simply returns the dataID for the given queue.
+Undefined queues, as always, raise the undefined exception and return
+a reasonable value (the NullType). Complexity: O(1).
+*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the head of theQueue or
+the NullItem if theQueue is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+(*
+PositionOf returns the number of positions from the given item to the
+front of the queue. If theItem is not present in theQueue then zero
+is returned. Complexity O(n).
+*)
+
+PROCEDURE PositionOf (    theQueue: Queue    (*-- in    *);
+                          theItem : Item     (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+VAR   index : Link;     (*-- loop index over items *)
+      count : CARDINAL; (*-- running value of position *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(positionof, undefined);
+  ELSE
+    count := 1;
+    index := theQueue^.head;
+    WHILE (index # NIL) DO
+      IF (theItem = index^.item) THEN
+        RETURN count;
+      END (*--if*);
+      INC(count);
+      index := index^.next;
+    END (*--while*);
+  END (*--if*);
+  RETURN 0;
+END PositionOf;
+(*-------------------------*)
+
+
+(*
+13.?.3 Module Initialization
+*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QPBSUMN.
+
+(*
+References
+
+[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading MA, 1983, pp. 56-60.
+[2] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+    Benjamin/Cummings 1987, pp. 92-93, 142-153.
+[3] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Addison-Wesley, London England 1984.
+[4] K. John Gough, ╥Writing Generic Utilities in Modula-2╙, Journal of
+    Pascal, Ada, and Modula-2, Vol. 5, No. 3, May/June 1986, pp 53-62.
+[5] T.A. Standish, Data Structure Techniques, Chapter 2: Stacks and Queues,
+    Addison-Wesley 1980, pp. 20-23, 28-32.
+[6] R.S. Wiener & G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons 1985,pp. 247-253
+[7] R.S. Wiener & R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons 1986, pp. 69-71
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSBMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSBMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSBMI.DEF
@@ -0,0 +1,147 @@
+DEFINITION MODULE QPNSBMI;
+(*===========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Priority Non-balking Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+(*
+11.1.1 Type Declarations
+
+A queue is declared as the abstract data type, Queue.  In the bounded
+form presented here a queue is limited to a maximum size of 8100
+items.
+
+An item's priority is declared as a generic entity, allowing the client
+module to have priorities of any complexity.  All that is needed for
+the priority form of queue is the ability to retrieve an item's priority
+and to compare priorities for the relational ordering between them.
+*)
+
+TYPE  Queue;
+TYPE  QueueSize = [1..8100];
+CONST NullQueue = Queue(NIL);
+
+TYPE  Priority;
+TYPE  PriorityProc    = PROCEDURE (Item) : Priority;
+TYPE  PriorityCompare = PROCEDURE (Priority, Priority) : Relation;
+
+
+(*
+11.1.2 Exceptions
+
+The ModuleID uniquely identifies this module from all others.
+
+QueueError returns the most recent queue exception, or noerr if the
+last operation was successful.  While SetHandler and GetHandler allow
+assignment and retrieval of exception handling routines for specific
+exceptions.
+*)
+
+CONST ModuleID = 9;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+(*
+11.1.3 Constructors
+
+Only the constructor Create has been changed from the non-priority
+form of queue to accomodate procedure parameters to (1) retrieve the
+priority for an item, and (2) compare two priorities.  All other
+constructors remain unchanged.
+*)
+
+PROCEDURE Create  (    theType    : TypeID          (*-- in    *);
+                       theSize    : QueueSize       (*-- in    *);
+                       priorityOf : PriorityProc    (*-- in    *);
+                       comparison : PriorityCompare (*-- in    *))
+                                  : Queue           (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+
+(*
+11.1.4 Selectors
+
+All of the selector interfaces are unchanged from the non-priority
+non-balking form of queue.
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+
+(*
+11.1.5 Iterators
+
+The interfaces to both iterators are unchanged from the non-priority
+non-balking form of queue.
+*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+END QPNSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSBMI.MOD
@@ -0,0 +1,591 @@
+IMPLEMENTATION MODULE QPNSBMI;
+(*==============================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Priority Non-Balking Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM SYSTEM IMPORT
+    (*--type*) ADDRESS;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc,
+               AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+11.2.1 Internal Bounded Priority Queue Representation
+
+A dynamically created array of Items is created when a priority queue
+is created. The front of the queue is always accessible by the
+index [1].  The header record is used to hold the queue size limit (size),
+the current back index (rear), data type id (dataID), the procedures to
+retrieve and compare item priorities (priority and compare, respectively),
+and the dynamic array of items.  Items are stored in a linear fashion
+within the array ordered by priority.  Figure 11.1, below,
+graphically depicts the internal structure used for the bounded priority
+queue:
+
+FIGURE 11.1
+
+Representation Invariants:
+Ñ MIN(QueueSize) <= size <= MAX(QueueSize)
+Ñ 0 <= rear <= size
+Ñ the queue is empty when rear is zero
+Ñ when not empty, the front of the queue is at items[MIN(QueueSize)]
+Ñ when not empty, priority(items[1]) < priority(items[2]) and so on
+*)
+
+TYPE  Priority = ADDRESS; (*-- any 4-byte pointer type will do *)
+TYPE  ItemsArray   = ARRAY QueueSize OF Item;
+TYPE  BoundedQueue = RECORD
+        dataID   : TypeID;          (*-- defined data type *)
+        priority : PriorityProc;    (*-- retrieve priority *)
+        compare  : PriorityCompare; (*-- compare priorities *)
+        size     : QueueSize;       (*-- maximum # of items *)
+        rear     : CARDINAL;        (*-- current # of items *)
+        items    : ItemsArray;      (*-- array [1..size] of item *)
+      END (*-- BoundedQueue *);
+
+TYPE  Queue = POINTER TO BoundedQueue;
+
+    (*--------------------*)
+
+
+(*
+11.2.2 Exceptions
+
+queueError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+queueError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+11.2.6).
+
+QueueError simply returns the current exception result stored
+in queueError and is used to determine whether a queue operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+11.2.3 Constructors
+
+Create attempts to form a new, empty bounded queue object associated
+with the given data type ID, maximum size, priority retrieval and
+priority comparison routines.  Only the specified
+number of entries given in theSize are actually allocated to the
+ItemsArray (items).  MacSystem.Allocate returns NIL if it is unable
+to successfully complete the allocation request whereupon the overflow
+exception is raised and the NullQueue returned.  If successful, the
+queue is initialized as follows before returning the new queue:
+Ñ theType is saved for later use by IsEqual,
+Ñ theSize is saved for later checking for queue overflow by Arrive and Assign, and
+Ñ rear is set to the empty queue state.
+Ñ the procedure parameters for priorities are saved for use in Arrive
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType    : TypeID          (*-- in    *);
+                       theSize    : QueueSize       (*-- in    *);
+                       priorityOf : PriorityProc    (*-- in    *);
+                       comparison : PriorityCompare (*-- in    *))
+                                  : Queue           (*-- out   *);
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, staticSize + itemSize * theSize);
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID   := theType;
+      priority := priorityOf;
+      compare  := comparison;
+      size     := theSize;
+      rear     := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theQueue rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullQueue). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, staticSize + itemSize * theQueue^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theQueue's data type, if
+any, and proceeds to free each item in theQueue.  If theQueue is empty
+the loop is not executed as rear will be greater than the minimum
+QueueSize.  Lastly, rear is set to ensure theQueue is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      FOR index := MIN(QueueSize) TO rear DO
+        free(items[index]);
+      END (*--for*);
+      rear := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theQueue to the target queue, toQueue. An
+undefined source queue raised an exception and leaves the target unchanged.
+If the target queue is undefined, it is created with the same size and
+data type attributes of the source; otherwise the target queue is
+cleared of its presnet contents and its data type is altered to reflect
+that of the source.  If the target queue is capable of containing all
+of the items present in the source, Assign simply copies each item from
+the source to the target afterwards updating the target's rear value.
+Complexity: O(n).
+*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(dataID, size, priority, compare);
+      END (*--with*);
+    ELSIF (theQueue^.rear <= toQueue^.size) THEN
+      Clear(toQueue);
+      WITH theQueue^ DO
+        toQueue^.dataID   := dataID;
+        toQueue^.priority := priority;
+        toQueue^.compare  := compare;
+      END (*--with*);
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (queueError = noerr) THEN
+      WITH theQueue^ DO
+        assignment := AssignOf(dataID);
+        FOR index := MIN(QueueSize) TO rear DO
+          toQueue^.items[index] := assignment(items[index]);
+        END (*--for*);
+        toQueue^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem into its proper position within the items array based
+on its priority.  A precondition is that the array be sorted in
+descending sequence by priority and the corresponding postcondition is
+the same.  Also, there may be more than one item with the same priority.
+In this case, items are ordered by their order of arrival. For this reason
+the loop is terminated when the comparison result is greater than or equal
+to the arriving item (e.g., not less than).
+The algorithm is a variant on 3.2 Sorted Array Search by Gonnet [2, pp. 31-32].
+When the rear of theQueue
+is already at its maximum allowed size the exception overflow is raised
+and theQueue remains unchanged.  Likewise, given an undefined queue
+raises the exception of the same name. Complexity: O(n).
+*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      itemPriority : Priority;
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear < size) THEN
+        itemPriority := priority(theItem);
+        index := rear;
+        INC(rear);
+        WHILE (index > 0) &
+              (compare(priority(items[index]), itemPriority) = less) DO
+          items[index + 1] := items[index];
+          DEC(index);
+        END (*--while*);
+        items[index + 1] := theItem;
+      ELSE
+        RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front of theQueue by shifting all items
+down one position in the items array and deducting one from the rear
+index.  Before overwriting the item being removed, it's value is
+freed via the disposal routine of theQueue's data type.  If theQueue
+is empty on entry to Depart the underflow exception is raised and
+theQueue is not changed.  When theQueue is not defined, the undefined
+exception is raised. Complexity: O(n).
+*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear = 0) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        free := DisposeOf(dataID);
+        free(items[MIN(QueueSize)]);
+        FOR index := MIN(QueueSize) + 1 TO rear DO
+          items[index - 1] := items[index];
+        END (*--for*);
+        DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+(*
+11.2.4 Selectors
+
+IsDefined verifies to the best of its ability whether theQueue has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theQueue is in the empty state, as indicated by
+the rear being zero, and False otherwise.  As per the specification
+(section 8.?) undefined queues are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right queues for equality, which in this
+context means they contain the same items and the same data type ID. The
+defined size of the queues is not relevant for the equality test.  Both
+queues must be defined and have the same data type ID; if they don not,
+then the exceptions undefined and typeerror are raised, respectively.
+Obviously, queues of different lengths (indicated by the value of rear)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both queues
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them. Complexity: O(n).
+*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      compareItems : CompareProc;   (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+      compareItems := CompareOf(dataID);
+      FOR index := MIN(QueueSize) TO rear DO
+        IF compareItems(items[index], right^.items[index]) # equal THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the rear index into the items array which is
+also the length of theQueue. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+SizeOf and TypeOf simply return the size and dataID for the given queue.
+Undefined queues, as always, raise the undefined exception and return
+reasonable values (zero and the NullType, respectively). The complexity
+of both routines is O(1).
+*)
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the front of theQueue or
+the NullItem if theQueue is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.items[MIN(QueueSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+
+(*
+11.2.5 Iterators
+
+Both LoopOver and Traverse simply loop through each of the queue items
+from the front to the rear passing the item value to theProcess
+procedure parameter.  LoopOver may terminate before reaching the rear
+if theProcess returns False. Complexity: O(n).
+*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theQueue^ DO
+      FOR index := MIN(QueueSize) TO rear DO
+        IF ~theProcess(items[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theQueue^ DO
+      FOR index := MIN(QueueSize) TO rear DO
+        theProcess(items[index]);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*
+11.2.6 Module Initialization
+
+The module's local variables are initialized to known states.
+queueError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.
+
+Since a FOR loop control variable is undefined following the loop,
+queueError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QPNSBMI.
+
+
+(*
+References
+
+[1] Booch
+[2] G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Addison-Wesley, London England, 1984.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSBMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSBMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSBMN.DEF
@@ -0,0 +1,100 @@
+DEFINITION MODULE QPNSBMN;
+(*===========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Priority Non-Balking Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+
+TYPE  Queue;
+TYPE  QueueSize = [1..8100];
+CONST NullQueue = Queue(NIL);
+
+TYPE  Priority;
+TYPE  PriorityProc    = PROCEDURE (Item) : Priority;
+TYPE  PriorityCompare = PROCEDURE (Priority, Priority) : Relation;
+
+
+    (*--------------------*)
+
+CONST ModuleID = 10;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+    (*--------------------*)
+
+PROCEDURE Create  (    theType    : TypeID          (*-- in    *);
+                       theSize    : QueueSize       (*-- in    *);
+                       priorityOf : PriorityProc    (*-- in    *);
+                       comparison : PriorityCompare (*-- in    *))
+                                  : Queue           (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+
+    (*--------------------*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+END QPNSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSBMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSBMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSBMN.MOD
@@ -0,0 +1,357 @@
+IMPLEMENTATION MODULE QPNSBMN;
+(*==============================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Priority Non-Balking Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM SYSTEM IMPORT
+    (*--type*) ADDRESS;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+
+TYPE  Priority = ADDRESS; (*-- any 4-byte pointer type will do *)
+TYPE  ItemsArray   = ARRAY QueueSize OF Item;
+TYPE  BoundedQueue = RECORD
+        dataID   : TypeID;          (*-- defined data type *)
+        priority : PriorityProc;    (*-- retrieve priority *)
+        compare  : PriorityCompare; (*-- compare priorities *)
+        size     : QueueSize;       (*-- maximum # of items *)
+        rear     : CARDINAL;        (*-- current # of items *)
+        items    : ItemsArray;      (*-- array [1..size] of item *)
+      END (*-- BoundedQueue *);
+
+TYPE  Queue = POINTER TO BoundedQueue;
+
+    (*--------------------*)
+
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+PROCEDURE Create  (    theType    : TypeID          (*-- in    *);
+                       theSize    : QueueSize       (*-- in    *);
+                       priorityOf : PriorityProc    (*-- in    *);
+                       comparison : PriorityCompare (*-- in    *))
+                                  : Queue           (*-- out   *);
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, staticSize + itemSize * theSize);
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID   := theType;
+      priority := priorityOf;
+      compare  := comparison;
+      size     := theSize;
+      rear     := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, staticSize + itemSize * theQueue^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      FOR index := MIN(QueueSize) TO rear DO
+        free(items[index]);
+      END (*--for*);
+      rear := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(dataID, size, priority, compare);
+      END (*--with*);
+    ELSIF (theQueue^.rear <= toQueue^.size) THEN
+      Clear(toQueue);
+      WITH theQueue^ DO
+        toQueue^.dataID   := dataID;
+        toQueue^.priority := priority;
+        toQueue^.compare  := compare;
+      END (*--with*);
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (queueError = noerr) THEN
+      WITH theQueue^ DO
+        assignment := AssignOf(dataID);
+        FOR index := MIN(QueueSize) TO rear DO
+          toQueue^.items[index] := assignment(items[index]);
+        END (*--for*);
+        toQueue^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      itemPriority : Priority;
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear < size) THEN
+        itemPriority := priority(theItem);
+        index := rear;
+        INC(rear);
+        WHILE (index > 0) &
+              (compare(priority(items[index]), itemPriority) = less) DO
+          items[index + 1] := items[index];
+          DEC(index);
+        END (*--while*);
+        items[index + 1] := theItem;
+      ELSE
+        RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear = 0) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        free := DisposeOf(dataID);
+        free(items[MIN(QueueSize)]);
+        FOR index := MIN(QueueSize) + 1 TO rear DO
+          items[index - 1] := items[index];
+        END (*--for*);
+        DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      compareItems : CompareProc;   (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+      compareItems := CompareOf(dataID);
+      FOR index := MIN(QueueSize) TO rear DO
+        IF compareItems(items[index], right^.items[index]) # equal THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.items[MIN(QueueSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QPNSBMN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSUMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSUMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSUMI.DEF
@@ -0,0 +1,136 @@
+DEFINITION MODULE QPNSUMI;
+(*===========================================================
+    Version  : 1.00  04 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Priority Non-balking Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  04 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+(*
+11.3.1 Type Declarations
+
+A queue is declared as the abstract data type, Queue.
+
+An item's priority is declared as a generic entity, allowing the client
+module to have priorities of any complexity.  All that is needed for
+the priority form of queue is the ability to retrieve an item's priority
+and to compare priorities for the relational ordering between them.
+*)
+
+TYPE  Queue;
+CONST NullQueue = Queue(NIL);
+
+TYPE  Priority;
+TYPE  PriorityProc    = PROCEDURE (Item) : Priority;
+TYPE  PriorityCompare = PROCEDURE (Priority, Priority) : Relation;
+
+
+(*
+11.3.2 Exceptions
+
+The ModuleID uniquely identifies this module from all others.
+
+QueueError returns the most recent queue exception, or noerr if the
+last operation was successful.  While SetHandler and GetHandler allow
+assignment and retrieval of exception handling routines for specific
+exceptions.
+*)
+
+CONST ModuleID = 11;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+(*
+11.3.3 Constructors
+
+Only the constructor Create has been changed from the non-priority
+form of queue to accomodate procedure parameters to (1) retrieve the
+priority for an item, and (2) compare two priorities.  All other
+constructors remain unchanged.
+*)
+
+PROCEDURE Create  (    theType    : TypeID          (*-- in    *);
+                       priorityOf : PriorityProc    (*-- in    *);
+                       comparison : PriorityCompare (*-- in    *))
+                                  : Queue           (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+
+(*
+11.3.4 Selectors
+
+The is no change to any of the interfaces from the non-priority form.
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+
+(*
+11.3.5 Iterators
+*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+END QPNSUMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSUMI.MOD
@@ -0,0 +1,636 @@
+IMPLEMENTATION MODULE QPNSUMI;
+(*==============================================================
+    Version  : 1.00  04 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Priority Non-balking Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  04 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM SYSTEM IMPORT
+    (*--Type*) ADDRESS;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc,
+               AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+11.4.1 Internal Unbounded Queue Representation
+
+Uses a linked list of nodes with a header, containing a pointer
+to the front node.  The second pointer, back, used in the non-priority
+form of queue is even less necessary here.  This is because insertion
+no longer always occurs at the end of the queue but now may occur
+anywhere within the queue which means we must traverse the list of
+nodes regardless.
+    
+By convention, an empty queue will be represented by the front
+pointer being NIL.
+
+Figure 11.2,
+below, graphically depicts the internal structure used for the
+unbounded priority queue:
+
+FIGURE 11.2
+
+Representation Invariants:
+* when queue is empty then head = NIL
+* head points to the first node in the list of queue nodes, i.e., the
+  node containing the item with the highest priority
+
+Note that TopSpeed doesn't allow us to map one opaque type to another, e.g.,
+Priority = Item. So we must use some four-byte quantity it will allow -
+in this case an ADDRESS.
+*)
+
+TYPE  Priority = ADDRESS; (*-- map to another opaque type *)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD
+        item : Item; (*-- item data *)
+        next : Link; (*-- link to next node *)
+      END (*-- Node *);
+
+TYPE  UnboundedQueue = RECORD
+        dataID   : TypeID;          (*-- defined data type *)
+        priority : PriorityProc;    (*-- priority retrieval routine *)
+        compare  : PriorityCompare; (*-- priority comparison routine *)
+        length   : CARDINAL;        (*-- current # of items *)
+        head     : Link;            (*-- pointer to first item *)
+      END (*-- UnboundedQueue *);
+
+TYPE  Queue = POINTER TO UnboundedQueue;
+
+    (*--------------------*)
+
+
+(*
+11.4.2 Exceptions
+
+queueError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+queueError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+11.4.6).
+
+QueueError simply returns the current exception result stored
+in queueError and is used to determine whether a queue operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+11.4.3 Constructors
+
+Create attempts to form a new, empty unbounded queue object associated
+with the given data type ID.  MacSystem.Allocate returns NIL if it is
+unable to successfully complete the allocation request whereupon the
+overflow exception is raised and the NullQueue returned.
+If successful, the
+queue is initialized as follows before returning the new queue:
+Ñ theType is saved for later use by IsEqual,
+Ñ the head link is set to the empty queue state (NIL),
+Ñ the current length is set to the empty queue state (zero),
+Ñ the priority retrieval and comparison routines are saved for later
+  used by Arrive.
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType    : TypeID          (*-- in    *);
+                       priorityOf : PriorityProc    (*-- in    *);
+                       comparison : PriorityCompare (*-- in    *))
+                                  : Queue           (*-- out   *);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, SIZE(UnboundedQueue));
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID   := theType;
+      priority := priorityOf;
+      compare  := comparison;
+      length   := 0;
+      head     := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theQueue rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullQueue). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, SIZE(theQueue^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theQueue's data type, if
+any, and proceeds to free each item in theQueue.  If theQueue is empty
+the loop is not executed as head already be NIL.  Lastly, tail and
+length are set to ensure theQueue is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- item node to deallocate *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      WHILE (head # NIL) DO
+        oldHead := head;
+        head    := head^.next;
+        free(oldHead^.item);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theQueue to the target queue, toQueue. An
+undefined source queue raises an exception and leaves the target unchanged.
+If the target queue is undefined, it is created with the same
+data type attribute of the source; otherwise the target queue is
+cleared of its present contents and its data type is altered to reflect
+that of the source.  Essentially, Assign traverses the links of the
+source queue copying items to new nodes created in the target queue.
+If a new node cannot be allocated the overflow exception is raised and
+the routine is aborted.
+Complexity: O(n).
+*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   fromIndex  : Link;       (*-- loop index over source nodes *)
+      tail       : Link;       (*-- to last node added *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(dataID, priority, compare);
+      END (*--with*);
+    ELSE
+      Clear(toQueue);
+      WITH theQueue^ DO
+        toQueue^.dataID   := dataID;
+        toQueue^.priority := priority;
+        toQueue^.compare  := compare;
+      END (*--with*);
+    END (*--if*);
+    IF (queueError = noerr) & (theQueue^.head # NIL) THEN
+      assignment := AssignOf(theQueue^.dataID);
+      Allocate(toQueue^.head, SIZE(Node));
+      IF (toQueue^.head = NIL) THEN
+        RaiseErrIn(assign, overflow);
+      ELSE
+        WITH toQueue^ DO
+          WITH head^ DO
+            item := assignment(theQueue^.head^.item);
+            next := NIL;
+          END (*--with*);
+          fromIndex := theQueue^.head;
+          tail := head;
+          WHILE (fromIndex^.next # NIL) DO
+            fromIndex := fromIndex^.next;
+            WITH tail^ DO
+              Allocate(next, SIZE(Node));
+              IF (next = NIL) THEN
+                RaiseErrIn(assign, overflow);
+                RETURN;
+              END (*--if*);
+              next^.item := assignment(fromIndex^.item);
+              next^.next := NIL;
+            END (*--with*);
+            tail := tail^.next;
+          END (*--while*);
+          length := theQueue^.length;
+        END (*--with*);
+      END (*--if*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to the rear of theQueue by first allocating a new
+node, storing theItem in that node and inserting the new node into
+its proper position within the queue, and updating the queue length.
+The key step is the insertion into its proper position.  The algorithm
+used here is 5.1.1 Sorted List Insertion from Gonnet [, pg. 270].
+When the node cannot be allocated the exception overflow is raised
+and theQueue remains unchanged.  Likewise, given an undefined queue
+raises the exception of the same name. Complexity: O(1).
+*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   newNode      : Link;     (*-- temporary for new node *)
+      index        : Link;     (*-- loop search index over nodes *)
+      itemPriority : Priority; (*-- new Item's priority *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+        item := theItem;
+        next := NIL;
+      END (*--with*);
+      WITH theQueue^ DO
+        itemPriority := priority(theItem);
+        INC(length);
+        IF (head = NIL) THEN
+          head := newNode;
+        ELSIF compare(priority(head^.item), itemPriority) = less THEN
+          newNode^.next := head;
+          head := newNode;
+        ELSE
+          index := head;
+          WHILE (index^.next # NIL) DO
+            IF compare(priority(index^.next^.item),
+                       itemPriority) = less THEN
+              newNode^.next := index^.next;
+              index^.next   := newNode;
+              RETURN;
+            END (*--if*);
+            index := index^.next;
+          END (*--while*);
+          index^.next := newNode;
+        END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front of theQueue by relinking the
+successor to the current queue head as the new head.  The departing
+item is freed via the disposal routine of theQueue's data type before
+actually releasing the old head node itself.
+
+If theQueue is empty on entry to Depart the underflow exception is
+raised and theQueue is not changed.  When theQueue is not defined,
+the undefined exception is raised. Complexity: O(1).
+*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- original head, departing *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (head = NIL) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        oldHead := head;
+        head    := head^.next;
+        DEC(length);
+        free := DisposeOf(dataID);
+        free(oldHead^.item);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+(*
+11.4.4 Selectors
+
+IsDefined verifies to the best of its ability whether theQueue has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theQueue is in the empty state, as indicated by
+the head being NIL, and False otherwise.  As per the specification
+(section 8.?) undefined queues are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right queues for equality, which in this
+context means they contain the same items and the same data type ID.
+Both queues must be defined and have the same data type ID; if they 
+do not, then the exceptions undefined and typeerror are raised,
+respectively.
+Obviously, queues of different lengths (indicated by the lengths)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both queues
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them. Note that
+because the lengths are equal, both index links will become NIL
+simultaneously.
+Complexity: O(n).
+*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- loop index over left items *)
+      rightIndex: Link; (*-- loop index over right items *)
+      compareItems : CompareProc;   (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+    compareItems := CompareOf(left^.dataID);
+    leftIndex := left^.head;
+    rightIndex:= right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF compareItems(leftIndex^.item, rightIndex^.item) # equal THEN
+        RETURN FALSE;
+      END (*--if*);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    END (*--while*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the length of theQueue. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+TypeOf simply returns the dataID for the given queue.
+Undefined queues, as always, raise the undefined exception and return
+a reasonable value (the NullType). Complexity: O(1).
+*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the head of theQueue or
+the NullItem if theQueue is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+
+(*
+11.4.5 Iterators
+
+Both LoopOver and Traverse simply loop through each of the queue items
+from the head to the tail passing the item value to theProcess
+procedure parameter.  LoopOver may terminate before reaching the tail
+if theProcess returns False. Complexity: O(n).
+*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theQueue^ DO
+      index := head;
+      WHILE (index # NIL) DO
+        IF ~theProcess(index^.item) THEN
+          RETURN;
+        END (*--if*);
+        index := index^.next;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theQueue^ DO
+      index := head;
+      WHILE (index # NIL) DO
+        theProcess(index^.item);
+        index := index^.next;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*
+11.4.6 Module Initialization
+
+The module's local variables are initialized to known states.
+queueError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.
+
+Since a FOR loop control variable is undefined following the loop,
+queueError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QPNSUMI.
+
+(* References
+[4] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading MA, 1983, pp. 56-60.
+[3] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+    Benjamin/Cummings 1987, pp. 92-93, 142-153.
+[]  G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Addison-Wesley, London England 1984.
+[6] K. John Gough, ╥Writing Generic Utilities in Modula-2╙, Journal of
+    Pascal, Ada, and Modula-2, Vol. 5, No. 3, May/June 1986, pp 53-62.
+[5] T.A. Standish, Data Structure Techniques, Chapter 2: Stacks and Queues,
+    Addison-Wesley 1980, pp. 20-23, 28-32.
+[1] R.S. Wiener & G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons 1985,pp. 247-253
+[2] R.S. Wiener & R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons 1986, pp. 69-71
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSUMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSUMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSUMN.DEF
@@ -0,0 +1,125 @@
+DEFINITION MODULE QPNSUMN;
+(*===========================================================
+    Version  : 1.00  04 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Priority Non-Balking Sequential Unbounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  04 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+(*
+13.3.1 Type Declarations
+
+A queue is declared as the abstract data type, Queue.
+
+An item's priority is declared as a generic entity, allowing the client
+module to have priorities of any complexity.  All that is needed for
+the priority form of queue is the ability to retrieve an item's priority
+and to compare priorities for the relational ordering between them.
+*)
+
+TYPE  Queue;
+CONST NullQueue = Queue(NIL);
+
+TYPE  Priority;
+TYPE  PriorityProc    = PROCEDURE (Item) : Priority;
+TYPE  PriorityCompare = PROCEDURE (Priority, Priority) : Relation;
+
+
+(*
+13.3.2 Exceptions
+
+The ModuleID uniquely identifies this module from all others.
+
+QueueError returns the most recent queue exception, or noerr if the
+last operation was successful.  While SetHandler and GetHandler allow
+assignment and retrieval of exception handling routines for specific
+exceptions.
+*)
+
+CONST ModuleID = 12;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+(*
+13.3.3 Constructors
+
+Only the constructor Create has been changed from the non-priority
+form of queue to accomodate procedure parameters to (1) retrieve the
+priority for an item, and (2) compare two priorities.  All other
+constructors remain unchanged.
+*)
+
+PROCEDURE Create  (    theType    : TypeID          (*-- in    *);
+                       priorityOf : PriorityProc    (*-- in    *);
+                       comparison : PriorityCompare (*-- in    *))
+                                  : Queue           (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+
+(*
+13.3.4 Selectors
+
+The is no change to any of the interfaces from the non-priority form.
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+END QPNSUMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSUMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSUMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QPNSUMN.MOD
@@ -0,0 +1,579 @@
+IMPLEMENTATION MODULE QPNSUMN;
+(*==============================================================
+    Version  : 1.00  04 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Priority Non-Balking Sequential Unbounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  04 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM SYSTEM IMPORT
+    (*--type*) ADDRESS;
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+13.4.1 Internal Unbounded Queue Representation
+
+Uses a linked list of nodes with a header, containing a pointer
+to the front node.  The second pointer, back, used in the non-priority
+form of queue is even less necessary here.  This is because insertion
+no longer always occurs at the end of the queue but now may occur
+anywhere within the queue which means we must traverse the list of
+nodes regardless.
+    
+By convention, an empty queue will be represented by the front
+pointer being NIL.
+
+Figure 13.2,
+below, graphically depicts the internal structure used for the
+unbounded priority queue:
+
+FIGURE 13.2
+
+Representation Invariants:
+Ñ when queue is empty then head = NIL
+Ñ head points to the first node in the list of queue nodes, i.e., the
+  node containing the item with the highest priority
+*)
+
+TYPE  Priority = ADDRESS; (*-- map to another opaque type *)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD
+        item : Item; (*-- item data *)
+        next : Link; (*-- link to next node *)
+      END (*-- Node *);
+
+TYPE  UnboundedQueue = RECORD
+        dataID   : TypeID;          (*-- defined data type *)
+        priority : PriorityProc;    (*-- priority retrieval routine *)
+        compare  : PriorityCompare; (*-- priority comparison routine *)
+        length   : CARDINAL;        (*-- current # of items *)
+        head     : Link;            (*-- pointer to first item *)
+      END (*-- UnboundedQueue *);
+
+TYPE  Queue = POINTER TO UnboundedQueue;
+
+    (*--------------------*)
+
+
+(*
+13.4.2 Exceptions
+
+queueError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+queueError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+13.4.5).
+
+QueueError simply returns the current exception result stored
+in queueError and is used to determine whether a queue operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+13.4.3 Constructors
+
+Create attempts to form a new, empty unbounded queue object associated
+with the given data type ID.  MacSystem.Allocate returns NIL if it is
+unable to successfully complete the allocation request whereupon the
+overflow exception is raised and the NullQueue returned.
+If successful, the
+queue is initialized as follows before returning the new queue:
+Ñ theType is saved for later use by IsEqual,
+Ñ the head link is set to the empty queue state (NIL),
+Ñ the current length is set to the empty queue state (zero),
+Ñ the priority retrieval and comparison routines are saved for later
+  used by Arrive.
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType    : TypeID          (*-- in    *);
+                       priorityOf : PriorityProc    (*-- in    *);
+                       comparison : PriorityCompare (*-- in    *))
+                                  : Queue           (*-- out   *);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, SIZE(UnboundedQueue));
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID   := theType;
+      priority := priorityOf;
+      compare  := comparison;
+      length   := 0;
+      head     := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theQueue rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullQueue). Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, SIZE(theQueue^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theQueue's data type, if
+any, and proceeds to free each item in theQueue.  If theQueue is empty
+the loop is not executed as head already be NIL.  Lastly, tail and
+length are set to ensure theQueue is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- item node to deallocate *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      WHILE (head # NIL) DO
+        oldHead := head;
+        head    := head^.next;
+        free(oldHead^.item);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theQueue to the target queue, toQueue. An
+undefined source queue raises an exception and leaves the target unchanged.
+If the target queue is undefined, it is created with the same
+data type attribute of the source; otherwise the target queue is
+cleared of its present contents and its data type is altered to reflect
+that of the source.  Essentially, Assign traverses the links of the
+source queue copying items to new nodes created in the target queue.
+If a new node cannot be allocated the overflow exception is raised and
+the routine is aborted.
+Complexity: O(n).
+*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   fromIndex  : Link;       (*-- loop index over source nodes *)
+      tail       : Link;       (*-- to last node added *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(dataID, priority, compare);
+      END (*--with*);
+    ELSE
+      Clear(toQueue);
+      WITH theQueue^ DO
+        toQueue^.dataID   := dataID;
+        toQueue^.priority := priority;
+        toQueue^.compare  := compare;
+      END (*--with*);
+    END (*--if*);
+    IF (queueError = noerr) & (theQueue^.head # NIL) THEN
+      assignment := AssignOf(theQueue^.dataID);
+      Allocate(toQueue^.head, SIZE(Node));
+      IF (toQueue^.head = NIL) THEN
+        RaiseErrIn(assign, overflow);
+      ELSE
+        WITH toQueue^ DO
+          WITH head^ DO
+            item := assignment(theQueue^.head^.item);
+            next := NIL;
+          END (*--with*);
+          fromIndex := theQueue^.head;
+          tail := head;
+          WHILE (fromIndex^.next # NIL) DO
+            fromIndex := fromIndex^.next;
+            WITH tail^ DO
+              Allocate(next, SIZE(Node));
+              IF (next = NIL) THEN
+                RaiseErrIn(assign, overflow);
+                RETURN;
+              END (*--if*);
+              next^.item := assignment(fromIndex^.item);
+              next^.next := NIL;
+            END (*--with*);
+            tail := tail^.next;
+          END (*--while*);
+          length := theQueue^.length;
+        END (*--with*);
+      END (*--if*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to the rear of theQueue by first allocating a new
+node, storing theItem in that node and inserting the new node into
+its proper position within the queue, and updating the queue length.
+The key step is the insertion into its proper position.  The algorithm
+used here is 5.1.1 Sorted List Insertion from Gonnet [, pg. 270].
+When the node cannot be allocated the exception overflow is raised
+and theQueue remains unchanged.  Likewise, given an undefined queue
+raises the exception of the same name. Complexity: O(n).
+*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   newNode      : Link;     (*-- temporary for new node *)
+      index        : Link;     (*-- loop search index over nodes *)
+      itemPriority : Priority; (*-- new Item's priority *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+        item := theItem;
+        next := NIL;
+      END (*--with*);
+      WITH theQueue^ DO
+        itemPriority := priority(theItem);
+        INC(length);
+        IF (head = NIL) THEN
+          head := newNode;
+        ELSIF compare(priority(head^.item), itemPriority) = less THEN
+          newNode^.next := head;
+          head := newNode;
+        ELSE
+          index := head;
+          WHILE (index^.next # NIL) DO
+            IF compare(priority(index^.next^.item),
+                       itemPriority) = less THEN
+              newNode^.next := index^.next;
+              index^.next   := newNode;
+              RETURN;
+            END (*--if*);
+            index := index^.next;
+          END (*--while*);
+          index^.next := newNode;
+        END (*--if*);
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front of theQueue by relinking the
+successor to the current queue head as the new head.  The departing
+item is freed via the disposal routine of theQueue's data type before
+actually releasing the old head node itself.
+
+If theQueue is empty on entry to Depart the underflow exception is
+raised and theQueue is not changed.  When theQueue is not defined,
+the undefined exception is raised. Complexity: O(1).
+*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- original head, departing *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (head = NIL) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        oldHead := head;
+        head    := head^.next;
+        DEC(length);
+        free := DisposeOf(dataID);
+        free(oldHead^.item);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+(*
+13.4.4 Selectors
+
+IsDefined verifies to the best of its ability whether theQueue has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theQueue is in the empty state, as indicated by
+the head being NIL, and False otherwise.  As per the specification
+(section 9.4) undefined queues are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right queues for equality, which in this
+context means they contain the same items and the same data type ID.
+Both queues must be defined and have the same data type ID; if they 
+do not, then the exceptions undefined and typeerror are raised,
+respectively.
+Obviously, queues of different lengths (indicated by the lengths)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both queues
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them. Note that
+because the lengths are equal, both index links will become NIL
+simultaneously.
+Complexity: O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- loop index over left items *)
+      rightIndex: Link; (*-- loop index over right items *)
+      compareItems : CompareProc;   (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+    compareItems := CompareOf(left^.dataID);
+    leftIndex := left^.head;
+    rightIndex:= right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF compareItems(leftIndex^.item, rightIndex^.item) # equal THEN
+        RETURN FALSE;
+      END (*--if*);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    END (*--while*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the length of theQueue. Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+TypeOf simply returns the dataID for the given queue.
+Undefined queues, as always, raise the undefined exception and return
+a reasonable value (the NullType). Complexity: O(1).
+*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the head of theQueue or
+the NullItem if theQueue is undefined or is empty. Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+
+(*
+13.4.5 Module Initialization
+
+The module's local variables are initialized to known states.
+queueError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.
+
+Since a FOR loop control variable is undefined following the loop,
+queueError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QPNSUMN.
+
+(*
+References
+
+[4] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading MA, 1983, pp. 56-60.
+[3] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+    Benjamin/Cummings 1987, pp. 92-93, 142-153.
+[]  G.H. Gonnet, Handbook of Algorithms and Data Structures,
+    Addison-Wesley, London England 1984.
+[6] K. John Gough, ╥Writing Generic Utilities in Modula-2╙, Journal of
+    Pascal, Ada, and Modula-2, Vol. 5, No. 3, May/June 1986, pp 53-62.
+[5] T.A. Standish, Data Structure Techniques, Chapter 2: Stacks and Queues,
+    Addison-Wesley 1980, pp. 20-23, 28-32.
+[1] R.S. Wiener & G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons 1985,pp. 247-253
+[2] R.S. Wiener & R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons 1986, pp. 69-71
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBMI.DEF
@@ -0,0 +1,134 @@
+(*
+10.2 Bounded Queue Interface
+
+Presented below is the interface definition for the bounded form of
+queue described abstractly in Chapter 9.  The algorithmic complexity
+measure for each operation is supplied in Table 10.1.
+*)
+
+DEFINITION MODULE QSBMI;
+(*===========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+(*
+10.2.1 Type Declarations
+
+A queue is declared as the abstract data type, Queue.  In the bounded
+form presented here, a queue is limited to a maximum size of 8100
+items due to implementation constraints placed on us by the compiler.
+*)
+
+TYPE  Queue;
+TYPE  QueueSize = [1..8100];
+CONST NullQueue = Queue(NIL);
+
+
+(*
+10.2.2 Exceptions
+
+The ModuleID uniquely identifies this module from all others.
+
+QueueError returns the most recent queue exception, or noerr if the
+last operation was successful.  While SetHandler and GetHandler allow
+assignment and retrieval of exception handling routines for specific
+exceptions.
+*)
+
+CONST ModuleID = 13;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+(*
+10.2.3 Constructors
+
+All of the constructor interfaces directly match that given in Chapter 9
+on the queue abstraction. The exception is Create which accepts parameters
+describing the queue's data type and maximum size.
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+                       theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+
+(*
+10.2.4 Selectors
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+
+(*
+10.2.5 Iterators
+*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+END QSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBMI.MOD
@@ -0,0 +1,556 @@
+(*
+10.3 Bounded Queue Implementation
+*)
+
+IMPLEMENTATION MODULE QSBMI;
+(*==============================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc,
+               AccessProc, LoopAccessProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+10.3.1 Internal Bounded Queue Representation
+
+A dynamically created array of Items is created when a queue
+is created. The front of the queue is always accessible by the
+index [1].  The header record is used to hold the queue size limit,
+the current back index, data type id, and the dynamic array of items.
+Items are stored in a linear fashion within the array.  Figure 10.1,
+below, graphically depicts the internal structure used for the bounded
+queue:
+
+FIGURE 10.1
+
+Representation Invariants:
+Ñ MIN(QueueSize) ▓ size ▓ MAX(QueueSize)
+Ñ 0 ▓ back ▓ size
+Ñ the queue is empty when back is zero
+Ñ when not empty, the front of the queue is at items[MIN(QueueSize)]
+*)
+
+TYPE  ItemsArray   = ARRAY QueueSize OF Item;
+TYPE  BoundedQueue = RECORD
+        dataID : TypeID;     (*-- defined data type *)
+        size   : QueueSize;  (*-- maximum # of items *)
+        rear   : CARDINAL;   (*-- current # of items *)
+        items  : ItemsArray; (*-- array [1..size] of item *)
+      END (*-- BoundedQueue *);
+
+TYPE  Queue = POINTER TO BoundedQueue;
+
+    (*--------------------*)
+
+
+(*
+10.3.2 Exceptions
+
+queueError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+queueError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+10.3.6).
+
+QueueError simply returns the current exception result stored
+in queueError and is used to determine whether a queue operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+10.3.3 Constructors
+
+Create attempts to form a new, empty bounded queue object associated
+with the given data type ID and maximum size.  Only the specified
+number of entries given in theSize are actually allocated to the
+ItemsArray (items).  MacSystem.Allocate returns NIL if it is unable
+to successfully complete the allocation request whereupon the overflow
+exception is raised and the NullQueue returned.  If successful, the
+queue is initialized as follows before returning the new queue:
+Ñ theType is saved for later use by IsEqual,
+Ñ theSize is saved for later checking for queue overflow by Arrive and Assign, and
+Ñ rear is set to the empty queue state.  Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+                       theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, staticSize + itemSize * theSize);
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID := theType;
+      size   := theSize;
+      rear   := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theQueue rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullQueue).  Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, SIZE(theQueue^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theQueue's data type, if
+any, and proceeds to free each item in theQueue.  If theQueue is empty
+the loop is not executed as rear will be greater than the minimum
+QueueSize.  Lastly, rear is set to ensure theQueue is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      FOR index := MIN(QueueSize) TO rear DO
+        free(items[index]);
+      END (*--for*);
+      rear := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theQueue to the target queue, toQueue. An
+undefined source queue raised an exception and leaves the target unchanged.
+If the target queue is undefined, it is created with the same size and
+data type attributes of the source; otherwise the target queue is
+cleared of its presnet contents and its data type is altered to reflect
+that of the source.  If the target queue is capable of containing all
+of the items present in the source, Assign simply copies each item from
+the source to the target afterwards updating the target's rear value.
+Complexity: O(n).
+*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(dataID, size);
+      END (*--with*);
+    ELSIF (theQueue^.rear <= toQueue^.size) THEN
+      Clear(toQueue);
+      toQueue^.dataID := theQueue^.dataID;
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (queueError = noerr) THEN
+      WITH theQueue^ DO
+        assignment := AssignOf(dataID);
+        FOR index := MIN(QueueSize) TO rear DO
+          toQueue^.items[index] := assignment(items[index]);
+        END (*--for*);
+        toQueue^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to the rear of theQueue by advancing the rear index
+value and storing theItem at that location.  When the rear of theQueue
+is already at its maximum allowed size the exception overflow is raised
+and theQueue remains unchanged.  Likewise, given an undefined queue
+raises the exception of the same name.  Complexity: O(1).
+*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear < size) THEN
+        INC(rear);
+        items[rear] := theItem;
+      ELSE
+        RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front of theQueue by shifting all items
+down one position in the items array and deducting one from the rear
+index.  Before overwriting the item being removed, it's value is
+freed via the disposal routine of theQueue's data type.  If theQueue
+is empty on entry to Depart the underflow exception is raised and
+theQueue is not changed.  When theQueue is not defined, the undefined
+exception is raised.  Complexity: O(n).
+*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear = 0) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        free := DisposeOf(dataID);
+        free(items[MIN(QueueSize)]);
+        FOR index := MIN(QueueSize) + 1 TO rear DO
+          items[index - 1] := items[index];
+        END (*--for*);
+        DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+(*
+10.3.4 Selectors
+
+IsDefined verifies to the best of its ability whether theQueue has been
+created and is still an active object.  Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theQueue is in the empty state, as indicated by
+the rear being zero, and False otherwise.  As per the specification
+(section 9.?) undefined queues are considered empty.  Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right queues for equality, which in this
+context means they contain the same items and the same data type ID. The
+defined size of the queues is not relevant for the equality test.  Both
+queues must be defined and have the same data type ID; if they do not,
+then the exceptions undefined and typeerror are raised, respectively.
+Obviously, queues of different lengths (indicated by the value of rear)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both queues
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them.  Complexity: O(n).
+*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      compare : CompareProc;    (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+      compare := CompareOf(left^.dataID);
+      FOR index := MIN(QueueSize) TO rear DO
+        IF compare(items[index], right^.items[index]) # equal THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the rear index into the items array which is
+also the length of theQueue.  Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+SizeOf and TypeOf simply return the size and dataID for the given queue.
+Undefined queues, as always, raise the undefined exception and return
+reasonable values (zero and the NullType, respectively).  The complexity
+of both routines is O(1).
+*)
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the front of theQueue or
+the NullItem if theQueue is undefined or is empty.  Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.items[MIN(QueueSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+
+(*
+10.3.5 Iterators
+
+Both LoopOver and Traverse simply loop through each of the queue items
+from the front to the rear passing the item value to theProcess
+procedure parameter.  LoopOver may terminate before reaching the rear
+if theProcess returns False.  Complexity: O(n).
+*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theQueue^ DO
+      FOR index := MIN(QueueSize) TO rear DO
+        IF ~theProcess(items[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theQueue^ DO
+      FOR index := MIN(QueueSize) TO rear DO
+        theProcess(items[index]);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*
+10.3.6 Module Initialization
+
+The module's local variables are initialized to known states.
+queueError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.   Since a FOR
+loop control variable is undefined following the loop,
+queueError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QSBMI.
+
+(*
+
+References
+
+
+[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983.
+[2] G. Booch, Software Components with Ada, Structures, Tools, and Subsystems,
+    Benjamin/Cummings, Menlo Park, CA 1987.
+[3] R. Wiener and R. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBMN.DEF
@@ -0,0 +1,122 @@
+(*
+10.4 Non-Iterator Bounded Queue Interface
+
+Presented below is the interface definition for the bounded form of
+queue described abstractly in Chapter 9.
+*)
+
+DEFINITION MODULE QSBMN;
+(*===========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-Priority Non-Balking Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+(*
+10.4.1 Type Declarations
+
+A queue is declared as the abstract data type, Queue.  In the bounded
+form presented here, a queue is limited to a maximum size of 8100
+items due to implementation constraints placed on us by the compiler.
+*)
+
+TYPE  Queue;
+TYPE  QueueSize = [1..8100];
+CONST NullQueue = Queue(NIL);
+
+
+(*
+10.4.2 Exceptions
+
+The ModuleID uniquely identifies this module from all others.
+
+QueueError returns the most recent queue exception, or noerr if the
+last operation was successful.  While SetHandler and GetHandler allow
+assignment and retrieval of exception handling routines for specific
+exceptions.
+*)
+
+CONST ModuleID = 14;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+(*
+10.4.3 Constructors
+
+All of the constructor interfaces directly match that given in Chapter 9
+on the queue abstraction. The exception is Create which accepts parameters
+describing the queue's data type and maximum size.
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+                       theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+
+(*
+10.4.4 Selectors
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+END QSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBMN.MOD
@@ -0,0 +1,509 @@
+(*
+10.5 Non-Iterator Bounded Queue Implementation
+*)
+
+IMPLEMENTATION MODULE QSBMN;
+(*==============================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-Priority Non-Balking Sequential Bounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+10.5.1 Internal Bounded Queue Representation
+
+A dynamically created array of Items is created when a queue
+is created. The front of the queue is always accessible by the
+index [1].  The header record is used to hold the queue size limit,
+the current back index, data type id, and the dynamic array of items.
+Items are stored in a linear fashion within the array.  Figure 10.2,
+below, graphically depicts the internal structure used for the bounded
+queue:
+
+FIGURE 10.2
+
+Representation Invariants:
+Ñ MIN(QueueSize) <= size <= MAX(QueueSize)
+Ñ 0 <= back <= size
+Ñ the queue is empty when back is zero
+Ñ when not empty, the front of the queue is at items[MIN(QueueSize)]
+*)
+
+TYPE  ItemsArray   = ARRAY QueueSize OF Item;
+TYPE  BoundedQueue = RECORD
+        dataID : TypeID;     (*-- defined data type *)
+        size   : QueueSize;  (*-- maximum # of items *)
+        rear   : CARDINAL;   (*-- current # of items *)
+        items  : ItemsArray; (*-- array [1..size] of item *)
+      END (*-- BoundedQueue *);
+
+TYPE  Queue = POINTER TO BoundedQueue;
+
+    (*--------------------*)
+
+
+(*
+10.5.2 Exceptions
+
+queueError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+queueError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+10.5.5).
+
+QueueError simply returns the current exception result stored
+in queueError and is used to determine whether a queue operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+10.5.3 Constructors
+
+Create attempts to form a new, empty bounded queue object associated
+with the given data type ID and maximum size.  Only the specified
+number of entries given in theSize are actually allocated to the
+ItemsArray (items).  MacSystem.Allocate returns NIL if it is unable
+to successfully complete the allocation request whereupon the overflow
+exception is raised and the NullQueue returned.  If successful, the
+queue is initialized as follows before returning the new queue:
+Ñ theType is saved for later use by IsEqual,
+Ñ theSize is saved for later checking for queue overflow by Arrive and Assign, and
+Ñ rear is set to the empty queue state.  Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+                       theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, staticSize + itemSize * theSize);
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID := theType;
+      size   := theSize;
+      rear   := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theQueue rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullQueue).  Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, staticSize + itemSize * theQueue^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theQueue's data type, if
+any, and proceeds to free each item in theQueue.  If theQueue is empty
+the loop is not executed as rear will be greater than the minimum
+QueueSize.  Lastly, rear is set to ensure theQueue is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      FOR index := MIN(QueueSize) TO rear DO
+        free(items[index]);
+      END (*--for*);
+      rear := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theQueue to the target queue, toQueue. An
+undefined source queue raised an exception and leaves the target unchanged.
+If the target queue is undefined, it is created with the same size and
+data type attributes of the source; otherwise the target queue is
+cleared of its present contents and its data type is altered to reflect
+that of the source.  If the target queue is capable of containing all
+of the items present in the source, Assign simply copies each item from
+the source to the target afterwards updating the target's rear value.
+Complexity: O(n).
+*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(dataID, size);
+      END (*--with*);
+    ELSIF (theQueue^.rear <= toQueue^.size) THEN
+      Clear(toQueue);
+      toQueue^.dataID := theQueue^.dataID;
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (queueError = noerr) THEN
+      WITH theQueue^ DO
+        assignment := AssignOf(dataID);
+        FOR index := MIN(QueueSize) TO rear DO
+          toQueue^.items[index] := assignment(items[index]);
+        END (*--for*);
+        toQueue^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to the rear of theQueue by advancing the rear index
+value and storing theItem at that location.  When the rear of theQueue
+is already at its maximum allowed size the exception overflow is raised
+and theQueue remains unchanged.  Likewise, given an undefined queue
+raises the exception of the same name.  Complexity: O(1).
+*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear < size) THEN
+        INC(rear);
+        items[rear] := theItem;
+      ELSE
+        RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front of theQueue by shifting all items
+down one position in the items array and deducting one from the rear
+index.  Before overwriting the item being removed, it's value is
+freed via the disposal routine of theQueue's data type.  If theQueue
+is empty on entry to Depart the underflow exception is raised and
+theQueue is not changed.  When theQueue is not defined, the undefined
+exception is raised.  Complexity: O(n).
+*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear = 0) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        free := DisposeOf(dataID);
+        free(items[MIN(QueueSize)]);
+        FOR index := MIN(QueueSize) + 1 TO rear DO
+          items[index - 1] := items[index];
+        END (*--for*);
+        DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+(*
+10.5.4 Selectors
+
+IsDefined verifies to the best of its ability whether theQueue has been
+created and is still an active object.  Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theQueue is in the empty state, as indicated by
+the rear being zero, and False otherwise.  As per the specification
+(section 9.4) undefined queues are considered empty.  Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right queues for equality, which in this
+context means they contain the same items and the same data type ID. The
+defined size of the queues is not relevant for the equality test.  Both
+queues must be defined and have the same data type ID; if they do not,
+then the exceptions undefined and typeerror are raised, respectively.
+Obviously, queues of different lengths (indicated by the value of rear)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both queues
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them. Complexity: O(n).
+*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      compare : CompareProc;    (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+      compare := CompareOf(dataID);
+      FOR index := MIN(QueueSize) TO rear DO
+        IF compare(items[index], right^.items[index]) # equal THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the rear index into the items array which is
+also the length of theQueue.  Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+SizeOf and TypeOf simply return the size and dataID for the given queue.
+Undefined queues, as always, raise the undefined exception and return
+reasonable values (zero and the NullType, respectively).  The complexity
+of both routines is O(1).
+*)
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the front of theQueue or
+the NullItem if theQueue is undefined or is empty.  Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.items[MIN(QueueSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+
+(*
+10.5.5 Module Initialization
+
+The module's local variables are initialized to known states.
+queueError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.   Since a FOR
+loop control variable is undefined following the loop,
+queueError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QSBMN.
+
+(*
+
+References
+
+
+[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983.
+[2] G. Booch, Software Components with Ada, Structures, Tools, and Subsystems,
+    Benjamin/Cummings, Menlo Park, CA 1987.
+[3] R. Wiener and R. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986.
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBUI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBUI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBUI.DEF
@@ -0,0 +1,95 @@
+DEFINITION MODULE QSBUI;
+(*===========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Bounded Unmanaged Iterator
+
+    This module is designed for use with the basic data types
+    (e.g., INTEGERs, POINTERs to other structures) as data items.
+    You must type cast the generic Items to/from your basic data type.
+    Clear and Destroy now have O(1) complexity.
+    Refer to the QueueSBMI module for all other commentary.
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins:
+      Initial implementation derived from QueueSBMI module.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+    (*--------------------*)
+
+TYPE  Queue;
+TYPE  QueueSize = [1..8100];
+CONST NullQueue = Queue(NIL);
+
+    (*--------------------*)
+
+CONST ModuleID = 15;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+    (*--------------------*)
+
+PROCEDURE Create  (    theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+
+    (*--------------------*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+    (*--------------------*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+END QSBUI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBUI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBUI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBUI.MOD
@@ -0,0 +1,344 @@
+IMPLEMENTATION MODULE QSBUI;
+(*==============================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Bounded Unmanaged Iterator
+    Code Size: R-  bytes
+
+    This module is designed for use with the basic data types
+    (e.g., INTEGERs, POINTERs to other structures) as data items.
+    You must type cast the generic Items to/from your basic data type.
+    Refer to the QueueSBMI module for all other commentary.
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins:
+      Initial implementation derived from QueueSBMI module.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+    (*--------------------*)
+
+TYPE  ItemsArray   = ARRAY QueueSize OF Item;
+TYPE  BoundedQueue = RECORD
+        size   : QueueSize;  (*-- maximum # of items *)
+        rear   : CARDINAL;   (*-- current # of items *)
+        items  : ItemsArray; (*-- array [1..size] of item *)
+      END (*-- BoundedQueue *);
+
+TYPE  Queue = POINTER TO BoundedQueue;
+
+    (*--------------------*)
+
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*-- Constructors --*)
+
+PROCEDURE Create  (    theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, staticSize + itemSize * theSize);
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      size   := theSize;
+      rear   := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    Deallocate(theQueue, staticSize + itemSize * theQueue^.size);
+  ELSE
+    RaiseErrIn(destroy, undefined);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    theQueue^.rear := 0;
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;   (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(size);
+      END (*--with*);
+    ELSIF (theQueue^.rear <= toQueue^.size) THEN
+      Clear(toQueue);
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (queueError = noerr) THEN
+      WITH theQueue^ DO
+        FOR index := MIN(QueueSize) TO rear DO
+          toQueue^.items[index] := items[index];
+        END (*--for*);
+        toQueue^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear < size) THEN
+        INC(rear);
+        items[rear] := theItem;
+      ELSE
+        RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear = 0) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        FOR index := MIN(QueueSize) + 1 TO rear DO
+          items[index - 1] := items[index];
+        END (*--for*);
+        DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+(*-- Selectors --*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+      FOR index := MIN(QueueSize) TO rear DO
+        IF (items[index] # right^.items[index]) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.items[MIN(QueueSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+
+(*-- Iterators --*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theQueue^ DO
+      FOR index := MIN(QueueSize) TO rear DO
+        IF ~theProcess(items[index]) THEN
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theQueue^ DO
+      FOR index := MIN(QueueSize) TO rear DO
+        theProcess(items[index]);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*-- Module Initialization --*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QSBUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBUN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBUN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBUN.DEF
@@ -0,0 +1,80 @@
+DEFINITION MODULE QSBUN;
+(*===========================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-Priority Non-Balking Sequential Bounded Unmanaged Non-Iterator
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+    (*--------------------*)
+
+TYPE  Queue;
+TYPE  QueueSize = [1..8100];
+CONST NullQueue = Queue(NIL);
+
+    (*--------------------*)
+
+CONST ModuleID = 16;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+    (*--------------------*)
+
+PROCEDURE Create  (    theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+    (*--------------------*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+END QSBUN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBUN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBUN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSBUN.MOD
@@ -0,0 +1,288 @@
+IMPLEMENTATION MODULE QSBUN;
+(*==============================================================
+    Version  : 1.00  18 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-Priority Non-Balking Sequential Bounded Unmanaged Non-Iterator
+
+    REVISION HISTORY
+    v1.00  18 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+    (*--------------------*)
+
+TYPE  ItemsArray   = ARRAY QueueSize OF Item;
+TYPE  BoundedQueue = RECORD
+        size   : QueueSize;  (*-- maximum # of items *)
+        rear   : CARDINAL;   (*-- current # of items *)
+        items  : ItemsArray; (*-- array [1..size] of item *)
+      END (*-- BoundedQueue *);
+
+TYPE  Queue = POINTER TO BoundedQueue;
+
+    (*--------------------*)
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+PROCEDURE Create  (    theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, staticSize + itemSize * theSize);
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      size   := theSize;
+      rear   := 0;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+CONST staticSize = SIZE(BoundedQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, staticSize + itemSize * theQueue^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      rear := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(size);
+      END (*--with*);
+    ELSIF (theQueue^.rear <= toQueue^.size) THEN
+      Clear(toQueue);
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (queueError = noerr) THEN
+      WITH theQueue^ DO
+        FOR index := MIN(QueueSize) TO rear DO
+          toQueue^.items[index] := items[index];
+        END (*--for*);
+        toQueue^.rear := rear;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear < size) THEN
+        INC(rear);
+        items[rear] := theItem;
+      ELSE
+        RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (rear = 0) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        FOR index := MIN(QueueSize) + 1 TO rear DO
+          items[index - 1] := items[index];
+        END (*--for*);
+        DEC(rear);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.rear = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.rear = right^.rear) THEN
+    WITH left^ DO
+      FOR index := MIN(QueueSize) TO rear DO
+        IF (items[index] # right^.items[index]) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+      RETURN TRUE;
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.rear;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.rear = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.items[MIN(QueueSize)];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QSBUN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCMI.DEF
@@ -0,0 +1,100 @@
+DEFINITION MODULE QSCMI;
+(*===========================================================
+    Version  : 1.00  19 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Circular Managed Iterator
+
+    REVISION HISTORY
+    v1.00  19 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+
+TYPE  Queue;
+TYPE  QueueSize = [1..8100];
+CONST NullQueue = Queue(NIL);
+
+    (*--------------------*)
+
+
+CONST ModuleID = 17;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+    (*--------------------*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+                       theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (    theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (    theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (    theQueue : Queue     (*-- inout *));
+
+
+    (*--------------------*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+
+    (*--------------------*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+END QSCMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCMI.MOD
@@ -0,0 +1,408 @@
+IMPLEMENTATION MODULE QSCMI;
+(*==============================================================
+    Version  : 1.00  19 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Circular Managed Iterator
+
+    REVISION HISTORY
+    v1.00  19 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc,
+               AccessProc, LoopAccessProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+
+TYPE  ItemsArray   = ARRAY QueueSize OF Item;
+TYPE  CircularQueue = RECORD
+        dataID : TypeID;     (*-- defined data type *)
+        size   : QueueSize;  (*-- maximum # of items *)
+        length : CARDINAL;   (*-- current # of items *)
+        front  : CARDINAL;   (*-- current head of the queue *)
+        items  : ItemsArray; (*-- array [1..size] of item *)
+      END (*-- CircularQueue *);
+
+TYPE  Queue = POINTER TO CircularQueue;
+
+    (*--------------------*)
+
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+                       theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+CONST staticSize = SIZE(CircularQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, staticSize + itemSize * theSize);
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID := theType;
+      size   := theSize;
+      length := 0;
+      front  := MIN(QueueSize);
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+CONST staticSize = SIZE(CircularQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, staticSize + itemSize * theQueue^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (    theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      back  : CARDINAL;    (*-- where the queue ends *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      index:= front;
+      back := (front+length) MOD size;
+      WHILE (index # back) DO
+        free(items[index]);
+        index := (index+1) MOD size;
+      END (*--while*);
+      length := 0;
+      front  := MIN(QueueSize);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      fromIndex  : CARDINAL;   (*-- index into source queue *)
+      toIndex    : CARDINAL;   (*-- index into target queue *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(dataID, size);
+      END (*--with*);
+    ELSIF (theQueue^.length <= toQueue^.size) THEN
+      Clear(toQueue);
+      toQueue^.dataID := theQueue^.dataID;
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (queueError = noerr) THEN
+      WITH theQueue^ DO
+        assignment := AssignOf(dataID);
+        fromIndex  := front;
+        toIndex    := toQueue^.front;
+        FOR index := MIN(QueueSize) TO length DO
+          toQueue^.items[toIndex] := assignment(items[fromIndex]);
+          fromIndex := (fromIndex+1) MOD size;
+          toIndex   := (toIndex+1) MOD toQueue^.size;
+        END (*--for*);
+        toQueue^.length := length;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (    theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (length < size) THEN
+        items[(front+length) MOD size] := theItem;
+        INC(length);
+      ELSE
+        RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (    theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (length = 0) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        free := DisposeOf(dataID);
+        free(items[front]);
+        front := (front+1) MOD size;
+        DEC(length);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.length = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : CARDINAL; (*-- loop index left queue items *)
+      rightIndex: CARDINAL; (*-- loop index right queue items *)
+      leftBack  : CARDINAL; (*-- where left queue ends *)
+      rightBack : CARDINAL; (*-- where right queue ends *)
+      compare   : CompareProc;  (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+
+    WITH left^ DO
+      leftIndex  := front;
+      leftBack   := (front + length) MOD size;
+    END (*--with*);
+
+    WITH right^ DO
+      rightIndex := front;
+      rightBack  := (front + length) MOD size;
+    END (*--with*);
+
+    WITH left^ DO
+      compare := CompareOf(dataID);
+      WHILE (leftIndex # leftBack) & (rightIndex # rightBack) DO
+        IF compare(items[leftIndex], right^.items[rightIndex]) # equal THEN
+          RETURN FALSE;
+        END (*--if*);
+        leftIndex  := (leftIndex + 1) MOD size;
+        rightIndex := (rightIndex + 1) MOD right^.size;
+      END (*--while*);
+      RETURN (leftIndex = leftBack) & (rightIndex = rightBack);
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.length = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.items[theQueue^.front];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      back  : CARDINAL; (*-- where the queue ends *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theQueue^ DO
+      index:= front;
+      back := (front+length) MOD size;
+      WHILE (index # back) DO
+        IF ~theProcess(items[index]) THEN
+          RETURN;
+        END (*--if*);
+        index := (index+1) MOD size;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      back  : CARDINAL; (*-- where the queue ends *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theQueue^ DO
+      index:= front;
+      back := (front+length) MOD size;
+      WHILE (index # back) DO
+        theProcess(items[index]);
+        index := (index+1) MOD size;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QSCMI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCMN.DEF
@@ -0,0 +1,91 @@
+DEFINITION MODULE QSCMN;
+(*===========================================================
+    Version  : 1.00  19 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Circular Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  19 May 1989  C. Lins:
+      Initial implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+
+TYPE  Queue;
+TYPE  QueueSize = [1..8100];
+CONST NullQueue = Queue(NIL);
+
+    (*--------------------*)
+
+
+CONST ModuleID = 18;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+    (*--------------------*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+                       theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (    theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (    theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (    theQueue : Queue     (*-- inout *));
+
+
+    (*--------------------*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+END QSCMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCMN.MOD
@@ -0,0 +1,358 @@
+IMPLEMENTATION MODULE QSCMN;
+(*==============================================================
+    Version  : 1.00  19 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Circular Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  19 May 1989  C. Lins:
+      Initial implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+
+TYPE  ItemsArray   = ARRAY QueueSize OF Item;
+TYPE  CircularQueue = RECORD
+        dataID : TypeID;     (*-- defined data type *)
+        size   : QueueSize;  (*-- maximum # of items *)
+        length : CARDINAL;   (*-- current # of items *)
+        front  : CARDINAL;   (*-- current head of the queue *)
+        items  : ItemsArray; (*-- array [1..size] of item *)
+      END (*-- CircularQueue *);
+
+TYPE  Queue = POINTER TO CircularQueue;
+
+    (*--------------------*)
+
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+                       theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+CONST staticSize = SIZE(CircularQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, staticSize + itemSize * theSize);
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID := theType;
+      size   := theSize;
+      length := 0;
+      front  := MIN(QueueSize);
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+CONST staticSize = SIZE(CircularQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, staticSize + itemSize * theQueue^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (    theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      back  : CARDINAL;    (*-- where the queue ends *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      index:= front;
+      back := (front+length) MOD size;
+      WHILE (index # back) DO
+        free(items[index]);
+        index := (index+1) MOD size;
+      END (*--while*);
+      length := 0;
+      front  := MIN(QueueSize);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      fromIndex  : CARDINAL;   (*-- index into source queue *)
+      toIndex    : CARDINAL;   (*-- index into target queue *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(dataID, size);
+      END (*--with*);
+    ELSIF (theQueue^.length <= toQueue^.size) THEN
+      Clear(toQueue);
+      toQueue^.dataID := theQueue^.dataID;
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (queueError = noerr) THEN
+      WITH theQueue^ DO
+        assignment := AssignOf(dataID);
+        fromIndex  := front;
+        toIndex    := toQueue^.front;
+        FOR index := MIN(QueueSize) TO length DO
+          toQueue^.items[toIndex] := assignment(items[fromIndex]);
+          fromIndex := (fromIndex+1) MOD size;
+          toIndex   := (toIndex+1) MOD toQueue^.size;
+        END (*--for*);
+        toQueue^.length := length;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (    theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (length < size) THEN
+        items[(front+length) MOD size] := theItem;
+        INC(length);
+      ELSE
+        RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (    theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+      free  : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (length = 0) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        free := DisposeOf(dataID);
+        free(items[front]);
+        front := (front+1) MOD size;
+        DEC(length);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.length = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : CARDINAL; (*-- loop index left queue items *)
+      rightIndex: CARDINAL; (*-- loop index right queue items *)
+      leftBack  : CARDINAL; (*-- where left queue ends *)
+      rightBack : CARDINAL; (*-- where right queue ends *)
+      compare   : CompareProc;  (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+
+    WITH left^ DO
+      leftIndex  := front;
+      leftBack   := (front + length) MOD size;
+    END (*--with*);
+
+    WITH right^ DO
+      rightIndex := front;
+      rightBack  := (front + length) MOD size;
+    END (*--with*);
+
+    WITH left^ DO
+      compare := CompareOf(dataID);
+      WHILE (leftIndex # leftBack) & (rightIndex # rightBack) DO
+        IF compare(items[leftIndex], right^.items[rightIndex]) # equal THEN
+          RETURN FALSE;
+        END (*--if*);
+        leftIndex  := (leftIndex + 1) MOD size;
+        rightIndex := (rightIndex + 1) MOD right^.size;
+      END (*--while*);
+      RETURN (leftIndex = leftBack) & (rightIndex = rightBack);
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.length = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.items[theQueue^.front];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QSCMN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCUI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCUI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCUI.DEF
@@ -0,0 +1,104 @@
+DEFINITION MODULE QSCUI;
+(*===========================================================
+    Version  : 1.00  19 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Circular Unmanaged Iterator
+
+    TypeID is used only for comparison of queue types in IsEqual.
+    Items are copied using simple assignment and they are never
+    disposed.
+
+    REVISION HISTORY
+    v1.00  19 May 1989  C. Lins:
+      Implemented based on QueueSCMI module.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+
+TYPE  Queue;
+TYPE  QueueSize = [1..8100];
+CONST NullQueue = Queue(NIL);
+
+    (*--------------------*)
+
+
+CONST ModuleID = 23;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+    (*--------------------*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+                       theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (    theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (    theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (    theQueue : Queue     (*-- inout *));
+
+
+    (*--------------------*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+
+    (*--------------------*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+END QSCUI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCUI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCUI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCUI.MOD
@@ -0,0 +1,384 @@
+IMPLEMENTATION MODULE QSCUI;
+(*==============================================================
+    Version  : 1.00  19 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Circular Unmanaged Iterator
+
+    REVISION HISTORY
+    v1.00  19 May 1989  C. Lins:
+      Implemented based on QueueSCMI module.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+
+TYPE  ItemsArray    = ARRAY QueueSize OF Item;
+TYPE  CircularQueue = RECORD
+        dataID : TypeID;     (*-- defined data type *)
+        size   : QueueSize;  (*-- maximum # of items *)
+        length : CARDINAL;   (*-- current # of items *)
+        front  : CARDINAL;   (*-- current head of the queue *)
+        items  : ItemsArray; (*-- array [1..size] of item *)
+      END (*-- CircularQueue *);
+
+TYPE  Queue = POINTER TO CircularQueue;
+
+    (*--------------------*)
+
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+                       theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+CONST staticSize = SIZE(CircularQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, staticSize + itemSize * theSize);
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID := theType;
+      size   := theSize;
+      length := 0;
+      front  := MIN(QueueSize);
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+CONST staticSize = SIZE(CircularQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, staticSize + itemSize * theQueue^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (    theQueue : Queue     (*-- inout *));
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      length := 0;
+      front  := MIN(QueueSize);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      fromIndex  : CARDINAL;   (*-- index into source queue *)
+      toIndex    : CARDINAL;   (*-- index into target queue *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(dataID, size);
+      END (*--with*);
+    ELSIF (theQueue^.length <= theQueue^.size) THEN
+      Clear(toQueue);
+      toQueue^.dataID := theQueue^.dataID;
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (queueError = noerr) THEN
+      WITH theQueue^ DO
+        fromIndex  := front;
+        toIndex    := toQueue^.front;
+        FOR index := MIN(QueueSize) TO length DO
+          toQueue^.items[toIndex] := items[fromIndex];
+          fromIndex := (fromIndex+1) MOD size;
+          toIndex   := (toIndex+1) MOD toQueue^.size;
+        END (*--for*);
+        toQueue^.length := length;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (    theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (length < size) THEN
+        items[(front+length) MOD size] := theItem;
+        INC(length);
+      ELSE
+        RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (    theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (length = 0) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        front := (front+1) MOD size;
+        DEC(length);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.length = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : CARDINAL; (*-- loop index left queue items *)
+      rightIndex: CARDINAL; (*-- loop index right queue items *)
+      leftBack  : CARDINAL; (*-- where left queue ends *)
+      rightBack : CARDINAL; (*-- where right queue ends *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+
+    WITH left^ DO
+      leftIndex  := front;
+      leftBack   := (front + length) MOD size;
+    END (*--with*);
+
+    WITH right^ DO
+      rightIndex := front;
+      rightBack  := (front + length) MOD size;
+    END (*--with*);
+
+    WITH left^ DO
+      WHILE (leftIndex # leftBack) & (rightIndex # rightBack) DO
+        IF (items[leftIndex] # right^.items[rightIndex]) THEN
+          RETURN FALSE;
+        END (*--if*);
+        leftIndex  := (leftIndex + 1) MOD size;
+        rightIndex := (rightIndex + 1) MOD right^.size;
+      END (*--while*);
+      RETURN (leftIndex = leftBack) & (rightIndex = rightBack);
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.length = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.items[theQueue^.front];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      back  : CARDINAL; (*-- where the queue ends *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theQueue^ DO
+      index:= front;
+      back := (front+length) MOD size;
+      WHILE (index # back) DO
+        IF ~theProcess(items[index]) THEN
+          RETURN;
+        END (*--if*);
+        index := (index+1) MOD size;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items *)
+      back  : CARDINAL; (*-- where the queue ends *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theQueue^ DO
+      index:= front;
+      back := (front+length) MOD size;
+      WHILE (index # back) DO
+        theProcess(items[index]);
+        index := (index+1) MOD size;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QSCUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCUN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCUN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCUN.DEF
@@ -0,0 +1,95 @@
+DEFINITION MODULE QSCUN;
+(*===========================================================
+    Version  : 1.00  19 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Circular Unmanaged Non-Iterator
+
+    TypeID is used only for comparison of queue types in IsEqual.
+    Items are copied using simple assignment and they are never
+    disposed.
+
+    REVISION HISTORY
+    v1.00  19 May 1989  C. Lins:
+      Implemented based on QueueSCMI module.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+
+TYPE  Queue;
+TYPE  QueueSize = [1..8100];
+CONST NullQueue = Queue(NIL);
+
+    (*--------------------*)
+
+
+CONST ModuleID = 24;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+    (*--------------------*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+                       theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (    theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (    theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (    theQueue : Queue     (*-- inout *));
+
+
+    (*--------------------*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+END QSCUN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCUN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCUN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSCUN.MOD
@@ -0,0 +1,336 @@
+IMPLEMENTATION MODULE QSCUN;
+(*==============================================================
+    Version  : 1.00  19 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2 Compiler
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Circular Unmanaged Non-Iterator
+
+    REVISION HISTORY
+    v1.00  19 May 1989  C. Lins:
+      Implemented based on QueueSCMI module.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+
+TYPE  ItemsArray    = ARRAY QueueSize OF Item;
+TYPE  CircularQueue = RECORD
+        dataID : TypeID;     (*-- defined data type *)
+        size   : QueueSize;  (*-- maximum # of items *)
+        length : CARDINAL;   (*-- current # of items *)
+        front  : CARDINAL;   (*-- current head of the queue *)
+        items  : ItemsArray; (*-- array [1..size] of item *)
+      END (*-- CircularQueue *);
+
+TYPE  Queue = POINTER TO CircularQueue;
+
+    (*--------------------*)
+
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *);
+                       theSize  : QueueSize (*-- in    *))
+                                : Queue     (*-- out   *);
+
+CONST staticSize = SIZE(CircularQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, staticSize + itemSize * theSize);
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID := theType;
+      size   := theSize;
+      length := 0;
+      front  := MIN(QueueSize);
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+CONST staticSize = SIZE(CircularQueue) - SIZE(ItemsArray);
+CONST itemSize   = SIZE(Item);
+
+VAR   newQueue : Queue;
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, staticSize + itemSize * theQueue^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (    theQueue : Queue     (*-- inout *));
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      length := 0;
+      front  := MIN(QueueSize);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   index      : CARDINAL;   (*-- loop index over items *)
+      fromIndex  : CARDINAL;   (*-- index into source queue *)
+      toIndex    : CARDINAL;   (*-- index into target queue *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      WITH theQueue^ DO
+        toQueue := Create(dataID, size);
+      END (*--with*);
+    ELSIF (theQueue^.length <= toQueue^.size) THEN
+      Clear(toQueue);
+      toQueue^.dataID := theQueue^.dataID;
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    IF (queueError = noerr) THEN
+      WITH theQueue^ DO
+        fromIndex  := front;
+        toIndex    := toQueue^.front;
+        FOR index := MIN(QueueSize) TO length DO
+          toQueue^.items[toIndex] := items[fromIndex];
+          fromIndex := (fromIndex+1) MOD size;
+          toIndex   := (toIndex+1) MOD toQueue^.size;
+        END (*--for*);
+        toQueue^.length := length;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (    theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (length < size) THEN
+        items[(front+length) MOD size] := theItem;
+        INC(length);
+      ELSE
+        RaiseErrIn(arrive, overflow);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (    theQueue : Queue     (*-- inout *));
+
+VAR   index : CARDINAL;    (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (length = 0) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        front := (front+1) MOD size;
+        DEC(length);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.length = 0);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : CARDINAL; (*-- loop index left queue items *)
+      rightIndex: CARDINAL; (*-- loop index right queue items *)
+      leftBack  : CARDINAL; (*-- where left queue ends *)
+      rightBack : CARDINAL; (*-- where right queue ends *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+
+    WITH left^ DO
+      leftIndex  := front;
+      leftBack   := (front + length) MOD size;
+    END (*--with*);
+
+    WITH right^ DO
+      rightIndex := front;
+      rightBack  := (front + length) MOD size;
+    END (*--with*);
+
+    WITH left^ DO
+      WHILE (leftIndex # leftBack) & (rightIndex # rightBack) DO
+        IF (items[leftIndex] # right^.items[rightIndex]) THEN
+          RETURN FALSE;
+        END (*--if*);
+        leftIndex  := (leftIndex + 1) MOD size;
+        rightIndex := (rightIndex + 1) MOD right^.size;
+      END (*--while*);
+      RETURN (leftIndex = leftBack) & (rightIndex = rightBack);
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.length = 0) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.items[theQueue^.front];
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QSCUN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUMI.DEF
@@ -0,0 +1,125 @@
+(*
+11.1 The Unbounded Queue Interface
+
+Now that the bounded queue form has been covered, let us move on to the
+unbounded form.  The only difference between the two interface definitions
+is the description of the constructor Create which does not require a size
+parameter as did the bounded form.  Table 11.1 summarizes the time complexity
+for each of the unbounded queue operations.
+*)
+
+DEFINITION MODULE QSUMI;
+(*===========================================================
+    Version  : 1.00  03 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  03 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+(*
+11.1.1 Type Declarations
+
+A queue is declared as the abstract data type, Queue.
+*)
+
+TYPE  Queue;
+CONST NullQueue = Queue(NIL);
+
+
+(*
+11.1.2 Exceptions
+
+The ModuleID uniquely identifies this module from all others.
+
+QueueError returns the most recent queue exception, or noerr if the
+last operation was successful.  While SetHandler and GetHandler allow
+assignment and retrieval of exception handling routines for specific
+exceptions.
+*)
+
+CONST ModuleID = 19;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+(*
+11.1.3 Constructors
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *))
+                                : Queue     (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+
+(*
+11.1.4 Selectors
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+
+(*
+11.1.5 Iterators
+*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+END QSUMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUMI.MOD
@@ -0,0 +1,604 @@
+(*
+11.2 Unbounded Queue Implementation
+*)
+
+IMPLEMENTATION MODULE QSUMI;
+(*==============================================================
+    Version  : 1.00  03 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  03 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc,
+               AccessProc, LoopAccessProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+11.2.1 Internal Unbounded Queue Representation
+
+Uses a linked list of nodes with a header, containing pointers
+to the front and the back.  The second pointer isn't absolutely
+necessary.  To add an item to the queue, the list could be
+traversed from the front until the end is reachedand then the
+item added.  For efficiency reasons, the back pointer is used
+so items can be added directly, making the traversal unnecessary.
+Instead of O(n) time complexity, insertion is O(1).
+    
+By convention, an empty queue will be represented by both the
+front and back pointers being NIL.
+
+Figure 11.1,
+below, graphically depicts the internal structure used for the
+unbounded queue:
+
+FIGURE 11.1
+
+Representation Invariants:
+Ñ an empty queue is repesented by length = 0, head = NIL, and tail = NIL
+Ñ when there is one item in the queue, length = 1, head = tail ¡ NIL
+*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD
+        item : Item; (*-- item data *)
+        next : Link; (*-- link to next node *)
+      END (*-- Node *);
+
+TYPE  UnboundedQueue = RECORD
+        dataID : TypeID;     (*-- defined data type *)
+        length : CARDINAL;   (*-- current # of items *)
+        head   : Link;       (*-- pointer to first item *)
+        tail   : Link;       (*-- pointer to last item *)
+      END (*-- UnboundedQueue *);
+
+TYPE  Queue = POINTER TO UnboundedQueue;
+
+    (*--------------------*)
+
+
+(*
+11.2.2 Exceptions
+
+queueError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+queueError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+11.2.6).
+
+QueueError simply returns the current exception result stored
+in queueError and is used to determine whether a queue operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+11.2.3 Constructors
+
+Create attempts to form a new, empty unbounded queue object associated
+with the given data type ID.  MacSystem.Allocate returns NIL if it is
+unable to successfully complete the allocation request whereupon the
+overflow exception is raised and the NullQueue returned.
+If successful, the
+queue is initialized as follows before returning the new queue:
+Ñ theType is saved for later use by IsEqual, Assign, and Clear
+Ñ the head and tail links are set to the empty queue state (NIL),
+Ñ the current length is set to the empty queue state (zero).
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *))
+                                : Queue     (*-- out   *);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, SIZE(UnboundedQueue));
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID := theType;
+      length := 0;
+      head   := NIL;
+      tail   := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theQueue rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullQueue).  Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, SIZE(theQueue^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theQueue's data type, if
+any, and proceeds to free each item in theQueue.  If theQueue is empty
+the loop is not executed as head already be NIL.  Lastly, tail and
+length are set to ensure theQueue is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- item node to deallocate *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      WHILE (head # NIL) DO
+        oldHead := head;
+        head    := head^.next;
+        free(oldHead^.item);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      tail   := NIL;
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theQueue to the target queue, toQueue. An
+undefined source queue raises an exception and leaves the target unchanged.
+If the target queue is undefined, it is created with the same
+data type attribute of the source; otherwise the target queue is
+cleared of its present contents and its data type is altered to reflect
+that of the source.  Essentially, Assign traverses the links of the
+source queue copying items to new nodes created in the target queue.
+If a new node cannot be allocated the overflow exception is raised and
+the routine is aborted.  Complexity: O(n).
+*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   fromIndex  : Link;       (*-- loop index over source nodes *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      toQueue := Create(theQueue^.dataID);
+    ELSE
+      Clear(toQueue);
+      toQueue^.dataID := theQueue^.dataID;
+    END (*--if*);
+    IF (queueError = noerr) & (theQueue^.head # NIL) THEN
+      assignment := AssignOf(theQueue^.dataID);
+      Allocate(toQueue^.head, SIZE(Node));
+      IF (toQueue^.head = NIL) THEN
+        RaiseErrIn(assign, overflow);
+      ELSE
+        WITH toQueue^ DO
+          WITH head^ DO
+            item := assignment(theQueue^.head^.item);
+            next := NIL;
+          END (*--with*);
+          fromIndex := theQueue^.head;
+          tail := head;
+          WHILE (fromIndex^.next # NIL) DO
+            fromIndex := fromIndex^.next;
+            WITH tail^ DO
+              Allocate(next, SIZE(Node));
+              IF (next = NIL) THEN
+                RaiseErrIn(assign, overflow);
+                RETURN;
+              END (*--if*);
+              next^.item := assignment(fromIndex^.item);
+              next^.next := NIL;
+            END (*--with*);
+            tail := tail^.next;
+          END (*--while*);
+          length := theQueue^.length;
+        END (*--with*);
+      END (*--if*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to the rear of theQueue by first allocating a new
+node, storing theItem in that node and then update the links head
+and tail, and the queue length. Note that tail will always point to
+the new node upon successful completion of the routine.
+When the node cannot be allocated the exception overflow is raised
+and theQueue remains unchanged.  Likewise, given an undefined queue
+raises the exception of the same name.  Complexity: O(1).
+*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   newNode : Link; (*-- temporary for new node *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+        item := theItem;
+        next := NIL;
+      END (*--with*);
+      WITH theQueue^ DO
+        INC(length);
+        IF (head = NIL) THEN
+          head := newNode;
+        ELSE
+          tail^.next := newNode;
+        END (*--if*);
+        tail := newNode;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front of theQueue by relinking the
+successor to the current queue head as the new head.  The departing
+item is freed via the disposal routine of theQueue's data type before
+actually releasing the old head node itself.
+
+If theQueue is empty on entry to Depart the underflow exception is
+raised and theQueue is not changed.  When theQueue is not defined,
+the undefined exception is raised.  Complexity: O(1).
+*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- original head, departing *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (tail = NIL) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        oldHead := head;
+        head    := head^.next;
+        IF (head = NIL) THEN
+          tail := NIL;
+        END (*--if*);
+        DEC(length);
+        free := DisposeOf(dataID);
+        free(oldHead^.item);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+(*
+11.2.4 Selectors
+
+IsDefined verifies to the best of its ability whether theQueue has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theQueue is in the empty state, as indicated by
+the head being NIL, and False otherwise.  As per the specification
+(section 9.?) undefined queues are considered empty.  Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right queues for equality, which in this
+context means they contain the same items and the same data type ID.
+Both queues must be defined and have the same data type ID; if they 
+do not, then the exceptions undefined and typeerror are raised,
+respectively.
+Obviously, queues of different lengths (indicated by the lengths)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both queues
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them. Note that
+because the lengths are equal, both index links will become NIL
+simultaneously.  Complexity: O(n).
+*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- loop index over left items *)
+      rightIndex: Link; (*-- loop index over right items *)
+      compare : CompareProc;    (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+    compare := CompareOf(left^.dataID);
+    leftIndex := left^.head;
+    rightIndex:= right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF compare(leftIndex^.item, rightIndex^.item) # equal THEN
+        RETURN FALSE;
+      END (*--if*);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    END (*--while*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the length of theQueue.  Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+TypeOf simply returns the dataID for the given queue.
+Undefined queues, as always, raise the undefined exception and return
+a reasonable value (the NullType).  Complexity: O(1).
+*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the head of theQueue or
+the NullItem if theQueue is undefined or is empty.  Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+
+(*
+11.2.5 Iterators
+
+Both LoopOver and Traverse simply loop through each of the queue items
+from the head to the tail passing the item value to theProcess
+procedure parameter.  LoopOver may terminate before reaching the tail
+if theProcess returns False.  Complexity: O(n).
+*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theQueue^ DO
+      index := head;
+      WHILE (index # NIL) DO
+        IF ~theProcess(index^.item) THEN
+          RETURN;
+        END (*--if*);
+        index := index^.next;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theQueue^ DO
+      index := head;
+      WHILE (index # NIL) DO
+        theProcess(index^.item);
+        index := index^.next;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*
+11.2.6 Module Initialization
+
+The module's local variables are initialized to known states.
+queueError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR
+loop control variable is undefined following the loop,
+queueError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QSUMI.
+
+(*
+References
+
+
+[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983, pp. 56-60.
+[2] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+    Benjamin/Cummings, Menlo Park, CA 1987, pp. 92-93, 142-153.
+[3] K. John Gough, ╥Writing Generic Utilities in Modula-2╙, Journal of
+    Pascal, Ada, and Modula-2, Vol. 5(3), (May/June 1986), pp 53-62.
+[4] T.A. Standish, Data Structure Techniques, Chapter 2: Stacks and Queues,
+    Addison-Wesley, Reading, MA 1980, pp. 20-23, 28-32.
+[5] R.S. Wiener and G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons, New York, NY 1985, pp. 247-253
+[6] R.S. Wiener and R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986, pp. 69-71
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUMN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUMN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUMN.DEF
@@ -0,0 +1,114 @@
+(*
+11.3 The Unbounded Queue Interface
+
+Now that the bounded queue form has been covered, let us move on to the
+unbounded form.  The only difference between the two interface definitions
+is the description of the constructor Create which does not require a size
+parameter as did the bounded form. From the iterator form the only difference
+is the removal of the two iterator routines from the interface and implementation.
+*)
+
+DEFINITION MODULE QSUMN;
+(*===========================================================
+    Version  : 1.00  03 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Unbounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  03 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+    (*--------------------*)
+
+(*
+11.3.1 Type Declarations
+
+A queue is declared as the abstract data type, Queue.
+*)
+
+TYPE  Queue;
+CONST NullQueue = Queue(NIL);
+
+
+(*
+11.3.2 Exceptions
+
+The ModuleID uniquely identifies this module from all others.
+
+QueueError returns the most recent queue exception, or noerr if the
+last operation was successful.  While SetHandler and GetHandler allow
+assignment and retrieval of exception handling routines for specific
+exceptions.
+*)
+
+CONST ModuleID = 20;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+(*
+11.3.3 Constructors
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *))
+                                : Queue     (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+
+(*
+11.3.4 Selectors
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+END QSUMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUMN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUMN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUMN.MOD
@@ -0,0 +1,549 @@
+(*
+11.4 Unbounded Queue Implementation
+*)
+
+IMPLEMENTATION MODULE QSUMN;
+(*==============================================================
+    Version  : 1.00  03 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-Priority Non-Balking Sequential Unbounded Managed Non-Iterator
+
+    REVISION HISTORY
+    v1.00  03 May 1989 C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc, CompareProc;
+
+FROM Relations IMPORT
+    (*--Type*) Relation;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*--------------------*)
+
+(*
+11.4.1 Internal Unbounded Queue Representation
+
+Uses a linked list of nodes with a header, containing pointers
+to the front and the back.  The second pointer isn't absolutely
+necessary.  To add an item to the queue, the list could be
+traversed from the front until the end is reachedand then the
+item added.  For efficiency reasons, the back pointer is used
+so items can be added directly, making the traversal unnecessary.
+Instead of O(n) time complexity, insertion is O(1).
+    
+By convention, an empty queue will be represented by both the
+front and back pointers being NIL.
+
+Figure 11.2,
+below, graphically depicts the internal structure used for the
+unbounded queue:
+
+FIGURE 11.2
+
+Representation Invariants:
+Ñ an empty queue is repesented by length = 0, head = NIL, and tail = NIL
+Ñ when there is one item in the queue, length = 1, head = tail ¡ NIL
+*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD
+        item : Item; (*-- item data *)
+        next : Link; (*-- link to next node *)
+      END (*-- Node *);
+
+TYPE  UnboundedQueue = RECORD
+        dataID : TypeID;     (*-- defined data type *)
+        length : CARDINAL;   (*-- current # of items *)
+        head   : Link;       (*-- pointer to first item *)
+        tail   : Link;       (*-- pointer to last item *)
+      END (*-- UnboundedQueue *);
+
+TYPE  Queue = POINTER TO UnboundedQueue;
+
+    (*--------------------*)
+
+
+(*
+11.4.2 Exceptions
+
+queueError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+queueError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+11.4.5).
+
+QueueError simply returns the current exception result stored
+in queueError and is used to determine whether a queue operation
+completed successfully.  SetHandler makes theHandler the current
+exception handler for theError, while GetHandler returns the
+current exception handler.
+*)
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+11.4.3 Constructors
+
+Create attempts to form a new, empty unbounded queue object associated
+with the given data type ID.  MacSystem.Allocate returns NIL if it is
+unable to successfully complete the allocation request whereupon the
+overflow exception is raised and the NullQueue returned.
+If successful, the
+queue is initialized as follows before returning the new queue:
+Ñ theType is saved for later use by IsEqual, Assign, and Clear
+Ñ the head and tail links are set to the empty queue state (NIL),
+Ñ the current length is set to the empty queue state (zero).
+Complexity: O(1).
+*)
+
+PROCEDURE Create  (    theType  : TypeID    (*-- in    *))
+                                : Queue     (*-- out   *);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, SIZE(UnboundedQueue));
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      dataID := theType;
+      length := 0;
+      head   := NIL;
+      tail   := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theQueue rear to the system.
+MacSystem.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullQueue).  Complexity: O(1).
+*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, SIZE(theQueue^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear retrieves the item disposal routine for theQueue's data type, if
+any, and proceeds to free each item in theQueue.  If theQueue is empty
+the loop is not executed as head already be NIL.  Lastly, tail and
+length are set to ensure theQueue is in the empty state.
+Complexity: O(n).
+*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- item node to deallocate *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      free := DisposeOf(dataID);
+      WHILE (head # NIL) DO
+        oldHead := head;
+        head    := head^.next;
+        free(oldHead^.item);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      tail   := NIL;
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates the items of theQueue to the target queue, toQueue. An
+undefined source queue raises an exception and leaves the target unchanged.
+If the target queue is undefined, it is created with the same
+data type attribute of the source; otherwise the target queue is
+cleared of its present contents and its data type is altered to reflect
+that of the source.  Essentially, Assign traverses the links of the
+source queue copying items to new nodes created in the target queue.
+If a new node cannot be allocated the overflow exception is raised and
+the routine is aborted.  Complexity: O(n).
+*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   fromIndex  : Link;       (*-- loop index over source nodes *)
+      assignment : AssignProc; (*-- item assignment routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      toQueue := Create(theQueue^.dataID);
+    ELSE
+      Clear(toQueue);
+      toQueue^.dataID := theQueue^.dataID;
+    END (*--if*);
+    IF (queueError = noerr) & (theQueue^.head # NIL) THEN
+      assignment := AssignOf(theQueue^.dataID);
+      Allocate(toQueue^.head, SIZE(Node));
+      IF (toQueue^.head = NIL) THEN
+        RaiseErrIn(assign, overflow);
+      ELSE
+        WITH toQueue^ DO
+          WITH head^ DO
+            item := assignment(theQueue^.head^.item);
+            next := NIL;
+          END (*--with*);
+          fromIndex := theQueue^.head;
+          tail := head;
+          WHILE (fromIndex^.next # NIL) DO
+            fromIndex := fromIndex^.next;
+            WITH tail^ DO
+              Allocate(next, SIZE(Node));
+              IF (next = NIL) THEN
+                RaiseErrIn(assign, overflow);
+                RETURN;
+              END (*--if*);
+              next^.item := assignment(fromIndex^.item);
+              next^.next := NIL;
+            END (*--with*);
+            tail := tail^.next;
+          END (*--while*);
+          length := theQueue^.length;
+        END (*--with*);
+      END (*--if*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Arrive adds theItem to the rear of theQueue by first allocating a new
+node, storing theItem in that node and then update the links head
+and tail, and the queue length. Note that tail will always point to
+the new node upon successful completion of the routine.
+When the node cannot be allocated the exception overflow is raised
+and theQueue remains unchanged.  Likewise, given an undefined queue
+raises the exception of the same name.  Complexity: O(1).
+*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   newNode : Link; (*-- temporary for new node *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+        item := theItem;
+        next := NIL;
+      END (*--with*);
+      WITH theQueue^ DO
+        INC(length);
+        IF (head = NIL) THEN
+          head := newNode;
+        ELSE
+          tail^.next := newNode;
+        END (*--if*);
+        tail := newNode;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+(*
+Depart removes theItem at the front of theQueue by relinking the
+successor to the current queue head as the new head.  The departing
+item is freed via the disposal routine of theQueue's data type before
+actually releasing the old head node itself.
+
+If theQueue is empty on entry to Depart the underflow exception is
+raised and theQueue is not changed.  When theQueue is not defined,
+the undefined exception is raised.  Complexity: O(1).
+*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- original head, departing *)
+      free    : DisposeProc; (*-- item disposal routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (tail = NIL) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        oldHead := head;
+        head    := head^.next;
+        IF (head = NIL) THEN
+          tail := NIL;
+        END (*--if*);
+        DEC(length);
+        free := DisposeOf(dataID);
+        free(oldHead^.item);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+(*
+11.4.4 Selectors
+
+IsDefined verifies to the best of its ability whether theQueue has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theQueue is in the empty state, as indicated by
+the head being NIL, and False otherwise.  As per the specification
+(section 9.4) undefined queues are considered empty.  Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual compares the left and right queues for equality, which in this
+context means they contain the same items and the same data type ID.
+Both queues must be defined and have the same data type ID; if they 
+do not, then the exceptions undefined and typeerror are raised,
+respectively.
+Obviously, queues of different lengths (indicated by the lengths)
+cannot be equal since there would be at least one item different between
+them.  The algorithm simply loops over each of the items in both queues
+returning false immediately upon encountering an inequality, and returning
+true if and only if every item is the same between them. Note that
+because the lengths are equal, both index links will become NIL
+simultaneously.  Complexity: O(n).
+*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- loop index over left items *)
+      rightIndex: Link; (*-- loop index over right items *)
+      compare : CompareProc;    (*-- item comparison routine *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.length = right^.length) THEN
+    compare := CompareOf(left^.dataID);
+    leftIndex := left^.head;
+    rightIndex:= right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF compare(leftIndex^.item, rightIndex^.item) # equal THEN
+        RETURN FALSE;
+      END (*--if*);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    END (*--while*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+LengthOf simply returns the length of theQueue.  Complexity: O(1).
+*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+(*
+TypeOf simply returns the dataID for the given queue.
+Undefined queues, as always, raise the undefined exception and return
+a reasonable value (the NullType).  Complexity: O(1).
+*)
+
+PROCEDURE TypeOf    (    theQueue : Queue    (*-- in    *))
+                                  : TypeID   (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END TypeOf;
+(*-------------------------*)
+
+(*
+FrontOf returns the value of the item that is at the head of theQueue or
+the NullItem if theQueue is undefined or is empty.  Complexity: O(1).
+*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+
+(*
+11.2.5 Module Initialization
+
+The module's local variables are initialized to known states.
+queueError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR
+loop control variable is undefined following the loop,
+queueError must be set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QSUMN.
+
+(*
+References
+
+
+[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983, pp. 56-60.
+[2] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+    Benjamin/Cummings, Menlo Park, CA 1987, pp. 92-93, 142-153.
+[3] K. John Gough, ╥Writing Generic Utilities in Modula-2╙, Journal of
+    Pascal, Ada, and Modula-2, Vol. 5(3), (May/June 1986), pp 53-62.
+[4] T.A. Standish, Data Structure Techniques, Chapter 2: Stacks and Queues,
+    Addison-Wesley, Reading, MA 1980, pp. 20-23, 28-32.
+[5] R.S. Wiener and G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons, New York, NY 1985, pp. 247-253
+[6] R.S. Wiener and R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986, pp. 69-71
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUUI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUUI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUUI.DEF
@@ -0,0 +1,93 @@
+DEFINITION MODULE QSUUI;
+(*===========================================================
+    Version  : 1.00  03 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Unbounded Unmanaged Iterator
+
+    This module is designed for use with the basic data types
+    (e.g., INTEGERs, POINTERs to other structures) as data items.
+    You must type cast the generic Items to/from your basic data type.
+    Clear and Destroy now have O(1) complexity.
+    Refer to the QueueSBMI module for all other commentary.
+
+    REVISION HISTORY
+    v1.00  03 May 1989  C. Lins:
+      Initial implementation derived from QueueSBMI module.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item, AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+
+(*-- Type Declarations --*)
+
+TYPE  Queue;
+CONST NullQueue = Queue(NIL);
+
+
+(*-- Exceptions --*)
+
+CONST ModuleID = 21;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+
+(*-- Constructors --*)
+
+PROCEDURE Create  ()            : Queue     (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+
+(*-- Selectors --*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+(*-- Iterators --*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+END QSUUI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUUI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUUI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUUI.MOD
@@ -0,0 +1,379 @@
+IMPLEMENTATION MODULE QSUUI;
+(*==============================================================
+    Version  : 1.00  03 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Unbounded Unmanaged Iterator
+    Code Size: R-  bytes
+
+    This module is designed for use with the basic data types
+    (e.g., INTEGERs, POINTERs to other structures) as data items.
+    You must type cast the generic Items to/from your basic data type.
+    Clear and Destroy now have O(1) complexity.
+    Refer to the QueueSBMI module for all other commentary.
+
+    REVISION HISTORY
+    v1.00  03 May 1989  C. Lins:
+      Initial implementation derived from QueueSBMI module.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, DisposeProc,
+               AccessProc, LoopAccessProc;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+    (*--------------------*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD
+        item : Item; (*-- item data *)
+        next : Link; (*-- link to next node *)
+      END (*-- Node *);
+
+TYPE  UnboundedQueue = RECORD
+        length : CARDINAL;   (*-- current # of items *)
+        head   : Link;       (*-- pointer to first item *)
+        tail   : Link;       (*-- pointer to last item *)
+      END (*-- UnboundedQueue *);
+
+TYPE  Queue = POINTER TO UnboundedQueue;
+
+    (*--------------------*)
+
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+PROCEDURE Create  ()            : Queue     (*-- out   *);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, SIZE(UnboundedQueue));
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      length := 0;
+      head   := NIL;
+      tail   := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, SIZE(theQueue^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- item node to deallocate *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      WHILE (head # NIL) DO
+        oldHead := head;
+        head    := head^.next;
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      tail   := NIL;
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   fromIndex  : Link;       (*-- loop index over source nodes *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      toQueue := Create();
+    ELSE
+      Clear(toQueue);
+    END (*--if*);
+    IF (queueError = noerr) & (theQueue^.head # NIL) THEN
+      Allocate(toQueue^.head, SIZE(Node));
+      IF (toQueue^.head = NIL) THEN
+        RaiseErrIn(assign, overflow);
+      ELSE
+        WITH toQueue^ DO
+          WITH head^ DO
+            item := theQueue^.head^.item;
+            next := NIL;
+          END (*--with*);
+          fromIndex := theQueue^.head;
+          tail := head;
+          WHILE (fromIndex^.next # NIL) DO
+            fromIndex := fromIndex^.next;
+            WITH tail^ DO
+              Allocate(next, SIZE(Node));
+              IF (next = NIL) THEN
+                RaiseErrIn(assign, overflow);
+                RETURN;
+              END (*--if*);
+              next^.item := fromIndex^.item;
+              next^.next := NIL;
+            END (*--with*);
+            tail := tail^.next;
+          END (*--while*);
+          length := theQueue^.length;
+        END (*--with*);
+      END (*--if*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   newNode : Link; (*-- temporary for new node *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+        item := theItem;
+        next := NIL;
+      END (*--with*);
+      WITH theQueue^ DO
+        INC(length);
+        IF (head = NIL) THEN
+          head := newNode;
+        ELSE
+          tail^.next := newNode;
+        END (*--if*);
+        tail := newNode;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- original head, departing *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (tail = NIL) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        oldHead := head;
+        head    := head^.next;
+        IF (head = NIL) THEN
+          tail := NIL;
+        END (*--if*);
+        DEC(length);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+
+(*-- Selectors --*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- loop index over left items *)
+      rightIndex: Link; (*-- loop index over right items *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.length = right^.length) THEN
+    leftIndex := left^.head;
+    rightIndex:= right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF (leftIndex^.item # rightIndex^.item) THEN
+        RETURN FALSE;
+      END (*--if*);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    END (*--while*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+
+(*-- Iterators --*)
+
+PROCEDURE LoopOver (    theQueue  : Queue          (*-- in    *);
+                        theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theQueue^ DO
+      index := head;
+      WHILE (index # NIL) DO
+        IF ~theProcess(index^.item) THEN
+          RETURN;
+        END (*--if*);
+        index := index^.next;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theQueue  : Queue          (*-- in    *);
+                        theProcess: AccessProc     (*-- in    *));
+
+VAR   index : Link; (*-- loop index over items *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theQueue^ DO
+      index := head;
+      WHILE (index # NIL) DO
+        theProcess(index^.item);
+        index := index^.next;
+      END (*--while*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+(*-- Module Initialization --*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QSUUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUUN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUUN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUUN.DEF
@@ -0,0 +1,75 @@
+DEFINITION MODULE QSUUN;
+(*===========================================================
+    Version  : 1.00  03 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-priority Non-balking Sequential Unbounded Unmanaged Non-Iterator
+
+    REVISION HISTORY
+    v1.00  03 May 1989  C. Lins:
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+===========================================================*)
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Exceptions;
+
+    (*--------------------*)
+
+TYPE  Queue;
+CONST NullQueue = Queue(NIL);
+
+    (*--------------------*)
+
+CONST ModuleID = 21;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+    (*--------------------*)
+
+PROCEDURE Create  ()            : Queue     (*-- out   *);
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+    (*--------------------*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+
+END QSUUN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUUN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUUN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol2/QUEUES/QSUUN.MOD
@@ -0,0 +1,316 @@
+IMPLEMENTATION MODULE QSUUN;
+(*==============================================================
+    Version  : 1.00  03 May 1989  C. Lins
+    Compiler : TopSpeed Modula-2
+    Code Size: R-  bytes
+    Component: Monolithic Structures - Queue (Opaque version)
+      Non-Priority Non-Balking Sequential Unbounded Unmanaged Non-Iterator
+
+    REVISION HISTORY
+    v1.00  03 May 1989  C. Lins
+      Initial TopSpeed Modula-2 implementation.
+
+    (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM Items IMPORT
+    (*--Cons*) NullItem,
+    (*--Type*) Item;
+
+FROM QEnum IMPORT
+    (*--Type*) Operations, Exceptions, ComponentID;
+
+    (*--------------------*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD
+        item : Item; (*-- item data *)
+        next : Link; (*-- link to next node *)
+      END (*-- Node *);
+
+TYPE  UnboundedQueue = RECORD
+        length : CARDINAL;   (*-- current # of items *)
+        head   : Link;       (*-- pointer to first item *)
+        tail   : Link;       (*-- pointer to last item *)
+      END (*-- UnboundedQueue *);
+
+TYPE  Queue = POINTER TO UnboundedQueue;
+
+    (*--------------------*)
+
+VAR   queueError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE QueueError () : Exceptions (*-- out   *);
+BEGIN
+  RETURN queueError;
+END QueueError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  queueError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+PROCEDURE Create  ()            : Queue     (*-- out   *);
+
+VAR   newQueue : Queue;
+
+BEGIN
+  queueError := noerr;
+  Allocate(newQueue, SIZE(UnboundedQueue));
+  IF (newQueue = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newQueue^ DO
+      length := 0;
+      head   := NIL;
+      tail   := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newQueue;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theQueue : Queue     (*-- inout *));
+BEGIN
+  Clear(theQueue);
+  IF (queueError = noerr) THEN
+    Deallocate(theQueue, SIZE(theQueue^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- item node to deallocate *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    WITH theQueue^ DO
+      WHILE (head # NIL) DO
+        oldHead := head;
+        head    := head^.next;
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--while*);
+      tail   := NIL;
+      length := 0;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(clear, undefined);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theQueue : Queue     (*-- in    *);
+                   VAR toQueue  : Queue     (*-- inout *));
+
+VAR   fromIndex  : Link;       (*-- loop index over source nodes *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theQueue # toQueue) THEN
+    IF (toQueue = NIL) THEN
+      toQueue := Create();
+    ELSE
+      Clear(toQueue);
+    END (*--if*);
+    IF (queueError = noerr) & (theQueue^.head # NIL) THEN
+      Allocate(toQueue^.head, SIZE(Node));
+      IF (toQueue^.head = NIL) THEN
+        RaiseErrIn(assign, overflow);
+      ELSE
+        WITH toQueue^ DO
+          WITH head^ DO
+            item := theQueue^.head^.item;
+            next := NIL;
+          END (*--with*);
+          fromIndex := theQueue^.head;
+          tail := head;
+          WHILE (fromIndex^.next # NIL) DO
+            fromIndex := fromIndex^.next;
+            WITH tail^ DO
+              Allocate(next, SIZE(Node));
+              IF (next = NIL) THEN
+                RaiseErrIn(assign, overflow);
+                RETURN;
+              END (*--if*);
+              next^.item := fromIndex^.item;
+              next^.next := NIL;
+            END (*--with*);
+            tail := tail^.next;
+          END (*--while*);
+          length := theQueue^.length;
+        END (*--with*);
+      END (*--if*);
+    END (*--if*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Arrive  (VAR theQueue : Queue     (*-- inout *);
+                       theItem  : Item      (*-- in    *));
+
+VAR   newNode : Link; (*-- temporary for new node *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(arrive, undefined);
+  ELSE
+    Allocate(newNode, SIZE(Node));
+    IF (newNode = NIL) THEN
+      RaiseErrIn(arrive, overflow);
+    ELSE
+      WITH newNode^ DO
+        item := theItem;
+        next := NIL;
+      END (*--with*);
+      WITH theQueue^ DO
+        INC(length);
+        IF (head = NIL) THEN
+          head := newNode;
+        ELSE
+          tail^.next := newNode;
+        END (*--if*);
+        tail := newNode;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Arrive;
+(*-------------------------*)
+
+PROCEDURE Depart  (VAR theQueue : Queue     (*-- inout *));
+
+VAR   oldHead : Link;        (*-- original head, departing *)
+
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(depart, undefined);
+  ELSE
+    WITH theQueue^ DO
+      IF (tail = NIL) THEN
+        RaiseErrIn(depart, underflow);
+      ELSE
+        oldHead := head;
+        head    := head^.next;
+        IF (head = NIL) THEN
+          tail := NIL;
+        END (*--if*);
+        DEC(length);
+        Deallocate(oldHead, SIZE(oldHead^));
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END Depart;
+(*-------------------------*)
+
+PROCEDURE IsDefined (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  RETURN theQueue # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theQueue : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN (theQueue^.head = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left     : Queue    (*-- in    *);
+                         right    : Queue    (*-- in    *))
+                                  : BOOLEAN  (*-- out   *);
+
+VAR   leftIndex : Link; (*-- loop index over left items *)
+      rightIndex: Link; (*-- loop index over right items *)
+
+BEGIN
+  queueError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.length = right^.length) THEN
+    leftIndex := left^.head;
+    rightIndex:= right^.head;
+    WHILE (leftIndex # NIL) DO
+      IF (leftIndex^.item # rightIndex^.item) THEN
+        RETURN FALSE;
+      END (*--if*);
+      leftIndex  := leftIndex^.next;
+      rightIndex := rightIndex^.next;
+    END (*--while*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE LengthOf  (    theQueue : Queue    (*-- in    *))
+                                  : CARDINAL (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue # NIL) THEN
+    RETURN theQueue^.length;
+  END (*--if*);
+  RaiseErrIn(lengthof, undefined);
+  RETURN 0;
+END LengthOf;
+(*-------------------------*)
+
+PROCEDURE FrontOf   (    theQueue : Queue    (*-- in    *))
+                                  : Item     (*-- out   *);
+BEGIN
+  queueError := noerr;
+  IF (theQueue = NIL) THEN
+    RaiseErrIn(frontof, undefined);
+  ELSIF (theQueue^.head = NIL) THEN
+    RaiseErrIn(frontof, underflow);
+  ELSE
+    RETURN theQueue^.head^.item;
+  END (*--if*);
+  RETURN NullItem;
+END FrontOf;
+(*-------------------------*)
+
+BEGIN
+  FOR queueError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(queueError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  queueError := noerr;
+END QSUUN.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/EBNF/EBNF.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/EBNF/EBNF.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/EBNF/EBNF.MOD
@@ -0,0 +1,209 @@
+MODULE EBNF;
+(*====================================================================
+    Version  : 1.00  04 Feb 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2 Compiler
+    Component: EBNF
+
+    INTRODUCTION
+    This is the main module to the tool EBNF. It reads a language
+    specification in EBNF format from a file. It writes to standard
+    output two lists: one of terminal symbols, the other of nonterminals.
+
+    The input source is checked for conformity with the EBNF syntax. The
+    errors that can result from an ill-formed specification are listed
+    in the procedure WrErrorCodes in this module.
+
+    REVISION HISTORY
+    v1.00  04 Feb 1989  C. Lins:
+      Initial implementation derived from Wirth's Programming in
+                        Modula-2, 4th edition, pp 96-100.
+    v1.01  06 Dec 1989  Iain Houston:
+      Adapted to JPI TopSpeed Modula2 compiler.
+      Improved error reporting.
+====================================================================*)
+
+FROM    EBNFScanner IMPORT
+        (*--type*)      Symbol,
+        (*--var *)      source, theSymbol, lineNo, theIdent, errorsFound,
+        (*--proc*)      GetSymbol, MarkError, SkipLine;
+
+FROM    EBNFTable IMPORT
+        (*--type*)      SymbolTable,
+        (*--proc*)      Create, Record, Tabulate, Overflow;
+
+FROM    FIO IMPORT
+        (*--proc*)      AssignBuffer,
+        (*--const*)     BufferOverhead;
+
+FROM    IO IMPORT
+        (*--proc*)      WrLn, WrStr;
+
+FROM    FIO IMPORT
+        (*--var*)      EOF,
+        (*--proc*)     Exists, Open, Close, File, RdChar;
+
+FROM    Lib IMPORT
+        (*--proc*)      ParamStr;
+
+VAR     terminals       : SymbolTable;
+        nonTerminals    : SymbolTable;
+        fileName        : ARRAY [0..64] OF CHAR;
+
+
+PROCEDURE SkipToSymbol (    errorNo : INTEGER (*--in   *));
+BEGIN
+        MarkError(errorNo);
+        WHILE (theSymbol < lparen) OR (theSymbol > period) DO
+                GetSymbol;
+        END (*--while*);
+END SkipToSymbol;
+
+PROCEDURE Expression;
+
+        PROCEDURE Term;
+
+                PROCEDURE Factor;
+                BEGIN
+                        IF (theSymbol = identifier) THEN
+                                Record(nonTerminals, theIdent, lineNo);
+                                GetSymbol;
+
+                        ELSIF (theSymbol = literal) THEN
+                                Record(terminals, theIdent, lineNo);
+                                GetSymbol;
+
+                        ELSIF (theSymbol = lparen) THEN
+                                GetSymbol;
+                                Expression;
+                                IF (theSymbol = rparen) THEN
+                                        GetSymbol;
+                                ELSE
+                                        SkipToSymbol(2);
+                                END (*--if*);
+
+                        ELSIF (theSymbol = lbraket) THEN
+                                GetSymbol;
+                                Expression;
+                                IF (theSymbol = rbraket) THEN
+                                        GetSymbol;
+                                ELSE
+                                        SkipToSymbol(3);
+                                END (*--if*);
+
+                        ELSIF (theSymbol = lbrace) THEN
+                                GetSymbol;
+                                Expression;
+                                IF (theSymbol = rbrace) THEN
+                                        GetSymbol;
+                                ELSE
+                                        SkipToSymbol(4);
+                                END (*--if*);
+
+                        ELSE
+                                SkipToSymbol(5);
+                        END (*--if*);
+                END Factor;
+
+        BEGIN           (*-- Term --*)
+                Factor;
+                WHILE (theSymbol < bar) DO
+                        Factor;
+                END (*--while*);
+        END Term;
+
+BEGIN           (*-- Expression --*)
+        Term;
+        WHILE (theSymbol = bar) DO
+                GetSymbol;
+                Term;
+        END (*--while*);
+END Expression;
+
+PROCEDURE Production;
+BEGIN
+        (*-- theSymbol = identifier --*)
+        Record(nonTerminals, theIdent, -lineNo);
+        GetSymbol;
+        IF (theSymbol = eql) THEN
+                GetSymbol;
+        ELSE
+                SkipToSymbol(7);
+        END (*--if*);
+        Expression;
+        IF (theSymbol # period) THEN
+                MarkError(8);
+                SkipLine;
+        END (*--if*);
+        GetSymbol;
+END Production;
+
+PROCEDURE WrErrorCodes;
+BEGIN
+        WrLn;WrLn;WrLn;
+        WrStr('Syntax errors were found. Errors were coded as follows:');
+        WrLn;WrLn;
+        WrStr('1.  <reserved>                                      ');WrLn;
+        WrStr('2.  Missing right parentheses                       ');WrLn;
+        WrStr('3.  Missing right bracket                           ');WrLn;
+        WrStr('4.  Missing right brace                             ');WrLn;
+        WrStr('5.  Identifier, literal, "(", "[", or "{" expected  ');WrLn;
+        WrStr('6.  Symbol table overflow                           ');WrLn;
+        WrStr('7.  Equal sign expected                             ');WrLn;
+        WrStr('8.  Period expected                                 ');WrLn
+END WrErrorCodes;
+
+PROCEDURE Main;
+BEGIN   (*--Main*)
+        terminals   := Create();
+        nonTerminals:= Create();
+
+        GetSymbol;
+        WHILE (theSymbol = identifier) & ~Overflow() DO
+                Production;
+        END (*--while*);
+        IF Overflow() THEN
+                WrLn;
+                WrStr("### EBNF: Symbol Table Overflow");
+                WrLn;
+        END (*--if*);
+        WrLn;WrLn;
+        WrStr("Non-Terminal Symbols");WrLn;
+        Tabulate(nonTerminals);WrLn;
+        WrStr("Terminal Symbols");WrLn;
+        Tabulate(terminals);
+        IF errorsFound THEN WrErrorCodes END
+END Main;
+
+CONST   toolName= "EBNF Tool";
+CONST   version = "  OS/2 v1.1  02 Dec 1989";
+CONST   author1 = "  by Iain Houston,";
+CONST   author2 = "  after Chuck Lins.";
+
+VAR sBuff: ARRAY [0..(2*512+BufferOverhead)] OF BYTE;
+
+BEGIN
+        WrStr(toolName);
+        WrStr(version);WrLn;
+        WrStr(author1);WrLn;
+        WrStr(author2);WrLn;
+        WrLn;
+
+        ParamStr( fileName, 1);   (*--find fileName from invocation argument*)
+        IF Exists( fileName ) THEN
+                source := Open( fileName );
+                WrStr('Reading a language definition from ');
+                WrStr(fileName);
+                WrLn;WrLn;
+                AssignBuffer(source, sBuff);
+                Main;
+                Close(source);
+                WrLn;
+                WrStr("Normal program termination.")
+        ELSE
+                WrStr("Couldn't find the file ");
+                WrStr(fileName);
+                WrLn;
+                WrStr("Program terminated.");
+        END     (*--IF Exists*)
+END EBNF.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/EBNF/EBNFSCAN.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/EBNF/EBNFSCAN.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/EBNF/EBNFSCAN.DEF
@@ -0,0 +1,47 @@
+DEFINITION MODULE EBNFScanner;
+(*====================================================================
+    Version  : 1.00  04 Feb 1989  C. Lins
+    Compiler : Bob Campbell's MPW Modula-2 Compiler
+    Component: EBNFScanner
+
+    INTRODUCTION
+    This module defines a scanner for EBNF.
+
+    REVISION HISTORY
+    v1.00  04 Feb 1989  C. Lins:
+      Initial implementation derived from Wirth's Programming in
+                        Modula-2, 4th edition, pp 96-100.
+====================================================================*)
+
+FROM    StrCSUMI IMPORT
+        (*--type*)      String;
+
+FROM    FIO      IMPORT
+        (*--type*)      File;
+
+TYPE    Symbol = (identifier,
+                  literal,
+                  lparen,
+                  lbraket,
+                  lbrace,
+                  bar,
+                  eql,
+                  period,
+                  rparen,
+                  rbraket,
+                  rbrace,
+                  other
+                );
+
+VAR             theSymbol  : Symbol;       (*-- current symbol *)
+                lineNo     : INTEGER;      (*-- current line number *)
+                theIdent   : String;       (*-- current identifier *)
+                source     : File;
+                errorsFound: BOOLEAN;
+
+PROCEDURE       GetSymbol;
+PROCEDURE       MarkError (errorNo : INTEGER);
+PROCEDURE       SkipLine;
+
+END EBNFScanner.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/EBNF/EBNFSCAN.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/EBNF/EBNFSCAN.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/EBNF/EBNFSCAN.MOD
@@ -0,0 +1,259 @@
+IMPLEMENTATION MODULE EBNFScanner;
+(*====================================================================
+    Version  : 1.0d2  06 Feb 1989  C. Lins
+    Compiler : JPI's TopSpeed Modula-2 Compiler
+    Component: EBNFScanner
+
+    INTRODUCTION
+    This module defines a scanner for EBNF.
+
+    REVISION HISTORY
+    v1.0d1  04 Feb 1989  C. Lins:
+      Initial implementation derived from Wirth's Programming in
+                        Modula-2, 4th edition, pp 96-100.
+    v1.0d2  06 Feb 1989  C. Lins:
+      Improved (speeded up) construction of unbounded string by
+      creating all at once rather than adding a character at a time.
+    v1.1    02 Dec 1989  I. S. C. Houston
+      Adapted to JPI TopSpeed compiler and library
+      and changed to take the language definition input
+      from a named file.
+      ====================================================================*)
+
+FROM    CharItems IMPORT
+        (*--cons*)      NullItem,
+        (*--type*)      Item;
+
+FROM    StrCSUMI IMPORT
+        (*--cons*)      NullString,
+        (*--type*)      String,
+        (*--proc*)      Construct;
+
+FROM    FIO IMPORT
+        (*--var*)       EOF,
+        (*--proc*)      RdChar;
+
+FROM    IO    IMPORT
+        (*--proc*)      WrChar, WrCharRep, WrStr, WrInt, WrLn;
+
+IMPORT ASCII;
+
+VAR     ch : CHAR;
+        currentChar : INTEGER;
+        colHiWater: INTEGER;
+        errColIndex: INTEGER;
+
+CONST   LineWidth = 256;
+VAR     line: ARRAY [0..LineWidth-1] OF CHAR;
+
+CONST   kMaxIdentifier = 30;
+
+PROCEDURE GetLine;
+BEGIN
+        IF (errColIndex > 0) THEN
+                (*--terminate active error report line*)
+                WrLn;
+                errColIndex := 0;
+        END (*--if*);
+
+        (*--ignore linefeed*)
+        REPEAT ch := RdChar(source)
+        UNTIL (ch # ASCII.lf);
+
+        IF EOF OR (ch = ASCII.sub) THEN
+                line[0] := ASCII.del;
+                colHiWater := 1
+        ELSE
+                (*--not at end of file*)
+                INC(lineNo);
+                WrInt(lineNo, 5);
+                WrChar(" ");
+                colHiWater := 0;
+
+                LOOP
+                        WrChar(ch);
+                        line[colHiWater] := ch;
+                        INC(colHiWater);
+
+                        ch := RdChar(source);
+                        IF EOF THEN ch := ASCII.nul END;
+
+                        IF (ch = ASCII.cr) OR
+                           (ch = ASCII.nul) THEN
+                                EXIT (*--loop*)
+                        END (*--if*);
+
+                END (*--loop*);
+                WrLn
+        END (*--if*);
+END GetLine;
+(*--------------------*)
+
+PROCEDURE GetChar;
+BEGIN
+        WHILE (colHiWater = currentChar) DO
+                currentChar := 0;
+                GetLine;
+        END (*--while*);
+        ch := line[currentChar];
+        INC(currentChar);
+END GetChar;
+(*--------------------*)
+
+
+PROCEDURE GetIdentifier;
+
+VAR     theString : ARRAY [0..kMaxIdentifier] OF Item;
+        index     : INTEGER;
+
+BEGIN
+        theSymbol := literal;
+        index := 0;
+        REPEAT
+                theString[index] := ch;
+                INC(index);
+                IF (ch > "Z") THEN
+                        theSymbol := identifier;
+                END (*--if*);
+                GetChar;
+        UNTIL (CAP(ch) < "A") OR (CAP(ch) > "Z");
+        theString[index] := NullItem; (*-- terminate the Modula string *)
+        theIdent := NullString; (*-- make sure the previous identifier isn't
+                                  -- automatically deallocated *)
+        Construct(theIdent, theString);
+END GetIdentifier;
+(*--------------------*)
+
+PROCEDURE GetLiteral (    termCh : CHAR);
+
+VAR             theString : ARRAY [0..kMaxIdentifier] OF Item;
+                index     : INTEGER;
+
+BEGIN
+        theSymbol := literal;
+        GetChar;
+        index := 0;
+        WHILE (ch # termCh) DO
+                theString[index] := ch;
+                INC(index);
+                GetChar;
+        END (*--while*);
+        theString[index] := NullItem; (*-- terminate the Modula string *)
+        theIdent := NullString; (*-- make sure the previous identifier isn't
+                                  -- automatically deallocated *)
+        Construct(theIdent, theString);
+        GetChar;
+END GetLiteral;
+(*--------------------*)
+
+
+PROCEDURE WrSymbol;
+BEGIN
+        CASE theSymbol OF
+        identifier:    WrStr("identifier");
+        | literal:     WrStr("literal");
+        | lparen:      WrStr("lparen");
+        | rparen:      WrStr("rparen");
+        | lbrace:      WrStr("lbrace");
+        | rbrace:      WrStr("rbrace");
+        | lbraket:     WrStr("lbraket");
+        | rbraket:     WrStr("rbraket");
+        | bar:         WrStr("bar");
+        | eql:         WrStr("eql");
+        | period:      WrStr("period");
+        ELSE           WrStr("other");
+        END (*--case*);
+        WrLn;
+END WrSymbol;
+
+PROCEDURE       GetSymbol;
+BEGIN
+        WHILE (ch = ASCII.space) OR
+              (ch = ASCII.cr) DO
+                GetChar;
+        END (*--while*);
+        IF (ch = ASCII.slash) THEN
+                SkipLine;
+                WHILE (ch = ASCII.space) OR
+                      (ch = ASCII.cr) DO
+                        GetChar;
+                END (*--while*);
+        END (*--if*);
+
+        IF (CAP(ch) >= "A") & (CAP(ch) <= "Z") THEN
+                GetIdentifier;
+        ELSIF (ch = ASCII.quote) OR (ch = ASCII.quotequote) THEN
+                GetLiteral(ch);
+        ELSIF (ch = ASCII.equalsign) THEN
+                theSymbol := eql;
+                GetChar;
+        ELSIF (ch = ASCII.lparen) THEN
+                theSymbol := lparen;
+                GetChar;
+        ELSIF (ch = ASCII.rparen) THEN
+                theSymbol := rparen;
+                GetChar;
+        ELSIF (ch = ASCII.lbracket) THEN
+                theSymbol := lbraket;
+                GetChar;
+        ELSIF (ch = ASCII.rbracket) THEN
+                theSymbol := rbraket;
+                GetChar;
+        ELSIF (ch = ASCII.lbrace) THEN
+                theSymbol := lbrace;
+                GetChar;
+        ELSIF (ch = ASCII.rbrace) THEN
+                theSymbol := rbrace;
+                GetChar;
+        ELSIF (ch = ASCII.bar) THEN
+                theSymbol := bar;
+                GetChar;
+        ELSIF (ch = ASCII.period) THEN
+                theSymbol := period;
+                GetChar;
+        ELSIF (ch = ASCII.del) THEN
+                theSymbol := other;
+        ELSE
+                theSymbol := other;
+                GetChar;
+        END (*--if*);
+END GetSymbol;
+(*--------------------*)
+
+PROCEDURE       MarkError (    errorNo : INTEGER);
+BEGIN
+        errorsFound := TRUE;
+        IF (errColIndex = 0) THEN (*--start error report line*)
+                WrChar("*");
+                WrCharRep(" ",3);
+        END (*--if*);
+        WrCharRep(" ",currentChar);
+        WrChar("^");
+        WrInt(errorNo, 1);
+        INC(errColIndex, 2);
+END MarkError;
+(*--------------------*)
+
+PROCEDURE SkipLine;
+VAR thisLineNo: INTEGER;
+BEGIN
+        thisLineNo := lineNo;
+        WHILE (thisLineNo = lineNo) DO
+                GetChar
+        END (*--while*);
+        GetChar;
+END SkipLine;
+(*--------------------*)
+
+BEGIN
+        theIdent       := NullString;
+        theSymbol      := other;
+        errorsFound    := FALSE;
+        lineNo         := 0;
+        currentChar    := 0;
+        colHiWater     := 0;
+        errColIndex    := 0;
+        ch             := " ";
+
+END EBNFScanner.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/EBNF/EBNFTABL.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/EBNF/EBNFTABL.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/EBNF/EBNFTABL.DEF
@@ -0,0 +1,35 @@
+DEFINITION MODULE EBNFTable;
+(*====================================================================
+    Version  : 1.00  04 Feb 1989  C. Lins
+    Compiler : Bob Campbell's MPW Modula-2 Compiler
+    Component: EBNFTable
+
+    INTRODUCTION
+    This module defines a symbol table for identifiers and line numbers
+                for the EBNF tool.
+
+                The act of tabulating a symbol table causes the table to be destroyed.
+
+    REVISION HISTORY
+    v1.00  04 Feb 1989  C. Lins:
+      Initial implementation derived from Wirth's Programming in
+                        Modula-2, 4th edition, pp 96-100.
+====================================================================*)
+
+FROM    StrCSUMI IMPORT
+        (*--type*)      String;
+
+TYPE    SymbolTable;
+
+PROCEDURE Create  () : SymbolTable                                              (*--out  *);
+
+PROCEDURE Record  (    inTable  : SymbolTable (*--inout*);
+                                                                                         theID          : String                        (*--in   *);
+                                                                                         lineNo         : INTEGER                       (*--in   *));
+
+PROCEDURE Tabulate (    theTable: SymbolTable (*--in   *));
+
+PROCEDURE Overflow () : BOOLEAN                                                         (*--out  *);
+
+END EBNFTable.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/EBNF/EBNFTABL.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/EBNF/EBNFTABL.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/EBNF/EBNFTABL.MOD
@@ -0,0 +1,231 @@
+IMPLEMENTATION MODULE EBNFTable;
+(*====================================================================
+    Version  : 1.0d2  06 Feb 1989  C. Lins
+    Compiler : JPI's TopSpeed Modula-2 Compiler
+    Component: EBNFTable
+
+    INTRODUCTION
+    This module defines a symbol table for identifiers and line numbers
+    for the EBNF tool.
+
+    The act of tabulating a symbol table causes the table to be destroyed.
+
+    REVISION HISTORY
+    v1.0d1  04 Feb 1989  C. Lins:
+      Initial implementation derived from Wirth's Programming in
+                        Modula-2, 4th edition, pp 96-100.
+    v1.0d2  06 Feb 1989  C. Lins:
+                        Changed to use k-balanced tree where k = 3.
+    v1.1    01 Dec 1989  I. S. C. Houston
+                        Changed to use JPI Compiler and library.
+====================================================================*)
+
+FROM    JPIStorage IMPORT
+        (*--proc*) Allocate, Deallocate;
+
+FROM    StrCSUMI IMPORT
+        (*--type*) String;
+
+FROM    Relations IMPORT
+        (*--type*) Relation;
+
+IMPORT  StrCSUMI;
+IMPORT  TreeTypes;
+IMPORT  IPBSUMI;
+IMPORT  TypeManager;
+IMPORT  CharItems;
+
+FROM    IO IMPORT
+        (*--proc*)  WrChar, WrCharRep, WrInt, WrLn;
+
+TYPE    SymbolTable = IPBSUMI.Tree;
+
+VAR     listOverflow : BOOLEAN;
+
+
+PROCEDURE StringAssign (    theKey : TreeTypes.Key) : TreeTypes.Key;
+VAR       newString : String;
+BEGIN
+        (* Ensure that target string doesn't contain garbage that Assign might
+                 interpret as a legal string and try and deallocate it. *)
+        newString := StrCSUMI.NullString;
+        (* Assign the string value from source to target *)
+        StrCSUMI.Assign( String(theKey), newString);
+        (* Return the new string copy *)
+        RETURN TreeTypes.Key(newString);
+END StringAssign;
+(*--------------------*)
+
+PROCEDURE StringCompare (    left, right : TreeTypes.Key) : Relation;
+BEGIN
+        RETURN StrCSUMI.Compare(String(left), String(right));
+END StringCompare;
+(*--------------------*)
+
+PROCEDURE StringDispose (VAR theKey : TreeTypes.Key);
+VAR             s : String;
+BEGIN
+        (* Coerce into proper type for use as VAR parameter *)
+        s := String(theKey);
+        (* Deallocate the dynamic string. "s" is changed to NIL *)
+        StrCSUMI.Destroy(s);
+        (* Store NIL back into the key *)
+        theKey := TreeTypes.Key(s);
+END StringDispose;
+(*--------------------*)
+
+TYPE    List = POINTER TO ListNode;
+TYPE    ListNode = RECORD
+             lineNo : INTEGER;
+             next   : List;
+        END (*--ListNode*);
+
+(* We must provide an assignment routine but know that it won't be used. *)
+PROCEDURE ListAssign (list : TreeTypes.Data) : TreeTypes.Data;
+BEGIN
+ RETURN list
+END ListAssign;
+(*--------------------*)
+
+PROCEDURE ListDispose (VAR list : TreeTypes.Data);
+VAR             l : List;
+BEGIN
+        l := List(list);
+        Deallocate(l,SIZE(ListNode)); (* returns NIL *)
+        list := TreeTypes.Data(l);    (* output null list of coerced type *)
+END ListDispose;
+(*--------------------*)
+
+PROCEDURE NewListNode (    theLineNo : INTEGER) : List;
+VAR             l : List;
+BEGIN
+        Allocate(l, SIZE(ListNode));
+        IF (l = NIL) THEN
+                listOverflow := TRUE;
+        ELSE
+                l^.lineNo := theLineNo;
+                l^.next   := NIL;
+        END (*--if*);
+        RETURN l;
+END NewListNode;
+
+
+PROCEDURE Create  () : SymbolTable  (*--out  *);
+
+VAR             theTable : SymbolTable;
+         stringKeyTypeID : TypeManager.TypeID;
+         listDataTypeID  : TypeManager.TypeID;
+
+BEGIN
+        stringKeyTypeID := TypeManager.Create("string",
+                                          StringAssign,
+                                          StringCompare,
+                                          StringDispose);
+        listDataTypeID  := TypeManager.Create("list",
+                                          ListAssign,
+                                          TypeManager.NoCompareProc,
+                                          ListDispose);
+        theTable := SymbolTable(
+                    IPBSUMI.Create(stringKeyTypeID,
+                    listDataTypeID, 3));
+        RETURN theTable;
+END Create;
+(*--------------------*)
+
+PROCEDURE Found (    theKey  : TreeTypes.Key;
+                 VAR theList : TreeTypes.Data;
+                     newData : TreeTypes.Data);
+
+VAR             newList : List;
+
+BEGIN
+        newList := List(newData);
+        newList^.next := List(theList);
+        theList := TreeTypes.Data(newList);
+END Found;
+(*--------------------*)
+
+PROCEDURE Record  (    inTable  : SymbolTable (*--inout*);
+                       theID    : String      (*--in   *);
+                       lineNo   : INTEGER     (*--in   *));
+
+VAR             t : IPBSUMI.Tree;
+                        newList : List;
+
+BEGIN
+        newList := NewListNode(lineNo);
+        IF NOT listOverflow THEN
+                t := IPBSUMI.Tree(inTable);
+                IPBSUMI.Insert(t,
+                               TreeTypes.Key(theID),
+                               TreeTypes.Data(newList),
+                               Found);
+        END (*--if*);
+     (* CursorControl.SpinCursor(8); *)
+END Record;
+(*--------------------*)
+
+
+PROCEDURE OutputString (c : CharItems.Item);
+BEGIN
+        WrChar(c);
+END OutputString;
+(*--------------------*)
+
+PROCEDURE WriteTable (    theKey : TreeTypes.Key  (*--in   *);
+                      VAR theData: TreeTypes.Data (*--in   *));
+
+CONST   width = 6;
+    lineWidth = 120;
+    wordWidth = 30;
+            N = (lineWidth - wordWidth) DIV width;
+
+VAR  q         : List;
+     i         : INTEGER;
+     keyLength : INTEGER;
+
+BEGIN
+     (* CursorControl.SpinCursor(-8); *)
+        StrCSUMI.Traverse( String(theKey), OutputString);
+        keyLength := StrCSUMI.LengthOf( String(theKey) );
+        IF (keyLength < wordWidth) THEN
+                WrCharRep(" ",wordWidth-keyLength);
+        END (*--if*);
+        WrChar(" ");
+
+        q := List(theData);
+        i := N;
+        WHILE (q # NIL) DO
+                IF (i = 0) THEN
+                        WrLn;
+                        WrCharRep(" ",wordWidth+1);
+                        i := N;
+                END (*--if*);
+                WrInt(q^.lineNo, width);
+                q := q^.next;
+                DEC(i);
+             (* CursorControl.SpinCursor(-4); *)
+        END (*--while*);
+        WrLn;
+END WriteTable;
+(*--------------------*)
+
+PROCEDURE Tabulate (    theTable: SymbolTable (*--in   *));
+VAR     t : IPBSUMI.Tree;
+BEGIN
+        IPBSUMI.Inorder( IPBSUMI.Tree(theTable), WriteTable);
+        t := IPBSUMI.Tree(theTable);
+        IPBSUMI.Destroy(t);
+END Tabulate;
+(*--------------------*)
+
+PROCEDURE Overflow () : BOOLEAN     (*--out  *);
+BEGIN
+        RETURN (IPBSUMI.TreeError() # TreeTypes.noerr) OR listOverflow;
+END Overflow;
+(*--------------------*)
+
+BEGIN
+        listOverflow := FALSE;
+END EBNFTable.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGRSBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGRSBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGRSBMI.MOD
@@ -0,0 +1,1635 @@
+(*
+11.2    Digraph - Sequential Bounded Managed Iterator
+
+In this section we provide the implementation module corresponding to
+the interface given above in 11.1. The following scheme is used in
+organizing this section:
+* 11.2.1  Internal Representation
+* 11.2.2  Exception Handling
+* 11.2.3  Local Routines
+* 11.2.4  Graph Constructors
+* 11.2.5  Vertex Constructors
+* 11.2.6  Edge Constructors
+* 11.2.7  Graph Selectors
+* 11.2.8  Vertex Selectors
+* 11.2.9  Edge Selectors
+* 11.2.10 Passive Iterators
+* 11.2.11 Active Iterators
+* 11.2.12 Module Initialization
+*)
+
+IMPLEMENTATION MODULE DigrSBMI;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: 6300 bytes
+    Component: Digraph - Sequential Bounded Managed Iterator
+
+    THE ABSTRACTION
+    This module provides interface definitions for the directed,
+        bounded, unmanaged, iterator graph abstract data type.
+
+    REVISION HISTORY
+    v1.00  26 May 1988  C. Lins:
+        Initial TML Modula-2 implementation
+    v1.01  11-14 Jan 1989  C. Lins:
+        Revised interface in conformance with new graph spec (Ch 9).
+        Changed implementation to represent vertex abstractly.
+    v1.02  10 Apr 1989  C. Lins:
+          Corrected initialization of handlers array.
+    v1.03  18 Apr 1989   C. Lins:
+          Added component id constant.
+    v2.00  24 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM SYSTEM IMPORT
+        (*--type*) ADDRESS,
+        (*--proc*) ADR;
+
+FROM JPIStorage IMPORT
+        (*--proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+        (*--cons*) NullItem,
+        (*--type*) Item, AssignProc, DisposeProc;
+
+FROM GraphTypes IMPORT
+        (*--type*) Operations, Exceptions, ComponentID;
+
+FROM ErrorHandling IMPORT
+        (*--cons*) NullHandler,
+        (*--type*) HandlerProc,
+        (*--proc*) Raise;
+
+FROM TypeManager IMPORT
+        (*--cons*) NullType,
+        (*--type*) TypeID,
+        (*--proc*) AssignOf, DisposeOf;
+
+        (*-------------------------*)
+
+(*
+11.2.1  Internal Representation
+
+The internal representation for a bounded digraph is similar to that used in
+the previous chapter for its unbounded counterpart. The main difference is in
+the adjacency list representation. We still have a singly linked list
+of vertices, the difference being that the list is stored in an array of
+vertex nodes. Thus, a Vertex could be represented using an array index. This
+was not done for several reasons:
+        1. because the TML Modula-2 compiler prohibits redefinition of an
+           opaque type as equal to an already defined type (TYPE Vertex = CARDINAL
+           is flagged as an error);
+        2. making the definition of Vertex transparent in the Definition Module
+           exposes to clients an aspect of the implementation (violating information
+           hiding principles); and
+        3. transformation of the unbounded form into the bounded form, as was done
+           here, is facilitated by taking another approach.
+
+The approach used in this module takes advantage of the fact than an element
+of an array can be accessed through its ADDRESS. So internally the module can
+use indices into the adjacency list where necessary while still maintaining
+an abstract presentation to client modules.
+
+This organization is shown below in Figure 11.1.
+
+Figure 11.1
+
+Edge:                   completes the opaque definition as a reference to a dynamically
+                                allocated edge node.
+
+Vertex:                 completes the opaque definition as the address of a vertex node
+                                in the adjacency list array.
+
+VertexNode:             defines the information requirements for a single vertex of a
+                                graph.
+        data:           contains the label data item associated with a vertex.
+        next:           index of the next vertex in the set of vertices for a graph. The
+                                last vertex of the list has a 'next' of 0 indicating
+                                the end of the list.
+        edges:          link to the first directed edge leaving this vertex. If the vertex
+                                has no edges leaving it, this field is set to the NullEdge.
+        indegree:       is used in maintaining a count of the number of edges having this
+                                vertex as its destination excluding self-loops (which are edges
+                                whose source and destination vertices are the same). This count
+                                is maintained by the constructors Link, Unlink and Assign. It
+                                is used by the constructor Remove in detecting attempts to
+                                delete vertices referenced as the destination of an edge. Since
+                                the alternative technique for detecting this precondition is
+                                a complete traversal of all the edges of a graph, we have chosen
+                                to record this information incrementally as edges are inserted
+                                and removed from the graph.
+        inGraph:        contains the reference to the enclosing graph object for the vertex.
+                                This avoids having the graph as a parameter to the vertex selectors.
+                                In addition, simplifying the membership test between a vertex and a
+                                graph, as well as the membership test for edges (through the
+                                initial or final vertex references of the edge).
+
+EdgeNode:               defines the information requirements for a single edge of a graph.
+        initial:        contains a reference to the initial (or source) vertex of the edge.
+        final:          contains a reference to the final (or destination) vertex of the edge.
+        weight:         contains the attribute of the edge.
+        next:           contains the link to the next edge leaving the initial vertex.
+                                The last edge of this list contains the NullEdge as its value
+                                indicating the end of the list.
+
+UnboundedGraph: describes (and holds) attributes of the graph itself.
+        labelType,
+        attrType:       contain the data type ID for the vertex label and edge attribute,
+                                respectively. These two fields are used to retrieve the procedures
+                                accomplishing assignment and disposal of data items.
+        numVertices,
+        numEdges:       contain counts of the total number of vertices and edges in the
+                                graph, respectively. Thus, the selectors OrderOf and SizeOf are
+                                O(1) algorithms instead of O(|V|) or O(|E|).
+        firstVertex: index of the first vertex in the adjacency list for a graph.
+        available:      index of the first available vertex in the adjacency list of a graph.
+        vertices:       the adjacency list of vertices. When a graph is initially created
+                                the array is sized based on the maximum number of vertices desired. So
+                                while the upper bound on the VertexIndex is MaxVertex elements, the
+                                actual size of the array will be something less than this.
+*)
+
+TYPE  Vertex = POINTER TO VertexNode;
+TYPE  Edge   = POINTER TO EdgeNode;
+
+TYPE  VertexNode = RECORD
+                inGraph : Graph;        (*-- graph in which this vertex is a member *)
+                data    : Label;        (*-- data item (label) for this vertex *)
+                indegree: CARDINAL; (*-- # of edges ending at this vertex *)
+                next    : CARDINAL;     (*-- next vertex in adjacency list *)
+                edges   : Edge;         (*-- link to first edge leaving this vertex *)
+          END (*-- VertexNode *);
+
+TYPE  EdgeNode = RECORD
+                initial : Vertex;       (*-- source vertex for this edge *)
+                final   : Vertex;       (*-- destination vertex for this edge *)
+                weight  : Attribute;(*-- weight/attribute for this edge *)
+                next    : Edge;         (*-- next edge leaving this vertex *)
+          END (*-- EdgeNode *);
+
+CONST MaxVertex = 2000;
+TYPE  VertexIndex = [1 .. MaxVertex];
+TYPE  AdjList = ARRAY VertexIndex OF VertexNode;
+
+TYPE  BoundedGraph = RECORD
+                labelType  : TypeID;    (*-- vertex label data type ID *)
+                attrType   : TypeID;    (*-- edge attribute data type ID *)
+                maxVertices: CARDINAL;  (*-- maximum number of vertices *)
+                numVertices: CARDINAL;  (*-- current number of vertices *)
+                numEdges   : CARDINAL;  (*-- current number of edges *)
+                firstVertex: CARDINAL;  (*-- 1st vertex in adjacency list *)
+                available  : CARDINAL;  (*-- 1st free vertex in adjacency list *)
+                vertices   : AdjList;   (*-- adjacency list of vertices *)
+          END (*-- BoundedGraph *);
+
+TYPE  Graph = POINTER TO BoundedGraph;
+
+        (*-------------------------*)
+
+(*
+11.2.2  Exception Handling
+
+graphError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+graphError before any other processing.
+
+The handlers array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see 10.3.12).
+
+GraphError      simply returns the current exception result stored
+                        in graphError and is used to determine whether a graph
+                        operation completed successfully.
+
+SetHandler      makes theHandler the current exception handler for theError
+                        by storing theHandler in the handler array.
+
+GetHandler      returns the current exception handler for theError from the
+                        handler array.
+*)
+
+VAR   graphError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE GraphError () : Exceptions               (*--out  *);
+BEGIN
+  RETURN graphError;
+END GraphError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                                                  theHandler : HandlerProc (*--in   *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                                                         : HandlerProc (*--out  *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*--in   *);
+                                                  theError   : Exceptions  (*--in   *));
+BEGIN
+  graphError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+(*
+11.2.3  Local Routines
+
+FreeAttribute is responsible for retrieval of the edge attribute item disposal
+routine and freeing the attribute when no longer needed. This occurs when
+        1. a graph is cleared or destroyed (Clear);
+        2. an edge is removed from a graph (Unlink);
+        3. a vertex is removed from a graph and any edges leaving it are implicitly
+           removed (ClearEdges); or
+        4. a new attribute is assigned to an edge (SetAttribute).
+Complexity: O(1).
+*)
+
+PROCEDURE FreeAttribute (    theEdge : Edge (*--inout*));
+
+VAR   free : DisposeProc; (*-- attribute disposal routine, if any *)
+
+BEGIN
+  WITH theEdge^ DO
+        free := DisposeOf(initial^.inGraph^.attrType);
+        free(weight);
+  END (*--with*);
+END FreeAttribute;
+(*-------------------------*)
+
+(*
+FreeLabel corresponds to FreeAttribute, above, for the clean-up of vertex labels
+when they are no longer needed. The conditions are similar to those above:
+        1. a graph is cleared or destroyed (Clear);
+        2. an vertex is removed from a graph (Remove); or
+        3. a new label is assigned to a vertex (SetLabel).
+Complexity: O(1).
+*)
+
+PROCEDURE FreeLabel (    theVertex : Vertex (*--inout*));
+
+VAR   free : DisposeProc; (*-- label disposal routine, if any *)
+
+BEGIN
+  WITH theVertex^ DO
+        free := DisposeOf(inGraph^.labelType);
+        free(data);
+  END (*--with*);
+END FreeLabel;
+(*-------------------------*)
+
+(*
+InitVertex initializes a single vertex for the free list. O(1)
+InitFreeList initializes the free list of available vertices. The free list
+of vertices is initialized when a graph is created or when a graph is cleared
+of its contents. O(s), where s is the size of the bounded array of vertices.
+*)
+
+PROCEDURE InitFreeList (VAR theGraph : Graph      (*--inout*));
+
+  PROCEDURE InitVertex   (VAR theNode  : VertexNode (*--inout*);
+                                                          theNext  : CARDINAL   (*--in   *));
+  BEGIN
+    WITH theNode DO
+          inGraph  := theGraph;
+          data     := NullItem;
+          indegree := 0;
+          next     := theNext;
+          edges    := NullEdge;
+    END (*--with*);
+  END InitVertex;
+
+VAR   v : VertexIndex; (*-- running index over vertices of the graph *)
+
+BEGIN
+  WITH theGraph^ DO
+    FOR v := MIN(VertexIndex) TO maxVertices-1 DO
+          InitVertex(vertices[v], v+1);
+        END (*--for*);
+        InitVertex(vertices[maxVertices], 0);
+        numVertices := 0;
+        firstVertex := 0;
+        available   := MIN(VertexIndex);
+  END (*--with*);
+END InitFreeList;
+(*-------------------------*)
+
+(*
+ClearEdges removes all edges leaving a given vertex. This is necessary when
+        1. a graph is cleared or destroyed (Clear); or
+        2. a vertex is removed from a graph (Remove).
+Essentially, the algorithm loops over each edge in the edge list for the vertex
+removing the edge from the list, updating the number of edges in the graph,
+deallocation of the edge attribute and, finally, deallocation of the edge itself.
+Since we guarantee the last edge in the list has a 'next' of NullEdge, 'edges'
+(the vertex's link to the first edge) is properly set to the NullEdge upon
+completion of the routine. O(outdegree(v)).
+*)
+
+PROCEDURE ClearEdges    (    theVertex: Vertex   (*--inout*));
+
+VAR   theEdge : Edge;            (*-- edge to be removed *)
+
+BEGIN
+  WITH theVertex^ DO
+        WHILE (edges # NullEdge) DO
+          theEdge := edges;
+          edges := edges^.next;
+          DEC(inGraph^.numEdges);
+          FreeAttribute(theEdge);
+          Deallocate(theEdge, SIZE(theEdge^));
+        END (*--while*);
+  END (*--with*);
+END ClearEdges;
+(*-------------------------*)
+
+(*
+NewEdge simple creates a new edge with the specified vertex endpoints and weight.
+The edge is not added to any edge list, leaving this to the caller. The overflow
+exception is automatically raised, if necessary, when a new edge node cannot be
+allocated. The structural sharing of the edge attribute is controlled, as described
+above for NewVertex, using a similar mechanism. Complexity O(1).
+*)
+
+PROCEDURE NewEdge (    fromVertex : Vertex     (*--in   *);
+                                           toVertex   : Vertex     (*--in   *);
+                                           theWeight  : Attribute  (*--in   *);
+                                           theRoutine : Operations (*--in   *))
+                                                                  : Edge           (*--out  *);
+
+VAR   theEdge : Edge;   (*-- newly created edge *)
+
+BEGIN
+  Allocate(theEdge, SIZE(EdgeNode));
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(theRoutine, overflow);
+  ELSE
+    WITH theEdge^ DO
+          initial := fromVertex;
+          final   := toVertex;
+          weight  := theWeight;
+          next    := NullEdge;
+    END (*--with*);
+  END (*--if*);
+  RETURN theEdge;
+END NewEdge;
+(*-------------------------*)
+
+
+(*
+11.2.4  Graph Constructors
+
+Create attempts to form a new, empty graph object with the given maximum
+number of vertices (theSize) and vertex label and edge label data types.
+First, the graph descriptor is allocated, the free list of vertices is
+initialized, and the vertex and edge data type IDs are stored in the graph
+descriptor. The number of vertices and edges are initialized to zero.
+If the descriptor allocation fails the overflow exception is raised and the
+NullGraph is returned, otherwise we return the newly allocated graph.
+Complexity O(theSize) due to the initialization of the free list of vertices.
+*)
+
+CONST baseSize = SIZE(BoundedGraph) - SIZE(AdjList);
+CONST nodeSize = SIZE(VertexNode);
+
+PROCEDURE Create   (    labels     : TypeID    (*--in   *);
+                                            attributes : TypeID    (*--in   *);
+                                            theSize    : CARDINAL  (*--in   *))
+                                                                   : Graph     (*--out  *);
+
+VAR   newGraph : Graph; (*-- temporary for new graph object *)
+
+BEGIN
+  graphError := noerr;
+  Allocate(newGraph, baseSize + (VAL(INTEGER, theSize) * nodeSize));
+  IF (newGraph = NullGraph) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newGraph^ DO
+          labelType   := labels;
+          attrType    := attributes;
+          maxVertices := theSize;
+          numEdges    := 0;
+        END (*--with*);
+        InitFreeList(newGraph);
+  END (*--if*);
+  RETURN newGraph;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy clears theGraph and then deallocates it making theGraph undefined.
+SCLStorage.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullGraph). Complexity O(v+e).
+*)
+
+PROCEDURE Destroy (VAR theGraph      : Graph     (*--inout*));
+BEGIN
+  Clear(theGraph);
+  IF (graphError = noerr) THEN
+    Deallocate(theGraph, baseSize + (theGraph^.maxVertices * nodeSize));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear removes all vertices and edges from theGraph making theGraph empty.
+We do this by iterating over each of the vertices and clearing all edges
+leaving the vertex (ClearEdges). As a final step we ensure that the graph is left in the
+empty state by resetting the head of the adjacency list to NIL and the number
+of vertices and edges in the graph to zero. The free list of available
+vertices is also reinitialized. Complexity O(v+e).
+*)
+
+PROCEDURE Clear   (VAR theGraph      : Graph    (*--inout*));
+
+VAR   theVertex : CARDINAL;        (*-- loop index over vertices *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theGraph^ DO
+          theVertex  := firstVertex;
+          WHILE (theVertex # 0) DO
+            ClearEdges(ADR(vertices[theVertex]));
+                FreeLabel(ADR(vertices[theVertex]));
+                theVertex := vertices[theVertex].next;
+          END (*--for*);
+        END (*--with*);
+        InitFreeList(theGraph);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign copies the source graph, theGraph, to the target graph, toGraph. The
+main body of Assign does this by first copying all the vertices followed by
+copying all the edges from the source to the destination graph.
+The algorithmic complexity is O(v^2+e) due to the mapping between the vertices
+of the source and target graphs while copying the edges (see the discussion
+of the vertexMap following RecreateTarget).
+*)
+
+PROCEDURE Assign  (    theGraph      : Graph     (*--in   *);
+                                   VAR toGraph       : Graph     (*--inout*));
+
+(*
+RecreateTarget reconstructs the target graph descriptor so that the fields
+defining the vertex label and edge attribute data types,
+and (optionally) maximum number of vertices between the
+source and destination graphs are the same. If the source and destination
+graphs are the same the routine returns FALSE indicating that the postconditions
+for the assignment operation are already met.
+The routine returns TRUE if the recreation of the target was successful.
+Complexity O(v+e) where v and e are the number of vertices and
+edges, respectively, in the original toGraph.  When Clearing the target graph
+is unnecessary (the toGraph is initially the NullGraph) the complexity falls
+to O(1)..
+*)
+
+  PROCEDURE RecreateTarget (): BOOLEAN (*--out  *);
+  BEGIN
+        IF (theGraph = NullGraph) THEN
+      RaiseErrIn(assign, undefined);
+
+        ELSIF (toGraph = NullGraph) THEN
+      WITH theGraph^ DO
+        toGraph := Create(labelType, attrType, maxVertices);
+          END (*--with*);
+
+        ELSIF (theGraph = toGraph) THEN
+      RETURN FALSE;
+
+        ELSIF (theGraph^.numVertices > toGraph^.maxVertices) THEN
+          RaiseErrIn(assign, overflow);
+
+        ELSE
+          Clear(toGraph);
+      WITH theGraph^ DO
+                toGraph^.labelType := labelType;
+                toGraph^.attrType  := attrType;
+          END (*--with*);
+        END (*--if*);
+        RETURN (graphError = noerr);
+  END RecreateTarget;
+
+(*
+One thorny issue in graph assignment is how to set-up the copied edges with the
+proper initial and final vertices? The edges of the source graph contain references
+to the source graph's vertices, not those of the target graph. The vertex
+labels cannot be used since more than one vertex can have the same label. In
+this case, an edge from the second (or greater) such vertex in the target graph
+would be linked incorrectly to the first vertex having that label. The solution
+is in having some form of temporary mapping from the source graph's vertices to
+their counterpart in the target graph. The necessary operations are add a mapping
+between a vertex from the source graph and its corresponding vertex in the
+target graph, and given a source graph vertex return the target graph vertex
+mapped to that source vertex.
+
+The data structure implementing our vertex mapping is an unordered array of mapping
+entries, one per vertex, between the vertices of the source graph and the
+target graph. This array is dynamically created on the heap based on the
+number of vertices in the source graph. (The ARRAY [0..0] OF ≡ construct is
+a special feature of the TML Modula-2 compiler allowing dynamic arrays.) The
+variable mapExtent controls where MapVertex entries are inserted into the
+array. A post-increment scheme is used so mapVertex is always one greater than
+the number of entries stored in the array.
+*)
+
+  TYPE  MapVertex = RECORD
+              old : Vertex; (*-- vertex from source graph *)
+              new : Vertex; (*-- corresponging vertex in target graph *)
+            END (*--MapVertex*);
+  TYPE  MapVertices = ARRAY [0..0] OF MapVertex;
+
+  VAR   vertexMap : POINTER TO MapVertices;
+  VAR   mapExtent : CARDINAL;
+
+
+(*
+CreateVertexMap allocates a dynamic array of vertex mapping entries on the
+heap based on the number of vertices in the source graph. vertexMap is set to
+NIL by Allocate if there isn't enough memory available to meet the request.
+*)
+
+  PROCEDURE CreateVertexMap;
+  BEGIN
+        Allocate(vertexMap,
+                         VAL(CARDINAL, SIZE(MapVertex)) * theGraph^.numVertices);
+        mapExtent := 0;
+  END CreateVertexMap;
+
+(*
+AddVertexToMap adds a mapping between the vertices of the source and target graphs.
+*)
+
+  PROCEDURE AddToVertexMap (    oldVertex : Vertex (*--in   *);
+                                                                newVertex : Vertex (*--in   *));
+  BEGIN
+        WITH vertexMap^[mapExtent] DO
+          old := oldVertex;
+          new := newVertex;
+        END (*--with*);
+    INC(mapExtent);
+  END AddToVertexMap;
+
+(*
+VertexInMap returns the mapping between the vertices of the source and target
+graphs. Since every vertex is represented failure to find a mapping is
+indicative of either a programming error in CopyVertices or a hardware/system
+software error at runtime.
+*)
+
+  PROCEDURE VertexInMap (    oldVertex : Vertex (*--in   *))
+                                                                           : Vertex (*--out  *);
+
+  VAR   index : CARDINAL;
+
+  BEGIN
+    FOR index := 0 TO mapExtent-1 DO
+          WITH vertexMap^[index] DO
+        IF (oldVertex = old) THEN
+                  RETURN new;
+                END (*--if*);
+          END (*--with*);
+    END (*--for*);
+        RETURN NullVertex;
+  END VertexInMap;
+
+(*
+DestroyVertexMap frees up the memory used by the vertexMap when the Assign
+operation is complete. Remember that Deallocate automatically
+releases the proper amount of space.
+*)
+
+  PROCEDURE DestroyVertexMap;
+  BEGIN
+        Deallocate(vertexMap, SIZE(vertexMap^));
+  END DestroyVertexMap;
+
+(*
+CopyVertices duplicates the vertices from the source graph to the destination
+graph returning TRUE if every vertex was successfully copied and FALSE otherwise.
+This BOOLEAN result is used by the main body of Assign to control whether to
+continue with the Assign operation by copying the edges. The following local
+variables are used:
+        1. v:                   indicates the current vertex being copied from the source
+                                        graph. This is also used as a 'loop index' over the vertices
+                                        from the source graph.
+        2. newVertex:   temporary for a new vertex for the destination graph.
+        3. lastVertex:  last vertex inserted into the destination graph. This is
+                                        used by TailInsert to add a new vertex to the end of the
+                                        destination graph's adjacency list.
+        4. assignItem:  vertex label assignment routine.
+
+Assignment of the vertex label presents an interesting situation. When a vertex
+is added to a graph, the client module expects the given label to be copied using
+the Modula-2 assignment statement (even for dynamically allocated data items)
+since we simply need to store the value in the vertex object. This is known as
+'structural sharing'. But when a graph is duplicated using Assign, new copies
+of the vertex labels are necessary - avoiding the problems presented by structural
+sharing of dynamically allocated items as described in Volume 1. CopyVertices
+resolves this through the assignment procedure associated with the graph's label
+data type duplicating the label as a NewVertex is created. Complexity O(v) where
+v is the number of vertices in the source graph.
+*)
+
+  PROCEDURE CopyVertices () : BOOLEAN;
+
+  VAR   v : CARDINAL;   (*--loop index over vertices being copied *)
+  VAR   theVertex : CARDINAL; (*-- index to new vertex *)
+  VAR   lastVertex: CARDINAL; (*--last vertex added to list of vertices *)
+  VAR   assignItem: AssignProc;
+
+(*
+TailInsert adds newVertex to the end of the target graph's adjacency list
+given pointers to the first and last elements of the list. Complexity O(1).
+*)
+
+    PROCEDURE TailInsert (VAR first : CARDINAL (*--inout *);
+                                                  VAR last  : CARDINAL (*--inout *));
+    BEGIN
+      IF (first = 0) THEN
+            first := theVertex;
+          ELSE
+            toGraph^.vertices[last].next := theVertex;
+          END (*--if*);
+          last := theVertex;
+    END TailInsert;
+
+  BEGIN
+        CreateVertexMap;
+        IF (vertexMap = NIL) THEN
+          RETURN FALSE;
+        END (*--if*);
+
+        assignItem := AssignOf(theGraph^.labelType);
+        v := theGraph^.firstVertex;
+        lastVertex := 0;
+
+    WHILE (v # 0) DO
+          WITH toGraph^ DO
+            theVertex := available;
+            available := vertices[available].next;
+
+            WITH vertices[theVertex] DO
+              inGraph  := toGraph;
+                  data     := assignItem(theGraph^.vertices[v].data);
+                  indegree := theGraph^.vertices[v].indegree;
+                  next     := 0;
+                  edges    := NullEdge;
+            END (*--with*);
+
+            TailInsert(firstVertex, lastVertex);
+            INC(numVertices);
+            AddToVertexMap(ADR(theGraph^.vertices[v]),
+                                           ADR(vertices[theVertex]));
+          END (*--with*);
+          v := theGraph^.vertices[v].next;
+        END (*--while*);
+
+        RETURN TRUE;
+  END CopyVertices;
+
+
+(*
+CopyEdges iterates over the edges of the source graph through the adjacency
+list of vertices and the edge lists for each vertex. As each edge in the
+source graph is encountered, a new edge is constructed in the target graph.
+This edge is then added to the target graph's vertex equivalent to the edges'
+initial vertex. The initial and final vertices of the new edge are retrieved
+from the vertex map created by CopyVertices. Note that NewEdge will raise the
+overflow exception if necessary.
+
+The following local variables are used:
+        v:                      indicates the current vertex from the source graph whose
+                                edges are being copied. This is also used as a 'loop index'
+                                over the vertices of the source graph.
+        e:                      indicates the current edge of the source graph being copied.
+                                Also used as a 'loop index' over the edges leaving each
+                                vertex, v.
+        fromVertex: the vertex of the target graph corresponding to 'v' in the
+                                source graph. Since all edges leaving any given vertex, v,
+                                have have 'v' as their initial vertex, fromVertex can be
+                                derived from the current vertex of the source graph rather than
+                                repeatedly retrieving it from the initial vertex of the edge.
+        newEdge:        temporary for a new edge in the target graph.
+        lastEdge:       last edge inserted into the edge list of the current vertex
+                                (fromVertex) destination graph. This is used by TailInsert
+                                to add a new edge to the end of fromVertex's edge list.
+        assignItem:     edge attribute assignment routine.
+
+So while the basic loop over the edges is linear with respect to the number of
+edges, the linear search of the vertex map nested within the loop over the
+source graph's vertices gives this algorithm time complexity O(v^2). A better
+mapping algorithm (i.e, one of constant time O(1)) would yield a linear time
+algorithm overall for the graph assignment.
+*)
+
+  PROCEDURE CopyEdges;
+
+  VAR   v : CARDINAL;             (*--loop index over vertices *)
+  VAR   e : Edge;                 (*--loop index over edges being copied *)
+  VAR   fromVertex: Vertex;   (*--vertex in target graph *)
+  VAR   newEdge   : Edge;         (*--new edge for target graph *)
+  VAR   lastEdge  : Edge;         (*--last edge inserted into new list of edges *)
+  VAR   assignItem: AssignProc; (*--attribute assignment procedure *)
+
+(*
+TailInsert adds newEdge to the end of the edge list given pointers to the first
+and last elements of the list. Complexity O(1)
+*)
+
+    PROCEDURE TailInsert (VAR first   : Edge (*--inout*);
+                                                  VAR last    : Edge (*--inout*));
+    BEGIN
+      IF (first = NullEdge) THEN
+            first := newEdge;
+          ELSE
+            last^.next := newEdge;
+          END (*--if*);
+          last := newEdge;
+    END TailInsert;
+
+  BEGIN
+        assignItem := AssignOf(theGraph^.attrType);
+        v := theGraph^.firstVertex;
+    WHILE (v # 0) DO
+          lastEdge := NullEdge;
+          WITH theGraph^ DO
+            e := vertices[v].edges;
+            fromVertex := VertexInMap(ADR(vertices[v]));
+          END (*--with*);
+          WHILE (e # NullEdge) DO
+            newEdge := NewEdge(fromVertex,
+                                                   VertexInMap(e^.final),
+                                                   assignItem(e^.weight),
+                                                   assign);
+                IF (newEdge = NullEdge) THEN
+                  RETURN;
+                END (*--if*);
+
+                TailInsert(fromVertex^.edges, lastEdge);
+                INC(toGraph^.numEdges);
+                e := e^.next;
+          END (*--while*);
+          v := theGraph^.vertices[v].next;
+        END (*--while*);
+  END CopyEdges;
+
+BEGIN (*-- Assign --*)
+  graphError := noerr;
+  IF RecreateTarget() & CopyVertices() THEN
+        CopyEdges;
+        DestroyVertexMap;
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+11.2.5  Vertex Constructors
+
+Insert adds a vertex to the given graph labeling the vertex with the
+given item.  If there are no available vertices in the free list the
+overflow exception is raised and the Insert operation aborted. Complexity O(1).
+*)
+
+PROCEDURE Insert   (VAR theGraph   : Graph     (*--inout*);
+                                        theItem    : Label     (*--in   *);
+                                        VAR theVertex  : Vertex    (*--out  *));
+
+VAR   theIndex : CARDINAL; (*-- vertex index into the adjacency list *)
+
+BEGIN
+  graphError := noerr;
+  theVertex  := NullVertex;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(insert, undefined);
+  ELSIF (theGraph^.available = 0) THEN
+    RaiseErrIn(insert, overflow);
+  ELSE
+    WITH theGraph^ DO
+          theIndex := available;
+          available := vertices[available].next;
+          WITH vertices[theIndex] DO
+            inGraph  := theGraph;
+                data     := theItem;
+                indegree := 0;
+                next     := firstVertex;
+                edges    := NullEdge;
+          END (*--with*);
+          firstVertex := theIndex;
+          INC(numVertices);
+          theVertex := ADR(vertices[theIndex]);
+        END (*--with*);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+(*
+Remove deletes the given vertex from the specified graph. If no such vertex
+can be found in the graph the novertex exception is raised and the routine
+aborted. Deleting a vertex that is the head of an edge would leave dangling
+edges (pointing to a non-existent vertex), and so, if the vertex is referenced
+by an edge (other than a self-loop) the exception references is raised and
+Remove is aborted. After we have checked that no exceptions can occur we remove
+all edges leaving the vertex, remove the vertex from the adjacency list,
+release any dynamically allocated memory used by the vertex label, release the
+vertex itself, and update the count of vertices in the graph. Complexity
+O(v).
+*)
+
+PROCEDURE Remove   (VAR theGraph   : Graph     (*--inout*);
+                                    VAR theVertex  : Vertex    (*--inout*));
+
+VAR   theIndex   : CARDINAL; (*-- of theItem to be removed *)
+VAR   priorVertex: CARDINAL; (*-- immediate predecessor of theVertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(remove, undefined);
+
+  ELSIF (theVertex = NullVertex) THEN
+    RaiseErrIn(remove, nullvertex);
+
+  ELSIF (theVertex^.inGraph # theGraph) THEN
+    RaiseErrIn(remove, novertex);
+
+  ELSIF (theVertex^.indegree > 0) THEN
+        RaiseErrIn(remove, referenced);
+
+  ELSE
+        ClearEdges(theVertex);
+        FreeLabel(theVertex);
+
+    WITH theGraph^ DO
+
+(*
+The following loop searches for the given vertex in the adjacency list array
+keeping track of the array index of theVertex's predecessor. This is used
+immediately after the loop to update the singly-linked list of vertices for the graph.
+*)
+      theIndex  := firstVertex;
+          priorVertex := 0;
+          WHILE (ADR(vertices[theIndex]) # theVertex) DO
+            priorVertex := theIndex;
+            theIndex    := vertices[theIndex].next;
+          END (*--while*);
+
+(*
+Remove the vertex from the adjacency list.
+*)
+          IF (priorVertex = 0) THEN
+                firstVertex := vertices[theIndex].next;
+          ELSE
+                vertices[priorVertex].next := vertices[theIndex].next;
+          END (*--if*);
+
+(*
+Update the graph component by adding the deleted vertex to the available list and the
+count of the number of vertices in the graph. Ensure that the vertex is no longer a
+valid member of the graph by clearing the vertexes reference to its enclosing graph.
+*)
+          vertices[theIndex].next := available;
+          vertices[theIndex].inGraph := NullGraph;
+          available := theIndex;
+          DEC(numVertices);
+        END (*--with*);
+        theVertex := NullVertex;
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+(*
+SetLabel assigns a new label to the given vertex of the graph. Prior to
+assigning a new vertex label we must release any dynamically allocated memory
+used by the old vertex label. Complexity O(1).
+*)
+
+PROCEDURE SetLabel (    theVertex  : Vertex    (*--inout*);
+                                            theItem    : Label     (*--in   *));
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(setlabel, nullvertex);
+  ELSE
+        FreeLabel(theVertex);
+    theVertex^.data := theItem;
+  END (*--if*);
+END SetLabel;
+(*-------------------------*)
+
+(*
+11.2.6  Edge Constructors
+
+Link adds a directed edge between the from and to vertices labeling the
+edge with the given weight attribute. The new edge is linked to the front
+of the fromVertex's edge list. Thus, edges appear in reverse order to their
+order of insertion. Complexity O(1).
+*)
+
+PROCEDURE Link     (VAR theGraph   : Graph     (*--inout*);
+                                        fromVertex : Vertex    (*--in   *);
+                                        toVertex   : Vertex    (*--in   *);
+                                        theWeight  : Attribute (*--in   *);
+                                        VAR theEdge    : Edge      (*--out  *));
+BEGIN
+  graphError := noerr;
+  theEdge    := NullEdge;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(link, undefined);
+  ELSIF (fromVertex = NullVertex) OR (toVertex = NullVertex) THEN
+    RaiseErrIn(link, nullvertex);
+  ELSIF (fromVertex^.inGraph # theGraph) OR
+                (toVertex^.inGraph # theGraph) THEN
+    RaiseErrIn(link, novertex);
+  ELSE
+
+    theEdge := NewEdge(fromVertex, toVertex, theWeight, link);
+        IF (theEdge # NullEdge) THEN
+          theEdge^.next := fromVertex^.edges;
+          fromVertex^.edges := theEdge;
+          IF (fromVertex # toVertex) THEN
+                INC(toVertex^.indegree);
+          END (*--if*);
+          INC(theGraph^.numEdges);
+        END (*--with*);
+  END (*--if*);
+END Link;
+(*-------------------------*)
+
+(*
+Unlink removes a directed edge between the two vertices, fromVertex and
+toVertex. Complexity O(d) where d is the out-degree of the fromVertex.
+*)
+
+PROCEDURE Unlink   (VAR theGraph   : Graph     (*--inout*);
+                                    VAR theEdge    : Edge      (*--inout*));
+
+VAR   e : Edge;   (*-- pointer to edge (v,w), if any *)
+VAR   f : Edge;   (*-- pointer to edge preceeding (v,w) in adjacency list *)
+
+BEGIN
+  graphError := noerr;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(unlink, undefined);
+
+  ELSIF (theEdge = NullEdge) THEN
+        RaiseErrIn(unlink, nulledge);
+
+  ELSIF (theEdge^.initial^.inGraph # theGraph) THEN
+    RaiseErrIn(unlink, noedge);
+
+  ELSE
+
+(*
+The following loop searches for the edge being removed in the list of edges
+associated with the edges' initial vertex. In addition, we need the prior
+edge in the list for the actual deletion of the edge from the list. This is
+a standard singly-linked list technique for the deletion of list nodes.
+This loop is guaranteed to succeed as Link ensures that the edge is placed in
+the initial vertex's list of edges. Complexity O(outdegree(v)).
+*)
+        e := theEdge^.initial^.edges;
+        f := NullEdge;
+        WHILE (e # theEdge) DO
+          f := e;
+          e := e^.next;
+        END (*--while*);
+
+        WITH theEdge^ DO
+
+(*
+Update the edge list of the initial vertex by removing the edge.
+*)
+          IF (f = NullEdge) THEN
+            initial^.edges := next;
+          ELSE
+            f^.next := next;
+          END (*--if*);
+
+(*
+Self-loops are not included in the final vertex's indegree count since such
+edges may be freely unlinked and do not effect the removal of the vertex. In
+any case, we must maintain the proper count of edges in the graph. As a final
+step, the edge attribute and the edge itself may be deallocated. To prevent
+clients from successfully accessing copies of an edge, the 'initial' and 'next'
+fields are set to empty (and illegal) values. This prevents any copies from
+being considered legal edges of the graph even though they have been deleted.
+*)
+          IF (initial # final) THEN
+            DEC(final^.indegree);
+          END (*--if*);
+          DEC(initial^.inGraph^.numEdges);
+
+      FreeAttribute(theEdge);
+          initial := NullVertex;
+          next    := NullEdge;
+          Deallocate(theEdge, SIZE(theEdge^));
+        END (*--with*);
+  END (*--if*);
+END Unlink;
+(*-------------------------*)
+
+(*
+SetAttribute assigns a new edge labelling to the given edge. Prior to assigning
+a new edge attribute we must release any dynamically allocated memory
+used by the old edge attribute. Complexity O(1).
+*)
+
+PROCEDURE SetAttribute  (    theEdge    : Edge      (*--inout*);
+                                             theWeight  : Attribute (*--in   *));
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+        RaiseErrIn(setattr, nulledge);
+  ELSE
+    FreeAttribute(theEdge);
+    theEdge^.weight := theWeight;
+  END (*--if*);
+END SetAttribute;
+(*-------------------------*)
+
+(*
+11.2.7  Graph Selectors
+
+IsDefined verifies to the best of its ability whether theGraph has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theGraph  : Graph       (*--in   *))
+                                                                   : BOOLEAN     (*--out  *);
+BEGIN
+  RETURN (theGraph # NullGraph);
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theGraph is in the empty state, as indicated by
+the number of vertices being zero, and False otherwise.  As per the
+specification (û9.3) undefined graphs are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theGraph  : Graph       (*--in   *))
+                                                                   : BOOLEAN     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isempty, undefined);
+        RETURN TRUE;
+  END (*--if*);
+  RETURN theGraph^.numVertices = 0;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+TypeOf simply returns the vertex label and edge attribute data type IDs for
+the given graph. Undefined graphs, as always, raise the undefined exception
+and return a reasonable value, in this case the NullType. Complexity O(1).
+*)
+
+PROCEDURE TypeOf    (    theGraph  : Graph       (*--in   *);
+                                         VAR labelType : TypeID      (*--out  *);
+                                         VAR attrType  : TypeID      (*--out  *));
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(typeof, undefined);
+        labelType := NullType;
+        attrType  := NullType;
+  ELSE
+        labelType := theGraph^.labelType;
+        attrType  := theGraph^.attrType;
+  END (*--if*);
+END TypeOf;
+(*-------------------------*)
+
+(*
+OrderOf returns the number of vertices in the graph, or zero for an undefined
+graph. Complexity O(1).
+*)
+
+PROCEDURE OrderOf   (    theGraph  : Graph       (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(orderof, undefined);
+        RETURN 0;
+  END (*--if*);
+  RETURN theGraph^.numVertices;
+END OrderOf;
+(*-------------------------*)
+
+(*
+OrderOf returns the number of edges in the graph, or zero for an undefined
+graph. Complexity O(1).
+*)
+
+PROCEDURE SizeOf    (    theGraph  : Graph       (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(sizeof, undefined);
+        RETURN 0;
+  END (*--if*);
+  RETURN theGraph^.numEdges;
+END SizeOf;
+(*-------------------------*)
+
+(*
+MaxOrderOf retuens the maximum number of vertices for the given graph, or zero
+for an undefined graph. Essentially, this is the maximum size of the list of
+vertices (both used and available). Complexity O(1).
+*)
+
+PROCEDURE MaxOrderOf (    theGraph  : Graph       (*--in   *))
+                                                                    : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(maxorderof, undefined);
+        RETURN 0;
+  END (*--if*);
+  RETURN theGraph^.maxVertices;
+END MaxOrderOf;
+(*-------------------------*)
+
+(*
+11.2.8  Vertex Selectors
+
+InDegree returns the number of edges entering the given vertex. Complexity O(1).
+*)
+
+PROCEDURE InDegree  (    theVertex : Vertex      (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(indegree, nullvertex);
+  ELSE
+    RETURN theVertex^.indegree;
+  END (*--if*);
+  RETURN 0;
+END InDegree;
+(*-------------------------*)
+
+(*
+OutDegree returns the number of edges leaving the given vertex. We do this by
+simply iterating over the edges of the vertex counting them along the way.
+Complexity O(outdegree(v)).
+*)
+
+PROCEDURE OutDegree (    theVertex : Vertex      (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+
+VAR   theEdge   : Edge;         (*-- loop index over edges of the vertex *)
+VAR   edgeCount : CARDINAL; (*-- running count of edges leaving this vertex *)
+
+BEGIN
+  graphError := noerr;
+  edgeCount  := 0;
+
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(outdegree, nullvertex);
+  ELSE
+    theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) DO
+          INC(edgeCount);
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+
+  RETURN edgeCount;
+END OutDegree;
+(*-------------------------*)
+
+(*
+LabelOf returns the vertex label associated with the given vertex.
+If the vertex is undefined the NullItem is returned. Complexity O(1).
+Complexity O(1).
+*)
+
+PROCEDURE LabelOf   (    theVertex : Vertex      (*--in   *))
+                                                                   : Label       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(labelof, nullvertex);
+  ELSE
+    RETURN theVertex^.data;
+  END (*--if*);
+  RETURN NullItem;
+END LabelOf;
+(*-------------------------*)
+
+(*
+Since we have stored a copy of the graph object associated with each vertex
+as a field of the vertex itself, IsVertex simply needs to compare the given
+graph with its own local state. This saves us from having to search the graph.
+Complexity O(1).
+*)
+
+PROCEDURE IsVertex  (    theGraph  : Graph       (*--in   *);
+                                             theVertex : Vertex      (*--in   *))
+                                                           : BOOLEAN     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isvertex, undefined);
+  ELSIF (theVertex = NullVertex) THEN
+    RaiseErrIn(isvertex, nullvertex);
+  ELSE
+    RETURN theVertex^.inGraph = theGraph;
+  END (*--if*);
+  RETURN FALSE;
+END IsVertex;
+(*-------------------------*)
+
+(*
+GraphOf simply returns its copy of the enclosing graph or the NullGraph if the
+vertex is undefined. Complexity O(1).
+*)
+
+PROCEDURE GraphOf   (    theVertex : Vertex      (*--in   *))
+                                                                   : Graph       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(graphof, nullvertex);
+  ELSE
+    RETURN theVertex^.inGraph;
+  END (*--if*);
+  RETURN NullGraph;
+END GraphOf;
+(*-------------------------*)
+
+(*
+11.2.9  Edge Selectors
+
+AttributeOf returns the edge attribute associated with the given edge.
+If the edge is undefined the NullItem is returned. Complexity O(1).
+*)
+
+PROCEDURE AttributeOf (    theEdge   : Edge        (*--in   *))
+                                                                 : Attribute   (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(attrof, nulledge);
+  ELSE
+    RETURN theEdge^.weight;
+  END (*--if*);
+  RETURN NullItem;
+END AttributeOf;
+(*-------------------------*)
+
+(*
+Given an edge, InitialOf returns the vertex that is the origin of
+the directed edge or the NullVertex if the edge is undefined. Complexity O(1).
+*)
+
+PROCEDURE InitialOf   (    theEdge   : Edge        (*--in   *))
+                                                                 : Vertex      (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(initialof, nulledge);
+  ELSE
+    RETURN theEdge^.initial;
+  END (*--if*);
+  RETURN NullVertex;
+END InitialOf;
+(*-------------------------*)
+
+(*
+Given an edge, FinalOf returns the vertex that is the destination of
+the directed edge or the NullVertex if the edge is undefined. Complexity O(1).
+*)
+
+PROCEDURE FinalOf     (    theEdge   : Edge        (*--in   *))
+                                                                 : Vertex      (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(finalof, nulledge);
+  ELSE
+    RETURN theEdge^.final;
+  END (*--if*);
+  RETURN NullVertex;
+END FinalOf;
+(*-------------------------*)
+
+(*
+IsEdge returns true if there the given directed edge is an edge of the given
+graph and false otherwise. An advantage of having each vertex identify its
+enclosing graph object is use of this field in testing whether the edge is
+part of a specified graph. This saves use from having to search every edge in
+the graph. Complexity O(1).
+*)
+
+PROCEDURE IsEdge      (    theGraph  : Graph       (*--in   *);
+                                               theEdge   : Edge        (*--in   *))
+                                                             : BOOLEAN     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isedge, undefined);
+  ELSIF (theEdge = NullEdge) THEN
+    RaiseErrIn(isedge, nulledge);
+  ELSIF (theEdge^.initial = NullVertex) THEN
+    RaiseErrIn(isedge, nullvertex);
+  ELSE
+    RETURN theEdge^.initial^.inGraph = theGraph;
+  END (*--if*);
+  RETURN FALSE;
+END IsEdge;
+(*-------------------------*)
+
+(*
+11.2.10 Passive Iterators
+
+LoopVertices simply iterates over the vertices of the given graph until every
+vertex has been examined or the process procedure parameter returns FALSE,
+whichever occurs first. Complexity O(v).
+*)
+
+PROCEDURE LoopVertices (    theGraph  : Graph          (*--in   *);
+                                                        process   : VertexLoopProc (*--in   *));
+
+VAR   theIndex : CARDINAL; (*--loop index over vertices *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(loopvertices, undefined);
+  ELSE
+    WITH theGraph^ DO
+          theIndex := firstVertex;
+          WHILE (theIndex # 0) & process(ADR(vertices[theIndex])) DO
+            theIndex := vertices[theIndex].next;
+          END (*--while*);
+        END (*--with*);
+  END (*--if*);
+END LoopVertices;
+(*-------------------------*)
+
+(*
+LoopEdges loops over the vertices of the given graph to access the edges associated
+with each vertex. Once the process procedure parameter returns FALSE, we exit
+both WHILE statements through the use of a RETURN which exits the procedure.
+Complexity O(v+e), though the v component will dominate the equation if v >> e.
+*)
+
+PROCEDURE LoopEdges    (    theGraph  : Graph          (*--in   *);
+                                                        process   : EdgeLoopProc   (*--in   *));
+
+VAR   theIndex  : CARDINAL; (*--loop index over vertices *)
+VAR   theEdge   : Edge;   (*--loop index over edges of a vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(loopedges, undefined);
+  ELSE
+    WITH theGraph^ DO
+          theIndex := firstVertex;
+          WHILE (theIndex # 0) DO
+            theEdge := vertices[theIndex].edges;
+            WHILE (theEdge # NullEdge) DO
+              IF ~process(theEdge) THEN
+                    RETURN;
+                  END (*--if*);
+                  theEdge := theEdge^.next;
+            END (*--while*);
+            theIndex := vertices[theIndex].next;
+          END (*--with*);
+        END (*--while*);
+  END (*--if*);
+END LoopEdges;
+(*-------------------------*)
+
+(*
+LoopIterate simply loops over the edges leaving a specified vertex. Complexity
+O(outdegree(v)).
+*)
+
+PROCEDURE LoopIterate  (    theVertex : Vertex         (*--in   *);
+                                                        process   : EdgeLoopProc   (*--in   *));
+
+VAR   theEdge : Edge;   (*--loop index over edges of the vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(loopiterate, nullvertex);
+  ELSE
+        theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) & process(theEdge) DO
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END LoopIterate;
+(*-------------------------*)
+
+(*
+TravVertices simply iterates over every vertex in the graph. Complexity O(v).
+*)
+
+PROCEDURE TravVertices (    theGraph  : Graph      (*--in   *);
+                                                        process   : VertexProc (*--in   *));
+
+VAR   v : CARDINAL; (*-- loop index over vertices *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(travvertices, undefined);
+  ELSE
+    WITH theGraph^ DO
+          v := firstVertex;
+          WHILE (v # 0) DO
+            process(ADR(vertices[v]));
+                v := vertices[v].next;
+          END (*--while*);
+        END (*--with*);
+  END (*--if*);
+END TravVertices;
+(*-------------------------*)
+
+(*
+TravEdges simply iterates over every edge in the graph. Since the only way
+to get at all the edges is through the vertices, we iterate over all the
+vertices and over each edge leaving each vertex. Complexity O(v+e).
+*)
+
+PROCEDURE TravEdges    (    theGraph  : Graph      (*--in   *);
+                                                        process   : EdgeProc   (*--in   *));
+
+VAR   v : CARDINAL; (*-- loop index over vertices *)
+VAR   e : Edge;         (*-- loop index over edges of a vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(travedges, undefined);
+  ELSE
+    WITH theGraph^ DO
+          v := firstVertex;
+          WHILE (v # 0) DO
+                e := vertices[v].edges;
+                WHILE (e # NullEdge) DO
+              process(e);
+                  e := e^.next;
+                END (*--while*);
+                v := vertices[v].next;
+          END (*--while*);
+        END (*--with*);
+  END (*--if*);
+END TravEdges;
+(*-------------------------*)
+
+(*
+Iterate simply loops over the edges leaving a specified vertex of a graph.
+Complexity O(outdegree(v)).
+*)
+
+PROCEDURE Iterate      (    theVertex : Vertex     (*--in   *);
+                                                        process   : EdgeProc   (*--in   *));
+
+VAR   theEdge : Edge;   (*-- loop index over edges of the vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(iterate, nullvertex);
+  ELSE
+        theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) DO
+          process(theEdge);
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END Iterate;
+(*-------------------------*)
+
+(*
+11.2.11 Active Iterators
+
+Each of the active iterators are essentially selectors for the underlying
+representation of the adjacency list. FirstVertex returns the abstract vertex
+corresponding to the first vertex in the graph's adjacency list. NextVertex
+returns the abstract vertex that is the successor to the given vertex in the
+graph's adjacency list. FirstEdge returns the edge at the head of the vertexes
+list of edges emanating from the given vertex. NextEdge returns the edge
+immediately following the given edge in a previosuly given vertexes edge list.
+The algorithmic complexity of all four routines is O(1).
+*)
+
+PROCEDURE FirstVertex  (    theGraph  : Graph      (*--in   *))
+                                                                          : Vertex     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(firstvertex, undefined);
+  ELSE
+        RETURN ADR(theGraph^.vertices[theGraph^.firstVertex]);
+  END (*--if*);
+  RETURN NullVertex;
+END FirstVertex;
+(*-------------------------*)
+
+PROCEDURE NextVertex   (    theVertex : Vertex     (*--in   *))
+                                                                          : Vertex     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(nextvertex, nullvertex);
+  ELSE
+        WITH theVertex^ DO
+          IF (next # 0) THEN
+                RETURN ADR(inGraph^.vertices[next]);
+          END (*--if*);
+        END (*--with*);
+  END (*--if*);
+  RETURN NullVertex;
+END NextVertex;
+(*-------------------------*)
+
+PROCEDURE FirstEdge    (    theVertex : Vertex     (*--in   *))
+                                                                          : Edge       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(firstedge, nullvertex);
+  ELSE
+    RETURN theVertex^.edges;
+  END (*--if*);
+  RETURN NullEdge;
+END FirstEdge;
+(*-------------------------*)
+
+PROCEDURE NextEdge     (    theEdge   : Edge       (*--in   *))
+                                                                          : Edge       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(nextedge, nulledge);
+  ELSE
+    RETURN theEdge^.next;
+  END (*--if*);
+  RETURN NullEdge;
+END NextEdge;
+(*-------------------------*)
+
+(*
+11.2.12 Module Initialization
+
+The module's local variables are initialized to known states.
+graphError is used to fill the handlers array with a routine
+that does nothing when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+Applying MIN and MAX to cover all exceptions ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, graphError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR graphError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(graphError, NullHandler);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  graphError := noerr;
+        NullGraph := NIL;
+        NullVertex := NIL;
+        NullEdge := NIL;
+END DigrSBMI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGRSBUI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGRSBUI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGRSBUI.MOD
@@ -0,0 +1,1059 @@
+(*
+11.4    Digraph - Sequential Bounded Unmanaged Iterator
+
+In this section we provide the implementation module corresponding to
+the interface given above in 11.3. The following scheme is used in
+organizing this section:
+* 11.4.1  Internal Representation
+* 11.4.2  Exception Handling
+* 11.4.3  Local Routines
+* 11.4.4  Graph Constructors
+* 11.4.5  Vertex Constructors
+* 11.4.6  Edge Constructors
+* 11.4.7  Graph Selectors
+* 11.4.8  Vertex Selectors
+* 11.4.9  Edge Selectors
+* 11.4.10 Passive Iterators
+* 11.4.11 Active Iterators
+* 11.4.12 Module Initialization
+*)
+
+IMPLEMENTATION MODULE DigrSBUI;
+(*====================================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size:  5830 bytes
+    Component: Graph Data Type - Directed Bounded Unmanaged Iterator
+
+    REVISION HISTORY
+    v1.00  26 May 1988  C. Lins:
+        Initial TML Modula-2 implementation
+    v1.01  26 Jan 1989  C. Lins:
+        Re-derived from DigraphSBMI module.
+    v1.02  10 Apr 1989  C. Lins:
+        Corrected initialization of handlers array.
+    v1.03  18 Apr 1989   C. Lins:
+          Added component id constant.
+    v2.00  24 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+          Used JPIStorage Allocate and Deallocate procedures.
+
+        (C) Copyright 1989 Charles A. Lins
+====================================================================*)
+
+FROM SYSTEM IMPORT
+        (*--type*) ADDRESS,
+        (*--proc*) ADR;
+
+FROM JPIStorage IMPORT
+        (*--proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+        (*--cons*) NullItem,
+        (*--type*) Item;
+
+FROM GraphTypes IMPORT
+        (*--type*) Operations, Exceptions, ComponentID;
+
+FROM ErrorHandling IMPORT
+        (*--cons*) NullHandler,
+        (*--type*) HandlerProc,
+        (*--proc*) Raise;
+
+        (*-------------------------*)
+
+(*
+11.4.1  Type Declarations
+*)
+
+TYPE  Vertex = POINTER TO VertexNode;
+TYPE  Edge   = POINTER TO EdgeNode;
+
+TYPE  VertexNode = RECORD
+                inGraph : Graph;        (*-- graph in which this vertex is a member *)
+                data    : Label;        (*-- data item (label) for this vertex *)
+                indegree: CARDINAL; (*-- # of edges ending at this vertex *)
+                next    : CARDINAL;     (*-- next vertex in adjacency list *)
+                edges   : Edge;         (*-- link to first edge leaving this vertex *)
+          END (*-- VertexNode *);
+
+TYPE  EdgeNode = RECORD
+                initial : Vertex;       (*-- source vertex for this edge *)
+                final   : Vertex;       (*-- destination vertex for this edge *)
+                weight  : Attribute;(*-- weight/attribute for this edge *)
+                next    : Edge;         (*-- next edge leaving this vertex *)
+          END (*-- EdgeNode *);
+
+CONST MaxVertex = 2000;
+TYPE  VertexIndex = [1 .. MaxVertex];
+TYPE  AdjList = ARRAY VertexIndex OF VertexNode;
+
+TYPE  BoundedGraph = RECORD
+                maxVertices: CARDINAL;  (*-- maximum number of vertices *)
+                numVertices: CARDINAL;  (*-- current number of vertices *)
+                numEdges   : CARDINAL;  (*-- current number of edges *)
+                firstVertex: CARDINAL;  (*-- 1st vertex in adjacency list *)
+                available  : CARDINAL;  (*-- 1st free vertex in adjacency list *)
+                vertices   : AdjList;   (*-- adjacency list of vertices *)
+          END (*-- BoundedGraph *);
+
+TYPE  Graph = POINTER TO BoundedGraph;
+
+        (*-------------------------*)
+
+
+(*
+11.4.2  Exceptions
+*)
+
+VAR   graphError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE GraphError () : Exceptions;
+BEGIN
+  RETURN graphError;
+END GraphError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                                                  theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                                                         : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*-- in    *);
+                                                  theError   : Exceptions  (*-- in    *));
+BEGIN
+  graphError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+11.4.3  Local Routines
+*)
+
+PROCEDURE InitFreeList (VAR theGraph : Graph      (*--inout*));
+
+  PROCEDURE InitVertex   (VAR theNode  : VertexNode (*--inout*);
+                                                          theNext  : CARDINAL   (*--in   *));
+  BEGIN
+    WITH theNode DO
+          inGraph  := theGraph;
+          data     := NullItem;
+          indegree := 0;
+          next     := theNext;
+          edges    := NullEdge;
+    END (*--with*);
+  END InitVertex;
+
+VAR   v : VertexIndex; (*-- running index over vertices of the graph *)
+
+BEGIN
+  WITH theGraph^ DO
+    FOR v := MIN(VertexIndex) TO maxVertices-1 DO
+          InitVertex(vertices[v], v+1);
+        END (*--for*);
+        InitVertex(vertices[maxVertices], 0);
+        numVertices := 0;
+        firstVertex := 0;
+        available   := MIN(VertexIndex);
+  END (*--with*);
+END InitFreeList;
+(*-------------------------*)
+
+PROCEDURE ClearEdges    (    theVertex: Vertex   (*--inout*));
+
+VAR   theEdge : Edge;            (*-- edge to be removed *)
+
+BEGIN
+  WITH theVertex^ DO
+        WHILE (edges # NullEdge) DO
+          theEdge := edges;
+          edges := edges^.next;
+          DEC(inGraph^.numEdges);
+          Deallocate(theEdge, SIZE(theEdge^));
+        END (*--while*);
+  END (*--with*);
+END ClearEdges;
+(*-------------------------*)
+
+PROCEDURE NewEdge (    fromVertex : Vertex     (*--in   *);
+                                           toVertex   : Vertex     (*--in   *);
+                                           theWeight  : Attribute  (*--in   *);
+                                           theRoutine : Operations (*--in   *))
+                                                                  : Edge           (*--out  *);
+
+VAR   theEdge : Edge;   (*-- newly created edge *)
+
+BEGIN
+  Allocate(theEdge, SIZE(EdgeNode));
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(theRoutine, overflow);
+  ELSE
+    WITH theEdge^ DO
+          initial := fromVertex;
+          final   := toVertex;
+          weight  := theWeight;
+          next    := NullEdge;
+    END (*--with*);
+  END (*--if*);
+  RETURN theEdge;
+END NewEdge;
+(*-------------------------*)
+
+(*
+11.4.4  Graph Constructors
+*)
+
+CONST baseSize = SIZE(BoundedGraph) - SIZE(AdjList);
+CONST nodeSize = SIZE(VertexNode);
+
+PROCEDURE Create   (    theSize    : CARDINAL  (*-- in    *))
+                                                                   : Graph     (*-- out   *);
+
+VAR   newGraph : Graph; (*-- temporary for new graph object *)
+
+BEGIN
+  graphError := noerr;
+  Allocate(newGraph, baseSize + (VAL(INTEGER, theSize) * nodeSize));
+  IF (newGraph = NullGraph) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newGraph^ DO
+          maxVertices := theSize;
+          numEdges    := 0;
+        END (*--with*);
+        InitFreeList(newGraph);
+  END (*--if*);
+  RETURN newGraph;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theGraph      : Graph     (*-- inout *));
+
+VAR   v : Vertex; (*-- loop index over vertices *)
+
+BEGIN
+  Clear(theGraph);
+  IF (graphError = noerr) THEN
+    Deallocate(theGraph, baseSize + (theGraph^.maxVertices * nodeSize));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theGraph      : Graph    (*--inout*));
+
+VAR   theVertex : CARDINAL;        (*-- loop index over vertices *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theGraph^ DO
+          theVertex  := firstVertex;
+          WHILE (theVertex # 0) DO
+            ClearEdges(ADR(vertices[theVertex]));
+                theVertex := vertices[theVertex].next;
+          END (*--for*);
+        END (*--with*);
+        InitFreeList(theGraph);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theGraph      : Graph     (*--in   *);
+                                   VAR toGraph       : Graph     (*--inout*));
+
+  PROCEDURE RecreateTarget (): BOOLEAN (*-- out   *);
+  BEGIN
+        IF (theGraph = NullGraph) THEN
+      RaiseErrIn(assign, undefined);
+
+        ELSIF (toGraph = NullGraph) THEN
+      WITH theGraph^ DO
+        toGraph := Create(maxVertices);
+          END (*--with*);
+
+        ELSIF (theGraph = toGraph) THEN
+      RETURN FALSE;
+
+        ELSIF (theGraph^.numVertices > toGraph^.maxVertices) THEN
+          RaiseErrIn(assign, overflow);
+
+        ELSE
+          Clear(toGraph);
+        END (*--if*);
+        RETURN (graphError = noerr);
+  END RecreateTarget;
+
+  TYPE  MapVertex = RECORD
+              old : Vertex; (*-- vertex from source graph *)
+              new : Vertex; (*-- corresponging vertex in target graph *)
+            END (*--MapVertex*);
+  TYPE  MapVertices = ARRAY [0..0] OF MapVertex;
+
+  VAR   vertexMap : POINTER TO MapVertices;
+  VAR   mapExtent : CARDINAL;
+
+  PROCEDURE CreateVertexMap;
+  BEGIN
+        Allocate(vertexMap,
+                         VAL(CARDINAL, SIZE(MapVertex)) * theGraph^.numVertices);
+        mapExtent := 0;
+  END CreateVertexMap;
+
+  PROCEDURE AddToVertexMap (    oldVertex : Vertex (*--in   *);
+                                                                newVertex : Vertex (*--in   *));
+  BEGIN
+        WITH vertexMap^[mapExtent] DO
+          old := oldVertex;
+          new := newVertex;
+        END (*--with*);
+    INC(mapExtent);
+  END AddToVertexMap;
+
+  PROCEDURE VertexInMap (    oldVertex : Vertex (*--in   *))
+                                                                           : Vertex (*--out  *);
+
+  VAR   index : CARDINAL;
+
+  BEGIN
+    FOR index := 0 TO mapExtent-1 DO
+          WITH vertexMap^[index] DO
+        IF (oldVertex = old) THEN
+                  RETURN new;
+                END (*--if*);
+          END (*--with*);
+    END (*--for*);
+        RETURN NullVertex;
+  END VertexInMap;
+
+  PROCEDURE DestroyVertexMap;
+  BEGIN
+        Deallocate(vertexMap, SIZE(vertexMap^));
+  END DestroyVertexMap;
+
+  PROCEDURE CopyVertices () : BOOLEAN;
+
+  VAR   v : CARDINAL;   (*--loop index over vertices being copied *)
+  VAR   theVertex : CARDINAL; (*-- index to new vertex *)
+  VAR   lastVertex: CARDINAL; (*--last vertex added to list of vertices *)
+
+    PROCEDURE TailInsert (VAR first : CARDINAL (*--inout *);
+                                                  VAR last  : CARDINAL (*--inout *));
+    BEGIN
+      IF (first = 0) THEN
+            first := theVertex;
+          ELSE
+            toGraph^.vertices[last].next := theVertex;
+          END (*--if*);
+          last := theVertex;
+    END TailInsert;
+
+  BEGIN
+        CreateVertexMap;
+        IF (vertexMap = NIL) THEN
+          RETURN FALSE;
+        END (*--if*);
+
+        v := theGraph^.firstVertex;
+        lastVertex := 0;
+
+    WHILE (v # 0) DO
+          WITH toGraph^ DO
+            theVertex := available;
+            available := vertices[available].next;
+
+            WITH vertices[theVertex] DO
+              inGraph  := toGraph;
+                  data     := theGraph^.vertices[v].data;
+                  indegree := theGraph^.vertices[v].indegree;
+                  next     := 0;
+                  edges    := NullEdge;
+            END (*--with*);
+
+            TailInsert(firstVertex, lastVertex);
+            INC(numVertices);
+            AddToVertexMap(ADR(theGraph^.vertices[v]),
+                                           ADR(vertices[theVertex]));
+          END (*--with*);
+          v := theGraph^.vertices[v].next;
+        END (*--while*);
+
+        RETURN TRUE;
+  END CopyVertices;
+
+  PROCEDURE CopyEdges;
+
+  VAR   v : CARDINAL;             (*--loop index over vertices *)
+  VAR   e : Edge;                 (*--loop index over edges being copied *)
+  VAR   fromVertex: Vertex;   (*--vertex in target graph *)
+  VAR   newEdge   : Edge;         (*--new edge for target graph *)
+  VAR   lastEdge  : Edge;         (*--last edge inserted into new list of edges *)
+
+    PROCEDURE TailInsert (VAR first   : Edge (*--inout*);
+                                                  VAR last    : Edge (*--inout*));
+    BEGIN
+      IF (first = NullEdge) THEN
+            first := newEdge;
+          ELSE
+            last^.next := newEdge;
+          END (*--if*);
+          last := newEdge;
+    END TailInsert;
+
+  BEGIN
+        v := theGraph^.firstVertex;
+    WHILE (v # 0) DO
+          lastEdge := NullEdge;
+          WITH theGraph^ DO
+            e := vertices[v].edges;
+            fromVertex := VertexInMap(ADR(vertices[v]));
+          END (*--with*);
+          WHILE (e # NullEdge) DO
+            newEdge := NewEdge(fromVertex,
+                                                   VertexInMap(e^.final),
+                                                   e^.weight,
+                                                   assign);
+                IF (newEdge = NullEdge) THEN
+                  RETURN;
+                END (*--if*);
+
+                TailInsert(fromVertex^.edges, lastEdge);
+                INC(toGraph^.numEdges);
+                e := e^.next;
+          END (*--while*);
+          v := theGraph^.vertices[v].next;
+        END (*--while*);
+  END CopyEdges;
+
+BEGIN (*-- Assign --*)
+  graphError := noerr;
+  IF RecreateTarget() & CopyVertices() THEN
+        CopyEdges;
+        DestroyVertexMap;
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+11.4.5  Vertex Constructors
+*)
+
+PROCEDURE Insert   (VAR theGraph   : Graph     (*--inout*);
+                                        theItem    : Label     (*--in   *);
+                                        VAR theVertex  : Vertex    (*--out  *));
+
+VAR   theIndex : CARDINAL; (*-- vertex index into the adjacency list *)
+
+BEGIN
+  graphError := noerr;
+  theVertex  := NullVertex;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(insert, undefined);
+  ELSIF (theGraph^.available = 0) THEN
+    RaiseErrIn(insert, overflow);
+  ELSE
+    WITH theGraph^ DO
+          theIndex := available;
+          available := vertices[available].next;
+          WITH vertices[theIndex] DO
+            inGraph  := theGraph;
+                data     := theItem;
+                indegree := 0;
+                next     := firstVertex;
+                edges    := NullEdge;
+          END (*--with*);
+          firstVertex := theIndex;
+          INC(numVertices);
+          theVertex := ADR(vertices[theIndex]);
+        END (*--with*);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+PROCEDURE Remove   (VAR theGraph   : Graph     (*--inout*);
+                                    VAR theVertex  : Vertex    (*--inout*));
+
+VAR   theIndex   : CARDINAL; (*-- of theItem to be removed *)
+VAR   priorVertex: CARDINAL; (*-- immediate predecessor of theVertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(remove, undefined);
+
+  ELSIF (theVertex = NullVertex) THEN
+    RaiseErrIn(remove, nullvertex);
+
+  ELSIF (theVertex^.inGraph # theGraph) THEN
+    RaiseErrIn(remove, novertex);
+
+  ELSIF (theVertex^.indegree > 0) THEN
+        RaiseErrIn(remove, referenced);
+
+  ELSE
+        ClearEdges(theVertex);
+
+    WITH theGraph^ DO
+
+      theIndex  := firstVertex;
+          priorVertex := 0;
+          WHILE (ADR(vertices[theIndex]) # theVertex) DO
+            priorVertex := theIndex;
+            theIndex    := vertices[theIndex].next;
+          END (*--while*);
+
+          IF (priorVertex = 0) THEN
+                firstVertex := vertices[theIndex].next;
+          ELSE
+                vertices[priorVertex].next := vertices[theIndex].next;
+          END (*--if*);
+
+          vertices[theIndex].next := available;
+          vertices[theIndex].inGraph := NullGraph;
+          available := theIndex;
+          DEC(numVertices);
+        END (*--with*);
+        theVertex := NullVertex;
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+PROCEDURE SetLabel (    theVertex  : Vertex    (*--inout*);
+                                            theItem    : Label     (*--in   *));
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(setlabel, nullvertex);
+  ELSE
+    theVertex^.data := theItem;
+  END (*--if*);
+END SetLabel;
+(*-------------------------*)
+
+(*
+11.4.6  Edge Constructors
+*)
+
+PROCEDURE Link     (VAR theGraph   : Graph     (*--inout*);
+                                        fromVertex : Vertex    (*--in   *);
+                                        toVertex   : Vertex    (*--in   *);
+                                        theWeight  : Attribute (*--in   *);
+                                        VAR theEdge    : Edge      (*--out  *));
+BEGIN
+  graphError := noerr;
+  theEdge    := NullEdge;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(link, undefined);
+  ELSIF (fromVertex = NullVertex) OR (toVertex = NullVertex) THEN
+    RaiseErrIn(link, nullvertex);
+  ELSIF (fromVertex^.inGraph # theGraph) OR
+                (toVertex^.inGraph # theGraph) THEN
+    RaiseErrIn(link, novertex);
+  ELSE
+
+    theEdge := NewEdge(fromVertex, toVertex, theWeight, link);
+        IF (theEdge # NullEdge) THEN
+          theEdge^.next := fromVertex^.edges;
+          fromVertex^.edges := theEdge;
+          IF (fromVertex # toVertex) THEN
+                INC(toVertex^.indegree);
+          END (*--if*);
+          INC(theGraph^.numEdges);
+        END (*--with*);
+  END (*--if*);
+END Link;
+(*-------------------------*)
+
+PROCEDURE Unlink   (VAR theGraph   : Graph     (*--inout*);
+                                    VAR theEdge    : Edge      (*--inout*));
+
+VAR   e : Edge;   (*-- pointer to edge (v,w), if any *)
+VAR   f : Edge;   (*-- pointer to edge preceeding (v,w) in adjacency list *)
+
+BEGIN
+  graphError := noerr;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(unlink, undefined);
+
+  ELSIF (theEdge = NullEdge) THEN
+        RaiseErrIn(unlink, nulledge);
+
+  ELSIF (theEdge^.initial^.inGraph # theGraph) THEN
+    RaiseErrIn(unlink, noedge);
+
+  ELSE
+
+        e := theEdge^.initial^.edges;
+        f := NullEdge;
+        WHILE (e # theEdge) DO
+          f := e;
+          e := e^.next;
+        END (*--while*);
+
+        WITH theEdge^ DO
+
+          IF (f = NullEdge) THEN
+            initial^.edges := next;
+          ELSE
+            f^.next := next;
+          END (*--if*);
+
+          IF (initial # final) THEN
+            DEC(final^.indegree);
+          END (*--if*);
+          DEC(initial^.inGraph^.numEdges);
+
+          initial := NullVertex;
+          next    := NullEdge;
+          Deallocate(theEdge, SIZE(theEdge^));
+        END (*--with*);
+  END (*--if*);
+END Unlink;
+(*-------------------------*)
+
+PROCEDURE SetAttribute  (    theEdge    : Edge      (*--inout*);
+                                             theWeight  : Attribute (*--in   *));
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+        RaiseErrIn(setattr, nulledge);
+  ELSE
+    theEdge^.weight := theWeight;
+  END (*--if*);
+END SetAttribute;
+(*-------------------------*)
+
+(*
+11.4.7  Graph Selectors
+*)
+
+PROCEDURE IsDefined (    theGraph  : Graph       (*-- in    *))
+                                                                   : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN (theGraph # NullGraph);
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theGraph  : Graph       (*-- in    *))
+                                                                   : BOOLEAN     (*-- out   *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isempty, undefined);
+        RETURN TRUE;
+  END (*--if*);
+  RETURN theGraph^.numVertices = 0;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE OrderOf   (    theGraph  : Graph       (*-- in    *))
+                                                                   : CARDINAL    (*-- out   *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(orderof, undefined);
+        RETURN 0;
+  END (*--if*);
+  RETURN theGraph^.numVertices;
+END OrderOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theGraph  : Graph       (*-- in    *))
+                                                                   : CARDINAL    (*-- out   *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(sizeof, undefined);
+        RETURN 0;
+  END (*--if*);
+  RETURN theGraph^.numEdges;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE MaxOrderOf (    theGraph  : Graph       (*--in   *))
+                                                                    : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(maxorderof, undefined);
+        RETURN 0;
+  END (*--if*);
+  RETURN theGraph^.maxVertices;
+END MaxOrderOf;
+(*-------------------------*)
+
+(*
+11.4.8  Vertex Selectors
+*)
+
+PROCEDURE InDegree  (    theVertex : Vertex      (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(indegree, nullvertex);
+  ELSE
+    RETURN theVertex^.indegree;
+  END (*--if*);
+  RETURN 0;
+END InDegree;
+(*-------------------------*)
+
+PROCEDURE OutDegree (    theVertex : Vertex      (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+
+VAR   theEdge   : Edge;         (*-- loop index over edges of the vertex *)
+VAR   edgeCount : CARDINAL; (*-- running count of edges leaving this vertex *)
+
+BEGIN
+  graphError := noerr;
+  edgeCount  := 0;
+
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(outdegree, nullvertex);
+  ELSE
+    theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) DO
+          INC(edgeCount);
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+
+  RETURN edgeCount;
+END OutDegree;
+(*-------------------------*)
+
+PROCEDURE LabelOf   (    theVertex : Vertex      (*--in   *))
+                                                                   : Label       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(labelof, nullvertex);
+  ELSE
+    RETURN theVertex^.data;
+  END (*--if*);
+  RETURN NullItem;
+END LabelOf;
+(*-------------------------*)
+
+PROCEDURE IsVertex  (    theGraph  : Graph       (*--in   *);
+                                             theVertex : Vertex      (*--in   *))
+                                                           : BOOLEAN     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isvertex, undefined);
+  ELSIF (theVertex = NullVertex) THEN
+    RaiseErrIn(isvertex, nullvertex);
+  ELSE
+    RETURN theVertex^.inGraph = theGraph;
+  END (*--if*);
+  RETURN FALSE;
+END IsVertex;
+(*-------------------------*)
+
+PROCEDURE GraphOf   (    theVertex : Vertex      (*--in   *))
+                                                                   : Graph       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(graphof, nullvertex);
+  ELSE
+    RETURN theVertex^.inGraph;
+  END (*--if*);
+  RETURN NullGraph;
+END GraphOf;
+(*-------------------------*)
+
+(*
+11.4.9  Edge Selectors
+*)
+
+PROCEDURE AttributeOf (    theEdge   : Edge        (*--in   *))
+                                                                 : Attribute   (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(attrof, nulledge);
+  ELSE
+    RETURN theEdge^.weight;
+  END (*--if*);
+  RETURN NullItem;
+END AttributeOf;
+(*-------------------------*)
+
+PROCEDURE InitialOf   (    theEdge   : Edge        (*--in   *))
+                                                                 : Vertex      (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(initialof, nulledge);
+  ELSE
+    RETURN theEdge^.initial;
+  END (*--if*);
+  RETURN NullVertex;
+END InitialOf;
+(*-------------------------*)
+
+PROCEDURE FinalOf     (    theEdge   : Edge        (*--in   *))
+                                                                 : Vertex      (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(finalof, nulledge);
+  ELSE
+    RETURN theEdge^.final;
+  END (*--if*);
+  RETURN NullVertex;
+END FinalOf;
+(*-------------------------*)
+
+PROCEDURE IsEdge      (    theGraph  : Graph       (*--in   *);
+                                               theEdge   : Edge        (*--in   *))
+                                                             : BOOLEAN     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isedge, undefined);
+  ELSIF (theEdge = NullEdge) THEN
+    RaiseErrIn(isedge, nulledge);
+  ELSIF (theEdge^.initial = NullVertex) THEN
+    RaiseErrIn(isedge, nullvertex);
+  ELSE
+    RETURN theEdge^.initial^.inGraph = theGraph;
+  END (*--if*);
+  RETURN FALSE;
+END IsEdge;
+(*-------------------------*)
+
+(*
+11.4.10 Passive Iterators
+*)
+
+PROCEDURE LoopVertices (    theGraph  : Graph          (*--in   *);
+                                                        process   : VertexLoopProc (*--in   *));
+
+VAR   theIndex : CARDINAL; (*--loop index over vertices *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(loopvertices, undefined);
+  ELSE
+    WITH theGraph^ DO
+          theIndex := firstVertex;
+          WHILE (theIndex # 0) & process(ADR(vertices[theIndex])) DO
+            theIndex := vertices[theIndex].next;
+          END (*--while*);
+        END (*--with*);
+  END (*--if*);
+END LoopVertices;
+(*-------------------------*)
+
+PROCEDURE LoopEdges    (    theGraph  : Graph          (*--in   *);
+                                                        process   : EdgeLoopProc   (*--in   *));
+
+VAR   theIndex  : CARDINAL; (*--loop index over vertices *)
+VAR   theEdge   : Edge;   (*--loop index over edges of a vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(loopedges, undefined);
+  ELSE
+    WITH theGraph^ DO
+          theIndex := firstVertex;
+          WHILE (theIndex # 0) DO
+            theEdge := vertices[theIndex].edges;
+            WHILE (theEdge # NullEdge) DO
+              IF ~process(theEdge) THEN
+                    RETURN;
+                  END (*--if*);
+                  theEdge := theEdge^.next;
+            END (*--while*);
+            theIndex := vertices[theIndex].next;
+          END (*--with*);
+        END (*--while*);
+  END (*--if*);
+END LoopEdges;
+(*-------------------------*)
+
+PROCEDURE LoopIterate  (    theVertex : Vertex         (*--in   *);
+                                                        process   : EdgeLoopProc   (*--in   *));
+
+VAR   theEdge : Edge;   (*--loop index over edges of the vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(loopiterate, nullvertex);
+  ELSE
+        theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) & process(theEdge) DO
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END LoopIterate;
+(*-------------------------*)
+
+PROCEDURE TravVertices (    theGraph  : Graph      (*--in   *);
+                                                        process   : VertexProc (*--in   *));
+
+VAR   v : CARDINAL; (*-- loop index over vertices *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(travvertices, undefined);
+  ELSE
+    WITH theGraph^ DO
+          v := firstVertex;
+          WHILE (v # 0) DO
+            process(ADR(vertices[v]));
+                v := vertices[v].next;
+          END (*--while*);
+        END (*--with*);
+  END (*--if*);
+END TravVertices;
+(*-------------------------*)
+
+PROCEDURE TravEdges    (    theGraph  : Graph      (*--in   *);
+                                                        process   : EdgeProc   (*--in   *));
+
+VAR   v : CARDINAL; (*-- loop index over vertices *)
+VAR   e : Edge;         (*-- loop index over edges of a vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(travedges, undefined);
+  ELSE
+    WITH theGraph^ DO
+          v := firstVertex;
+          WHILE (v # 0) DO
+                e := vertices[v].edges;
+                WHILE (e # NullEdge) DO
+              process(e);
+                  e := e^.next;
+                END (*--while*);
+                v := vertices[v].next;
+          END (*--while*);
+        END (*--with*);
+  END (*--if*);
+END TravEdges;
+(*-------------------------*)
+
+PROCEDURE Iterate      (    theVertex : Vertex     (*--in   *);
+                                                        process   : EdgeProc   (*--in   *));
+
+VAR   theEdge : Edge;   (*-- loop index over edges of the vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(iterate, nullvertex);
+  ELSE
+        theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) DO
+          process(theEdge);
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END Iterate;
+(*-------------------------*)
+
+(*
+11.4.12 Active Iterators
+*)
+
+PROCEDURE FirstVertex  (    theGraph  : Graph      (*--in   *))
+                                                                          : Vertex     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(firstvertex, undefined);
+  ELSE
+        RETURN ADR(theGraph^.vertices[theGraph^.firstVertex]);
+  END (*--if*);
+  RETURN NullVertex;
+END FirstVertex;
+(*-------------------------*)
+
+PROCEDURE NextVertex   (    theVertex : Vertex     (*--in   *))
+                                                                          : Vertex     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(nextvertex, nullvertex);
+  ELSE
+        WITH theVertex^ DO
+          IF (next # 0) THEN
+                RETURN ADR(inGraph^.vertices[next]);
+          END (*--if*);
+        END (*--with*);
+  END (*--if*);
+  RETURN NullVertex;
+END NextVertex;
+(*-------------------------*)
+
+PROCEDURE FirstEdge    (    theVertex : Vertex     (*--in   *))
+                                                                          : Edge       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(firstedge, nullvertex);
+  ELSE
+    RETURN theVertex^.edges;
+  END (*--if*);
+  RETURN NullEdge;
+END FirstEdge;
+(*-------------------------*)
+
+PROCEDURE NextEdge     (    theEdge   : Edge       (*--in   *))
+                                                                          : Edge       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(nextedge, nulledge);
+  ELSE
+    RETURN theEdge^.next;
+  END (*--if*);
+  RETURN NullEdge;
+END NextEdge;
+(*-------------------------*)
+
+(*
+11.4.13 Module Initialization
+*)
+
+BEGIN
+  FOR graphError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(graphError, NullHandler);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  graphError := noerr;
+        NullGraph := NIL;
+        NullVertex := NIL;
+        NullEdge := NIL;
+END DigrSBUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGRSUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGRSUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGRSUMI.MOD
@@ -0,0 +1,1529 @@
+(*
+10.3    Digraph - Sequential Unbounded Managed Iterator
+
+In this section we provide the implementation module corresponding to
+the interface given above in û10.2. The following scheme is used in
+organizing this section:
+* 10.3.1  Internal Representation
+* 10.3.2  Exception Handling
+* 10.3.3  Local Routines
+* 10.3.4  Graph Constructors
+* 10.3.5  Vertex Constructors
+* 10.3.6  Edge Constructors
+* 10.3.7  Graph Selectors
+* 10.3.8  Vertex Selectors
+* 10.3.9  Edge Selectors
+* 10.3.10 Passive Iterators
+* 10.3.11 Active Iterators
+* 10.3.12 Module Initialization
+*)
+
+IMPLEMENTATION MODULE DigrSUMI;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: 5988 bytes
+    Component: Digraph - Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  26 May 1988  C. Lins:
+        Initial TML Modula-2 implementation
+    v1.01  06 Oct 1988  C. Lins:
+        Added extensive comments for book.
+    v1.02  07-14 Jan 1989  C. Lins:
+        Revised interface in conformance with new graph spec (Ch 9).
+                Modified implementations accordingly.
+    v1.03  10 Apr 1989  C. Lins:
+        Corrected initialization of handlers array.
+    v1.04  18 Apr 1989   C. Lins:
+          Added component id constant.
+    v2.00  24 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+        (*--proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+        (*--cons*) NullItem,
+        (*--type*) Item, AssignProc, DisposeProc;
+
+FROM GraphTypes IMPORT
+        (*--type*) Operations, Exceptions, ComponentID;
+
+FROM ErrorHandling IMPORT
+        (*--cons*) NullHandler,
+        (*--type*) HandlerProc,
+        (*--proc*) Raise;
+
+FROM TypeManager IMPORT
+        (*--cons*) NullType,
+        (*--type*) TypeID,
+        (*--proc*) AssignOf, DisposeOf;
+
+        (*-------------------------*)
+
+(*
+10.3.1  Internal Representation
+
+The internal representation of an unbounded directed graph uses a variant of a
+structure known as an adjacency list (shown below in Figure 10.1). In this
+representation, the set of vertices for a graph is given by a linear list. Since
+an unbounded graph requires the list to grow and shrink in size dynamically, a
+linked list of dynamically allocated vertex nodes is used. Then, each vertex is
+associated with the set of directed edges leaving the vertex. The set of all
+edges of the graph is thus the union of all the sets of edges for each of the
+graph's vertices.
+
+Following the figure is a description of the various TYPEs used for our internal
+representation including the component fields of each record structure.
+
+_Figure 10.1_
+
+Edge:                   completes the opaque definition as a reference to a dynamically
+                                allocated edge node.
+
+Vertex:                 completes the opaque definition as a reference to a dynamically
+                                allocated vertex node.
+
+VertexNode:             defines the information requirements for a single vertex of a
+                                graph.
+        data:           contains the label data item associated with a vertex.
+        next:           link to the next vertex in the set of vertices for a graph. The
+                                last vertex of the list has a 'next' of NullVertex indicating
+                                the end of the list.
+        edges:          link to the first directed edge leaving this vertex. If the vertex
+                                has no edges leaving it, this field is set to the NullEdge.
+        indegree:       is used in maintaining a count of the number of edges having this
+                                vertex as its destination excluding self-loops (which are edges
+                                whose source and destination vertices are the same). This count
+                                is maintained by the constructors Link, Unlink and Assign. It
+                                is used by the constructor Remove in detecting attempts to
+                                delete vertices referenced as the destination of an edge. Since
+                                the alternative technique for detecting this precondition is
+                                a complete traversal of all the edges of a graph, we have chosen
+                                to record this information incrementally as edges are inserted
+                                and removed from the graph.
+        inGraph:        contains the reference to the enclosing graph object for the vertex.
+                                This avoids having the graph as a parameter to the vertex selectors.
+                                In addition, simplifying the membership test between a vertex and a
+                                graph, as well as the membership test for edges (through the
+                                initial or final vertex references of the edge).
+
+EdgeNode:               defines the information requirements for a single edge of a graph.
+        initial:        contains a reference to the initial (or source) vertex of the edge.
+        final:          contains a reference to the final (or destination) vertex of the edge.
+        weight:         contains the attribute of the edge.
+        next:           contains the link to the next edge leaving the initial vertex.
+                                The last edge of this list contains the NullEdge as its value
+                                indicating the end of the list.
+
+UnboundedGraph: describes (and holds) attributes of the graph itself.
+        labelType,
+        attrType:       contain the data type ID for the vertex label and edge attribute,
+                                respectively. These two fields are used to retrieve the procedures
+                                accomplishing assignment and disposal of data items.
+        numVertices,
+        numEdges:       contain counts of the total number of vertices and edges in the
+                                graph, respectively. Thus, the selectors OrderOf and SizeOf are
+                                O(1) algorithms instead of O(|V|) or O(|E|).
+        firstVertex: reference to the first vertex in the adjacency list for a graph.
+*)
+
+TYPE  Edge   = POINTER TO EdgeNode;
+TYPE  Vertex = POINTER TO VertexNode;
+
+TYPE  VertexNode = RECORD
+                inGraph  : Graph;        (*-- graph in which this vertex is a member *)
+                data     : Label;        (*-- data item (label) for this vertex *)
+                indegree : CARDINAL; (*-- # of edges ending at this vertex *)
+                next     : Vertex;       (*-- next vertex in adjacency list *)
+                edges    : Edge;         (*-- link to first edge leaving this vertex *)
+          END (*-- VertexNode *);
+
+TYPE  EdgeNode = RECORD
+                initial : Vertex;       (*-- source vertex for this edge *)
+                final   : Vertex;       (*-- destination vertex for this edge *)
+                weight  : Attribute;(*-- weight/attribute for this edge *)
+                next    : Edge;         (*-- next edge leaving this vertex *)
+          END (*-- EdgeNode *);
+
+TYPE  UnboundedGraph = RECORD
+                labelType  : TypeID;    (*-- vertex label data type ID *)
+                attrType   : TypeID;    (*-- edge attribute data type ID *)
+                numVertices: CARDINAL;  (*-- current total number of vertices *)
+                numEdges   : CARDINAL;  (*-- current total number of edges *)
+                firstVertex: Vertex;    (*-- first vertex in adjacency list *)
+          END (*-- UnboundedGraph *);
+
+TYPE  Graph = POINTER TO UnboundedGraph;
+
+        (*-------------------------*)
+
+(*
+10.3.2  Exception Handling
+
+graphError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+graphError before any other processing.
+
+The handler array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see û10.3.12).
+
+GraphError      simply returns the current exception result stored
+                        in graphError and is used to determine whether a graph
+                        operation completed successfully.
+
+SetHandler      makes theHandler the current exception handler for theError
+                        by storing theHandler in the handler array.
+
+GetHandler      returns the current exception handler for theError from the
+                        handler array.
+*)
+
+VAR   graphError : Exceptions;
+VAR   handler    : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE GraphError () : Exceptions;
+BEGIN
+  RETURN graphError;
+END GraphError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in  *);
+                                                  theHandler : HandlerProc (*--in  *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                                                         : HandlerProc (*--out  *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*--in   *);
+                                                  theError   : Exceptions  (*--in   *));
+BEGIN
+  graphError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+(*
+10.3.3  Local Routines
+
+FreeAttribute is responsible for retrieval of the edge attribute item disposal
+routine and freeing the attribute when no longer needed. This occurs when
+        1. a graph is cleared or destroyed (Clear);
+        2. an edge is removed from a graph (Unlink);
+        3. a vertex is removed from a graph and any edges leaving it are implicitly
+           removed (ClearEdges); or
+        4. a new attribute is assigned to an edge (SetAttribute).
+Complexity: O(1).
+*)
+
+PROCEDURE FreeAttribute (    theEdge : Edge (*--inout*));
+
+VAR   free : DisposeProc; (*-- attribute disposal routine, if any *)
+
+BEGIN
+  WITH theEdge^ DO
+        free := DisposeOf(initial^.inGraph^.attrType);
+        free(weight);
+  END (*--with*);
+END FreeAttribute;
+(*-------------------------*)
+
+(*
+FreeLabel corresponds to FreeAttribute, above, for the clean-up of vertex labels
+when they are no longer needed. The conditions are similar to those above:
+        1. a graph is cleared or destroyed (Clear);
+        2. an vertex is removed from a graph (Remove); or
+        3. a new label is assigned to a vertex (SetLabel).
+Complexity: O(1).
+*)
+
+PROCEDURE FreeLabel (    theVertex : Vertex (*--inout*));
+
+VAR   free : DisposeProc; (*-- label disposal routine, if any *)
+
+BEGIN
+  WITH theVertex^ DO
+        free := DisposeOf(inGraph^.labelType);
+        free(data);
+  END (*--with*);
+END FreeLabel;
+(*-------------------------*)
+
+(*
+ClearEdges removes all edges from a given vertex. This is necessary when
+        1. a graph is cleared or destroyed (Clear); or
+        2. a vertex is removed from a graph (Remove).
+Essentially, the algorithm loops over each edge in the edge list for the vertex
+removing the edge from the list, updating the number of edges in the graph,
+deallocation of the edge attribute and, finally, deallocation of the edge itself.
+Since we guarantee the last edge in the list has a 'next' of NullEdge, 'edges'
+(the vertex's link to the first edge) is properly set to the NullEdge upon
+completion of the routine. O(outdegree(v)).
+*)
+
+PROCEDURE ClearEdges    (    theVertex: Vertex   (*--inout*));
+
+VAR   theEdge : Edge;   (*-- edge being removed from vertex *)
+
+BEGIN
+  WITH theVertex^ DO
+        WHILE (edges # NullEdge) DO
+          theEdge := edges;
+          edges := edges^.next;
+          DEC(inGraph^.numEdges);
+          FreeAttribute(theEdge);
+          Deallocate(theEdge, SIZE(theEdge^));
+        END (*--while*);
+  END (*--with*);
+END ClearEdges;
+(*-------------------------*)
+
+(*
+NewVertex allocates and constructs a new, empty, vertex node. The vertex field
+inGraph is set to the proper value (its enclosing graph object) while indegree,
+edges, and next are initialized to an empty state. The caller is responsible for
+adding the vertex to the adjacency list for the graph. The routine also automatically
+raises the overflow exception with the appropriate parameters, if necessary. As
+noted in Volume 1, the version of Allocate used here sets theVertex to NIL if the
+allocation fails. Thus, we ensure that theVertex returned is the NullVertex in
+case of a memory management failure. Complexity O(1).
+*)
+
+PROCEDURE NewVertex (    theGraph   : Graph      (*--in   *);
+                                                 theItem    : Label      (*--in   *);
+                                                 theRoutine : Operations (*--in   *))
+                                                                    : Vertex     (*--out  *);
+
+VAR   theVertex : Vertex;               (*-- newly created vertex *)
+
+BEGIN
+  Allocate(theVertex, SIZE(VertexNode));
+  IF (theVertex = NullVertex) THEN
+        RaiseErrIn(theRoutine, overflow);
+  ELSE
+        WITH theVertex^ DO
+          inGraph       := theGraph;
+          data          := theItem;
+          indegree      := 0;
+          edges         := NullEdge;
+          next          := NullVertex;
+        END (*--with*);
+  END (*--if*);
+  RETURN theVertex;
+END NewVertex;
+(*-------------------------*)
+
+(*
+NewEdge simple creates a new edge with the specified vertex endpoints and weight.
+The edge is not added to any edge list, leaving this to the caller. The overflow
+exception is automatically raised, if necessary, when a new edge node cannot be
+allocated. The structural sharing of the edge attribute is controlled, as described
+above for NewVertex, using a similar mechanism. Complexity O(1).
+*)
+
+PROCEDURE NewEdge (    fromVertex : Vertex     (*--in   *);
+                                           toVertex   : Vertex     (*--in   *);
+                                           theWeight  : Attribute  (*--in   *);
+                                           theRoutine : Operations (*--in   *))
+                                                                  : Edge           (*--out  *);
+
+VAR   theEdge : Edge;   (*-- newly created edge *)
+
+BEGIN
+  Allocate(theEdge, SIZE(EdgeNode));
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(theRoutine, overflow);
+  ELSE
+    WITH theEdge^ DO
+          initial := fromVertex;
+          final   := toVertex;
+          weight  := theWeight;
+          next    := NullEdge;
+    END (*--with*);
+  END (*--if*);
+  RETURN theEdge;
+END NewEdge;
+(*-------------------------*)
+
+
+(*
+10.3.4  Graph Constructors
+
+Create attempts to form a new, empty graph object with the given vertex
+label and edge label data types. First, the graph descriptor is allocated and the vertex
+and edge data type IDs are stored there. The number of vertices and edges are
+initialized to zero. The pointer to the head of the adjacency list (firstVertex)
+is initialized to the empty state (NIL). If the descriptor allocation
+fails the overflow exception is raised and the NullGraph is returned,
+otherwise we return the newly allocated graph. Complexity O(1).
+*)
+
+PROCEDURE Create   (    labels     : TypeID    (*--in   *);
+                                            attributes : TypeID    (*--in   *))
+                                                                   : Graph     (*--out  *);
+
+VAR   newGraph : Graph; (*-- temporary for new graph object *)
+
+BEGIN
+  graphError := noerr;
+  Allocate(newGraph, SIZE(UnboundedGraph));
+  IF (newGraph = NullGraph) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newGraph^ DO
+          labelType   := labels;
+          attrType    := attributes;
+          numVertices := 0;
+          numEdges    := 0;
+          firstVertex := NullVertex;
+        END (*--with*);
+  END (*--if*);
+  RETURN newGraph;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy clears theGraph and then deallocates it making theGraph undefined.
+SCLStorage.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullGraph). Complexity O(v+e).
+*)
+
+PROCEDURE Destroy (VAR theGraph      : Graph     (*--inout *));
+BEGIN
+  Clear(theGraph);
+  IF (graphError = noerr) THEN
+    Deallocate(theGraph, SIZE(theGraph^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear removes all vertices and edges from theGraph making theGraph empty.
+We do this by iterating over each of the vertices and clearing all edges
+leaving the vertex (ClearEdges). As a final step we ensure that the graph is left in the
+empty state by resetting the head of the adjacency list to NIL and the number
+of vertices and edges in the graph to zero. Complexity O(v+e).
+*)
+
+PROCEDURE Clear   (VAR theGraph      : Graph    (*--inout *));
+
+VAR   theVertex : Vertex;          (*--loop index over vertices *)
+VAR   oldVertex : Vertex;          (*--vertex to deallocate *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theGraph^ DO
+          theVertex := firstVertex;
+          WHILE (theVertex # NullVertex) DO
+            ClearEdges(theVertex);
+                FreeLabel(theVertex);
+                oldVertex := theVertex;
+                theVertex := theVertex^.next;
+                Deallocate(oldVertex, SIZE(oldVertex^));
+          END (*--while*);
+          firstVertex := NullVertex;
+          numVertices := 0;
+          numEdges    := 0;
+        END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign copies the source graph, theGraph, to the target graph, toGraph. The
+main body of Assign does this by first copying all the vertices followed by
+copying all the edges from the source to the destination graph.
+The algorithmic complexity is O(v^2+e) due to the mapping between the vertices
+of the source and target graphs while copying the edges (see the discussion
+of the vertexMap following RecreateTarget).
+*)
+
+PROCEDURE Assign  (    theGraph      : Graph     (*--in   *);
+                                   VAR toGraph       : Graph     (*--inout *));
+
+(*
+RecreateTarget reconstructs the target graph descriptor so that the fields
+defining the vertex label and edge attribute data types, and (optionally)
+maximum number of vertices between the source and destination graphs are the
+same. If the source and destination graphs are the same the routine returns
+FALSE indicating that the postconditions for the assignment operation are
+already met. The routine returns TRUE if the recreation of the target was
+successful. Complexity O(v+e) where v and e are the number of vertices and
+edges, respectively, in the original toGraph.  When Clearing the target graph
+is unnecessary (the toGraph is initially the NullGraph) the complexity falls
+to O(1).
+*)
+
+  PROCEDURE RecreateTarget (): BOOLEAN (*--out  *);
+  BEGIN
+        IF (theGraph = NullGraph) THEN
+      RaiseErrIn(assign, undefined);
+
+        ELSIF (toGraph = NullGraph) THEN
+      WITH theGraph^ DO
+        toGraph := Create(labelType, attrType);
+          END (*--with*);
+
+        ELSIF (theGraph = toGraph) THEN
+      RETURN FALSE;
+
+        ELSE
+          Clear(toGraph);
+      WITH theGraph^ DO
+                toGraph^.labelType := labelType;
+                toGraph^.attrType  := attrType;
+          END (*--with*);
+        END (*--if*);
+        RETURN (graphError = noerr);
+  END RecreateTarget;
+
+(*
+One thorny issue in graph assignment is how to set-up the copied edges with the
+proper initial and final vertices? The edges of the source graph contain references
+to the source graph's vertices, not those of the target graph. The vertex
+labels cannot be used since more than one vertex can have the same label. In
+this case, an edge from the second (or greater) such vertex in the target graph
+would be linked incorrectly to the first vertex having that label. The solution
+is in having some form of temporary mapping from the source graph's vertices to
+their counterpart in the target graph. The necessary operations are add a mapping
+between a vertex from the source graph and its corresponding vertex in the
+target graph, and given a source graph vertex return the target graph vertex
+mapped to that source vertex.
+
+The data structure implementing our vertex mapping is an unordered array of mapping
+entries, one per vertex, between the vertices of the source graph and the
+target graph. This array is dynamically created on the heap based on the
+number of vertices in the source graph. (The ARRAY [0..0] OF ≡ construct is
+a special feature of the TML Modula-2 compiler allowing dynamic arrays.) The
+variable mapExtent controls where MapVertex entries are inserted into the
+array. A post-increment scheme is used so mapVertex is always one greater than
+the number of entries stored in the array.
+*)
+
+  TYPE  MapVertex = RECORD
+              old : Vertex; (*-- vertex from source graph *)
+              new : Vertex; (*-- corresponging vertex in target graph *)
+            END (*--MapVertex*);
+  TYPE  MapVertices = ARRAY [0..0] OF MapVertex;
+
+  VAR   vertexMap : POINTER TO MapVertices;
+  VAR   mapExtent : CARDINAL;
+
+
+(*
+CreateVertexMap allocates a dynamic array of vertex mapping entries on the
+heap based on the number of vertices in the source graph. vertexMap is set to
+NIL by Allocate if there isn't enough memory available to meet the request.
+*)
+
+  PROCEDURE CreateVertexMap;
+  BEGIN
+        Allocate(vertexMap,
+                         VAL(CARDINAL, SIZE(MapVertex)) * theGraph^.numVertices);
+        mapExtent := 0;
+  END CreateVertexMap;
+
+(*
+AddVertexToMap adds a mapping between the vertices of the source and target graphs.
+*)
+
+  PROCEDURE AddToVertexMap (    oldVertex : Vertex (*--in   *);
+                                                                newVertex : Vertex (*--in   *));
+  BEGIN
+        WITH vertexMap^[mapExtent] DO
+          old := oldVertex;
+          new := newVertex;
+        END (*--with*);
+    INC(mapExtent);
+  END AddToVertexMap;
+
+(*
+VertexInMap returns the mapping between the vertices of the source and target
+graphs. Since every vertex is represented failure to find a mapping is
+indicative of either a programming error in CopyVertices or a hardware/system
+software error at runtime.
+*)
+
+  PROCEDURE VertexInMap (    oldVertex : Vertex (*--in   *))
+                                                                           : Vertex (*--out  *);
+
+  VAR   index : CARDINAL; (*-- loop index over mapping entries *)
+
+  BEGIN
+    FOR index := 0 TO mapExtent-1 DO
+          WITH vertexMap^[index] DO
+        IF (oldVertex = old) THEN
+                  RETURN new;
+                END (*--if*);
+          END (*--with*);
+    END (*--for*);
+        RETURN NullVertex;
+  END VertexInMap;
+
+(*
+DestroyVertexMap frees up the memory used by the vertexMap when the Assign
+operation is complete. Remember that Deallocate automatically
+releases the proper amount of space.
+*)
+
+  PROCEDURE DestroyVertexMap;
+  BEGIN
+        Deallocate(vertexMap, SIZE(vertexMap^));
+  END DestroyVertexMap;
+
+
+(*
+CopyVertices duplicates the vertices from the source graph to the destination
+graph returning TRUE if every vertex was successfully copied and FALSE otherwise.
+This BOOLEAN result is used by the main body of Assign to control whether the
+graph assignment operation continues by copying the edges. The following local
+variables are used:
+        1. v:                   indicates the current vertex being copied from the source
+                                        graph. This is also used as a 'loop index' over the vertices
+                                        of the source graph.
+        2. newVertex:   temporary for a new vertex for the destination graph.
+        3. lastVertex:  last vertex inserted into the destination graph. This is
+                                        used by TailInsert to add a new vertex to the end of the
+                                        destination graph's adjacency list.
+        4. assignItem:  vertex label assignment routine.
+
+Assignment of the vertex label presents an interesting situation. When a vertex
+is added to a graph, the client module expects the given label to be copied using
+the Modula-2 assignment statement (even for dynamically allocated data items)
+since we simply need to store the value in the vertex object. This is known as
+'structural sharing'. But when a graph is duplicated using Assign, new copies
+of the vertex labels are necessary - avoiding the problems presented by structural
+sharing of dynamically allocated items as described in Volume 1. CopyVertices
+resolves this through the assignment procedure associated with the graph's label
+data type duplicating the label as a NewVertex is created. Complexity O(v) where
+v is the number of vertices in the source graph.
+*)
+
+  PROCEDURE CopyVertices () : BOOLEAN;
+
+  VAR   v : Vertex;     (*--loop index over vertices being copied *)
+  VAR   newVertex : Vertex; (*--new vertex in target graph *)
+  VAR   lastVertex: Vertex; (*--last vertex added to list of vertices *)
+  VAR   assignItem: AssignProc;
+
+(*
+TailInsert adds newVertex to the end of the target graph's adjacency list
+given pointers to the first and last elements of the list. Complexity O(1).
+*)
+
+    PROCEDURE TailInsert (VAR first : Vertex (*--inout *);
+                                                  VAR last  : Vertex (*--inout *));
+    BEGIN
+      IF (first = NullVertex) THEN
+            first := newVertex;
+          ELSE
+            last^.next := newVertex;
+          END (*--if*);
+          last := newVertex;
+    END TailInsert;
+
+  BEGIN
+        CreateVertexMap;
+        IF (vertexMap = NIL) THEN
+          RETURN FALSE;
+        END (*--if*);
+
+        assignItem := AssignOf(theGraph^.labelType);
+        v := theGraph^.firstVertex;
+        lastVertex := NullVertex;
+
+    WHILE (v # NullVertex) DO
+          newVertex := NewVertex(toGraph, assignItem(v^.data), assign);
+          IF (newVertex = NullVertex) THEN
+            DestroyVertexMap;
+                RETURN FALSE;
+          END (*--if*);
+
+          newVertex^.indegree  := v^.indegree;
+          TailInsert(toGraph^.firstVertex, lastVertex);
+          INC(toGraph^.numVertices);
+          AddToVertexMap(v, newVertex);
+
+          v := v^.next;
+        END (*--while*);
+
+        RETURN TRUE;
+  END CopyVertices;
+
+
+(*
+CopyEdges iterates over the edges of the source graph through the adjacency
+list of vertices and the edge lists for each vertex. As each edge in the
+source graph is encountered, a new edge is constructed in the target graph.
+This edge is then added to the target graph's vertex equivalent to the edges'
+initial vertex. The initial and final vertices of the new edge are retrieved
+from the vertex map created by CopyVertices. Note that NewEdge will raise the
+overflow exception if necessary.
+
+The following local variables are used:
+        v:                      indicates the current vertex from the source graph whose
+                                edges are being copied. This is also used as a 'loop index'
+                                over the vertices of the source graph.
+        e:                      indicates the current edge of the source graph being copied.
+                                Also used as a 'loop index' over the edges leaving each
+                                vertex, v.
+        fromVertex: the vertex of the target graph corresponding to 'v' in the
+                                source graph. Since all edges leaving any given vertex, v,
+                                have have 'v' as their initial vertex, fromVertex can be
+                                derived from the current vertex of the source graph rather than
+                                repeatedly retrieving it from the initial vertex of the edge.
+        newEdge:        temporary for a new edge in the target graph.
+        lastEdge:       last edge inserted into the edge list of the current vertex
+                                (fromVertex) destination graph. This is used by TailInsert
+                                to add a new edge to the end of fromVertex's edge list.
+        assignItem:     edge attribute assignment routine.
+
+So while the basic loop over the edges is linear with respect to the number of
+edges, the linear search of the vertex map nested within the loop over the
+source graph's vertices gives this algorithm time complexity O(v^2). A better
+mapping algorithm (i.e, one of constant time O(1)) would yield a linear time
+algorithm overall for the graph assignment.
+*)
+
+  PROCEDURE CopyEdges;
+
+  VAR   v : Vertex;                     (*--loop index over vertices in source graph *)
+  VAR   e : Edge;               (*--loop index over edges in source graph *)
+  VAR   fromVertex: Vertex; (*--vertex in target graph corresponding to v *)
+  VAR   newEdge   : Edge;       (*--new edge for target graph *)
+  VAR   lastEdge  : Edge;       (*--last edge inserted into new list of edges *)
+  VAR   assignItem: AssignProc; (*--attribute assignment procedure *)
+
+(*
+TailInsert adds newEdge to the end of an edge list given pointers to the first
+and last elements of the list. Complexity O(1).
+*)
+
+    PROCEDURE TailInsert (VAR first : Edge (*--inout *);
+                                                  VAR last  : Edge (*--inout *));
+    BEGIN
+      IF (first = NullEdge) THEN
+            first := newEdge;
+          ELSE
+            last^.next := newEdge;
+          END (*--if*);
+          last := newEdge;
+    END TailInsert;
+
+  BEGIN
+        assignItem := AssignOf(theGraph^.attrType);
+        v := theGraph^.firstVertex;
+    WHILE (v # NullVertex) DO
+          e := v^.edges;
+          lastEdge := NullEdge;
+          fromVertex := VertexInMap(v);
+          WHILE (e # NullEdge) DO
+            newEdge := NewEdge(fromVertex,
+                                                   VertexInMap(e^.final),
+                                                   assignItem(e^.weight),
+                                                   assign);
+                IF (newEdge = NullEdge) THEN
+                  RETURN;
+                END (*--if*);
+
+                TailInsert(fromVertex^.edges, lastEdge);
+                INC(toGraph^.numEdges);
+                e := e^.next;
+          END (*--while*);
+          v := v^.next;
+        END (*--while*);
+  END CopyEdges;
+
+BEGIN (*--Assign --*)
+  graphError := noerr;
+  IF RecreateTarget() & CopyVertices() THEN
+        CopyEdges;
+        DestroyVertexMap;
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+10.3.5  Vertex Constructors
+
+Insert adds a vertex to the given graph labeling the vertex with the given item.
+The first step is to allocate a new vertex node which, if successful,
+is followed by adding the vertex at the head of the adjacency list. If we cannot
+create a new vertex node the overflow exception is raised and the Insert operation
+aborted. Complexity O(1).
+*)
+
+PROCEDURE Insert   (VAR theGraph   : Graph     (*--inout*);
+                                        theItem    : Label     (*--in   *);
+                                        VAR theVertex  : Vertex    (*--out  *));
+BEGIN
+  graphError := noerr;
+  theVertex  := NullVertex;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(insert, undefined);
+  ELSE
+    theVertex := NewVertex(theGraph, theItem, insert);
+        IF (theVertex # NullVertex) THEN
+      WITH theGraph^ DO
+                theVertex^.next := firstVertex;
+            firstVertex := theVertex;
+            INC(numVertices);
+          END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+(*
+Remove deletes the given vertex from the specified graph. If no such vertex
+can be found in the graph the novertex exception is raised and the routine
+aborted. Deleting a vertex that is the head of an edge would leave dangling
+edges (pointing to a non-existent vertex), and so, if the vertex is referenced
+by an edge (other than a self-loop) the exception references is raised and
+Remove is aborted. After we have checked that no exceptions can occur we remove
+all edges leaving the vertex, remove the vertex from the adjacency list,
+release any dynamically allocated memory used by the vertex label, release the
+vertex itself, and update the count of vertices in the graph. Complexity
+O(outdegree(v)).
+*)
+
+PROCEDURE Remove   (VAR theGraph   : Graph     (*--inout*);
+                                    VAR theVertex  : Vertex    (*--inout*));
+
+VAR   loopVertex : Vertex; (*--loop index over vertices *)
+VAR   priorVertex: Vertex; (*--immediate predecessor of theVertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(remove, undefined);
+
+  ELSIF (theVertex = NullVertex) THEN
+    RaiseErrIn(remove, nullvertex);
+
+  ELSIF (theVertex^.inGraph # theGraph) THEN
+    RaiseErrIn(remove, novertex);
+
+  ELSIF (theVertex^.indegree > 0) THEN
+        RaiseErrIn(remove, referenced);
+
+  ELSE
+    loopVertex  := theGraph^.firstVertex;
+        priorVertex := NullVertex;
+        WHILE (loopVertex # theVertex) DO
+          priorVertex := loopVertex;
+          loopVertex  := loopVertex^.next;
+        END (*--while*);
+
+        ClearEdges(theVertex);
+        IF (priorVertex = NullVertex) THEN
+          theGraph^.firstVertex := theVertex^.next;
+        ELSE
+          priorVertex^.next := theVertex^.next;
+        END (*--if*);
+        FreeLabel(theVertex);
+        Deallocate(theVertex, SIZE(theVertex^));
+        DEC(theGraph^.numVertices);
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+(*
+SetLabel assigns a new label to the given vertex of the graph. Prior to
+assigning a new vertex label we must release any dynamically allocated memory
+used by the old vertex label. Complexity O(1).
+*)
+
+PROCEDURE SetLabel (    theVertex  : Vertex    (*--inout*);
+                                            theItem    : Label     (*--in   *));
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(setlabel, nullvertex);
+  ELSE
+        FreeLabel(theVertex);
+    theVertex^.data := theItem;
+  END (*--if*);
+END SetLabel;
+(*-------------------------*)
+
+(*
+10.3.6  Edge Constructors
+
+Link adds a directed edge between the from and to vertices labeling the
+edge with the given weight attribute. The new edge is linked to the front
+of the fromVertex's edge list. Thus, edges appear in reverse order to their
+order of insertion. Complexity O(1).
+*)
+
+PROCEDURE Link          (VAR theGraph   : Graph     (*--inout*);
+                                             fromVertex : Vertex    (*--in   *);
+                                             toVertex   : Vertex    (*--in   *);
+                                             theWeight  : Attribute (*--in   *);
+                                             VAR theEdge    : Edge      (*--out  *));
+BEGIN
+  graphError := noerr;
+  theEdge    := NullEdge;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(link, undefined);
+  ELSIF (fromVertex = NullVertex) OR (toVertex = NullVertex) THEN
+    RaiseErrIn(link, nullvertex);
+  ELSIF (fromVertex^.inGraph # theGraph) OR
+                (toVertex^.inGraph # theGraph) THEN
+    RaiseErrIn(link, novertex);
+  ELSE
+
+    theEdge := NewEdge(fromVertex, toVertex, theWeight, link);
+        IF (theEdge # NullEdge) THEN
+          theEdge^.next := fromVertex^.edges;
+          fromVertex^.edges := theEdge;
+          IF (fromVertex # toVertex) THEN
+                INC(toVertex^.indegree);
+          END (*--if*);
+          INC(theGraph^.numEdges);
+        END (*--if*);
+  END (*--if*);
+END Link;
+(*-------------------------*)
+
+(*
+Unlink removes a directed edge between the two vertices, fromVertex and
+toVertex. Complexity O(d) where d is the out-degree of the from vertex (derived
+from the initial vertex of theEdge).
+*)
+
+PROCEDURE Unlink        (VAR theGraph   : Graph     (*--inout*);
+                                         VAR theEdge    : Edge      (*--inout*));
+
+VAR   e : Edge;   (*--pointer to edge (v,w), if any *)
+VAR   f : Edge;   (*--pointer to edge preceeding (v,w) in adjacency list *)
+
+BEGIN
+  graphError := noerr;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(unlink, undefined);
+
+  ELSIF (theEdge = NullEdge) THEN
+        RaiseErrIn(unlink, nulledge);
+
+  ELSIF (theEdge^.initial^.inGraph # theGraph) THEN
+    RaiseErrIn(unlink, noedge);
+
+  ELSE
+
+(*
+The following loop searches for the edge being removed in the list of edges
+associated with the edges' initial vertex. In addition, we need the prior
+edge in the list for the actual deletion of the edge from the list. This is
+a standard singly-linked list technique for the deletion of list nodes.
+This loop is guaranteed to succeed as Link ensures that the edge is placed in
+the initial vertex's list of edges. Complexity O(outdegree(v)).
+*)
+        e := theEdge^.initial^.edges;
+        f := NullEdge;
+        WHILE (e # theEdge) DO
+          f := e;
+          e := e^.next;
+        END (*--while*);
+
+        WITH theEdge^ DO
+
+(*
+Update the edge list of the initial vertex by removing the edge.
+*)
+          IF (f = NullEdge) THEN
+            initial^.edges := next;
+          ELSE
+            f^.next := next;
+          END (*--if*);
+
+(*
+Self-loops are not included in the final vertex's indegree count since such
+edges may be freely unlinked and do not effect the removal of the vertex. In
+any case, we must maintain the proper count of edges in the graph. As a final
+step, the edge attribute and the edge itself may be deallocated. In case a
+client module has stored a copy of the edge somewhere, we insure that these
+duplicates are invalid by clearing their inital vertex (used to determine if
+an edge is an element of a graph) and cut their link to any other edges.
+*)
+          IF (initial # final) THEN
+            DEC(final^.indegree);
+          END (*--if*);
+          DEC(initial^.inGraph^.numEdges);
+
+      FreeAttribute(theEdge);
+          initial := NullVertex;
+          next    := NullEdge;
+          Deallocate(theEdge, SIZE(theEdge^));
+        END (*--with*);
+  END (*--if*);
+END Unlink;
+(*-------------------------*)
+
+(*
+SetAttribute assigns a new edge labelling to the given edge. Prior to assigning
+a new edge attribute we must release any dynamically allocated memory
+used by the old edge attribute. Complexity O(1).
+*)
+
+PROCEDURE SetAttribute  (    theEdge    : Edge      (*--inout*);
+                                             theWeight  : Attribute (*--in   *));
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+        RaiseErrIn(setattr, nulledge);
+  ELSE
+    FreeAttribute(theEdge);
+    theEdge^.weight := theWeight;
+  END (*--if*);
+END SetAttribute;
+(*-------------------------*)
+
+
+(*
+10.3.7  Graph Selectors
+
+IsDefined verifies to the best of its ability whether theGraph has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theGraph  : Graph       (*--in   *))
+                                                                   : BOOLEAN     (*--out  *);
+BEGIN
+  RETURN (theGraph # NullGraph);
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theGraph is in the empty state, as indicated by
+the number of vertices being zero, and False otherwise.  As per the
+specification (û9.3) undefined graphs are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theGraph  : Graph       (*--in   *))
+                                                                   : BOOLEAN     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isempty, undefined);
+        RETURN TRUE;
+  END (*--if*);
+  RETURN theGraph^.numVertices = 0;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+TypeOf simply returns the vertex label and edge attribute data type IDs for
+the given graph. Undefined graphs, as always, raise the undefined exception
+and return a reasonable value, in this case the NullType. Complexity O(1).
+*)
+
+PROCEDURE TypeOf    (    theGraph  : Graph       (*--in   *);
+                                         VAR labelType : TypeID      (*--out  *);
+                                         VAR attrType  : TypeID      (*--out  *));
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(typeof, undefined);
+        labelType := NullType;
+        attrType  := NullType;
+  ELSE
+        labelType := theGraph^.labelType;
+        attrType  := theGraph^.attrType;
+  END (*--if*);
+END TypeOf;
+(*-------------------------*)
+
+(*
+OrderOf returns the number of vertices in the graph, or zero for an undefined
+graph. Complexity O(1).
+*)
+
+PROCEDURE OrderOf   (    theGraph  : Graph       (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(orderof, undefined);
+        RETURN 0;
+  END (*--if*);
+  RETURN theGraph^.numVertices;
+END OrderOf;
+(*-------------------------*)
+
+(*
+OrderOf returns the number of edges in the graph, or zero for an undefined
+graph. Complexity O(1).
+*)
+
+PROCEDURE SizeOf    (    theGraph  : Graph       (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(sizeof, undefined);
+        RETURN 0;
+  END (*--if*);
+  RETURN theGraph^.numEdges;
+END SizeOf;
+(*-------------------------*)
+
+(*
+10.3.8  Vertex Selectors
+
+InDegree returns the number of edges entering the given vertex. Complexity O(1).
+*)
+
+PROCEDURE InDegree  (    theVertex : Vertex      (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(indegree, nullvertex);
+  ELSE
+    RETURN theVertex^.indegree;
+  END (*--if*);
+  RETURN 0;
+END InDegree;
+(*-------------------------*)
+
+(*
+OutDegree returns the number of edges leaving the given vertex. We do this by
+simply iterating over the edges of the vertex counting them along the way.
+Complexity O(outdegree(v)).
+*)
+
+PROCEDURE OutDegree (    theVertex : Vertex      (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+
+VAR   theEdge   : Edge;         (*-- loop index over edges of the vertex *)
+VAR   edgeCount : CARDINAL; (*--running count of edges leaving this vertex *)
+
+BEGIN
+  graphError := noerr;
+  edgeCount  := 0;
+
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(outdegree, nullvertex);
+  ELSE
+    theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) DO
+          INC(edgeCount);
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+
+  RETURN edgeCount;
+END OutDegree;
+(*-------------------------*)
+
+(*
+LabelOf returns the vertex label associated with the given vertex.
+If the vertex is undefined the NullItem is returned. Complexity O(1).
+*)
+
+PROCEDURE LabelOf   (    theVertex : Vertex      (*--in   *))
+                                                                   : Label       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(labelof, nullvertex);
+  ELSE
+    RETURN theVertex^.data;
+  END (*--if*);
+  RETURN NullItem;
+END LabelOf;
+(*-------------------------*)
+
+(*
+Since we have stored a copy of the graph object associated with each vertex
+as a field of the vertex itself, IsVertex simply needs to compare the given
+graph with its own local state. This saves us from having to search the graph.
+Complexity O(1).
+*)
+
+PROCEDURE IsVertex  (    theGraph  : Graph       (*--in   *);
+                                             theVertex : Vertex      (*--in   *))
+                                                           : BOOLEAN     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isvertex, undefined);
+  ELSIF (theVertex = NullVertex) THEN
+    RaiseErrIn(isvertex, nullvertex);
+  ELSE
+    RETURN theVertex^.inGraph = theGraph;
+  END (*--if*);
+  RETURN FALSE;
+END IsVertex;
+(*-------------------------*)
+
+(*
+GraphOf simply returns its copy of the enclosing graph or the NullGraph if the
+vertex is undefined. Complexity O(1).
+*)
+
+PROCEDURE GraphOf   (    theVertex : Vertex      (*--in   *))
+                                                                   : Graph       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(graphof, nullvertex);
+  ELSE
+    RETURN theVertex^.inGraph;
+  END (*--if*);
+  RETURN NullGraph;
+END GraphOf;
+(*-------------------------*)
+
+(*
+10.3.9  Edge Selectors
+
+AttributeOf returns the edge attribute associated with the given edge.
+If the edge is undefined the NullItem is returned. Complexity O(1).
+*)
+
+PROCEDURE AttributeOf (    theEdge   : Edge        (*--in   *))
+                                                                 : Attribute   (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(attrof, nulledge);
+  ELSE
+    RETURN theEdge^.weight;
+  END (*--if*);
+  RETURN NullItem;
+END AttributeOf;
+(*-------------------------*)
+
+(*
+Given an edge, InitialOf returns the vertex that is the origin of
+the directed edge or the NullVertex if the edge is undefined. Complexity O(1).
+*)
+
+PROCEDURE InitialOf   (    theEdge   : Edge        (*--in   *))
+                                                                 : Vertex      (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(initialof, nulledge);
+  ELSE
+    RETURN theEdge^.initial;
+  END (*--if*);
+  RETURN NullVertex;
+END InitialOf;
+(*-------------------------*)
+
+(*
+Given an edge, FinalOf returns the vertex that is the destination of
+the directed edge or the NullVertex if the edge is undefined. Complexity O(1).
+*)
+
+PROCEDURE FinalOf     (    theEdge   : Edge        (*--in   *))
+                                                                 : Vertex      (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(finalof, nulledge);
+  ELSE
+    RETURN theEdge^.final;
+  END (*--if*);
+  RETURN NullVertex;
+END FinalOf;
+(*-------------------------*)
+
+(*
+IsEdge returns true if there the given directed edge is an edge of the given
+graph and false otherwise. An advantage of having each vertex identify its
+enclosing graph object is use of this field in testing whether the edge is
+part of a specified graph. This saves use from having to search every edge in
+the graph. Complexity O(1).
+*)
+
+PROCEDURE IsEdge      (    theGraph  : Graph       (*--in   *);
+                                               theEdge   : Edge        (*--in   *))
+                                                             : BOOLEAN     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isedge, undefined);
+  ELSIF (theEdge = NullEdge) THEN
+    RaiseErrIn(isedge, nulledge);
+  ELSIF (theEdge^.initial = NullVertex) THEN
+    RaiseErrIn(isedge, nullvertex);
+  ELSE
+    RETURN theEdge^.initial^.inGraph = theGraph;
+  END (*--if*);
+  RETURN FALSE;
+END IsEdge;
+(*-------------------------*)
+
+
+(*
+10.3.10 Passive Iterators
+
+LoopVertices simply iterates over the vertices of the given graph until every
+vertex has been examined or the process procedure parameter returns FALSE,
+whichever occurs first. Complexity O(|V|).
+*)
+
+PROCEDURE LoopVertices (    theGraph  : Graph          (*--in   *);
+                                                        process   : VertexLoopProc (*--in   *));
+
+VAR   theVertex : Vertex; (*--loop index over vertices *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(loopvertices, undefined);
+  ELSE
+        theVertex := theGraph^.firstVertex;
+        WHILE (theVertex # NullVertex) & process(theVertex) DO
+          theVertex := theVertex^.next;
+        END (*--while*);
+  END (*--if*);
+END LoopVertices;
+(*-------------------------*)
+
+(*
+LoopEdges loops over the vertices of the given graph to access the edges associated
+with each vertex. Once the process procedure parameter returns FALSE, we exit
+both WHILE statements through the use of a RETURN which exits the procedure.
+Complexity O(|E|).
+*)
+
+PROCEDURE LoopEdges    (    theGraph  : Graph          (*--in   *);
+                                                        process   : EdgeLoopProc   (*--in   *));
+
+VAR   theVertex : Vertex; (*--loop index over vertices *)
+VAR   theEdge   : Edge;   (*--loop index over edges of a vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(loopedges, undefined);
+  ELSE
+        theVertex := theGraph^.firstVertex;
+        WHILE (theVertex # NullVertex) DO
+          theEdge := theVertex^.edges;
+          WHILE (theEdge # NullEdge) DO
+            IF ~process(theEdge) THEN
+                  RETURN;
+                END (*--if*);
+                theEdge := theEdge^.next;
+          END (*--while*);
+          theVertex := theVertex^.next;
+        END (*--while*);
+  END (*--if*);
+END LoopEdges;
+(*-------------------------*)
+
+(*
+LoopIterate simply loops over the edges leaving a specified vertex. Complexity
+O(outdegree(v)).
+*)
+
+PROCEDURE LoopIterate  (    theVertex : Vertex         (*--in   *);
+                                                        process   : EdgeLoopProc   (*--in   *));
+
+VAR   theEdge : Edge;   (*--loop index over edges of the vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(loopiterate, nullvertex);
+  ELSE
+        theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) & process(theEdge) DO
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END LoopIterate;
+(*-------------------------*)
+
+(*
+TravVertices simply iterates over every vertex in the graph. Complexity O(|V|).
+*)
+
+PROCEDURE TravVertices (    theGraph  : Graph      (*--in   *);
+                                                        process   : VertexProc (*--in   *));
+
+VAR   theVertex : Vertex; (*--loop index over vertices *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(travvertices, undefined);
+  ELSE
+        theVertex := theGraph^.firstVertex;
+        WHILE (theVertex # NullVertex) DO
+          process(theVertex);
+          theVertex := theVertex^.next;
+        END (*--while*);
+  END (*--if*);
+END TravVertices;
+(*-------------------------*)
+
+(*
+TravEdges simply iterates over every edge in the graph. Since the only way
+to get at all the edges is through the vertices, we iterate over all the
+vertices and over each edge leaving each vertex. Complexity O(v+e).
+*)
+
+PROCEDURE TravEdges    (    theGraph  : Graph      (*--in   *);
+                                                        process   : EdgeProc   (*--in   *));
+
+VAR   theVertex : Vertex; (*--loop index over vertices *)
+VAR   theEdge   : Edge;   (*--loop index over edges of a vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(travedges, undefined);
+  ELSE
+        theVertex := theGraph^.firstVertex;
+        WHILE (theVertex # NullVertex) DO
+          theEdge := theVertex^.edges;
+          WHILE (theEdge # NullEdge) DO
+            process(theEdge);
+                theEdge := theEdge^.next;
+          END (*--while*);
+          theVertex := theVertex^.next;
+        END (*--while*);
+  END (*--if*);
+END TravEdges;
+(*-------------------------*)
+
+(*
+Iterate simply loops over every edge leaving the specified vertex of a graph.
+Complexity O(outdegree(v)).
+*)
+
+PROCEDURE Iterate      (    theVertex : Vertex     (*--in   *);
+                                                        process   : EdgeProc   (*--in   *));
+
+VAR   theEdge : Edge;   (*--loop index over edges of the vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(iterate, nullvertex);
+  ELSE
+        theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) DO
+          process(theEdge);
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END Iterate;
+(*-------------------------*)
+
+(*
+10.3.11 Active Iterators
+
+Each of the active iterators are essentially selectors for the underlying
+representation of the adjacency list. Their complexity is O(1).
+*)
+
+PROCEDURE FirstVertex  (    theGraph  : Graph      (*--in   *))
+                                                                          : Vertex     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(firstvertex, undefined);
+  ELSE
+        RETURN theGraph^.firstVertex;
+  END (*--if*);
+  RETURN NullVertex;
+END FirstVertex;
+(*-------------------------*)
+
+PROCEDURE NextVertex   (    theVertex : Vertex     (*--in   *))
+                                                                          : Vertex     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(nextvertex, nullvertex);
+  ELSE
+        RETURN theVertex^.next;
+  END (*--if*);
+  RETURN NullVertex;
+END NextVertex;
+(*-------------------------*)
+
+PROCEDURE FirstEdge    (    theVertex : Vertex     (*--in   *))
+                                                                          : Edge       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(firstedge, nullvertex);
+  ELSE
+    RETURN theVertex^.edges;
+  END (*--if*);
+  RETURN NullEdge;
+END FirstEdge;
+(*-------------------------*)
+
+PROCEDURE NextEdge     (    theEdge   : Edge       (*--in   *))
+                                                                          : Edge       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(nextedge, nulledge);
+  ELSE
+    RETURN theEdge^.next;
+  END (*--if*);
+  RETURN NullEdge;
+END NextEdge;
+(*-------------------------*)
+
+(*
+10.3.12 Module Initialization
+
+The module's local variables are initialized to known states. graphError is
+used to fill the handler array with a routine that does nothing when an exception
+is raised (saving the declaration of a special loop control variable for this
+purpose). Applying MIN and MAX to cover all exceptions ensures that this
+initialization will be unaffected by any future changes to the number of
+Exceptions or their order of declaration within the enumeration. Since a FOR
+loop control variable is undefined following the loop, graphError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR graphError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(graphError, NullHandler);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  graphError := noerr;
+        NullGraph := NIL;
+        NullVertex := NIL;
+        NullEdge := NIL;
+END DigrSUMI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGRSUUI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGRSUUI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGRSUUI.MOD
@@ -0,0 +1,976 @@
+(*
+10.5    Digraph - Sequential Unbounded Unmanaged Iterator
+
+See DigraphSUMI for comments. The only difference here is that assignment
+of Items uses the Modula-2 assignment statement and Items are never
+deallocated.
+*)
+
+IMPLEMENTATION MODULE DigrSUUI;
+(*====================================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: 5509 bytes
+    Component: Digraph - Sequential Unbounded Unmanaged Iterator
+
+    REVISION HISTORY
+    v1.00  29 May 1988  C. Lins:
+        Initial TML Modula-2 implementation
+    v2.00  15 Jan 1989  C. Lins:
+        Revised interface in conformance with new graph spec (Ch 9).
+                Removed use of TypeID in Create as it's not used by this module.
+    v2.01  10 Apr 1989  C. Lins:
+        Corrected initialization of handlers array.
+    v2.02  18 Apr 1989   C. Lins:
+          Added component id constant.
+    v2.00  24 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+====================================================================*)
+
+FROM JPIStorage IMPORT
+        (*--proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+        (*--cons*) NullItem,
+        (*--type*) Item;
+
+FROM GraphTypes IMPORT
+        (*--type*) Operations, Exceptions, ComponentID;
+
+FROM ErrorHandling IMPORT
+        (*--cons*) NullHandler,
+        (*--type*) HandlerProc,
+        (*--proc*) Raise;
+
+        (*-------------------------*)
+
+(*
+10.5.1  Type Declarations
+*)
+
+TYPE  Edge   = POINTER TO EdgeNode;
+TYPE  Vertex = POINTER TO VertexNode;
+
+TYPE  VertexNode = RECORD
+                inGraph : Graph;        (*-- graph in which this vertex is a member *)
+                data    : Label;        (*-- data item (label) for this vertex *)
+                indegree: CARDINAL; (*-- # of edges ending at this vertex *)
+                next    : Vertex;       (*-- next vertex in adjacency list *)
+                edges   : Edge;         (*-- link to first edge leaving this vertex *)
+          END (*-- VertexNode *);
+
+TYPE  EdgeNode = RECORD
+                initial : Vertex;       (*-- source vertex for this edge *)
+                final   : Vertex;       (*-- destination vertex for this edge *)
+                weight  : Attribute;(*-- weight/attribute for this edge *)
+                next    : Edge;         (*-- next edge leaving this vertex *)
+          END (*-- EdgeNode *);
+
+TYPE  UnboundedGraph = RECORD
+                numVertices: CARDINAL;  (*-- current number of vertices *)
+                numEdges   : CARDINAL;  (*-- current number of edges *)
+                firstVertex: Vertex;    (*-- first vertex in adjacency list *)
+          END (*-- UnboundedGraph *);
+
+TYPE  Graph = POINTER TO UnboundedGraph;
+
+        (*-------------------------*)
+
+(*
+10.5.2  Exceptions
+*)
+
+VAR   graphError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE GraphError () : Exceptions;
+BEGIN
+  RETURN graphError;
+END GraphError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                                                  theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                                                         : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*-- in    *);
+                                                  theError   : Exceptions  (*-- in    *));
+BEGIN
+  graphError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+(*
+10.5.3  Local Routines
+
+ClearEdges removes all edges from a given vertex. O(outdegree(v))
+*)
+
+PROCEDURE ClearEdges    (    theVertex: Vertex   (*--inout*));
+
+VAR   theEdge : Edge;   (*-- edge being removed from vertex *)
+
+BEGIN
+  WITH theVertex^ DO
+        WHILE (edges # NullEdge) DO
+          theEdge := edges;
+          edges := edges^.next;
+          DEC(inGraph^.numEdges);
+          Deallocate(theEdge, SIZE(theEdge^));
+        END (*--while*);
+  END (*--with*);
+END ClearEdges;
+(*-------------------------*)
+
+PROCEDURE NewVertex (    theGraph   : Graph      (*--in   *);
+                                                 theItem    : Label      (*--in   *);
+                                                 theRoutine : Operations (*--in   *))
+                                                                    : Vertex     (*--out  *);
+
+VAR   theVertex : Vertex;               (*-- newly created vertex *)
+
+BEGIN
+  Allocate(theVertex, SIZE(VertexNode));
+  IF (theVertex = NullVertex) THEN
+        RaiseErrIn(theRoutine, overflow);
+  ELSE
+        WITH theVertex^ DO
+          inGraph := theGraph;
+          data    := theItem;
+          indegree:= 0;
+          edges   := NullEdge;
+          next    := NullVertex;
+        END (*--with*);
+  END (*--if*);
+  RETURN theVertex;
+END NewVertex;
+(*-------------------------*)
+
+PROCEDURE NewEdge (    fromVertex : Vertex     (*--in   *);
+                                           toVertex   : Vertex     (*--in   *);
+                                           theWeight  : Attribute  (*--in   *);
+                                           theRoutine : Operations (*--in   *))
+                                                                  : Edge           (*--out  *);
+
+VAR   theEdge : Edge;   (*-- newly created edge *)
+
+BEGIN
+  Allocate(theEdge, SIZE(EdgeNode));
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(theRoutine, overflow);
+  ELSE
+    WITH theEdge^ DO
+          initial := fromVertex;
+          final   := toVertex;
+          weight  := theWeight;
+          next    := NullEdge;
+    END (*--with*);
+  END (*--if*);
+  RETURN theEdge;
+END NewEdge;
+(*-------------------------*)
+
+(*
+10.5.4  Graph Constructors
+*)
+
+PROCEDURE Create   ()                      : Graph     (*-- out   *);
+
+VAR   newGraph : Graph; (*-- temporary for new graph object *)
+
+BEGIN
+  graphError := noerr;
+  Allocate(newGraph, SIZE(UnboundedGraph));
+  IF (newGraph = NullGraph) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newGraph^ DO
+          numVertices := 0;
+          numEdges    := 0;
+          firstVertex := NullVertex;
+        END (*--with*);
+  END (*--if*);
+  RETURN newGraph;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theGraph      : Graph     (*-- inout *));
+BEGIN
+  Clear(theGraph);
+  IF (graphError = noerr) THEN
+    Deallocate(theGraph, SIZE(theGraph^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theGraph      : Graph    (*-- inout *));
+
+VAR   theVertex : Vertex;          (*-- loop index over vertices *)
+VAR   oldVertex : Vertex;          (*-- vertex to deallocate *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theGraph^ DO
+          theVertex := firstVertex;
+          WHILE (theVertex # NullVertex) DO
+            ClearEdges(theVertex);
+                oldVertex := theVertex;
+                theVertex := theVertex^.next;
+                Deallocate(oldVertex, SIZE(oldVertex^));
+          END (*--while*);
+          firstVertex := NullVertex;
+          numVertices := 0;
+          numEdges    := 0;
+        END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theGraph      : Graph     (*-- in    *);
+                                   VAR toGraph       : Graph     (*-- inout *));
+
+  PROCEDURE RecreateTarget (): BOOLEAN (*-- out   *);
+  BEGIN
+        IF (theGraph = NullGraph) THEN
+      RaiseErrIn(assign, undefined);
+
+        ELSIF (toGraph = NullGraph) THEN
+      WITH theGraph^ DO
+        toGraph := Create();
+          END (*--with*);
+
+        ELSIF (theGraph = toGraph) THEN
+      RETURN FALSE;
+
+        ELSE
+          Clear(toGraph);
+        END (*--if*);
+        RETURN (graphError = noerr);
+  END RecreateTarget;
+
+  TYPE  MapVertex = RECORD
+              old : Vertex; (*-- vertex from source graph *)
+              new : Vertex; (*-- corresponging vertex in target graph *)
+            END (*--MapVertex*);
+  TYPE  MapVertices = ARRAY [0..0] OF MapVertex;
+
+  VAR   vertexMap : POINTER TO MapVertices;
+  VAR   mapExtent : CARDINAL;
+
+  PROCEDURE CreateVertexMap;
+  BEGIN
+        Allocate(vertexMap,
+                         VAL(CARDINAL, SIZE(MapVertex)) * theGraph^.numVertices);
+        mapExtent := 0;
+  END CreateVertexMap;
+
+  PROCEDURE AddToVertexMap (    oldVertex : Vertex (*--in   *);
+                                                                newVertex : Vertex (*--in   *));
+  BEGIN
+        WITH vertexMap^[mapExtent] DO
+          old := oldVertex;
+          new := newVertex;
+        END (*--with*);
+    INC(mapExtent);
+  END AddToVertexMap;
+
+  PROCEDURE VertexInMap (    oldVertex : Vertex (*--in   *))
+                                                                           : Vertex (*--out  *);
+
+  VAR   index : CARDINAL; (*-- loop index over mapping entries *)
+
+  BEGIN
+    FOR index := 0 TO mapExtent-1 DO
+          WITH vertexMap^[index] DO
+        IF (oldVertex = old) THEN
+                  RETURN new;
+                END (*--if*);
+          END (*--with*);
+    END (*--for*);
+        RETURN NullVertex;
+  END VertexInMap;
+
+  PROCEDURE DestroyVertexMap;
+  BEGIN
+        Deallocate(vertexMap, SIZE(vertexMap^));
+  END DestroyVertexMap;
+
+  PROCEDURE CopyVertices () : BOOLEAN;
+
+  VAR   v : Vertex;     (*--loop index over vertices being copied *)
+  VAR   newVertex : Vertex; (*--new vertex in target graph *)
+  VAR   lastVertex: Vertex; (*--last vertex added to list of vertices *)
+
+    PROCEDURE TailInsert (VAR first : Vertex (*--inout *);
+                                                  VAR last  : Vertex (*--inout *));
+    BEGIN
+      IF (first = NullVertex) THEN
+            first := newVertex;
+          ELSE
+            last^.next := newVertex;
+          END (*--if*);
+          last := newVertex;
+    END TailInsert;
+
+  BEGIN
+        CreateVertexMap;
+        IF (vertexMap = NIL) THEN
+          RETURN FALSE;
+        END (*--if*);
+
+        v := theGraph^.firstVertex;
+        lastVertex := NullVertex;
+
+    WHILE (v # NullVertex) DO
+          newVertex := NewVertex(toGraph, v^.data, assign);
+          IF (newVertex = NullVertex) THEN
+            DestroyVertexMap;
+                RETURN FALSE;
+          END (*--if*);
+
+          newVertex^.indegree := v^.indegree;
+          TailInsert(toGraph^.firstVertex, lastVertex);
+          INC(toGraph^.numVertices);
+          AddToVertexMap(v, newVertex);
+
+          v := v^.next;
+        END (*--while*);
+
+        RETURN TRUE;
+  END CopyVertices;
+
+
+  PROCEDURE CopyEdges;
+
+  VAR   v : Vertex;                     (*--loop index over vertices in source graph *)
+  VAR   e : Edge;               (*--loop index over edges in source graph *)
+  VAR   fromVertex: Vertex; (*--vertex in target graph corresponding to v *)
+  VAR   newEdge   : Edge;       (*--new edge for target graph *)
+  VAR   lastEdge  : Edge;       (*--last edge inserted into new list of edges *)
+
+    PROCEDURE TailInsert (VAR first : Edge (*--inout *);
+                                                  VAR last  : Edge (*--inout *));
+    BEGIN
+      IF (first = NullEdge) THEN
+            first := newEdge;
+          ELSE
+            last^.next := newEdge;
+          END (*--if*);
+          last := newEdge;
+    END TailInsert;
+
+  BEGIN
+        v := theGraph^.firstVertex;
+    WHILE (v # NullVertex) DO
+          e := v^.edges;
+          lastEdge := NullEdge;
+          fromVertex := VertexInMap(v);
+          WHILE (e # NullEdge) DO
+            newEdge := NewEdge(fromVertex,
+                                                   VertexInMap(e^.final),
+                                                   e^.weight,
+                                                   assign);
+                IF (newEdge = NullEdge) THEN
+                  RETURN;
+                END (*--if*);
+
+                TailInsert(fromVertex^.edges, lastEdge);
+                INC(toGraph^.numEdges);
+                e := e^.next;
+          END (*--while*);
+          v := v^.next;
+        END (*--while*);
+  END CopyEdges;
+
+BEGIN (*--Assign --*)
+  graphError := noerr;
+  IF RecreateTarget() & CopyVertices() THEN
+        CopyEdges;
+        DestroyVertexMap;
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+10.5.5  Vertex Constructors
+*)
+
+PROCEDURE Insert   (VAR theGraph   : Graph     (*--inout*);
+                                        theItem    : Label     (*--in   *);
+                                        VAR theVertex  : Vertex    (*--out  *));
+BEGIN
+  graphError := noerr;
+  theVertex  := NullVertex;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(insert, undefined);
+  ELSE
+    theVertex := NewVertex(theGraph, theItem, insert);
+        IF (theVertex # NullVertex) THEN
+      WITH theGraph^ DO
+                theVertex^.next := firstVertex;
+            firstVertex := theVertex;
+            INC(numVertices);
+          END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+PROCEDURE Remove   (VAR theGraph   : Graph     (*--inout*);
+                                    VAR theVertex  : Vertex    (*--inout*));
+
+VAR   loopVertex : Vertex; (*--loop index over vertices *)
+VAR   priorVertex: Vertex; (*--immediate predecessor of theVertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(remove, undefined);
+
+  ELSIF (theVertex = NullVertex) THEN
+    RaiseErrIn(remove, nullvertex);
+
+  ELSIF (theVertex^.inGraph # theGraph) THEN
+    RaiseErrIn(remove, novertex);
+
+  ELSIF (theVertex^.indegree > 0) THEN
+        RaiseErrIn(remove, referenced);
+
+  ELSE
+    loopVertex  := theGraph^.firstVertex;
+        priorVertex := NullVertex;
+        WHILE (loopVertex # theVertex) DO
+          priorVertex := loopVertex;
+          loopVertex  := loopVertex^.next;
+        END (*--while*);
+
+        ClearEdges(theVertex);
+        IF (priorVertex = NullVertex) THEN
+          theGraph^.firstVertex := theVertex^.next;
+        ELSE
+          priorVertex^.next := theVertex^.next;
+        END (*--if*);
+        Deallocate(theVertex, SIZE(theVertex^));
+        DEC(theGraph^.numVertices);
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+PROCEDURE SetLabel (    theVertex  : Vertex    (*--inout*);
+                                            theItem    : Label     (*--in   *));
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(setlabel, nullvertex);
+  ELSE
+    theVertex^.data := theItem;
+  END (*--if*);
+END SetLabel;
+(*-------------------------*)
+
+(*
+10.5.6  Edge Constructors
+*)
+
+PROCEDURE Link          (VAR theGraph   : Graph     (*--inout*);
+                                             fromVertex : Vertex    (*--in   *);
+                                             toVertex   : Vertex    (*--in   *);
+                                             theWeight  : Attribute (*--in   *);
+                                             VAR theEdge    : Edge      (*--out  *));
+BEGIN
+  graphError := noerr;
+  theEdge    := NullEdge;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(link, undefined);
+  ELSIF (fromVertex = NullVertex) OR (toVertex = NullVertex) THEN
+    RaiseErrIn(link, nullvertex);
+  ELSIF (fromVertex^.inGraph # theGraph) OR
+                (toVertex^.inGraph # theGraph) THEN
+    RaiseErrIn(link, novertex);
+  ELSE
+
+    theEdge := NewEdge(fromVertex, toVertex, theWeight, link);
+        IF (theEdge # NullEdge) THEN
+          theEdge^.next := fromVertex^.edges;
+          fromVertex^.edges := theEdge;
+          IF (fromVertex # toVertex) THEN
+                INC(toVertex^.indegree);
+          END (*--if*);
+          INC(theGraph^.numEdges);
+        END (*--if*);
+  END (*--if*);
+END Link;
+(*-------------------------*)
+
+PROCEDURE Unlink        (VAR theGraph   : Graph     (*--inout*);
+                                         VAR theEdge    : Edge      (*--inout*));
+
+VAR   e : Edge;   (*--pointer to edge (v,w), if any *)
+VAR   f : Edge;   (*--pointer to edge preceeding (v,w) in adjacency list *)
+
+BEGIN
+  graphError := noerr;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(unlink, undefined);
+
+  ELSIF (theEdge = NullEdge) THEN
+        RaiseErrIn(unlink, nulledge);
+
+  ELSIF (theEdge^.initial^.inGraph # theGraph) THEN
+    RaiseErrIn(unlink, noedge);
+
+  ELSE
+
+        e := theEdge^.initial^.edges;
+        f := NullEdge;
+        WHILE (e # theEdge) DO
+          f := e;
+          e := e^.next;
+        END (*--while*);
+
+        WITH theEdge^ DO
+
+          IF (f = NullEdge) THEN
+            initial^.edges := next;
+          ELSE
+            f^.next := next;
+          END (*--if*);
+
+          IF (initial # final) THEN
+            DEC(final^.indegree);
+          END (*--if*);
+          DEC(initial^.inGraph^.numEdges);
+
+          initial := NullVertex;
+          next    := NullEdge;
+          Deallocate(theEdge, SIZE(theEdge^));
+        END (*--with*);
+  END (*--if*);
+END Unlink;
+(*-------------------------*)
+
+PROCEDURE SetAttribute  (    theEdge    : Edge      (*--inout*);
+                                             theWeight  : Attribute (*--in   *));
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+        RaiseErrIn(setattr, nulledge);
+  ELSE
+    theEdge^.weight := theWeight;
+  END (*--if*);
+END SetAttribute;
+(*-------------------------*)
+
+(*
+10.5.7  Graph Selectors
+*)
+
+PROCEDURE IsDefined (    theGraph  : Graph       (*-- in    *))
+                                                                   : BOOLEAN     (*-- out   *);
+BEGIN
+  RETURN (theGraph # NullGraph);
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theGraph  : Graph       (*-- in    *))
+                                                                   : BOOLEAN     (*-- out   *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isempty, undefined);
+        RETURN TRUE;
+  END (*--if*);
+  RETURN theGraph^.numVertices = 0;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE OrderOf   (    theGraph  : Graph       (*-- in    *))
+                                                                   : CARDINAL    (*-- out   *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(orderof, undefined);
+        RETURN 0;
+  END (*--if*);
+  RETURN theGraph^.numVertices;
+END OrderOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theGraph  : Graph       (*-- in    *))
+                                                                   : CARDINAL    (*-- out   *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(sizeof, undefined);
+        RETURN 0;
+  END (*--if*);
+  RETURN theGraph^.numEdges;
+END SizeOf;
+(*-------------------------*)
+
+(*
+10.5.8  Vertex Selectors
+*)
+
+PROCEDURE InDegree  (    theVertex : Vertex      (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(indegree, nullvertex);
+  ELSE
+    RETURN theVertex^.indegree;
+  END (*--if*);
+  RETURN 0;
+END InDegree;
+(*-------------------------*)
+
+PROCEDURE OutDegree (    theVertex : Vertex      (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+
+VAR   theEdge   : Edge;         (*-- loop index over edges of the vertex *)
+VAR   edgeCount : CARDINAL; (*--running count of edges leaving this vertex *)
+
+BEGIN
+  graphError := noerr;
+  edgeCount  := 0;
+
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(outdegree, nullvertex);
+  ELSE
+    theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) DO
+          INC(edgeCount);
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+
+  RETURN edgeCount;
+END OutDegree;
+(*-------------------------*)
+
+PROCEDURE LabelOf   (    theVertex : Vertex      (*--in   *))
+                                                                   : Label       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(labelof, nullvertex);
+  ELSE
+    RETURN theVertex^.data;
+  END (*--if*);
+  RETURN NullItem;
+END LabelOf;
+(*-------------------------*)
+
+PROCEDURE IsVertex  (    theGraph  : Graph       (*--in   *);
+                                             theVertex : Vertex      (*--in   *))
+                                                           : BOOLEAN     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isvertex, undefined);
+  ELSIF (theVertex = NullVertex) THEN
+    RaiseErrIn(isvertex, nullvertex);
+  ELSE
+    RETURN theVertex^.inGraph = theGraph;
+  END (*--if*);
+  RETURN FALSE;
+END IsVertex;
+(*-------------------------*)
+
+PROCEDURE GraphOf   (    theVertex : Vertex      (*--in   *))
+                                                                   : Graph       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(graphof, nullvertex);
+  ELSE
+    RETURN theVertex^.inGraph;
+  END (*--if*);
+  RETURN NullGraph;
+END GraphOf;
+(*-------------------------*)
+
+(*
+10.5.9  Edge Selectors
+*)
+
+PROCEDURE AttributeOf (    theEdge   : Edge        (*--in   *))
+                                                                 : Attribute   (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(attrof, nulledge);
+  ELSE
+    RETURN theEdge^.weight;
+  END (*--if*);
+  RETURN NullItem;
+END AttributeOf;
+(*-------------------------*)
+
+PROCEDURE InitialOf   (    theEdge   : Edge        (*--in   *))
+                                                                 : Vertex      (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(initialof, nulledge);
+  ELSE
+    RETURN theEdge^.initial;
+  END (*--if*);
+  RETURN NullVertex;
+END InitialOf;
+(*-------------------------*)
+
+PROCEDURE FinalOf     (    theEdge   : Edge        (*--in   *))
+                                                                 : Vertex      (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(finalof, nulledge);
+  ELSE
+    RETURN theEdge^.final;
+  END (*--if*);
+  RETURN NullVertex;
+END FinalOf;
+(*-------------------------*)
+
+PROCEDURE IsEdge      (    theGraph  : Graph       (*--in   *);
+                                               theEdge   : Edge        (*--in   *))
+                                                             : BOOLEAN     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isedge, undefined);
+  ELSIF (theEdge = NullEdge) THEN
+    RaiseErrIn(isedge, nulledge);
+  ELSIF (theEdge^.initial = NullVertex) THEN
+    RaiseErrIn(isedge, nullvertex);
+  ELSE
+    RETURN theEdge^.initial^.inGraph = theGraph;
+  END (*--if*);
+  RETURN FALSE;
+END IsEdge;
+(*-------------------------*)
+
+(*
+10.5.10 Passive Iterators
+*)
+
+PROCEDURE LoopVertices (    theGraph  : Graph          (*--in   *);
+                                                        process   : VertexLoopProc (*--in   *));
+
+VAR   theVertex : Vertex; (*--loop index over vertices *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(loopvertices, undefined);
+  ELSE
+        theVertex := theGraph^.firstVertex;
+        WHILE (theVertex # NullVertex) & process(theVertex) DO
+          theVertex := theVertex^.next;
+        END (*--while*);
+  END (*--if*);
+END LoopVertices;
+(*-------------------------*)
+
+PROCEDURE LoopEdges    (    theGraph  : Graph          (*--in   *);
+                                                        process   : EdgeLoopProc   (*--in   *));
+
+VAR   theVertex : Vertex; (*--loop index over vertices *)
+VAR   theEdge   : Edge;   (*--loop index over edges of a vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(loopedges, undefined);
+  ELSE
+        theVertex := theGraph^.firstVertex;
+        WHILE (theVertex # NullVertex) DO
+          theEdge := theVertex^.edges;
+          WHILE (theEdge # NullEdge) DO
+            IF ~process(theEdge) THEN
+                  RETURN;
+                END (*--if*);
+                theEdge := theEdge^.next;
+          END (*--while*);
+          theVertex := theVertex^.next;
+        END (*--while*);
+  END (*--if*);
+END LoopEdges;
+(*-------------------------*)
+
+PROCEDURE LoopIterate  (    theVertex : Vertex         (*--in   *);
+                                                        process   : EdgeLoopProc   (*--in   *));
+
+VAR   theEdge : Edge;   (*--loop index over edges of the vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(loopiterate, nullvertex);
+  ELSE
+        theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) & process(theEdge) DO
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END LoopIterate;
+(*-------------------------*)
+
+
+PROCEDURE TravVertices (    theGraph  : Graph      (*--in   *);
+                                                        process   : VertexProc (*--in   *));
+
+VAR   theVertex : Vertex; (*--loop index over vertices *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(travvertices, undefined);
+  ELSE
+        theVertex := theGraph^.firstVertex;
+        WHILE (theVertex # NullVertex) DO
+          process(theVertex);
+          theVertex := theVertex^.next;
+        END (*--while*);
+  END (*--if*);
+END TravVertices;
+(*-------------------------*)
+
+PROCEDURE TravEdges    (    theGraph  : Graph      (*--in   *);
+                                                        process   : EdgeProc   (*--in   *));
+
+VAR   theVertex : Vertex; (*--loop index over vertices *)
+VAR   theEdge   : Edge;   (*--loop index over edges of a vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(travedges, undefined);
+  ELSE
+        theVertex := theGraph^.firstVertex;
+        WHILE (theVertex # NullVertex) DO
+          theEdge := theVertex^.edges;
+          WHILE (theEdge # NullEdge) DO
+            process(theEdge);
+                theEdge := theEdge^.next;
+          END (*--while*);
+          theVertex := theVertex^.next;
+        END (*--while*);
+  END (*--if*);
+END TravEdges;
+(*-------------------------*)
+
+PROCEDURE Iterate      (    theVertex : Vertex     (*--in   *);
+                                                        process   : EdgeProc   (*--in   *));
+
+VAR   theEdge : Edge;   (*--loop index over edges of the vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(iterate, nullvertex);
+  ELSE
+        theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) DO
+          process(theEdge);
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END Iterate;
+(*-------------------------*)
+
+(*
+10.5.11 Active Iterators
+*)
+
+PROCEDURE FirstVertex  (    theGraph  : Graph      (*-- in    *))
+                                                                          : Vertex     (*-- out   *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(firstvertex, undefined);
+  ELSE
+        RETURN theGraph^.firstVertex;
+  END (*--if*);
+  RETURN NullVertex;
+END FirstVertex;
+(*-------------------------*)
+
+PROCEDURE NextVertex   (    theVertex : Vertex     (*-- in    *))
+                                                                          : Vertex     (*-- out   *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(nextvertex, nullvertex);
+  ELSE
+        RETURN theVertex^.next;
+  END (*--if*);
+  RETURN NullVertex;
+END NextVertex;
+(*-------------------------*)
+
+PROCEDURE FirstEdge    (    theVertex : Vertex     (*-- in    *))
+                                                                          : Edge       (*-- out   *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(firstedge, nullvertex);
+  ELSE
+    RETURN theVertex^.edges;
+  END (*--if*);
+  RETURN NullEdge;
+END FirstEdge;
+(*-------------------------*)
+
+PROCEDURE NextEdge     (    theEdge   : Edge       (*-- in    *))
+                                                                          : Edge       (*-- out   *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(nextedge, nulledge);
+  ELSE
+    RETURN theEdge^.next;
+  END (*--if*);
+  RETURN NullEdge;
+END NextEdge;
+(*-------------------------*)
+
+(*
+10.5.12 Module Initialization
+*)
+
+BEGIN
+  FOR graphError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(graphError, NullHandler);
+  END (*--for*);
+  graphError := noerr;
+        NullGraph := NIL;
+        NullVertex := NIL;
+        NullEdge := NIL;
+END DigrSUUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGSBMIU.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGSBMIU.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGSBMIU.MOD
@@ -0,0 +1,357 @@
+(*
+11.4    DigraphSBMI Utilities Implementation
+
+This module provides interface definitions for utility operations
+supporting the unbounded form of the digraph abstract data type. Of
+course, these routines could have been included in the exported operations
+of the digraph module itself. The reason we have not done so it that none
+of the operations in this module are primitive, i.e., require the internal
+representation of the digraph in order to accomplish their function.
+*)
+
+IMPLEMENTATION MODULE DigSBMIUtil;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: 1481 bytes
+    Component: DigraphSBMI Utilities
+
+    REVISION HISTORY
+    v1.01  08 Oct 1988  C. Lins:
+        Initial TML Modula-2 implementation
+    v1.02  12-13 Jan 1989  C. Lins:
+        Removed Graph parameter from vertex selectors.
+        Added depth-first search, breadth-first search, and
+                HasPath operations.
+    v1.03  14 Mar 1989  C. Lins:
+                Changed name of HasPath to IsReachable.
+        v2.00  24 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM DigrSBMI IMPORT
+        (*--cons*) NullGraph, NullEdge, NullVertex,
+        (*--type*) Graph, Vertex, Edge, VertexLoopProc,
+        (*--proc*) FirstVertex, NextVertex, FirstEdge, NextEdge,
+                           InDegree, OutDegree, FinalOf, TravVertices;
+
+FROM TypeManager IMPORT
+    (*--Proc*) Create, LongCardTypeID;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+IMPORT SetSUMN;
+IMPORT QSUMN;
+
+(*
+11.4.1  Graph Selector Utilities
+
+To find the minimum or maximum degree of a graph we must traverse the vertices of
+the given graph. Whenever a vertex is found having a degree smaller than the current
+minimum (or larger than the current maximum) we update the current value of the minimum
+(or maximum). For this algorithm to work correctly, we must initialize the current
+minimum to the largest possible minimum value (conversely, the maximum must be initialized
+to the smallest possible maximum). Since every vertex must be examined, the algorithmic
+complexity of both MinDegree and MaxDegree is O(|V|).
+*)
+
+
+VAR   minimum : CARDINAL; (*-- current minimum degree *)
+
+PROCEDURE FindMinDegree (    theVertex : Vertex (*--in   *));
+
+VAR   degree : CARDINAL; (*-- degree of the current vertex *)
+
+BEGIN
+  degree := InDegree(theVertex) + OutDegree(theVertex);
+  IF (degree < minimum) THEN
+        minimum := degree;
+  END (*--if*);
+END FindMinDegree;
+(*-------------------------*)
+
+PROCEDURE MinDegree (    theGraph  : Graph       (*-- in    *))
+                                                                   : CARDINAL    (*-- out   *);
+BEGIN
+  IF (theGraph = NullGraph) THEN
+        RETURN 0;
+  ELSE
+        minimum := MAX(CARDINAL);
+        TravVertices(theGraph, FindMinDegree);
+        RETURN minimum;
+  END (*--if*);
+END MinDegree;
+(*-------------------------*)
+
+
+VAR   maximum : CARDINAL; (*-- current minimum degree *)
+
+PROCEDURE FindMaxDegree (    theVertex : Vertex (*--in   *));
+
+VAR   degree : CARDINAL; (*-- degree of the current vertex *)
+
+BEGIN
+  degree := InDegree(theVertex) + OutDegree(theVertex);
+  IF (degree > maximum) THEN
+        maximum := degree;
+  END (*--if*);
+END FindMaxDegree;
+(*-------------------------*)
+
+PROCEDURE MaxDegree (    theGraph  : Graph       (*-- in    *))
+                                                                   : CARDINAL    (*-- out   *);
+BEGIN
+  maximum := MIN(CARDINAL);
+  IF (theGraph # NullGraph) THEN
+        TravVertices(theGraph, FindMaxDegree);
+  END (*--if*);
+  RETURN maximum;
+END MaxDegree;
+(*-------------------------*)
+
+(*
+A graph is called loop-free if every vertex of the graph contains no edges to itself.
+Thus, we can iterate over the vertices returning false as soon as a vertex is found
+to contain a loop. Otherwise, if all vertices have been examined without exiting we
+know that there are no loops in the graph. Since the selector HasSelfLoops uses the
+graph object in its call we choose to use an active iteration over the vertices
+instead of the passive iterator TravVertices. An undefined graph is considered
+loop-free. Complexity O(v+e).
+*)
+
+PROCEDURE IsLoopFree (    theGraph  : Graph       (*--in   *))
+                                                                    : BOOLEAN     (*--out  *);
+
+VAR   theVertex : Vertex;
+
+BEGIN
+  IF (theGraph # NullGraph) THEN
+        theVertex := FirstVertex(theGraph);
+        WHILE (theVertex # NullVertex) DO
+          IF HasSelfLoops(theVertex) THEN
+            RETURN FALSE;
+          END (*--if*);
+          theVertex := NextVertex(theVertex);
+        END (*--while*);
+  END (*--if*);
+  RETURN TRUE;
+END IsLoopFree;
+(*-------------------------*)
+
+
+(*
+11.4.2  Vertex Selector Utilities
+
+IsTerminal simply needs to determine if there are any directed edges leaving the
+given vertex. Thus we can use the active iterator FirstEdge to retrieve the first
+edge leaving the given vertex. If there is no first edge we know that the vertex
+is terminal. Complexity O(1).
+*)
+
+PROCEDURE IsTerminal   (    theVertex : Vertex  (*-- in    *))
+                                                              : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN FirstEdge(theVertex) = NullEdge;
+END IsTerminal;
+(*-------------------------*)
+
+
+(*
+An isolated vertex not only has no edges leaving the vertex but no edge is
+incident to the vertex. We can determine whether a vertex is isolated by
+testing the indegree of the vertex being zero and the vertex having no edges
+leaving it as we did above for IsTerminal. Complexity O(1).
+*)
+
+PROCEDURE IsIsolated   (    theVertex : Vertex  (*-- in    *))
+                                                              : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN (FirstEdge(theVertex) = NullEdge) & (InDegree(theVertex) = 0);
+END IsIsolated;
+(*-------------------------*)
+
+
+(*
+A vertex has a self-loop is at least one edge leaving the vertex has that
+vertex as its destination. Thus we iterate over the edges seeking an edge
+that meets this criteria. As soon as such an edge is found we return True.
+If all edges leaving the vertex are examined without the routine exiting we
+know that the vertex has no self-loops. Complexity O(outdegree(v)).
+*)
+
+PROCEDURE HasSelfLoops (    theVertex : Vertex  (*-- in    *))
+                                                              : BOOLEAN (*-- out   *);
+
+VAR   theEdge : Edge;   (*-- loop pointer over edges of this vertex *)
+
+BEGIN
+  theEdge := FirstEdge(theVertex);
+  WHILE (theEdge # NullEdge) DO
+        IF (FinalOf(theEdge) = theVertex) THEN
+          RETURN TRUE;
+        END (*--if*);
+        theEdge := NextEdge(theEdge);
+  END (*--while*);
+  RETURN FALSE;
+END HasSelfLoops;
+(*-------------------------*)
+
+(*
+IsReachable uses a variation on the depth-first search given below. We create a
+set of vertices that have been visited and each time a vertex is processed
+it is added to the set. This way each vertex is examined only once. The traversal
+stops once the algorithm determines that there is a path between the fromVertex
+and the toVertex. Otherwise, the traversal completes without finding a path and
+FALSE is returned to the caller.
+*)
+
+PROCEDURE IsReachable (    fromVertex: Vertex      (*--in   *);
+                                                   toVertex  : Vertex      (*--in   *))
+                                                                         : BOOLEAN     (*--out  *);
+
+VAR   visited  : SetSUMN.Set; (*-- set of vertices already visited *)
+          pathFound: BOOLEAN;     (*-- true when path between vertices is found *)
+
+  PROCEDURE Visit (v : Vertex);
+
+  VAR   e : Edge;   (*-- loop index over edges from v *)
+  VAR   w : Vertex; (*-- destination vertex of an edge *)
+
+  BEGIN
+    pathFound := (v = toVertex);
+        IF ~pathFound THEN
+          (*-- add v to the set of vertices already visited *)
+          SetSUMN.Include(Item(v), visited);
+
+          e := FirstEdge(v);
+          WHILE (e # NullEdge) & ~pathFound DO
+            w := FinalOf(e);
+            IF ~SetSUMN.IsAMember(Item(w), visited) THEN
+              Visit(w);
+            END (*--if*);
+            e := NextEdge(e);
+          END (*--while*);
+        END (*--if*);
+  END Visit;
+
+BEGIN
+  visited := SetSUMN.Create(LongCardTypeID());
+  Visit(fromVertex);
+  SetSUMN.Destroy(visited);
+  RETURN pathFound;
+END IsReachable;
+(*-------------------------*)
+
+
+(*
+10.5.3  Graph Traversal Utilities
+
+The two algorithms below implement the standard depth-first and breadth-first
+search for a directed graph as given by Sedgewick [] and Mehlhorn []. Both
+algorithms stop whenever the VertexLoopProc returns FALSE.
+*)
+
+PROCEDURE DFS   (    theGraph   : Graph          (*--in   *);
+                                         process    : VertexLoopProc (*--in   *));
+
+VAR   v : Vertex; (*-- loop index over vertices *)
+          continue : BOOLEAN;     (*-- controls termination of DFS *)
+          visited  : SetSUMN.Set; (*-- set of vertices already visited *)
+
+  PROCEDURE Visit (v : Vertex);
+
+  VAR   e : Edge;   (*-- loop index over edges from v *)
+  VAR   w : Vertex; (*-- destination vertex of an edge *)
+
+  BEGIN
+    continue := process(v);
+        IF continue THEN
+          (*-- add v to the set of vertices already visited *)
+          SetSUMN.Include(Item(v), visited);
+
+          e := FirstEdge(v);
+          WHILE (e # NullEdge) & continue DO
+            w := FinalOf(e);
+            IF ~SetSUMN.IsAMember(Item(w), visited) THEN
+              Visit(w);
+            END (*--if*);
+            e := NextEdge(e);
+          END (*--while*);
+        END (*--if*);
+  END Visit;
+
+BEGIN
+  continue := TRUE;
+  visited := SetSUMN.Create(LongCardTypeID());
+  v := FirstVertex(theGraph);
+  LOOP
+    IF (v = NullVertex) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+    IF ~SetSUMN.IsAMember(Item(v), visited) THEN
+          Visit(v);
+          IF ~continue THEN
+                EXIT (*--loop*);
+          END (*--if*);
+        END (*--if*);
+        v := NextVertex(v);
+  END (*--loop*);
+  SetSUMN.Destroy(visited);
+END DFS;
+(*-------------------------*)
+
+PROCEDURE BFS   (    theGraph   : Graph          (*--in   *);
+                                         process    : VertexLoopProc (*--in   *));
+
+VAR   u, v, w  : Vertex;      (*-- loop indexes over vertices *)
+          e        : Edge;                (*-- loop index over edges *)
+          continue : BOOLEAN;     (*-- controls termination of DFS *)
+          visited  : SetSUMN.Set; (*-- set of vertices already visited *)
+          toVisit  : QSUMN.Queue; (*-- vertices waiting to be visited *)
+
+BEGIN
+  continue := TRUE;
+  visited  := SetSUMN.Create(LongCardTypeID());
+  toVisit  := QSUMN.Create(LongCardTypeID());
+  u := FirstVertex(theGraph);
+
+  WHILE continue & (u # NullVertex) DO
+        IF ~SetSUMN.IsAMember(Item(u), visited) THEN
+          SetSUMN.Include(Item(u), visited);
+          QSUMN.Arrive(toVisit, Item(u));
+
+          WHILE continue & ~QSUMN.IsEmpty(toVisit) DO
+        v := Vertex(QSUMN.FrontOf(toVisit));
+                QSUMN.Depart(toVisit);
+
+                continue := process(v);
+
+                e := FirstEdge(v);
+                WHILE continue & (e # NullEdge) DO
+                  w := FinalOf(e);
+                  IF ~SetSUMN.IsAMember(Item(w), visited) THEN
+                QSUMN.Arrive(toVisit, Item(w));
+                        SetSUMN.Include(Item(w), visited);
+                  END (*--if*);
+                  e := NextEdge(e);
+                END (*--while*);
+          END (*--while*);
+        END (*--if*);
+        u := NextVertex(u);
+  END (*--while*);
+
+  SetSUMN.Destroy(visited);
+  QSUMN.Destroy(toVisit);
+END BFS;
+(*-------------------------*)
+
+END DigSBMIUtil.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGSBUIU.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGSBUIU.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGSBUIU.MOD
@@ -0,0 +1,293 @@
+IMPLEMENTATION MODULE DigSBUIUtil;
+(*====================================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: 1474 bytes
+    Component: DigraphSBUI Utilities
+
+    INTRODUCTION
+    This module provides the implementation of utility operations
+        supporting the digraph SBUI abstract data type.
+
+    REVISION HISTORY
+    v1.00  24 May 1988  C. Lins:
+        Initial TML Modula-2 implementation
+    v1.01  26 Jan 1989  C. Lins:
+        Revised to conform with DigraphSBMI implementation.
+    v1.03  14 Mar 1989  C. Lins:
+          Changed name of HasPath to IsReachable.
+    v2.00  24 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+====================================================================*)
+
+FROM DigrSBUI IMPORT
+        (*--cons*) NullGraph, NullEdge, NullVertex,
+        (*--type*) Graph, Vertex, Edge, VertexLoopProc,
+        (*--proc*) FirstVertex, NextVertex, FirstEdge, NextEdge,
+                           InDegree, OutDegree, FinalOf, TravVertices;
+
+FROM TypeManager IMPORT
+    (*--Proc*) Create, LongCardTypeID;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+IMPORT SetSUUN;
+IMPORT QSUUN;
+
+(*
+13.5.1  Graph Utility Operations
+*)
+
+VAR   minimum : CARDINAL; (*-- current minimum degree *)
+
+PROCEDURE FindMinDegree (    theVertex : Vertex (*--in   *));
+
+VAR   degree : CARDINAL; (*-- degree of the current vertex *)
+
+BEGIN
+  degree := InDegree(theVertex) + OutDegree(theVertex);
+  IF (degree < minimum) THEN
+        minimum := degree;
+  END (*--if*);
+END FindMinDegree;
+(*-------------------------*)
+
+PROCEDURE MinDegree (    theGraph  : Graph       (*-- in    *))
+                                                                   : CARDINAL    (*-- out   *);
+BEGIN
+  IF (theGraph = NullGraph) THEN
+        RETURN 0;
+  ELSE
+        minimum := MAX(CARDINAL);
+        TravVertices(theGraph, FindMinDegree);
+        RETURN minimum;
+  END (*--if*);
+END MinDegree;
+(*-------------------------*)
+
+
+VAR   maximum : CARDINAL; (*-- current minimum degree *)
+
+PROCEDURE FindMaxDegree (    theVertex : Vertex (*--in   *));
+
+VAR   degree : CARDINAL; (*-- degree of the current vertex *)
+
+BEGIN
+  degree := InDegree(theVertex) + OutDegree(theVertex);
+  IF (degree > maximum) THEN
+        maximum := degree;
+  END (*--if*);
+END FindMaxDegree;
+(*-------------------------*)
+
+PROCEDURE MaxDegree (    theGraph  : Graph       (*-- in    *))
+                                                                   : CARDINAL    (*-- out   *);
+BEGIN
+  maximum := MIN(CARDINAL);
+  IF (theGraph # NullGraph) THEN
+        TravVertices(theGraph, FindMaxDegree);
+  END (*--if*);
+  RETURN maximum;
+END MaxDegree;
+(*-------------------------*)
+
+PROCEDURE IsLoopFree (    theGraph  : Graph       (*--in   *))
+                                                                    : BOOLEAN     (*--out  *);
+
+VAR   theVertex : Vertex;
+
+BEGIN
+  IF (theGraph # NullGraph) THEN
+        theVertex := FirstVertex(theGraph);
+        WHILE (theVertex # NullVertex) DO
+          IF HasSelfLoops(theVertex) THEN
+            RETURN FALSE;
+          END (*--if*);
+          theVertex := NextVertex(theVertex);
+        END (*--while*);
+  END (*--if*);
+  RETURN TRUE;
+END IsLoopFree;
+(*-------------------------*)
+
+(*
+13.5.2  Vertex Utility Operations
+*)
+
+PROCEDURE IsTerminal   (    theVertex : Vertex  (*-- in    *))
+                                                              : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN FirstEdge(theVertex) = NullEdge;
+END IsTerminal;
+(*-------------------------*)
+
+PROCEDURE IsIsolated   (    theVertex : Vertex  (*-- in    *))
+                                                              : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN (FirstEdge(theVertex) = NullEdge) & (InDegree(theVertex) = 0);
+END IsIsolated;
+(*-------------------------*)
+
+PROCEDURE HasSelfLoops (    theVertex : Vertex  (*-- in    *))
+                                                              : BOOLEAN (*-- out   *);
+
+VAR   theEdge : Edge;   (*-- loop pointer over edges of this vertex *)
+
+BEGIN
+  theEdge := FirstEdge(theVertex);
+  WHILE (theEdge # NullEdge) DO
+        IF (FinalOf(theEdge) = theVertex) THEN
+          RETURN TRUE;
+        END (*--if*);
+        theEdge := NextEdge(theEdge);
+  END (*--while*);
+  RETURN FALSE;
+END HasSelfLoops;
+(*-------------------------*)
+
+PROCEDURE IsReachable (    fromVertex: Vertex  (*--in   *);
+                                                   toVertex  : Vertex  (*--in   *))
+                                                                         : BOOLEAN (*--out  *);
+
+VAR   visited  : SetSUUN.Set; (*-- set of vertices already visited *)
+          pathFound: BOOLEAN;     (*-- true when path between vertices is found *)
+
+  PROCEDURE Visit (v : Vertex);
+
+  VAR   e : Edge;   (*-- loop index over edges from v *)
+  VAR   w : Vertex; (*-- destination vertex of an edge *)
+
+  BEGIN
+    pathFound := (v = toVertex);
+        IF ~pathFound THEN
+          (*-- add v to the set of vertices already visited *)
+          SetSUUN.Include(Item(v), visited);
+
+          e := FirstEdge(v);
+          WHILE (e # NullEdge) & ~pathFound DO
+            w := FinalOf(e);
+            IF ~SetSUUN.IsAMember(Item(w), visited) THEN
+              Visit(w);
+            END (*--if*);
+            e := NextEdge(e);
+          END (*--while*);
+        END (*--if*);
+  END Visit;
+
+BEGIN
+  visited := SetSUUN.Create(LongCardTypeID());
+  Visit(fromVertex);
+  SetSUUN.Destroy(visited);
+  RETURN pathFound;
+END IsReachable;
+(*-------------------------*)
+
+
+(*
+11.5.3  Graph Traversal Utilities
+*)
+
+PROCEDURE DFS   (    theGraph   : Graph          (*--in   *);
+                                         process    : VertexLoopProc (*--in   *));
+
+VAR   v : Vertex; (*-- loop index over vertices *)
+          continue : BOOLEAN;     (*-- controls termination of DFS *)
+          visited  : SetSUUN.Set; (*-- set of vertices already visited *)
+
+  PROCEDURE Visit (v : Vertex);
+
+  VAR   e : Edge;   (*-- loop index over edges from v *)
+  VAR   w : Vertex; (*-- destination vertex of an edge *)
+
+  BEGIN
+    continue := process(v);
+        IF continue THEN
+          (*-- add v to the set of vertices already visited *)
+          SetSUUN.Include(Item(v), visited);
+
+          e := FirstEdge(v);
+          WHILE (e # NullEdge) & continue DO
+            w := FinalOf(e);
+            IF ~SetSUUN.IsAMember(Item(w), visited) THEN
+              Visit(w);
+            END (*--if*);
+            e := NextEdge(e);
+          END (*--while*);
+        END (*--if*);
+  END Visit;
+
+BEGIN
+  continue := TRUE;
+  visited := SetSUUN.Create(LongCardTypeID());
+  v := FirstVertex(theGraph);
+  LOOP
+    IF (v = NullVertex) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+    IF ~SetSUUN.IsAMember(Item(v), visited) THEN
+          Visit(v);
+          IF ~continue THEN
+                EXIT (*--loop*);
+          END (*--if*);
+        END (*--if*);
+        v := NextVertex(v);
+  END (*--loop*);
+  SetSUUN.Destroy(visited);
+END DFS;
+(*-------------------------*)
+
+PROCEDURE BFS   (    theGraph   : Graph          (*--in   *);
+                                         process    : VertexLoopProc (*--in   *));
+
+VAR   u, v, w  : Vertex;      (*-- loop indexes over vertices *)
+          e        : Edge;                (*-- loop index over edges *)
+          continue : BOOLEAN;     (*-- controls termination of DFS *)
+          visited  : SetSUUN.Set; (*-- set of vertices already visited *)
+          toVisit  : QSUUN.Queue; (*-- vertices waiting to be visited *)
+
+BEGIN
+  continue := TRUE;
+  visited  := SetSUUN.Create(LongCardTypeID());
+  toVisit  := QSUUN.Create();
+  u := FirstVertex(theGraph);
+
+  WHILE continue & (u # NullVertex) DO
+        IF ~SetSUUN.IsAMember(Item(u), visited) THEN
+          SetSUUN.Include(Item(u), visited);
+          QSUUN.Arrive(toVisit, Item(u));
+
+          WHILE continue & ~QSUUN.IsEmpty(toVisit) DO
+        v := Vertex(QSUUN.FrontOf(toVisit));
+                QSUUN.Depart(toVisit);
+
+                continue := process(v);
+
+                e := FirstEdge(v);
+                WHILE continue & (e # NullEdge) DO
+                  w := FinalOf(e);
+                  IF ~SetSUUN.IsAMember(Item(w), visited) THEN
+                QSUUN.Arrive(toVisit, Item(w));
+                        SetSUUN.Include(Item(w), visited);
+                  END (*--if*);
+                  e := NextEdge(e);
+                END (*--while*);
+          END (*--while*);
+        END (*--if*);
+        u := NextVertex(u);
+  END (*--while*);
+
+  SetSUUN.Destroy(visited);
+  QSUUN.Destroy(toVisit);
+END BFS;
+(*-------------------------*)
+
+END DigSBUIUtil.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGSUMIU.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGSUMIU.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGSUMIU.MOD
@@ -0,0 +1,354 @@
+(*
+10.5    DigraphSUMI Utilities Implementation
+
+This module provides the implementation of utility operations
+supporting the unbounded form of the digraph abstract data type. Of
+course, these routines could have been included in the exported operations
+of the digraph module itself. The reason we have not done so it that none
+of the operations in this module are primitive, i.e., require the internal
+representation of the digraph in order to accomplish their function.
+*)
+
+IMPLEMENTATION MODULE DigSUMIU;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: 1481 bytes
+    Component: DigraphSUMI Utilities
+
+    REVISION HISTORY
+    v1.01  09 Oct 1988  C. Lins:
+        Initial TML Modula-2 implementation
+    v1.02  10-13 Jan 1989  C. Lins:
+        Removed Graph parameter from vertex selectors.
+        Added depth-first search, breadth-first search, and
+        HasPath operations.
+    v2.00  24 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM DigrSUMI IMPORT
+        (*--cons*) NullGraph, NullEdge, NullVertex,
+        (*--type*) Graph, Vertex, Edge, VertexLoopProc,
+        (*--proc*) FirstVertex, NextVertex, FirstEdge, NextEdge,
+                   InDegree, OutDegree, FinalOf, TravVertices;
+
+FROM TypeManager IMPORT
+    (*--Proc*) Create, LongCardTypeID;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+IMPORT SetSUMN;
+IMPORT QSUMN;
+
+(*
+10.5.1  Graph Selector Utilities
+
+To find the minimum or maximum degree of a graph we must traverse the vertices of
+the given graph. Whenever a vertex is found having a degree smaller than the current
+minimum (or larger than the current maximum) we update the current value of the minimum
+(or maximum). For this algorithm to work correctly, we must initialize the current
+minimum to the largest possible minimum value (conversely, the maximum must be initialized
+to the smallest possible maximum). Since every vertex must be examined, the algorithmic
+complexity of both MinDegree and MaxDegree is O(|V|).
+*)
+
+VAR   minimum : CARDINAL; (*-- current minimum degree *)
+
+PROCEDURE FindMinDegree (    theVertex : Vertex (*--in   *));
+
+VAR   degree : CARDINAL; (*-- degree of the current vertex *)
+
+BEGIN
+  degree := InDegree(theVertex) + OutDegree(theVertex);
+  IF (degree < minimum) THEN
+        minimum := degree;
+  END (*--if*);
+END FindMinDegree;
+(*-------------------------*)
+
+PROCEDURE MinDegree (    theGraph  : Graph       (*-- in    *))
+                                                                   : CARDINAL    (*-- out   *);
+BEGIN
+  IF (theGraph = NullGraph) THEN
+        RETURN 0;
+  ELSE
+        minimum := MAX(CARDINAL);
+        TravVertices(theGraph, FindMinDegree);
+        RETURN minimum;
+  END (*--if*);
+END MinDegree;
+(*-------------------------*)
+
+
+VAR   maximum : CARDINAL; (*-- current minimum degree *)
+
+PROCEDURE FindMaxDegree (    theVertex : Vertex (*--in   *));
+
+VAR   degree : CARDINAL; (*-- degree of the current vertex *)
+
+BEGIN
+  degree := InDegree(theVertex) + OutDegree(theVertex);
+  IF (degree > maximum) THEN
+        maximum := degree;
+  END (*--if*);
+END FindMaxDegree;
+(*-------------------------*)
+
+PROCEDURE MaxDegree (    theGraph  : Graph       (*-- in    *))
+                                                                   : CARDINAL    (*-- out   *);
+BEGIN
+  maximum := MIN(CARDINAL);
+  IF (theGraph # NullGraph) THEN
+        TravVertices(theGraph, FindMaxDegree);
+  END (*--if*);
+  RETURN maximum;
+END MaxDegree;
+(*-------------------------*)
+
+(*
+A graph is called loop-free if every vertex of the graph contains no edges to itself.
+Thus, we can iterate over the vertices returning false as soon as a vertex is found
+to contain a loop. Otherwise, if all vertices have been examined without exiting we
+know that there are no loops in the graph. Since the selector HasSelfLoops uses the
+graph object in its call we choose to use an active iteration over the vertices
+instead of the passive iterator TravVertices. An undefined graph is considered
+loop-free. Complexity O(v+e).
+*)
+
+PROCEDURE IsLoopFree (    theGraph  : Graph       (*--in   *))
+                                                                    : BOOLEAN     (*--out  *);
+
+VAR   theVertex : Vertex;
+
+BEGIN
+  IF (theGraph # NullGraph) THEN
+        theVertex := FirstVertex(theGraph);
+        WHILE (theVertex # NullVertex) DO
+          IF HasSelfLoops(theVertex) THEN
+            RETURN FALSE;
+          END (*--if*);
+          theVertex := NextVertex(theVertex);
+        END (*--while*);
+  END (*--if*);
+  RETURN TRUE;
+END IsLoopFree;
+(*-------------------------*)
+
+
+(*
+10.5.2  Vertex Selector Utilities
+
+IsTerminal simply needs to determine if there are any directed edges leaving the
+given vertex. Thus we can use the active iterator FirstEdge to retrieve the first
+edge leaving the given vertex. If there is no first edge we know that the vertex
+is terminal. Complexity O(1).
+*)
+
+PROCEDURE IsTerminal   (    theVertex : Vertex  (*-- in    *))
+                                                              : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN FirstEdge(theVertex) = NullEdge;
+END IsTerminal;
+(*-------------------------*)
+
+
+(*
+An isolated vertex not only has no edges leaving the vertex but no edge is
+incident to the vertex. We can determine whether a vertex is isolated by
+testing the indegree of the vertex being zero and the vertex having no edges
+leaving it as we did above for IsTerminal. Complexity O(1).
+*)
+
+PROCEDURE IsIsolated   (    theVertex : Vertex  (*-- in    *))
+                                                              : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN (FirstEdge(theVertex) = NullEdge) & (InDegree(theVertex) = 0);
+END IsIsolated;
+(*-------------------------*)
+
+
+(*
+A vertex has a self-loop is at least one edge leaving the vertex has that
+vertex as its destination. Thus we iterate over the edges seeking an edge
+that meets this criteria. As soon as such an edge is found we return True.
+If all edges leaving the vertex are examined without the routine exiting we
+know that the vertex has no self-loops. Complexity O(outdegree(v)).
+*)
+
+PROCEDURE HasSelfLoops (    theVertex : Vertex  (*-- in    *))
+                                                              : BOOLEAN (*-- out   *);
+
+VAR   theEdge : Edge;   (*-- loop pointer over edges of this vertex *)
+
+BEGIN
+  theEdge := FirstEdge(theVertex);
+  WHILE (theEdge # NullEdge) DO
+        IF (FinalOf(theEdge) = theVertex) THEN
+          RETURN TRUE;
+        END (*--if*);
+        theEdge := NextEdge(theEdge);
+  END (*--while*);
+  RETURN FALSE;
+END HasSelfLoops;
+(*-------------------------*)
+
+(*
+IsReachable uses a variation on the depth-first search given below. We create a
+set of vertices that have been visited and each time a vertex is processed
+it is added to the set. This way each vertex is examined only once. The traversal
+stops once the algorithm determines that there is a path between the fromVertex
+and the toVertex. Otherwise, the traversal completes without finding a path and
+FALSE is returned to the caller.
+*)
+
+PROCEDURE IsReachable    (    fromVertex: Vertex      (*--in   *);
+                                                          toVertex  : Vertex      (*--in   *))
+                                                                        : BOOLEAN     (*--out  *);
+
+VAR   visited  : SetSUMN.Set; (*-- set of vertices already visited *)
+          pathFound: BOOLEAN;     (*-- true when path between vertices is found *)
+
+  PROCEDURE Visit (v : Vertex);
+
+  VAR   e : Edge;   (*-- loop index over edges from v *)
+  VAR   w : Vertex; (*-- destination vertex of an edge *)
+
+  BEGIN
+    pathFound := (v = toVertex);
+        IF ~pathFound THEN
+          (*-- add v to the set of vertices already visited *)
+          SetSUMN.Include(Item(v), visited);
+
+          e := FirstEdge(v);
+          WHILE (e # NullEdge) & ~pathFound DO
+            w := FinalOf(e);
+            IF ~SetSUMN.IsAMember(Item(w), visited) THEN
+              Visit(w);
+            END (*--if*);
+            e := NextEdge(e);
+          END (*--while*);
+        END (*--if*);
+  END Visit;
+
+BEGIN
+  visited := SetSUMN.Create(LongCardTypeID());
+  Visit(fromVertex);
+  SetSUMN.Destroy(visited);
+  RETURN pathFound;
+END IsReachable;
+(*-------------------------*)
+
+
+(*
+10.5.3  Graph Traversal Utilities
+
+The two algorithms below implement the standard depth-first and breadth-first
+search for a directed graph as given by Sedgewick [] and Mehlhorn []. Both
+algorithms stop whenever the VertexLoopProc returns FALSE.
+*)
+
+PROCEDURE DFS   (    theGraph   : Graph          (*--in   *);
+                                         process    : VertexLoopProc (*--in   *));
+
+VAR   v : Vertex; (*-- loop index over vertices *)
+          continue : BOOLEAN;     (*-- controls termination of DFS *)
+          visited  : SetSUMN.Set; (*-- set of vertices already visited *)
+
+  PROCEDURE Visit (v : Vertex);
+
+  VAR   e : Edge;   (*-- loop index over edges from v *)
+  VAR   w : Vertex; (*-- destination vertex of an edge *)
+
+  BEGIN
+    continue := process(v);
+        IF continue THEN
+          (*-- add v to the set of vertices already visited *)
+          SetSUMN.Include(Item(v), visited);
+
+          e := FirstEdge(v);
+          WHILE (e # NullEdge) & continue DO
+            w := FinalOf(e);
+            IF ~SetSUMN.IsAMember(Item(w), visited) THEN
+              Visit(w);
+            END (*--if*);
+            e := NextEdge(e);
+          END (*--while*);
+        END (*--if*);
+  END Visit;
+
+BEGIN
+  continue := TRUE;
+  visited := SetSUMN.Create(LongCardTypeID());
+  v := FirstVertex(theGraph);
+  LOOP
+    IF (v = NullVertex) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+    IF ~SetSUMN.IsAMember(Item(v), visited) THEN
+          Visit(v);
+          IF ~continue THEN
+                EXIT (*--loop*);
+          END (*--if*);
+        END (*--if*);
+        v := NextVertex(v);
+  END (*--loop*);
+  SetSUMN.Destroy(visited);
+END DFS;
+(*-------------------------*)
+
+PROCEDURE BFS   (    theGraph   : Graph          (*--in   *);
+                                         process    : VertexLoopProc (*--in   *));
+
+VAR   u, v, w  : Vertex;      (*-- loop indexes over vertices *)
+          e        : Edge;                (*-- loop index over edges *)
+          continue : BOOLEAN;     (*-- controls termination of DFS *)
+          visited  : SetSUMN.Set; (*-- set of vertices already visited *)
+          toVisit  : QSUMN.Queue; (*-- vertices waiting to be visited *)
+
+BEGIN
+  continue := TRUE;
+  visited  := SetSUMN.Create(LongCardTypeID());
+  toVisit  := QSUMN.Create(LongCardTypeID());
+  u := FirstVertex(theGraph);
+
+  WHILE continue & (u # NullVertex) DO
+        IF ~SetSUMN.IsAMember(Item(u), visited) THEN
+          SetSUMN.Include(Item(u), visited);
+          QSUMN.Arrive(toVisit, Item(u));
+
+          WHILE continue & ~QSUMN.IsEmpty(toVisit) DO
+        v := Vertex(QSUMN.FrontOf(toVisit));
+                QSUMN.Depart(toVisit);
+
+                continue := process(v);
+
+                e := FirstEdge(v);
+                WHILE continue & (e # NullEdge) DO
+                  w := FinalOf(e);
+                  IF ~SetSUMN.IsAMember(Item(w), visited) THEN
+                QSUMN.Arrive(toVisit, Item(w));
+                        SetSUMN.Include(Item(w), visited);
+                  END (*--if*);
+                  e := NextEdge(e);
+                END (*--while*);
+          END (*--while*);
+        END (*--if*);
+        u := NextVertex(u);
+  END (*--while*);
+
+  SetSUMN.Destroy(visited);
+  QSUMN.Destroy(toVisit);
+END BFS;
+(*-------------------------*)
+
+END DigSUMIU.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGSUUIU.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGSUUIU.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/DIGSUUIU.MOD
@@ -0,0 +1,282 @@
+(*
+10.7    DigraphSUUI Utilities Implementation
+*)
+
+IMPLEMENTATION MODULE DigSUUIU;
+(*====================================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: 1382 bytes
+    Component: DigraphSUUI Utilities
+
+    INTRODUCTION
+    This module provides the implementation of utility operations
+        supporting the digraph SUUI abstract data type.
+
+    REVISION HISTORY
+    v1.00  29 May 1988  C. Lins:
+        Initial TML Modula-2 implementation
+    v2.00  15 Jan 1989  C. Lins:
+        Derived from DigraphSUMIUtil
+    v2.01  14 Mar 1989  C. Lins:
+                Changed name of HasPath to IsReachable.
+    v2.00  24 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+====================================================================*)
+
+FROM DigrSUUI IMPORT
+        (*--cons*) NullGraph, NullEdge, NullVertex,
+        (*--type*) Graph, Vertex, Edge, VertexLoopProc,
+        (*--proc*) FirstVertex, NextVertex, FirstEdge, NextEdge,
+                           InDegree, OutDegree, FinalOf, TravVertices;
+
+FROM TypeManager IMPORT
+    (*--Proc*) Create, LongCardTypeID;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+IMPORT SetSUUN;
+IMPORT QSUUN;
+
+(*
+10.7.1  Graph Utility Operations
+*)
+
+VAR   minimum : CARDINAL; (*-- current minimum degree *)
+
+PROCEDURE FindMinDegree (    theVertex : Vertex (*--in   *));
+
+VAR   degree : CARDINAL; (*-- degree of the current vertex *)
+
+BEGIN
+  degree := InDegree(theVertex) + OutDegree(theVertex);
+  IF (degree < minimum) THEN
+        minimum := degree;
+  END (*--if*);
+END FindMinDegree;
+(*-------------------------*)
+
+PROCEDURE MinDegree (    theGraph  : Graph       (*-- in    *))
+                                                                   : CARDINAL    (*-- out   *);
+BEGIN
+  IF (theGraph = NullGraph) THEN
+        RETURN 0;
+  ELSE
+        minimum := MAX(CARDINAL);
+        TravVertices(theGraph, FindMinDegree);
+        RETURN minimum;
+  END (*--if*);
+END MinDegree;
+(*-------------------------*)
+
+
+VAR   maximum : CARDINAL; (*-- current minimum degree *)
+
+PROCEDURE FindMaxDegree (    theVertex : Vertex (*--in   *));
+
+VAR   degree : CARDINAL; (*-- degree of the current vertex *)
+
+BEGIN
+  degree := InDegree(theVertex) + OutDegree(theVertex);
+  IF (degree > maximum) THEN
+        maximum := degree;
+  END (*--if*);
+END FindMaxDegree;
+(*-------------------------*)
+
+PROCEDURE MaxDegree (    theGraph  : Graph       (*-- in    *))
+                                                                   : CARDINAL    (*-- out   *);
+BEGIN
+  maximum := MIN(CARDINAL);
+  IF (theGraph # NullGraph) THEN
+        TravVertices(theGraph, FindMaxDegree);
+  END (*--if*);
+  RETURN maximum;
+END MaxDegree;
+(*-------------------------*)
+
+(*
+10.7.2  Vertex Utility Operations
+*)
+
+PROCEDURE IsTerminal   (    theVertex : Vertex  (*-- in    *))
+                                                              : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN FirstEdge(theVertex) = NullEdge;
+END IsTerminal;
+(*-------------------------*)
+
+PROCEDURE IsIsolated   (    theVertex : Vertex  (*-- in    *))
+                                                              : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN (FirstEdge(theVertex) = NullEdge) & (InDegree(theVertex) = 0);
+END IsIsolated;
+(*-------------------------*)
+
+PROCEDURE HasSelfLoops (    theVertex : Vertex  (*-- in    *))
+                                                              : BOOLEAN (*-- out   *);
+
+VAR   theEdge : Edge;   (*-- loop pointer over edges of this vertex *)
+
+BEGIN
+  theEdge := FirstEdge(theVertex);
+  WHILE (theEdge # NullEdge) DO
+        IF (FinalOf(theEdge) = theVertex) THEN
+          RETURN TRUE;
+        END (*--if*);
+        theEdge := NextEdge(theEdge);
+  END (*--while*);
+  RETURN FALSE;
+END HasSelfLoops;
+(*-------------------------*)
+
+PROCEDURE IsReachable (    fromVertex: Vertex  (*--in   *);
+                                                   toVertex  : Vertex  (*--in   *))
+                                                                         : BOOLEAN (*--out  *);
+
+VAR   visited  : SetSUUN.Set; (*-- set of vertices already visited *)
+          pathFound: BOOLEAN;     (*-- true when path between vertices is found *)
+
+  PROCEDURE Visit (v : Vertex);
+
+  VAR   e : Edge;   (*-- loop index over edges from v *)
+  VAR   w : Vertex; (*-- destination vertex of an edge *)
+
+  BEGIN
+    pathFound := (v = toVertex);
+        IF ~pathFound THEN
+          (*-- add v to the set of vertices already visited *)
+          SetSUUN.Include(Item(v), visited);
+
+          e := FirstEdge(v);
+          WHILE (e # NullEdge) & ~pathFound DO
+            w := FinalOf(e);
+            IF ~SetSUUN.IsAMember(Item(w), visited) THEN
+              Visit(w);
+            END (*--if*);
+            e := NextEdge(e);
+          END (*--while*);
+        END (*--if*);
+  END Visit;
+
+BEGIN
+  visited := SetSUUN.Create(LongCardTypeID());
+  Visit(fromVertex);
+  SetSUUN.Destroy(visited);
+  RETURN pathFound;
+END IsReachable;
+(*-------------------------*)
+
+
+(*
+10.5.3  Graph Traversal Utilities
+
+The two algorithms below implement the standard depth-first and breadth-first
+search for a directed graph as given by Sedgewick [] and Mehlhorn []. Both
+algorithms stop whenever the VertexLoopProc returns FALSE.
+*)
+
+PROCEDURE DFS   (    theGraph   : Graph          (*--in   *);
+                                         process    : VertexLoopProc (*--in   *));
+
+VAR   v : Vertex; (*-- loop index over vertices *)
+          continue : BOOLEAN;     (*-- controls termination of DFS *)
+          visited  : SetSUUN.Set; (*-- set of vertices already visited *)
+
+  PROCEDURE Visit (v : Vertex);
+
+  VAR   e : Edge;   (*-- loop index over edges from v *)
+  VAR   w : Vertex; (*-- destination vertex of an edge *)
+
+  BEGIN
+    continue := process(v);
+        IF continue THEN
+          (*-- add v to the set of vertices already visited *)
+          SetSUUN.Include(Item(v), visited);
+
+          e := FirstEdge(v);
+          WHILE (e # NullEdge) & continue DO
+            w := FinalOf(e);
+            IF ~SetSUUN.IsAMember(Item(w), visited) THEN
+              Visit(w);
+            END (*--if*);
+            e := NextEdge(e);
+          END (*--while*);
+        END (*--if*);
+  END Visit;
+
+BEGIN
+  continue := TRUE;
+  visited := SetSUUN.Create(LongCardTypeID());
+  v := FirstVertex(theGraph);
+  LOOP
+    IF (v = NullVertex) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+    IF ~SetSUUN.IsAMember(Item(v), visited) THEN
+          Visit(v);
+          IF ~continue THEN
+                EXIT (*--loop*);
+          END (*--if*);
+        END (*--if*);
+        v := NextVertex(v);
+  END (*--loop*);
+  SetSUUN.Destroy(visited);
+END DFS;
+(*-------------------------*)
+
+PROCEDURE BFS   (    theGraph   : Graph          (*--in   *);
+                                         process    : VertexLoopProc (*--in   *));
+
+VAR   u, v, w  : Vertex;      (*-- loop indexes over vertices *)
+          e        : Edge;                (*-- loop index over edges *)
+          continue : BOOLEAN;     (*-- controls termination of DFS *)
+          visited  : SetSUUN.Set; (*-- set of vertices already visited *)
+          toVisit  : QSUUN.Queue; (*-- vertices waiting to be visited *)
+
+BEGIN
+  continue := TRUE;
+  visited  := SetSUUN.Create(LongCardTypeID());
+  toVisit  := QSUUN.Create();
+  u := FirstVertex(theGraph);
+
+  WHILE continue & (u # NullVertex) DO
+        IF ~SetSUUN.IsAMember(Item(u), visited) THEN
+          SetSUUN.Include(Item(u), visited);
+          QSUUN.Arrive(toVisit, Item(u));
+
+          WHILE continue & ~QSUUN.IsEmpty(toVisit) DO
+        v := Vertex(QSUUN.FrontOf(toVisit));
+                QSUUN.Depart(toVisit);
+
+                continue := process(v);
+
+                e := FirstEdge(v);
+                WHILE continue & (e # NullEdge) DO
+                  w := FinalOf(e);
+                  IF ~SetSUUN.IsAMember(Item(w), visited) THEN
+                QSUUN.Arrive(toVisit, Item(w));
+                        SetSUUN.Include(Item(w), visited);
+                  END (*--if*);
+                  e := NextEdge(e);
+                END (*--while*);
+          END (*--while*);
+        END (*--if*);
+        u := NextVertex(u);
+  END (*--while*);
+
+  SetSUUN.Destroy(visited);
+  QSUUN.Destroy(toVisit);
+END BFS;
+(*-------------------------*)
+
+END DigSUUIU.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRAFSBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRAFSBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRAFSBMI.MOD
@@ -0,0 +1,1783 @@
+(*
+14.2    Graph - Sequential Bounded Managed Iterator
+
+In this section we provide the implementation module corresponding to
+the interface given above in û12.1. The following scheme is used in
+organizing this section:
+* 14.2.1  Internal Representation
+* 14.2.2  Exception Handling
+* 14.2.3  Local Routines
+* 14.2.4  Graph Constructors
+* 14.2.5  Vertex Constructors
+* 14.2.6  Edge Constructors
+* 14.2.7  Graph Selectors
+* 14.2.8  Vertex Selectors
+* 14.2.9  Edge Selectors
+* 14.2.10 Passive Iterators
+* 14.2.11 Active Iterators
+* 14.2.12 Module Initialization
+*)
+
+IMPLEMENTATION MODULE GrafSBMI;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: 7492 bytes
+    Component: Graph - Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.00  17 Feb 1989  C. Lins:
+        Initial implementation based on unbounded graph module.
+    v1.01  10 Apr 1989  C. Lins:
+        Corrected initialization of handlers array.
+    v1.02  18 Apr 1989   C. Lins:
+        Added component id constant.
+    v2.00  24 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM SYSTEM IMPORT
+        (*--type*) ADDRESS,
+        (*--proc*) ADR;
+
+FROM JPIStorage IMPORT
+        (*--proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+        (*--cons*) NullItem,
+        (*--type*) Item, AssignProc, DisposeProc;
+
+FROM GraphTypes IMPORT
+        (*--type*) Operations, Exceptions, ComponentID;
+
+FROM ErrorHandling IMPORT
+        (*--cons*) NullHandler,
+        (*--type*) HandlerProc,
+        (*--proc*) Raise;
+
+FROM TypeManager IMPORT
+        (*--cons*) NullType,
+        (*--type*) TypeID,
+        (*--proc*) AssignOf, DisposeOf;
+
+        (*-------------------------*)
+
+(*
+14.2.1  Internal Representation
+
+The internal representation of an unbounded directed graph uses a variant of the
+adjacency list structure used in Chapter 10 for the directed graph (shown below
+in Figure 12.1). In this representation, the set of vertices for a graph is given
+by a linear list. Since a bounded graph has a fixed number of vertices (maximum)
+the module manages its own 'heap' of vertex nodes. This heap is hidden from
+clients through the opaque definition of a vertex as an address which is really
+the address of an item in the array.
+Secondly, each vertex is associated with the set of undirected edges incident on
+the vertex. The set of all edges of the graph is thus the union of all the sets
+of edges for each of the graph's vertices.
+
+This is the same conceptual model used in representing the unbounded directed graph
+of Chapter 10. In that chapter we were able to easily implement this model directly.
+Often, undirected graphs are represented using the directed graph model where each
+undirected edge, {v, w}, is presented as two directed edges, (v, w) and (w, v).
+Though such an approach could be taken with this implementation, we consider it
+unsatisfactory for two reasons:
+        1. iteration over the edges would cause each edge to be processed twice making
+           the implementation structure visible to client modules; and
+        2. the selector SetAttribute would have to deallocate and assign the weight
+           attribute in two edge nodes in order to keep them in sync.
+
+The solution used here keeps only a single edge node for each edge while the edge
+lists of the vertices contain references to the 'real' edge nodes. These real edges
+are stored in a doubly-linked list the head of which is kept in the descriptor of
+the graph itself. The edge references are also held in doubly-linked lists and each
+vertex has a reference to the head of their list of edges.
+
+_Figure 12.1_
+
+Following the figure is a description of the various TYPEs used for our internal
+representation including the component fields of each record structure. One
+aspect of this representation that may cause some confusion is that the abstract
+edge entity is in reality an edge reference. Since are two of these for each edge,
+the reader may wonder which reference is used by client modules for the edge
+selectors. This potential problem is resolved by the convention that client modules
+are never aware of more than one of the two edge references, the second edge
+reference is only used internally. Furthermore, when edges are added to a graph
+the reference given back to the client is always for the directed edge reference
+(v, w) where v is the first vertex of the pair of vertices to which the edge is
+linked.
+
+EdgePtr:                defines a reference to a dynamically allocated undirected edge node.
+Edge:                   completes the opaque definition as a reference to a dynamically
+                                allocated directed edge node.
+Vertex:                 completes the opaque definition as a reference to a dynamically
+                                allocated vertex node.
+
+VertexNode:             defines the information requirements for a single vertex of a
+                                graph.
+        data:           contains the label data item associated with a vertex.
+        next:           link to the next vertex in the set of vertices for a graph. The
+                                last vertex of the list has a 'next' of NullVertex indicating
+                                the end of the list.
+        prior:          link to the previous vertex in the set of vertices for a graph. The
+                                first vertex of the list has a 'prior' of NullVertex indicating
+                                the front of the list.
+        edges:          link to the first directed edge leaving this vertex. If the vertex
+                                has no edges leaving it, this field is set to the NullEdge.
+        degree:         is used in maintaining a count of the number of edges incident on this
+                                vertex as its destination excluding self-loops (which are edges
+                                whose first and second vertices are the same). This count
+                                is maintained by the constructors Link, Unlink and Assign. It
+                                is used to make the selector DegreeOf an O(1) algorithm instead
+                                of an O(Degree(v)) algorithm. The alternative technique for would be
+                                a complete traversal of all the edges associated with a vertex.
+        inGraph:        contains the reference to the enclosing graph object for the vertex.
+                                This avoids having the graph as a parameter to the vertex selectors.
+                                In addition, simplifying the membership test between a vertex and a
+                                graph, as well as the membership test for edges (through the
+                                initial or final vertex references of the edge).
+
+EdgeNode:               defines the information requirements for an undirected edge of a graph.
+        first:          contains a reference to the first vertex of the edge.
+        second:         contains a reference to the second vertex of the edge.
+        edgeRef1:       contains a reference to the directed edge (first, second) in the
+                                first vertexes edge list corresponding to this undirected edge.
+        edgeRef2:       contains a reference to the directed edge (second, first) in the
+                                second vertexes edge list corresponding to this undirected edge.
+        weight:         contains the attribute of the edge.
+        next:           contains the link to the next edge in the graph.
+                                The last edge of this list contains the NullRef as its value
+                                indicating the end of the list.
+        prior:          contains the link to the prior edge in the linked list of edges
+                                in the graph. The first edge of this list contains the NullRef as
+                                its value indicating the front of the list.
+
+EdgeRefNode:    defines the information requirements for a directed edge of a graph.
+                                There are two such nodes for every EdgeNode.
+        realEdge:       contains a reference to the actual undirected edge corresponding
+                                to this directed edge.
+        next:           contains a link to the next directed edge in a vertexes edge list.
+                                The last edge in an edge list contains a value of NullEdge indicating
+                                the end of the list.
+        prior:          contains a link to the previous directed edge in a vertexes edge list.
+                                The first edge in an edge list contains a value of NullEdge indicating
+                                the front of the list.
+
+UnboundedGraph: describes (and holds) attributes of the graph itself.
+        labelType,
+        attrType:       contain the data type ID for the vertex label and edge attribute,
+                                respectively. These two fields are used to retrieve the procedures
+                                accomplishing assignment and disposal of data items.
+        numVertices,
+        numEdges:       contain counts of the total number of vertices and edges in the
+                                graph, respectively. Thus, the selectors OrderOf and SizeOf are
+                                O(1) algorithms instead of O(|V|) or O(|E|).
+        firstVertex: reference to the first vertex in the adjacency list for a graph.
+        firstEdge:  reference to the first edge in the set of all edges for a graph.
+*)
+
+TYPE  EdgePtr = POINTER TO EdgeNode;
+TYPE  Edge    = POINTER TO EdgeRefNode;
+TYPE  Vertex  = POINTER TO VertexNode;
+
+CONST NullRef = NIL;
+
+TYPE  EdgeRefNode = RECORD
+                realEdge : EdgePtr;     (*--link to the actual edge node *)
+                prior    : Edge;        (*--prior edge in this edge list *)
+                next     : Edge;        (*--next edge in this edge list *)
+          END (*--EdgeRefNode *);
+
+TYPE  VertexNode = RECORD
+                inGraph : Graph;   (*--graph in which this vertex is a member *)
+                data    : Label;   (*--data item (label) for this vertex *)
+                degree  : CARDINAL;(*--degree of this vertex *)
+                prior   : Vertex;  (*--prior vertex in adjacency list *)
+                next    : Vertex;  (*--next vertex in adjacency list *)
+                edges   : Edge;    (*--link to first edge of this vertex *)
+          END (*--VertexNode *);
+
+TYPE  EdgeNode = RECORD
+                first   : Vertex;       (*--first vertex for this edge *)
+                second  : Vertex;       (*--second vertex for this edge *)
+                weight  : Attribute;(*--weight/attribute for this edge *)
+                edgeRef1: Edge;     (*--link to edge in 1st vertex edge list *)
+                edgeRef2: Edge;     (*--link to edge in 2nd vertex edge list *)
+                prior   : EdgePtr;      (*--prior edge in the set of all edges *)
+                next    : EdgePtr;      (*--next edge in the set of all edges *)
+          END (*--EdgeNode *);
+
+CONST maxVertex   = 1480;
+TYPE  VertexIndex = [1..maxVertex];
+TYPE  Vertices    = ARRAY VertexIndex OF VertexNode;
+
+TYPE  BoundedGraph = RECORD
+                labelType  : TypeID;    (*--vertex label data type ID *)
+                attrType   : TypeID;    (*--edge attribute data type ID *)
+                maxVertices: CARDINAL;  (*--maximum number of vertices *)
+                numVertices: CARDINAL;  (*--current number of vertices *)
+                numEdges   : CARDINAL;  (*--current number of edges *)
+                firstVertex: Vertex;    (*--first vertex in adjacency list *)
+                available  : Vertex;    (*--first vertex in available list *)
+                firstEdge  : EdgePtr;   (*--first edge in edge set *)
+                vertices   : Vertices;  (*--bounded adjacency list *)
+          END (*--BoundedGraph *);
+
+TYPE  Graph = POINTER TO BoundedGraph;
+
+        (*-------------------------*)
+
+(*
+14.2.2  Exception Handling
+
+graphError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+graphError before any other processing. The handlers array holds the
+current exception handler for the possible exceptions that may be
+raised from within this module. Both are initialized by the module
+initialization (see û10.3.12).
+
+GraphError      simply returns the current exception result stored
+                        in graphError and is used to determine whether a graph
+                        operation completed successfully.
+SetHandler      makes theHandler the current exception handler for theError
+                        by storing theHandler in the handlers array.
+GetHandler      returns the current exception handler for theError from the
+                        handlers array.
+*)
+
+VAR   graphError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE GraphError () : Exceptions;
+BEGIN
+  RETURN graphError;
+END GraphError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                                                  theHandler : HandlerProc (*--in   *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                                                         : HandlerProc (*--out  *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*--in   *);
+                                                  theError   : Exceptions  (*--in   *));
+BEGIN
+  graphError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+(*
+14.2.3  Local Routines
+
+FreeAttribute is responsible for retrieval of the edge attribute item disposal
+routine and freeing the attribute when no longer needed. This occurs when
+        1. a graph is cleared or destroyed (Clear);
+        2. an edge is removed from a graph (Unlink);
+        3. a vertex is removed from a graph and any edges leaving it are implicitly
+           removed (ClearEdges); or
+        4. a new attribute is assigned to an edge (SetAttribute).
+Complexity: O(1).
+*)
+
+PROCEDURE FreeAttribute (    theEdge : EdgePtr (*--inout*));
+
+VAR   free : DisposeProc; (*-- attribute disposal routine, if any *)
+
+BEGIN
+  WITH theEdge^ DO
+        free := DisposeOf(first^.inGraph^.attrType);
+        free(weight);
+  END (*--with*);
+END FreeAttribute;
+(*-------------------------*)
+
+(*
+FreeLabel corresponds to FreeAttribute, above, for the clean-up of vertex labels
+when they are no longer needed. The conditions are similar to those above:
+        1. a graph is cleared or destroyed (Clear);
+        2. an vertex is removed from a graph (Remove); or
+        3. a new label is assigned to a vertex (SetLabel).
+Complexity: O(1).
+*)
+
+PROCEDURE FreeLabel (    theVertex : Vertex (*--inout*));
+
+VAR   free : DisposeProc; (*-- label disposal routine, if any *)
+
+BEGIN
+  WITH theVertex^ DO
+        free := DisposeOf(inGraph^.labelType);
+        free(data);
+  END (*--with*);
+END FreeLabel;
+(*-------------------------*)
+
+
+(*
+InitVertex initializes a single vertex for the free list. O(1)
+InitFreeList initializes the free list of available vertices. The free list
+of vertices is initialized when a graph is created or when a graph is cleared
+of its contents. O(s), where s is the size of the bounded array of vertices.
+*)
+
+PROCEDURE InitFreeList (VAR theGraph : Graph      (*--inout*));
+
+  PROCEDURE InitVertex   (VAR theNode  : VertexNode (*--inout*);
+                                                          theNext  : Vertex     (*--in   *));
+  BEGIN
+    WITH theNode DO
+          inGraph  := NullGraph;
+          data     := NullItem;
+          degree   := 0;
+          prior    := NullVertex;
+          next     := theNext;
+          edges    := NullEdge;
+    END (*--with*);
+  END InitVertex;
+
+VAR   v : VertexIndex; (*-- running index over vertices of the graph *)
+
+BEGIN
+  WITH theGraph^ DO
+    FOR v := MIN(VertexIndex) TO maxVertices-1 DO
+          InitVertex(vertices[v], ADR(vertices[v+1]));
+        END (*--for*);
+        InitVertex(vertices[maxVertices], NullVertex);
+        numVertices := 0;
+        firstVertex := NullVertex;
+        available   := ADR(vertices[MIN(VertexIndex)]);
+  END (*--with*);
+END InitFreeList;
+(*-------------------------*)
+
+
+(*
+NewVertex retrievs a new, empty, vertex node from the list of available nodes.
+The vertex field
+inGraph is set to the proper value (its enclosing graph object) while indegree,
+edges, and next are initialized to an empty state. The caller is responsible for
+adding the vertex to the adjacency list for the graph. The routine also automatically
+raises the overflow exception with the appropriate parameters, if necessary. As
+noted in Volume 1, the version of Allocate used here sets theVertex to NIL if the
+allocation fails. Thus, we ensure that theVertex returned is the NullVertex in
+case of a memory management failure. Complexity O(1).
+*)
+
+PROCEDURE NewVertex (    theGraph   : Graph      (*--in   *);
+                                                 theItem    : Label      (*--in   *);
+                                                 theRoutine : Operations (*--in   *))
+                                                                    : Vertex     (*--out  *);
+
+VAR   newVertex : Vertex;               (*-- newly created vertex *)
+
+BEGIN
+  IF (theGraph^.numVertices = theGraph^.maxVertices) THEN
+        RaiseErrIn(theRoutine, overflow);
+  ELSE
+        WITH theGraph^ DO
+          newVertex := available;
+          available := newVertex^.next;
+        END (*--with*);
+        WITH newVertex^ DO
+          inGraph := theGraph;
+          data    := theItem;
+          degree  := 0;
+          edges   := NullEdge;
+          prior   := NullVertex;
+          next    := NullVertex;
+        END (*--with*);
+  END (*--if*);
+  RETURN newVertex;
+END NewVertex;
+(*-------------------------*)
+
+(*
+AddVertex adds theVertex to theGraph's set of all vertices. The vertex
+is placed at the front of the doubly-linked list used to represent this
+set. Complexity O(1)
+*)
+
+PROCEDURE AddVertex (    theGraph  : Graph  (*--inout*);
+                                             theVertex : Vertex (*--inout*));
+BEGIN
+  WITH theGraph^ DO
+        IF (firstVertex # NullVertex) THEN
+          firstVertex^.prior := theVertex;
+        END (*--if*);
+        theVertex^.next := firstVertex;
+        firstVertex := theVertex;
+        INC(numVertices);
+  END (*--with*);
+END AddVertex;
+(*-------------------------*)
+
+(*
+FreeVertex removes theVertex from theGraph's set of all vertices.
+This routine uses a standard doubly-linked list removal
+algorithm giving a constant time complexity of O(1).
+*)
+
+PROCEDURE FreeVertex (    theGraph  : Graph  (*--inout*);
+                                          VAR theVertex : Vertex (*--inout*));
+BEGIN
+  WITH theVertex^ DO
+        IF (prior = NullVertex) THEN
+          theGraph^.firstVertex := next;
+        ELSE
+          prior^.next := next;
+        END (*--if*);
+        IF (next # NullVertex) THEN
+          next^.prior := prior;
+        END (*--if*);
+  END (*--with*);
+  FreeLabel(theVertex);
+  WITH theGraph^ DO
+        DEC(numVertices);
+        theVertex^.next := available;
+        available := theVertex;
+  END (*--with*);
+  theVertex := NullVertex;
+END FreeVertex;
+(*-------------------------*)
+
+
+(*
+NewEdge simply creates a new edge with the specified vertex endpoints and weight.
+The edge is not added to any edge list, leaving this to the caller. The overflow
+exception is automatically raised, if necessary, when a new edge node cannot be
+allocated. Complexity O(1).
+*)
+
+PROCEDURE NewEdge (    vertex1    : Vertex     (*--in   *);
+                                           vertex2    : Vertex     (*--in   *);
+                                           theWeight  : Attribute  (*--in   *);
+                                           theRoutine : Operations (*--in   *))
+                                                          : EdgePtr    (*--out  *);
+
+VAR       newEdgeRef : EdgePtr; (*--new edge being created *)
+
+BEGIN
+  Allocate(newEdgeRef, SIZE(EdgeNode));
+  IF (newEdgeRef = NullRef) THEN
+    RaiseErrIn(theRoutine, overflow);
+  ELSE
+        WITH newEdgeRef^ DO
+          first    := vertex1;
+          second   := vertex2;
+          weight   := theWeight;
+          edgeRef1 := NullEdge;
+          edgeRef2 := NullEdge;
+          next     := NullRef;
+          prior    := NullRef;
+        END (*--with*);
+  END (*--if*);
+  RETURN newEdgeRef;
+END NewEdge;
+(*-------------------------*)
+
+(*
+AddEdge adds theEdge to theGraph's set of all edges. The edge is placed
+at the front of the doubly-linked list used to represent this set. Complexity O(1)
+*)
+
+PROCEDURE AddEdge (    theGraph : Graph    (*--inout*);
+                                           theEdge  : EdgePtr  (*--inout*));
+BEGIN
+  WITH theGraph^ DO
+        IF (firstEdge # NullRef) THEN
+          firstEdge^.prior := theEdge;
+        END (*--if*);
+        theEdge^.next := firstEdge;
+        firstEdge := theEdge;
+        INC(numEdges);
+  END (*--with*);
+END AddEdge;
+(*-------------------------*)
+
+(*
+FreeEdge removes theEdge from theGraph's set of all edges.
+This routine uses a standard doubly-linked list removal
+algorithm giving a constant time complexity of O(1).
+*)
+
+PROCEDURE FreeEdge (    theGraph : Graph    (*--inout*);
+                                        VAR theEdge  : EdgePtr  (*--inout*));
+BEGIN
+  WITH theEdge^ DO
+        IF (prior = NullRef) THEN
+          theGraph^.firstEdge := next;
+        ELSE
+          prior^.next := next;
+        END (*--if*);
+        IF (next # NullRef) THEN
+          next^.prior := prior;
+        END (*--if*);
+  END (*--with*);
+  DEC(theGraph^.numEdges);
+  FreeAttribute(theEdge);
+  Deallocate(theEdge, SIZE(theEdge^));
+END FreeEdge;
+(*-------------------------*)
+
+
+(*
+NewRef constructs a new edge reference node. The node is linked to its
+associated EdgeNode while the links into a vertexes edge list are set to
+the empty state. Complexity O(1).
+*)
+
+PROCEDURE NewEdgeRef (    theEdgePtr : EdgePtr    (*--in   *);
+                                              theRoutine : Operations (*--in   *))
+                                                             : Edge           (*--out  *);
+
+VAR       newEdge : Edge; (*--new edge reference being created *)
+
+BEGIN
+  Allocate(newEdge, SIZE(EdgeRefNode));
+  IF (newEdge = NullEdge) THEN
+    RaiseErrIn(theRoutine, overflow);
+  ELSE
+        WITH newEdge^ DO
+          realEdge := theEdgePtr;
+          next     := NullEdge;
+          prior    := NullEdge;
+        END (*--with*);
+  END (*--if*);
+  RETURN newEdge;
+END NewEdgeRef;
+(*-------------------------*)
+
+(*
+AddEdgeRef adds theEdge to theVertex's set of edges incident on theVertex.
+The edge is placed at the front of the doubly-linked list used to
+represent this set. Complexity O(1)
+*)
+
+PROCEDURE AddEdgeRef (    theVertex : Vertex (*--inout*);
+                                                  theEdge   : Edge   (*--inout*));
+BEGIN
+  WITH theVertex^ DO
+        IF (edges # NullEdge) THEN
+          edges^.prior := theEdge;
+        END (*--if*);
+    theEdge^.next := edges;
+    edges := theEdge;
+        INC(degree);
+  END (*--with*);
+END AddEdgeRef;
+(*-------------------------*)
+
+(*
+FreeEdgeRef removes theEdge from theVertex's set of edges incident on
+theVertex. This routine uses a standard doubly-linked list removal
+algorithm giving a constant time complexity of O(1).
+*)
+
+PROCEDURE FreeEdgeRef (    theVertex : Vertex (*--inout*);
+                                           VAR theEdge   : Edge   (*--inout*));
+BEGIN
+  WITH theEdge^ DO
+        IF (prior = NullEdge) THEN
+          theVertex^.edges := next;
+        ELSE
+          prior^.next := next;
+        END (*--if*);
+        IF (next # NullEdge) THEN
+          next^.prior := prior;
+        END (*--if*);
+  END (*--with*);
+  DEC(theVertex^.degree);
+  Deallocate(theEdge, SIZE(theEdge^));
+END FreeEdgeRef;
+(*-------------------------*)
+
+(*
+ClearEdgeRefs removes all directed edge referencess from a given vertexes edge list.
+O(outdegree(v))
+*)
+
+PROCEDURE ClearEdgeRefs (VAR theVertex : Vertex    (*--inout*));
+
+VAR   theEdge : Edge; (*--edge reference being removed *)
+
+BEGIN
+  WITH theVertex^ DO
+        WHILE (edges # NIL) DO
+          theEdge := edges;
+          edges := edges^.next;
+          DEC(degree);
+          Deallocate(theEdge, SIZE(theEdge^));
+        END (*--while*);
+  END (*--with*);
+END ClearEdgeRefs;
+(*-------------------------*)
+
+(*
+14.2.4  Graph Constructors
+
+Create attempts to form a new, empty graph object with the given vertex
+label and edge label data types. First, the graph descriptor is allocated and the vertex
+and edge data type IDs are stored there. The number of vertices and edges are
+initialized to zero. The pointer to the head of the adjacency list (firstVertex)
+is initialized to the empty state (NIL). If the descriptor allocation
+fails the overflow exception is raised and the NullGraph is returned,
+otherwise we return the newly allocated graph. Complexity O(1).
+*)
+
+CONST baseSize = SIZE(BoundedGraph) - SIZE(Vertices);
+CONST nodeSize = SIZE(VertexNode);
+
+PROCEDURE Create   (    labels     : TypeID    (*--in   *);
+                                            attributes : TypeID    (*--in   *);
+                                            theSize    : CARDINAL  (*--in   *))
+                                                                   : Graph     (*--out  *);
+
+VAR   newGraph : Graph; (*--temporary for new graph object *)
+
+BEGIN
+  graphError := noerr;
+  Allocate(newGraph, baseSize + (VAL(INTEGER, theSize) * nodeSize));
+  IF (newGraph = NullGraph) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newGraph^ DO
+          labelType   := labels;
+          attrType    := attributes;
+          maxVertices := theSize;
+          numVertices := 0;
+          numEdges    := 0;
+          firstEdge   := NullRef;
+        END (*--with*);
+        InitFreeList(newGraph);
+  END (*--if*);
+  RETURN newGraph;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy clears theGraph and then deallocates it making theGraph undefined.
+SCLStorage.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullGraph). Complexity O(|V|+|E|).
+*)
+
+PROCEDURE Destroy (VAR theGraph      : Graph     (*--inout *));
+BEGIN
+  Clear(theGraph);
+  IF (graphError = noerr) THEN
+    Deallocate(theGraph, baseSize + (theGraph^.maxVertices * nodeSize));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear removes all vertices and edges from theGraph making theGraph empty.
+We do this by iterating over each of the vertices and clearing all edges
+leaving the vertex (ClearEdges). As a final step we ensure that the graph is left in the
+empty state by resetting the head of the adjacency list to NIL and the number
+of vertices and edges in the graph to zero. Complexity O(|V|+|E|).
+*)
+
+PROCEDURE Clear   (    theGraph      : Graph    (*--inout *));
+
+  PROCEDURE ClearEdges (VAR theGraph : Graph    (*--inout *));
+
+  VAR   theEdge : EdgePtr; (*--edge to be removed *)
+
+  BEGIN
+    WITH theGraph^ DO
+          WHILE (firstEdge # NullRef) DO
+            theEdge := firstEdge;
+            firstEdge := firstEdge^.next;
+            DEC(numEdges);
+            FreeAttribute(theEdge);
+            Deallocate(theEdge, SIZE(theEdge^));
+          END (*--while*);
+    END (*--with*);
+  END ClearEdges;
+  (*-------------------------*)
+
+VAR   theVertex : Vertex;          (*--loop index over vertices *)
+VAR   oldVertex : Vertex;          (*--vertex to deallocate *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+        ClearEdges(theGraph);
+    WITH theGraph^ DO
+          theVertex := firstVertex;
+          WHILE (theVertex # NullVertex) DO
+            ClearEdgeRefs(theVertex);
+                FreeLabel(theVertex);
+                oldVertex := theVertex;
+                theVertex := theVertex^.next;
+                oldVertex^.next := available;
+                available := oldVertex;
+                oldVertex^.inGraph := NullGraph;
+          END (*--while*);
+          firstVertex := NullVertex;
+          numVertices := 0;
+        END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign copies the source graph, theGraph, to the target graph, toGraph. The
+main body of Assign does this by first copying all the vertices followed by
+copying all the edges from the source to the destination graph.
+The algorithmic complexity is O(|V|^2+|E|) due to the mapping between the vertices
+of the source and target graphs while copying the edges (see the discussion
+of the vertexMap following RecreateTarget).
+*)
+
+PROCEDURE Assign  (    theGraph      : Graph     (*--in   *);
+                                   VAR toGraph       : Graph     (*--inout *));
+
+(*
+RecreateTarget reconstructs the target graph descriptor so that the fields
+defining the vertex label and edge attribute data types, and (optionally)
+maximum number of vertices between the source and destination graphs are the
+same. If the source and destination graphs are the same the routine returns
+FALSE indicating that the postconditions for the assignment operation are
+already met. The routine returns TRUE if the recreation of the target was
+successful. Complexity O(v+e) where v and e are the number of vertices and
+edges, respectively, in the original toGraph.  When Clearing the target graph
+is unnecessary (the toGraph is initially the NullGraph) the complexity falls
+to O(1).
+*)
+
+  PROCEDURE RecreateTarget (): BOOLEAN (*--out  *);
+  BEGIN
+        IF (theGraph = NullGraph) THEN
+      RaiseErrIn(assign, undefined);
+
+        ELSIF (toGraph = NullGraph) THEN
+      WITH theGraph^ DO
+        toGraph := Create(labelType, attrType, maxVertices);
+          END (*--with*);
+
+        ELSIF (theGraph = toGraph) THEN
+      RETURN FALSE;
+
+        ELSE
+          Clear(toGraph);
+      WITH theGraph^ DO
+                toGraph^.labelType := labelType;
+                toGraph^.attrType  := attrType;
+          END (*--with*);
+        END (*--if*);
+        RETURN (graphError = noerr);
+  END RecreateTarget;
+
+(*
+One thorny issue in graph assignment is how to set-up the copied edges with the
+proper initial and final vertices? The edges of the source graph contain references
+to the source graph's vertices, not those of the target graph. The vertex
+labels cannot be used since more than one vertex can have the same label. In
+this case, an edge from the second (or greater) such vertex in the target graph
+would be linked incorrectly to the first vertex having that label. The solution
+is in having some form of temporary mapping from the source graph's vertices to
+their counterpart in the target graph. The necessary operations are add a mapping
+between a vertex from the source graph and its corresponding vertex in the
+target graph, and given a source graph vertex return the target graph vertex
+mapped to that source vertex.
+
+The data structure implementing our vertex mapping is an unordered array of mapping
+entries, one per vertex, between the vertices of the source graph and the
+target graph. This array is dynamically created on the heap based on the
+number of vertices in the source graph. (The ARRAY [0..0] OF ≡ construct is
+a special feature of the TML Modula-2 compiler allowing dynamic arrays.) The
+variable mapExtent controls where MapVertex entries are inserted into the
+array. A post-increment scheme is used so mapVertex is always one greater than
+the number of entries stored in the array.
+*)
+
+  TYPE  MapVertex = RECORD
+              old : Vertex; (*-- vertex from source graph *)
+              new : Vertex; (*-- corresponging vertex in target graph *)
+            END (*--MapVertex*);
+  TYPE  MapVertices = ARRAY [0..0] OF MapVertex;
+
+  VAR   vertexMap : POINTER TO MapVertices;
+  VAR   mapExtent : CARDINAL;
+
+
+(*
+CreateVertexMap allocates a dynamic array of vertex mapping entries on the
+heap based on the number of vertices in the source graph. vertexMap is set to
+NIL by Allocate if there isn't enough memory available to meet the request.
+*)
+
+  PROCEDURE CreateVertexMap;
+  BEGIN
+        Allocate(vertexMap,
+                         VAL(CARDINAL, SIZE(MapVertex)) * theGraph^.numVertices);
+        mapExtent := 0;
+  END CreateVertexMap;
+
+(*
+AddVertexToMap adds a mapping between the vertices of the source and target graphs.
+*)
+
+  PROCEDURE AddToVertexMap (    oldVertex : Vertex (*--in   *);
+                                                                newVertex : Vertex (*--in   *));
+  BEGIN
+        WITH vertexMap^[mapExtent] DO
+          old := oldVertex;
+          new := newVertex;
+        END (*--with*);
+    INC(mapExtent);
+  END AddToVertexMap;
+
+(*
+VertexInMap returns the mapping between the vertices of the source and target
+graphs. Since every vertex is represented failure to find a mapping is
+indicative of either a programming error in CopyVertices or a hardware/system
+software error at runtime.
+*)
+
+  PROCEDURE VertexInMap (    oldVertex : Vertex (*--in   *))
+                                                                           : Vertex (*--out  *);
+
+  VAR   index : CARDINAL; (*-- loop index over mapping entries *)
+
+  BEGIN
+    FOR index := 0 TO mapExtent-1 DO
+          WITH vertexMap^[index] DO
+        IF (oldVertex = old) THEN
+                  RETURN new;
+                END (*--if*);
+          END (*--with*);
+    END (*--for*);
+        RETURN NullVertex;
+  END VertexInMap;
+
+(*
+DestroyVertexMap frees up the memory used by the vertexMap when the Assign
+operation is complete. Remember that Deallocate automatically
+releases the proper amount of space.
+*)
+
+  PROCEDURE DestroyVertexMap;
+  BEGIN
+        Deallocate(vertexMap, SIZE(vertexMap^));
+  END DestroyVertexMap;
+
+
+(*
+CopyVertices duplicates the vertices from the source graph to the destination
+graph returning TRUE if every vertex was successfully copied and FALSE otherwise.
+This BOOLEAN result is used by the main body of Assign to control whether the
+graph assignment operation continues by copying the edges. The following local
+variables are used:
+        1. v:                   indicates the current vertex being copied from the source
+                                        graph. This is also used as a 'loop index' over the vertices
+                                        of the source graph.
+        2. newVertex:   temporary for a new vertex for the destination graph.
+        3. lastVertex:  last vertex inserted into the destination graph. This is
+                                        used by TailInsert to add a new vertex to the end of the
+                                        destination graph's adjacency list.
+        4. assignItem:  vertex label assignment routine.
+
+Assignment of the vertex label presents an interesting situation. When a vertex
+is added to a graph, the client module expects the given label to be copied using
+the Modula-2 assignment statement (even for dynamically allocated data items)
+since we simply need to store the value in the vertex object. This is known as
+'structural sharing'. But when a graph is duplicated using Assign, new copies
+of the vertex labels are necessary - avoiding the problems presented by structural
+sharing of dynamically allocated items as described in Volume 1. CopyVertices
+resolves this through the assignment procedure associated with the graph's label
+data type duplicating the label as a NewVertex is created. Complexity O(v) where
+v is the number of vertices in the source graph.
+*)
+
+  PROCEDURE CopyVertices () : BOOLEAN;
+
+  VAR   v : Vertex;     (*--loop index over vertices being copied *)
+  VAR   newVertex : Vertex; (*--new vertex in target graph *)
+  VAR   lastVertex: Vertex; (*--last vertex added to list of vertices *)
+  VAR   assignItem: AssignProc;
+
+(*
+TailInsert adds newVertex to the end of the target graph's adjacency list
+given pointers to the first and last elements of the list. Complexity O(1).
+*)
+
+    PROCEDURE TailInsert (VAR first : Vertex (*--inout *);
+                                                  VAR last  : Vertex (*--inout *));
+    BEGIN
+      IF (first = NullVertex) THEN
+            first := newVertex;
+          ELSE
+            last^.next := newVertex;
+          END (*--if*);
+          last := newVertex;
+    END TailInsert;
+
+  BEGIN
+        CreateVertexMap;
+        IF (vertexMap = NIL) THEN
+          RETURN FALSE;
+        END (*--if*);
+
+        assignItem := AssignOf(theGraph^.labelType);
+        v := theGraph^.firstVertex;
+        lastVertex := NullVertex;
+
+    WHILE (v # NullVertex) DO
+          newVertex := NewVertex(toGraph, assignItem(v^.data), assign);
+          IF (newVertex = NullVertex) THEN
+            DestroyVertexMap;
+                RETURN FALSE;
+          END (*--if*);
+
+          TailInsert(toGraph^.firstVertex, lastVertex);
+          INC(toGraph^.numVertices);
+          AddToVertexMap(v, newVertex);
+
+          v := v^.next;
+        END (*--while*);
+
+        RETURN TRUE;
+  END CopyVertices;
+
+  PROCEDURE CopyEdges;
+
+  VAR   theEdge   : EdgePtr; (*--loop index over edges in source graph *)
+  VAR   newEdge   : EdgePtr; (*--new edge for target graph *)
+  VAR   lastEdge  : EdgePtr; (*--last edge inserted into new list of edges *)
+  VAR   epRef1    : Edge;
+  VAR   epRef2    : Edge;
+  VAR   assignItem: AssignProc; (*--attribute assignment procedure *)
+  VAR   vertex1   : Vertex; (*--first vertex of theEdge in target graph *)
+  VAR   vertex2   : Vertex; (*--second vertex of theEdge in target graph *)
+
+  BEGIN
+        assignItem := AssignOf(theGraph^.attrType);
+        theEdge    := theGraph^.firstEdge;
+        lastEdge   := NullRef;
+        WHILE (theEdge # NullRef) DO
+          vertex1 := VertexInMap(theEdge^.first);
+          vertex2 := VertexInMap(theEdge^.second);
+          newEdge := NewEdge(vertex1,
+                                                 vertex2,
+                                                 assignItem(theEdge^.weight),
+                                                 assign);
+          IF (newEdge = NullRef) THEN
+                RETURN;
+          END (*--if*);
+          epRef1 := NewEdgeRef(newEdge, assign);
+          IF (epRef1 = NullEdge) THEN
+            Deallocate(newEdge, SIZE(newEdge^));
+            RETURN;
+          END (*--if*);
+          newEdge^.edgeRef1 := epRef1;
+
+          IF (vertex1 # vertex2) THEN
+            epRef2 := NewEdgeRef(newEdge, assign);
+            IF (epRef2 = NullEdge) THEN
+              Deallocate(newEdge, SIZE(newEdge^));
+              Deallocate(epRef1, SIZE(epRef1^));
+              RETURN;
+            END (*--if*);
+            newEdge^.edgeRef2 := epRef2;
+            AddEdgeRef(vertex2, epRef2);
+      END (*--if*);
+
+          AddEdgeRef(vertex1, epRef1);
+          AddEdge(toGraph, newEdge);
+
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END CopyEdges;
+
+BEGIN (*--Assign --*)
+  graphError := noerr;
+  IF RecreateTarget() & CopyVertices() THEN
+    CopyEdges;
+        DestroyVertexMap;
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+14.2.5  Vertex Constructors
+
+Insert adds a vertex to the given graph labeling the vertex with the given item.
+The first step is to allocate a new vertex node which, if successful,
+is followed by adding the vertex at the head of the adjacency list. If we cannot
+create a new vertex node the overflow exception is raised and the Insert operation
+aborted. Complexity O(1).
+*)
+
+PROCEDURE Insert   (VAR theGraph   : Graph     (*--inout *);
+                                        theItem    : Label     (*--in    *);
+                                        VAR theVertex  : Vertex    (*--out   *));
+BEGIN
+  graphError := noerr;
+  theVertex  := NullVertex;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(insert, undefined);
+  ELSE
+    theVertex := NewVertex(theGraph, theItem, insert);
+        IF (theVertex # NullVertex) THEN
+      AddVertex(theGraph, theVertex);
+    END (*--if*);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+(*
+Remove deletes the given vertex from the specified graph. If no such vertex
+can be found in the graph the novertex exception is raised and the routine
+aborted. After we have checked that no exceptions can occur we remove
+all edges incident on the vertex, remove the vertex from the adjacency list,
+release any dynamically allocated memory used by the vertex label, release the
+vertex itself, and update the count of vertices in the graph. Complexity
+O(degree(v)).
+*)
+
+PROCEDURE Remove   (VAR theGraph   : Graph     (*--inout*);
+                                    VAR theVertex  : Vertex    (*--inout*));
+
+(*
+Given a vertex and an edge reference, OtherVertex returns the other
+member of the unordered pair of vertices associated with the edge.
+For example, given the vertex v and the undirected edge {v, w}
+OtherVertex returns the vertex w. Complexity O(1)
+*)
+
+  PROCEDURE OtherVertex (    theVertex : Vertex (*--in   *);
+                                                     theEdge   : Edge   (*--in   *))
+                                                                           : Vertex (*--out  *);
+  BEGIN
+    WITH theEdge^.realEdge^ DO
+          IF (first = theVertex) THEN
+            RETURN second;
+          ELSE
+            RETURN first;
+          END (*--if*);
+    END (*--with*);
+  END OtherVertex;
+
+(*
+Given a directed edge reference, OtherEdge returns the
+other directed edge used in representing an undirected edge.
+Complexity O(1).
+*)
+
+  PROCEDURE OtherEdge (    theEdge : Edge (*--in   *))
+                                                                   : Edge (*--out  *);
+  BEGIN
+    WITH theEdge^.realEdge^ DO
+          IF (edgeRef1 = theEdge) THEN
+            RETURN edgeRef2;
+          ELSE
+            RETURN edgeRef1;
+          END (*--if*);
+    END (*--with*);
+  END OtherEdge;
+
+VAR   anEdge  : Edge;   (*--loop index over edges *)
+VAR   vertex2 : Vertex; (*--other endpoint in anEdge *)
+VAR   edge2   : Edge;   (*--edge in vertex2's edge list *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(remove, undefined);
+
+  ELSIF (theVertex = NullVertex) THEN
+    RaiseErrIn(remove, nullvertex);
+
+  ELSIF (theVertex^.inGraph # theGraph) THEN
+    RaiseErrIn(remove, novertex);
+
+  ELSE
+    anEdge := theVertex^.edges;
+        WHILE (anEdge # NullEdge) DO
+          vertex2 := OtherVertex(theVertex, anEdge);
+          edge2   := OtherEdge(anEdge);
+          FreeEdgeRef(vertex2, edge2);
+          FreeEdge(theGraph, anEdge^.realEdge);
+          anEdge := anEdge^.next;
+        END (*--while*);
+        ClearEdgeRefs(theVertex);
+        FreeVertex(theGraph, theVertex);
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+(*
+SetLabel assigns a new label to the given vertex of the graph. Prior to
+assigning a new vertex label we must release any dynamically allocated memory
+used by the old vertex label. Complexity O(1).
+*)
+
+PROCEDURE SetLabel (    theVertex  : Vertex    (*--inout*);
+                                            theItem    : Label     (*--in   *));
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) OR (theVertex^.inGraph = NullGraph) THEN
+    RaiseErrIn(setlabel, nullvertex);
+  ELSE
+        FreeLabel(theVertex);
+    theVertex^.data := theItem;
+  END (*--if*);
+END SetLabel;
+(*-------------------------*)
+
+(*
+14.2.6  Edge Constructors
+
+Link adds an undirected edge between the from and to vertices labelling the
+edge with the given weight attribute. The first step creates a new edge. Secondly,
+new references for each vertices edge list are created (only one edge reference
+is created when endpoint1 = endpoint2). Lastly, the new edge references and the
+edge itself are added to their respective lists. If the memory allocation for
+any of the nodes fails, allocations performed prior to the one that failed are
+deallocated preventing needless clutter. Complexity O(1).
+*)
+
+PROCEDURE Link         (VAR theGraph   : Graph     (*--inout*);
+                                            endpoint1  : Vertex    (*--in   *);
+                                            endpoint2  : Vertex    (*--in   *);
+                                            theWeight  : Attribute (*--in   *);
+                                            VAR theEdge    : Edge      (*--out  *));
+
+VAR   newEdgePtr : EdgePtr;
+VAR   newEdge    : Edge;    (*-- edge ref for {ep2, ep1} *)
+
+BEGIN
+  graphError := noerr;
+  theEdge    := NullEdge;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(link, undefined);
+  ELSIF (endpoint1 = NullVertex) OR (endpoint2 = NullVertex) THEN
+    RaiseErrIn(link, nullvertex);
+  ELSIF (endpoint1^.inGraph # theGraph) OR
+                (endpoint2^.inGraph # theGraph) THEN
+    RaiseErrIn(link, novertex);
+  ELSE
+
+    newEdgePtr := NewEdge(endpoint1, endpoint2, theWeight, link);
+        IF (newEdgePtr = NullRef) THEN
+          RETURN;
+        END (*--if*);
+
+        theEdge := NewEdgeRef(newEdgePtr, link);
+        IF (theEdge = NullEdge) THEN
+          Deallocate(newEdgePtr, SIZE(newEdgePtr^));
+          RETURN;
+        END (*--if*);
+        newEdgePtr^.edgeRef1 := theEdge;
+
+        IF (endpoint1 # endpoint2) THEN
+          newEdge := NewEdgeRef(newEdgePtr, link);
+          IF (newEdge = NullEdge) THEN
+            Deallocate(newEdgePtr, SIZE(newEdgePtr^));
+            Deallocate(theEdge, SIZE(theEdge^));
+            RETURN;
+          END (*--if*);
+          newEdgePtr^.edgeRef2 := newEdge;
+          AddEdgeRef(endpoint2, newEdge);
+    END (*--if*);
+
+        AddEdge(theGraph, newEdgePtr);
+        AddEdgeRef(endpoint1, theEdge);
+  END (*--if*);
+END Link;
+(*-------------------------*)
+
+(*
+Unlink removes an undirected edge between the two vertices, fromVertex and
+toVertex. Complexity O(d) where d is the degree of the from vertex.
+*)
+
+PROCEDURE Unlink       (VAR theGraph   : Graph     (*--inout*);
+                                        VAR theEdge    : Edge      (*--inout*));
+
+VAR   theRealEdge  : EdgePtr;
+
+BEGIN
+  graphError := noerr;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(unlink, undefined);
+
+  ELSIF (theEdge = NullEdge) THEN
+        RaiseErrIn(unlink, nulledge);
+
+  ELSIF (theEdge^.realEdge^.first = NullVertex) THEN
+    RaiseErrIn(unlink, nullvertex);
+
+  ELSIF (theEdge^.realEdge^.first^.inGraph # theGraph) THEN
+    RaiseErrIn(unlink, noedge);
+
+  ELSE
+        theRealEdge := theEdge^.realEdge;
+    WITH theRealEdge^ DO
+          FreeEdgeRef(first, edgeRef1);
+          IF (edgeRef2 # NullEdge) THEN
+            FreeEdgeRef(second, edgeRef2);
+          END (*--if*);
+        END (*--with*);
+        FreeEdge(theGraph, theRealEdge);
+        theEdge := NullEdge;
+  END (*--if*);
+END Unlink;
+(*-------------------------*)
+
+(*
+SetAttribute assigns a new edge labeling to the given edge. Prior to assigning
+a new edge attribute we must release any dynamically allocated memory
+used by the old edge attribute. Complexity O(1).
+*)
+
+PROCEDURE SetAttribute (    theEdge    : Edge      (*--inout*);
+                                            theWeight  : Attribute (*--in   *));
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+        RaiseErrIn(setattr, nulledge);
+  ELSE
+    WITH theEdge^ DO
+      FreeAttribute(realEdge);
+      realEdge^.weight := theWeight;
+    END (*--with*);
+  END (*--if*);
+END SetAttribute;
+(*-------------------------*)
+
+(*
+14.2.7  Graph Selectors
+
+IsDefined verifies to the best of its ability whether theGraph has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theGraph  : Graph       (*--in   *))
+                                                                   : BOOLEAN     (*--out  *);
+BEGIN
+  RETURN (theGraph # NullGraph);
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theGraph is in the empty state, as indicated by
+the number of vertices being zero, and False otherwise.  As per the
+specification (û9.3) undefined graphs are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theGraph  : Graph       (*--in   *))
+                                                                   : BOOLEAN     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isempty, undefined);
+        RETURN TRUE;
+  END (*--if*);
+  RETURN theGraph^.numVertices = 0;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+TypeOf simply returns the vertex label and edge attribute data type IDs for
+the given graph. Undefined graphs, as always, raise the undefined exception
+and return a reasonable value, in this case the NullType. Complexity O(1).
+*)
+
+PROCEDURE TypeOf    (    theGraph  : Graph       (*--in   *);
+                                         VAR labelType : TypeID      (*--out  *);
+                                         VAR attrType  : TypeID      (*--out  *));
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(typeof, undefined);
+        labelType := NullType;
+        attrType  := NullType;
+  ELSE
+        labelType := theGraph^.labelType;
+        attrType  := theGraph^.attrType;
+  END (*--if*);
+END TypeOf;
+(*-------------------------*)
+
+(*
+OrderOf returns the number of vertices in the graph, or zero for an undefined
+graph. Complexity O(1).
+*)
+
+PROCEDURE OrderOf   (    theGraph  : Graph       (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(orderof, undefined);
+        RETURN 0;
+  END (*--if*);
+  RETURN theGraph^.numVertices;
+END OrderOf;
+(*-------------------------*)
+
+(*
+SizeOf returns the number of edges in the graph, or zero for an undefined
+graph. Complexity O(1).
+*)
+
+PROCEDURE SizeOf    (    theGraph  : Graph       (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(sizeof, undefined);
+        RETURN 0;
+  END (*--if*);
+  RETURN theGraph^.numEdges;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE MaxOrderOf (    theGraph  : Graph      (*--in   *))
+                                                                    : CARDINAL   (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(maxorderof, undefined);
+        RETURN 0;
+  END (*--if*);
+  RETURN theGraph^.maxVertices;
+END MaxOrderOf;
+(*-------------------------*)
+
+(*
+14.2.8  Vertex Selectors
+
+DegreeOf returns the number of edges incident on the given vertex.
+We do this by simply returning the value maintained by Link and Unlink.
+Complexity O(1).
+*)
+
+PROCEDURE DegreeOf  (    theVertex : Vertex      (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF  (theVertex = NullVertex) THEN
+    RaiseErrIn(degreeof, nullvertex);
+    RETURN 0;
+  END (*--if*);
+  RETURN theVertex^.degree;
+END DegreeOf;
+(*-------------------------*)
+
+(*
+LabelOf returns the vertex label associated with the given vertex.
+If the vertex is undefined the NullItem is returned. Complexity O(1).
+*)
+
+PROCEDURE LabelOf   (    theVertex : Vertex      (*--in   *))
+                                                                   : Label       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(labelof, nullvertex);
+  ELSE
+    RETURN theVertex^.data;
+  END (*--if*);
+  RETURN NullItem;
+END LabelOf;
+(*-------------------------*)
+
+(*
+Since we have stored a copy of the graph object associated with each vertex
+as a field of the vertex itself, IsVertex simply needs to compare the given
+graph with its own local state. This saves us from having to search the graph.
+Complexity O(1).
+*)
+
+PROCEDURE IsVertex  (    theGraph  : Graph       (*--in   *);
+                                             theVertex : Vertex      (*--in   *))
+                                                           : BOOLEAN     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isvertex, undefined);
+  ELSIF (theVertex = NullVertex) THEN
+    RaiseErrIn(isvertex, nullvertex);
+  ELSE
+    RETURN theVertex^.inGraph = theGraph;
+  END (*--if*);
+  RETURN FALSE;
+END IsVertex;
+(*-------------------------*)
+
+(*
+GraphOf simply returns its copy of the enclosing graph or the NullGraph if the
+vertex is undefined. Complexity O(1).
+*)
+
+PROCEDURE GraphOf   (    theVertex : Vertex      (*--in   *))
+                                                                   : Graph       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(graphof, nullvertex);
+    RETURN NullGraph;
+  END (*--if*);
+  RETURN theVertex^.inGraph;
+END GraphOf;
+(*-------------------------*)
+
+(*
+14.2.9  Edge Selectors
+
+AttributeOf returns the edge attribute associated with the given edge.
+If the edge is undefined the NullItem is returned. Complexity O(1).
+*)
+
+PROCEDURE AttributeOf (    theEdge   : Edge        (*--in   *))
+                                                                 : Attribute   (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(attrof, nulledge);
+  ELSE
+    RETURN theEdge^.realEdge^.weight;
+  END (*--if*);
+  RETURN NullItem;
+END AttributeOf;
+(*-------------------------*)
+
+(*
+Given an edge, FirstOf returns the  first vertex in the set of vertices
+associated with the given edge or the NullVertex if the edge is undefined.
+Complexity O(1).
+*)
+
+PROCEDURE FirstOf        (    theEdge   : Edge       (*--in  *))
+                                                                : Vertex     (*--out *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(firstof, nulledge);
+  ELSE
+    RETURN theEdge^.realEdge^.first;
+  END (*--if*);
+  RETURN NullVertex;
+END FirstOf;
+(*-------------------------*)
+
+(*
+Given an edge, SecondOf returns the second vertex in the set of vertices
+associated with the given edge or the NullVertex if the edge is undefined.
+Complexity O(1).
+*)
+
+PROCEDURE SecondOf   (    theEdge   : Edge       (*--in  *))
+                                                                : Vertex     (*--out *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(secondof, nulledge);
+  ELSE
+    RETURN theEdge^.realEdge^.second;
+  END (*--if*);
+  RETURN NullVertex;
+END SecondOf;
+(*-------------------------*)
+
+(*
+IncidentOn is simply a combination of FirstOf and SecondOf.
+Complexity O(1).
+*)
+
+PROCEDURE IncidentOn  (    theEdge   : Edge       (*--in   *);
+                                           VAR endpoint1 : Vertex         (*--out  *);
+                                           VAR endpoint2 : Vertex         (*--out  *));
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(incidenton, nulledge);
+    endpoint1 := NullVertex;
+    endpoint2 := NullVertex;
+  ELSE
+    WITH theEdge^.realEdge^ DO
+      endpoint1 := first;
+      endpoint2 := second;
+    END (*--with*);
+  END (*--if*);
+END IncidentOn;
+(*-------------------------*)
+
+(*
+IsEdge returns true if there the given directed edge is an edge of the given
+graph and false otherwise. An advantage of having each vertex identify its
+enclosing graph object is use of this field in testing whether the edge is
+part of a specified graph. This saves use from having to search every edge in
+the graph. Complexity O(1).
+*)
+
+PROCEDURE IsEdge     (    theGraph  : Graph      (*--in *);
+                                              theEdge   : Edge       (*--in *))
+                                                            : BOOLEAN    (*--out *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isedge, undefined);
+  ELSIF (theEdge = NullEdge) THEN
+    RaiseErrIn(isedge, nulledge);
+  ELSIF (theEdge^.realEdge^.first = NullVertex) THEN
+    RaiseErrIn(isedge, nullvertex);
+  ELSE
+    RETURN theEdge^.realEdge^.first^.inGraph = theGraph;
+  END (*--if*);
+  RETURN FALSE;
+END IsEdge;
+(*-------------------------*)
+
+(*
+14.2.10 Passive Iterators
+
+LoopVertices simply iterates over the vertices of the given graph until every
+vertex has been examined or the process procedure parameter returns FALSE,
+whichever occurs first. Complexity O(|V|).
+*)
+
+PROCEDURE LoopVertices (    theGraph  : Graph          (*--in   *);
+                                                        process   : VertexLoopProc (*--in   *));
+
+VAR   theVertex : Vertex; (*--loop index over vertices *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(loopvertices, undefined);
+  ELSE
+        theVertex := theGraph^.firstVertex;
+        WHILE (theVertex # NullVertex) & process(theVertex) DO
+          theVertex := theVertex^.next;
+        END (*--while*);
+  END (*--if*);
+END LoopVertices;
+(*-------------------------*)
+
+(*
+LoopEdges loops over the vertices of the given graph to access the edges associated
+with each vertex. Once the process procedure parameter returns FALSE, we exit
+both WHILE statements through the use of a RETURN which exits the procedure.
+Complexity O(|E|).
+*)
+
+PROCEDURE LoopEdges    (    theGraph  : Graph          (*--in   *);
+                                                        process   : EdgeLoopProc   (*--in   *));
+
+VAR   theEdge : EdgePtr; (*--loop index over edges of a graph *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(loopedges, undefined);
+  ELSE
+        theEdge := theGraph^.firstEdge;
+        WHILE (theEdge # NullRef) & process(theEdge^.edgeRef1) DO
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END LoopEdges;
+(*-------------------------*)
+
+(*
+LoopIterate simply loops over the edges leaving a specified vertex. Complexity
+O(degree(v)).
+*)
+
+PROCEDURE LoopIterate  (    theVertex : Vertex         (*--in   *);
+                                                        process   : EdgeLoopProc   (*--in   *));
+
+VAR   theEdge : Edge;   (*--loop index over edges of the vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(loopiterate, nullvertex);
+  ELSE
+        theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) & process(theEdge) DO
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END LoopIterate;
+(*-------------------------*)
+
+(*
+TravVertices simply iterates over every vertex in the graph. Complexity O(|V|).
+*)
+
+PROCEDURE TravVertices (    theGraph  : Graph      (*--in   *);
+                                                        process   : VertexProc (*--in   *));
+
+VAR   theVertex : Vertex; (*--loop index over vertices *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(travvertices, undefined);
+  ELSE
+        theVertex := theGraph^.firstVertex;
+        WHILE (theVertex # NullVertex) DO
+          process(theVertex);
+          theVertex := theVertex^.next;
+        END (*--while*);
+  END (*--if*);
+END TravVertices;
+(*-------------------------*)
+
+(*
+TravEdges simply iterates over every edge in the graph using the
+set of all edges. Complexity O(|E|).
+*)
+
+PROCEDURE TravEdges    (    theGraph  : Graph      (*--in   *);
+                                                        process   : EdgeProc   (*--in   *));
+
+VAR   theEdge : EdgePtr;   (*--loop index over edges *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(travedges, undefined);
+  ELSE
+        theEdge := theGraph^.firstEdge;
+        WHILE (theEdge # NullRef) DO
+          process(theEdge^.edgeRef1);
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END TravEdges;
+(*-------------------------*)
+
+PROCEDURE Iterate      (    theVertex : Vertex     (*--in   *);
+                                                        process   : EdgeProc   (*--in   *));
+
+VAR   theEdge : Edge; (*--loop index over edges of the vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(iterate, nullvertex);
+  ELSE
+        theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) DO
+          process(theEdge);
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END Iterate;
+(*-------------------------*)
+
+(*
+14.2.11 Active Iterators
+
+Each of the active iterators are essentially selectors for the underlying
+representation of the adjacency list. Their complexity is O(1).
+*)
+
+PROCEDURE FirstVertex  (    theGraph  : Graph      (*--in   *))
+                                                                          : Vertex     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(firstvertex, undefined);
+  ELSE
+        RETURN theGraph^.firstVertex;
+  END (*--if*);
+  RETURN NullVertex;
+END FirstVertex;
+(*-------------------------*)
+
+PROCEDURE NextVertex   (    theVertex : Vertex     (*--in   *))
+                                                                          : Vertex     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(nextvertex, nullvertex);
+  ELSE
+        RETURN theVertex^.next;
+  END (*--if*);
+  RETURN NullVertex;
+END NextVertex;
+(*-------------------------*)
+
+PROCEDURE FirstEdge    (    theVertex : Vertex     (*--in   *))
+                                                                          : Edge       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(firstedge, nullvertex);
+  ELSE
+    RETURN theVertex^.edges;
+  END (*--if*);
+  RETURN NullEdge;
+END FirstEdge;
+(*-------------------------*)
+
+PROCEDURE NextEdge     (    theEdge   : Edge       (*--in   *))
+                                                                          : Edge       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(nextedge, nulledge);
+  ELSE
+    RETURN theEdge^.next;
+  END (*--if*);
+  RETURN NullEdge;
+END NextEdge;
+(*-------------------------*)
+
+(*
+14.2.12 Module Initialization
+
+The module's local variables are initialized to known states. graphError is
+used to fill the handler array with a routine that does nothing when an exception
+is raised (saving the declaration of a special loop control variable for this
+purpose). Applying MIN and MAX to cover all exceptions ensures that this
+initialization will be unaffected by any future changes to the number of
+Exceptions or their order of declaration within the enumeration. Since a FOR
+loop control variable is undefined following the loop, graphError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR graphError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(graphError, NullHandler);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  graphError := noerr;
+        NullGraph := NIL;
+        NullVertex := NIL;
+        NullEdge := NIL;
+END GrafSBMI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRAFSUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRAFSUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRAFSUMI.MOD
@@ -0,0 +1,1714 @@
+(*
+12.2    Graph - Sequential Unbounded Managed Iterator
+
+In this section we provide the implementation module corresponding to
+the interface given above in û12.1. The following scheme is used in
+organizing this section:
+* 12.2.1  Internal Representation
+* 12.2.2  Exception Handling
+* 12.2.3  Local Routines
+* 12.2.4  Graph Constructors
+* 12.2.5  Vertex Constructors
+* 12.2.6  Edge Constructors
+* 12.2.7  Graph Selectors
+* 12.2.8  Vertex Selectors
+* 12.2.9  Edge Selectors
+* 12.2.10 Passive Iterators
+* 12.2.11 Active Iterators
+* 12.2.12 Module Initialization
+*)
+
+IMPLEMENTATION MODULE GrafSUMI;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: 7044 bytes
+    Component: Graph - Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.01  06 Nov 1988  C. Lins:
+        Initial TML Modula-2 implementation
+    v1.02  11 Nov 1988  C. Lins:
+        Fixed bug in TravEdges and Iterate which needed a reference
+        to the vertex.
+    v1.03  15 Jan 1989  C. Lins:
+        Revised interface in conformance with new graph spec (Ch 9).
+        Modified implementations accordingly. Changed to use
+        doubly-linked lists.
+    v1.04  10 Apr 1989  C. Lins:
+        Corrected initialization of handlers array.
+    v1.05  18 Apr 1989   C. Lins:
+        Added component id constant.
+    v2.00  24 Oct 1989  C. Lins
+        Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+        Adapted to JPI Compiler:
+        Used type transfer functions instead of VAL.
+        Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+        (*--proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+        (*--cons*) NullItem,
+        (*--type*) Item, AssignProc, DisposeProc;
+
+FROM GraphTypes IMPORT
+        (*--type*) Operations, Exceptions, ComponentID;
+
+FROM ErrorHandling IMPORT
+        (*--cons*) NullHandler,
+        (*--type*) HandlerProc,
+        (*--proc*) Raise;
+
+FROM TypeManager IMPORT
+        (*--cons*) NullType,
+        (*--type*) TypeID,
+        (*--proc*) AssignOf, DisposeOf;
+
+        (*-------------------------*)
+
+(*
+12.2.1  Internal Representation
+
+The internal representation of an unbounded directed graph uses a variant of the
+adjacency list structure used in Chapter 10 for the directed graph (shown below
+in Figure 12.1). In this representation, the set of vertices for a graph is given
+by a linear list. Since an unbounded graph requires the list to grow and shrink
+in size dynamically, a linked list of dynamically allocated vertex nodes is used.
+Secondly, each vertex is associated with the set of undirected edges incident on
+the vertex. The set of all edges of the graph is thus the union of all the sets
+of edges for each of the graph's vertices.
+
+This is the same conceptual model used in representing the unbounded directed graph
+of Chapter 10. In that chapter we were able to easily implement this model directly.
+Often, undirected graphs are represented using the directed graph model where each
+undirected edge, {v, w}, is presented as two directed edges, (v, w) and (w, v).
+Though such an approach could be taken with this implementation, we consider it
+unsatisfactory for two reasons:
+        1. iteration over the edges would cause each edge to be processed twice making
+           the implementation structure visible to client modules; and
+        2. the selector SetAttribute would have to deallocate and assign the weight
+           attribute in two edge nodes in order to keep them in sync.
+
+The solution used here keeps only a single edge node for each edge while the edge
+lists of the vertices contain references to the 'real' edge nodes. These real edges
+are stored in a doubly-linked list the head of which is kept in the descriptor of
+the graph itself. The edge references are also held in doubly-linked lists and each
+vertex has a reference to the head of their list of edges.
+
+_Figure 12.1_
+
+Following the figure is a description of the various TYPEs used for our internal
+representation including the component fields of each record structure. One
+aspect of this representation that may cause some confusion is that the abstract
+edge entity is in reality an edge reference. Since are two of these for each edge,
+the reader may wonder which reference is used by client modules for the edge
+selectors. This potential problem is resolved by the convention that client modules
+are never aware of more than one of the two edge references, the second edge
+reference is only used internally. Furthermore, when edges are added to a graph
+the reference given back to the client is always for the directed edge reference
+(v, w) where v is the first vertex of the pair of vertices to which the edge is
+linked.
+
+EdgePtr:                defines a reference to a dynamically allocated undirected edge node.
+Edge:                   completes the opaque definition as a reference to a dynamically
+                                allocated directed edge node.
+Vertex:                 completes the opaque definition as a reference to a dynamically
+                                allocated vertex node.
+
+VertexNode:             defines the information requirements for a single vertex of a
+                                graph.
+        data:           contains the label data item associated with a vertex.
+        next:           link to the next vertex in the set of vertices for a graph. The
+                                last vertex of the list has a 'next' of NullVertex indicating
+                                the end of the list.
+        prior:          link to the previous vertex in the set of vertices for a graph. The
+                                first vertex of the list has a 'prior' of NullVertex indicating
+                                the front of the list.
+        edges:          link to the first directed edge leaving this vertex. If the vertex
+                                has no edges leaving it, this field is set to the NullEdge.
+        degree:         is used in maintaining a count of the number of edges incident on this
+                                vertex as its destination excluding self-loops (which are edges
+                                whose first and second vertices are the same). This count
+                                is maintained by the constructors Link, Unlink and Assign. It
+                                is used to make the selector DegreeOf an O(1) algorithm instead
+                                of an O(Degree(v)) algorithm. The alternative technique for would be
+                                a complete traversal of all the edges associated with a vertex.
+        inGraph:        contains the reference to the enclosing graph object for the vertex.
+                                This avoids having the graph as a parameter to the vertex selectors.
+                                In addition, simplifying the membership test between a vertex and a
+                                graph, as well as the membership test for edges (through the
+                                initial or final vertex references of the edge).
+
+EdgeNode:               defines the information requirements for an undirected edge of a graph.
+        first:          contains a reference to the first vertex of the edge.
+        second:         contains a reference to the second vertex of the edge.
+        edgeRef1:       contains a reference to the directed edge (first, second) in the
+                                first vertexes edge list corresponding to this undirected edge.
+        edgeRef2:       contains a reference to the directed edge (second, first) in the
+                                second vertexes edge list corresponding to this undirected edge.
+        weight:         contains the attribute of the edge.
+        next:           contains the link to the next edge in the graph.
+                                The last edge of this list contains the NullRef as its value
+                                indicating the end of the list.
+        prior:          contains the link to the prior edge in the linked list of edges
+                                in the graph. The first edge of this list contains the NullRef as
+                                its value indicating the front of the list.
+
+EdgeRefNode:    defines the information requirements for a directed edge of a graph.
+                                There are two such nodes for every EdgeNode.
+        realEdge:       contains a reference to the actual undirected edge corresponding
+                                to this directed edge.
+        next:           contains a link to the next directed edge in a vertexes edge list.
+                                The last edge in an edge list contains a value of NullEdge indicating
+                                the end of the list.
+        prior:          contains a link to the previous directed edge in a vertexes edge list.
+                                The first edge in an edge list contains a value of NullEdge indicating
+                                the front of the list.
+
+UnboundedGraph: describes (and holds) attributes of the graph itself.
+        labelType,
+        attrType:       contain the data type ID for the vertex label and edge attribute,
+                                respectively. These two fields are used to retrieve the procedures
+                                accomplishing assignment and disposal of data items.
+        numVertices,
+        numEdges:       contain counts of the total number of vertices and edges in the
+                                graph, respectively. Thus, the selectors OrderOf and SizeOf are
+                                O(1) algorithms instead of O(|V|) or O(|E|).
+        firstVertex: reference to the first vertex in the adjacency list for a graph.
+        firstEdge:  reference to the first edge in the set of all edges for a graph.
+*)
+
+TYPE  EdgePtr = POINTER TO EdgeNode;
+TYPE  Edge    = POINTER TO EdgeRefNode;
+TYPE  Vertex  = POINTER TO VertexNode;
+
+CONST NullRef = NIL;
+
+TYPE  EdgeRefNode = RECORD
+                realEdge : EdgePtr;     (*--link to the actual edge node *)
+                prior    : Edge;        (*--prior edge in this edge list *)
+                next     : Edge;        (*--next edge in this edge list *)
+          END (*--EdgeRefNode *);
+
+TYPE  VertexNode = RECORD
+                inGraph : Graph;   (*--graph in which this vertex is a member *)
+                data    : Label;   (*--data item (label) for this vertex *)
+                degree  : CARDINAL;(*--degree of this vertex *)
+                prior   : Vertex;  (*--prior vertex in adjacency list *)
+                next    : Vertex;  (*--next vertex in adjacency list *)
+                edges   : Edge;    (*--link to first edge of this vertex *)
+          END (*--VertexNode *);
+
+TYPE  EdgeNode = RECORD
+                first   : Vertex;       (*--first vertex for this edge *)
+                second  : Vertex;       (*--second vertex for this edge *)
+                weight  : Attribute;(*--weight/attribute for this edge *)
+                edgeRef1: Edge;     (*--link to edge in 1st vertex edge list *)
+                edgeRef2: Edge;     (*--link to edge in 2nd vertex edge list *)
+                prior   : EdgePtr;      (*--prior edge in the set of all edges *)
+                next    : EdgePtr;      (*--next edge in the set of all edges *)
+          END (*--EdgeNode *);
+
+TYPE  UnboundedGraph = RECORD
+                labelType  : TypeID;    (*--vertex label data type ID *)
+                attrType   : TypeID;    (*--edge attribute data type ID *)
+                numVertices: CARDINAL;  (*--current number of vertices *)
+                numEdges   : CARDINAL;  (*--current number of edges *)
+                firstVertex: Vertex;    (*--first vertex in adjacency list *)
+                firstEdge  : EdgePtr;   (*--first edge in edge set *)
+          END (*--UnboundedGraph *);
+
+TYPE  Graph = POINTER TO UnboundedGraph;
+
+        (*-------------------------*)
+
+(*
+12.2.2  Exception Handling
+
+graphError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+graphError before any other processing. The handlers array holds the
+current exception handler for the possible exceptions that may be
+raised from within this module. Both are initialized by the module
+initialization (see û10.3.12).
+
+GraphError      simply returns the current exception result stored
+                        in graphError and is used to determine whether a graph
+                        operation completed successfully.
+SetHandler      makes theHandler the current exception handler for theError
+                        by storing theHandler in the handlers array.
+GetHandler      returns the current exception handler for theError from the
+                        handlers array.
+*)
+
+VAR   graphError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE GraphError () : Exceptions;
+BEGIN
+  RETURN graphError;
+END GraphError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                                                  theHandler : HandlerProc (*--in   *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                                                         : HandlerProc (*--out  *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*--in   *);
+                                                  theError   : Exceptions  (*--in   *));
+BEGIN
+  graphError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+(*
+12.2.3  Local Routines
+
+FreeAttribute is responsible for retrieval of the edge attribute item disposal
+routine and freeing the attribute when no longer needed. This occurs when
+        1. a graph is cleared or destroyed (Clear);
+        2. an edge is removed from a graph (Unlink);
+        3. a vertex is removed from a graph and any edges leaving it are implicitly
+           removed (ClearEdges); or
+        4. a new attribute is assigned to an edge (SetAttribute).
+Complexity: O(1).
+*)
+
+PROCEDURE FreeAttribute (    theEdge : EdgePtr (*--inout*));
+
+VAR   free : DisposeProc; (*-- attribute disposal routine, if any *)
+
+BEGIN
+  WITH theEdge^ DO
+        free := DisposeOf(first^.inGraph^.attrType);
+        free(weight);
+  END (*--with*);
+END FreeAttribute;
+(*-------------------------*)
+
+(*
+FreeLabel corresponds to FreeAttribute, above, for the clean-up of vertex labels
+when they are no longer needed. The conditions are similar to those above:
+        1. a graph is cleared or destroyed (Clear);
+        2. an vertex is removed from a graph (Remove); or
+        3. a new label is assigned to a vertex (SetLabel).
+Complexity: O(1).
+*)
+
+PROCEDURE FreeLabel (    theVertex : Vertex (*--inout*));
+
+VAR   free : DisposeProc; (*-- label disposal routine, if any *)
+
+BEGIN
+  WITH theVertex^ DO
+        free := DisposeOf(inGraph^.labelType);
+        free(data);
+  END (*--with*);
+END FreeLabel;
+(*-------------------------*)
+
+
+(*
+NewVertex allocates and constructs a new, empty, vertex node. The vertex field
+inGraph is set to the proper value (its enclosing graph object) while indegree,
+edges, and next are initialized to an empty state. The caller is responsible for
+adding the vertex to the adjacency list for the graph. The routine also automatically
+raises the overflow exception with the appropriate parameters, if necessary. As
+noted in Volume 1, the version of Allocate used here sets theVertex to NIL if the
+allocation fails. Thus, we ensure that theVertex returned is the NullVertex in
+case of a memory management failure. Complexity O(1).
+*)
+
+PROCEDURE NewVertex (    theGraph   : Graph      (*--in   *);
+                                                 theItem    : Label      (*--in   *);
+                                                 theRoutine : Operations (*--in   *))
+                                                                    : Vertex     (*--out  *);
+
+VAR   newVertex : Vertex;               (*-- newly created vertex *)
+
+BEGIN
+  Allocate(newVertex, SIZE(VertexNode));
+  IF (newVertex = NullVertex) THEN
+        RaiseErrIn(theRoutine, overflow);
+  ELSE
+        WITH newVertex^ DO
+          inGraph := theGraph;
+          data    := theItem;
+          degree  := 0;
+          edges   := NullEdge;
+          prior   := NullVertex;
+          next    := NullVertex;
+        END (*--with*);
+  END (*--if*);
+  RETURN newVertex;
+END NewVertex;
+(*-------------------------*)
+
+(*
+AddVertex adds theVertex to theGraph's set of all vertices. The vertex
+is placed at the front of the doubly-linked list used to represent this
+set. Complexity O(1)
+*)
+
+PROCEDURE AddVertex (    theGraph  : Graph  (*--inout*);
+                                             theVertex : Vertex (*--inout*));
+BEGIN
+  WITH theGraph^ DO
+        IF (firstVertex # NullVertex) THEN
+          firstVertex^.prior := theVertex;
+        END (*--if*);
+        theVertex^.next := firstVertex;
+        firstVertex := theVertex;
+        INC(numVertices);
+  END (*--with*);
+END AddVertex;
+(*-------------------------*)
+
+(*
+FreeVertex removes theVertex from theGraph's set of all vertices.
+This routine uses a standard doubly-linked list removal
+algorithm giving a constant time complexity of O(1).
+        pre:  theGraph # NIL, theVertex # NIL
+        post: theVertex = NIL, ~(OLD theVertex IN theGraph's set of vertices)
+*)
+
+PROCEDURE FreeVertex (    theGraph  : Graph  (*--inout*);
+                                          VAR theVertex : Vertex (*--inout*));
+BEGIN
+  WITH theVertex^ DO
+        IF (prior = NullVertex) THEN
+          theGraph^.firstVertex := next;
+        ELSE
+          prior^.next := next;
+        END (*--if*);
+        IF (next # NullVertex) THEN
+          next^.prior := prior;
+        END (*--if*);
+  END (*--with*);
+  DEC(theGraph^.numVertices);
+  FreeLabel(theVertex);
+  Deallocate(theVertex, SIZE(theVertex^));
+END FreeVertex;
+(*-------------------------*)
+
+
+(*
+NewEdge simply creates a new edge with the specified vertex endpoints and weight.
+The edge is not added to any edge list, leaving this to the caller. The overflow
+exception is automatically raised, if necessary, when a new edge node cannot be
+allocated. Complexity O(1).
+*)
+
+PROCEDURE NewEdge (    vertex1    : Vertex     (*--in   *);
+                                           vertex2    : Vertex     (*--in   *);
+                                           theWeight  : Attribute  (*--in   *);
+                                           theRoutine : Operations (*--in   *))
+                                                          : EdgePtr    (*--out  *);
+
+VAR       newEdgeRef : EdgePtr; (*--new edge being created *)
+
+BEGIN
+  Allocate(newEdgeRef, SIZE(EdgeNode));
+  IF (newEdgeRef = NullRef) THEN
+    RaiseErrIn(theRoutine, overflow);
+  ELSE
+        WITH newEdgeRef^ DO
+          first    := vertex1;
+          second   := vertex2;
+          weight   := theWeight;
+          edgeRef1 := NullEdge;
+          edgeRef2 := NullEdge;
+          next     := NullRef;
+          prior    := NullRef;
+        END (*--with*);
+  END (*--if*);
+  RETURN newEdgeRef;
+END NewEdge;
+(*-------------------------*)
+
+(*
+AddEdge adds theEdge to theGraph's set of all edges. The edge is placed
+at the front of the doubly-linked list used to represent this set. Complexity O(1)
+*)
+
+PROCEDURE AddEdge (    theGraph : Graph    (*--inout*);
+                                           theEdge  : EdgePtr  (*--inout*));
+BEGIN
+  WITH theGraph^ DO
+        IF (firstEdge # NullRef) THEN
+          firstEdge^.prior := theEdge;
+        END (*--if*);
+        theEdge^.next := firstEdge;
+        firstEdge := theEdge;
+        INC(numEdges);
+  END (*--with*);
+END AddEdge;
+(*-------------------------*)
+
+(*
+FreeEdge removes theEdge from theGraph's set of all edges.
+This routine uses a standard doubly-linked list removal
+algorithm giving a constant time complexity of O(1).
+*)
+
+PROCEDURE FreeEdge (    theGraph : Graph    (*--inout*);
+                                        VAR theEdge  : EdgePtr  (*--inout*));
+BEGIN
+  WITH theEdge^ DO
+        IF (prior = NullRef) THEN
+          theGraph^.firstEdge := next;
+        ELSE
+          prior^.next := next;
+        END (*--if*);
+        IF (next # NullRef) THEN
+          next^.prior := prior;
+        END (*--if*);
+  END (*--with*);
+  DEC(theGraph^.numEdges);
+  FreeAttribute(theEdge);
+  Deallocate(theEdge, SIZE(theEdge^));
+END FreeEdge;
+(*-------------------------*)
+
+
+(*
+NewRef constructs a new edge reference node. The node is linked to its
+associated EdgeNode while the links into a vertexes edge list are set to
+the empty state. Complexity O(1).
+*)
+
+PROCEDURE NewEdgeRef (    theEdgePtr : EdgePtr    (*--in   *);
+                                              theRoutine : Operations (*--in   *))
+                                                             : Edge           (*--out  *);
+
+VAR       newEdge : Edge; (*--new edge reference being created *)
+
+BEGIN
+  Allocate(newEdge, SIZE(EdgeRefNode));
+  IF (newEdge = NullEdge) THEN
+    RaiseErrIn(theRoutine, overflow);
+  ELSE
+        WITH newEdge^ DO
+          realEdge := theEdgePtr;
+          next     := NullEdge;
+          prior    := NullEdge;
+        END (*--with*);
+  END (*--if*);
+  RETURN newEdge;
+END NewEdgeRef;
+(*-------------------------*)
+
+(*
+AddEdgeRef adds theEdge to theVertex's set of edges incident on theVertex.
+The edge is placed at the front of the doubly-linked list used to
+represent this set. Complexity O(1)
+*)
+
+PROCEDURE AddEdgeRef (    theVertex : Vertex (*--inout*);
+                                                  theEdge   : Edge   (*--inout*));
+BEGIN
+  WITH theVertex^ DO
+        IF (edges # NullEdge) THEN
+          edges^.prior := theEdge;
+        END (*--if*);
+    theEdge^.next := edges;
+    edges := theEdge;
+        INC(degree);
+  END (*--with*);
+END AddEdgeRef;
+(*-------------------------*)
+
+(*
+FreeEdgeRef removes theEdge from theVertex's set of edges incident on
+theVertex. This routine uses a standard doubly-linked list removal
+algorithm giving a constant time complexity of O(1).
+*)
+
+PROCEDURE FreeEdgeRef (    theVertex : Vertex (*--inout*);
+                                           VAR theEdge   : Edge   (*--inout*));
+BEGIN
+  WITH theEdge^ DO
+        IF (prior = NullEdge) THEN
+          theVertex^.edges := next;
+        ELSE
+          prior^.next := next;
+        END (*--if*);
+        IF (next # NullEdge) THEN
+          next^.prior := prior;
+        END (*--if*);
+  END (*--with*);
+  DEC(theVertex^.degree);
+  Deallocate(theEdge, SIZE(theEdge^));
+END FreeEdgeRef;
+(*-------------------------*)
+
+(*
+ClearEdgeRefs removes all directed edge referencess from a given vertexes edge list.
+O(outdegree(v))
+*)
+
+PROCEDURE ClearEdgeRefs (VAR theVertex : Vertex    (*--inout*));
+
+VAR   theEdge : Edge; (*--edge reference being removed *)
+
+BEGIN
+  WITH theVertex^ DO
+        WHILE (edges # NIL) DO
+          theEdge := edges;
+          edges := edges^.next;
+          DEC(degree);
+          Deallocate(theEdge, SIZE(theEdge^));
+        END (*--while*);
+  END (*--with*);
+END ClearEdgeRefs;
+(*-------------------------*)
+
+(*
+12.2.4  Graph Constructors
+
+Create attempts to form a new, empty graph object with the given vertex
+label and edge label data types. First, the graph descriptor is allocated and the vertex
+and edge data type IDs are stored there. The number of vertices and edges are
+initialized to zero. The pointer to the head of the adjacency list (firstVertex)
+is initialized to the empty state (NIL). If the descriptor allocation
+fails the overflow exception is raised and the NullGraph is returned,
+otherwise we return the newly allocated graph. Complexity O(1).
+*)
+
+PROCEDURE Create   (    labels     : TypeID    (*--in   *);
+                                            attributes : TypeID    (*--in   *))
+                                                                   : Graph     (*--out  *);
+
+VAR   newGraph : Graph; (*--temporary for new graph object *)
+
+BEGIN
+  graphError := noerr;
+  Allocate(newGraph, SIZE(UnboundedGraph));
+  IF (newGraph = NullGraph) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newGraph^ DO
+          labelType   := labels;
+          attrType    := attributes;
+          numVertices := 0;
+          numEdges    := 0;
+          firstVertex := NullVertex;
+          firstEdge   := NullRef;
+        END (*--with*);
+  END (*--if*);
+  RETURN newGraph;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy clears theGraph and then deallocates it making theGraph undefined.
+SCLStorage.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullGraph). Complexity O(|V|+|E|).
+*)
+
+PROCEDURE Destroy (VAR theGraph      : Graph     (*--inout *));
+BEGIN
+  Clear(theGraph);
+  IF (graphError = noerr) THEN
+    Deallocate(theGraph, SIZE(theGraph^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear removes all vertices and edges from theGraph making theGraph empty.
+We do this by iterating over each of the vertices and clearing all edges
+leaving the vertex (ClearEdges). As a final step we ensure that the graph is left in the
+empty state by resetting the head of the adjacency list to NIL and the number
+of vertices and edges in the graph to zero. Complexity O(|V|+|E|).
+*)
+
+PROCEDURE Clear   (VAR theGraph      : Graph    (*--inout *));
+
+  PROCEDURE ClearEdges (VAR theGraph : Graph    (*--inout *));
+
+  VAR   theEdge : EdgePtr; (*--edge to be removed *)
+
+  BEGIN
+    WITH theGraph^ DO
+          WHILE (firstEdge # NullRef) DO
+            theEdge := firstEdge;
+            firstEdge := firstEdge^.next;
+            DEC(numEdges);
+            FreeAttribute(theEdge);
+            Deallocate(theEdge, SIZE(theEdge^));
+          END (*--while*);
+    END (*--with*);
+  END ClearEdges;
+  (*-------------------------*)
+
+VAR   theVertex : Vertex;          (*--loop index over vertices *)
+VAR   oldVertex : Vertex;          (*--vertex to deallocate *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+        ClearEdges(theGraph);
+    WITH theGraph^ DO
+          theVertex := firstVertex;
+          WHILE (theVertex # NullVertex) DO
+            ClearEdgeRefs(theVertex);
+                FreeLabel(theVertex);
+                oldVertex := theVertex;
+                theVertex := theVertex^.next;
+                Deallocate(oldVertex, SIZE(oldVertex^));
+          END (*--while*);
+          firstVertex := NullVertex;
+          numVertices := 0;
+        END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign copies the source graph, theGraph, to the target graph, toGraph. The
+main body of Assign does this by first copying all the vertices followed by
+copying all the edges from the source to the destination graph.
+The algorithmic complexity is O(|V|^2+|E|) due to the mapping between the vertices
+of the source and target graphs while copying the edges (see the discussion
+of the vertexMap following RecreateTarget).
+*)
+
+PROCEDURE Assign  (    theGraph      : Graph     (*--in   *);
+                                   VAR toGraph       : Graph     (*--inout *));
+
+(*
+RecreateTarget reconstructs the target graph descriptor so that the fields
+defining the vertex label and edge attribute data types, and (optionally)
+maximum number of vertices between the source and destination graphs are the
+same. If the source and destination graphs are the same the routine returns
+FALSE indicating that the postconditions for the assignment operation are
+already met. The routine returns TRUE if the recreation of the target was
+successful. Complexity O(v+e) where v and e are the number of vertices and
+edges, respectively, in the original toGraph.  When Clearing the target graph
+is unnecessary (the toGraph is initially the NullGraph) the complexity falls
+to O(1).
+*)
+
+  PROCEDURE RecreateTarget (): BOOLEAN (*--out  *);
+  BEGIN
+        IF (theGraph = NullGraph) THEN
+      RaiseErrIn(assign, undefined);
+
+        ELSIF (toGraph = NullGraph) THEN
+      WITH theGraph^ DO
+        toGraph := Create(labelType, attrType);
+          END (*--with*);
+
+        ELSIF (theGraph = toGraph) THEN
+      RETURN FALSE;
+
+        ELSE
+          Clear(toGraph);
+      WITH theGraph^ DO
+                toGraph^.labelType := labelType;
+                toGraph^.attrType  := attrType;
+          END (*--with*);
+        END (*--if*);
+        RETURN (graphError = noerr);
+  END RecreateTarget;
+
+(*
+One thorny issue in graph assignment is how to set-up the copied edges with the
+proper initial and final vertices? The edges of the source graph contain references
+to the source graph's vertices, not those of the target graph. The vertex
+labels cannot be used since more than one vertex can have the same label. In
+this case, an edge from the second (or greater) such vertex in the target graph
+would be linked incorrectly to the first vertex having that label. The solution
+is in having some form of temporary mapping from the source graph's vertices to
+their counterpart in the target graph. The necessary operations are add a mapping
+between a vertex from the source graph and its corresponding vertex in the
+target graph, and given a source graph vertex return the target graph vertex
+mapped to that source vertex.
+
+The data structure implementing our vertex mapping is an unordered array of mapping
+entries, one per vertex, between the vertices of the source graph and the
+target graph. This array is dynamically created on the heap based on the
+number of vertices in the source graph. (The ARRAY [0..0] OF ≡ construct is
+a special feature of the TML Modula-2 compiler allowing dynamic arrays.) The
+variable mapExtent controls where MapVertex entries are inserted into the
+array. A post-increment scheme is used so mapVertex is always one greater than
+the number of entries stored in the array.
+*)
+
+  TYPE  MapVertex = RECORD
+              old : Vertex; (*-- vertex from source graph *)
+              new : Vertex; (*-- corresponging vertex in target graph *)
+            END (*--MapVertex*);
+  TYPE  MapVertices = ARRAY [0..0] OF MapVertex;
+
+  VAR   vertexMap : POINTER TO MapVertices;
+  VAR   mapExtent : CARDINAL;
+
+
+(*
+CreateVertexMap allocates a dynamic array of vertex mapping entries on the
+heap based on the number of vertices in the source graph. vertexMap is set to
+NIL by Allocate if there isn't enough memory available to meet the request.
+*)
+
+  PROCEDURE CreateVertexMap;
+  BEGIN
+        Allocate(vertexMap,
+                         VAL(CARDINAL, SIZE(MapVertex)) * theGraph^.numVertices);
+        mapExtent := 0;
+  END CreateVertexMap;
+
+(*
+AddVertexToMap adds a mapping between the vertices of the source and target graphs.
+*)
+
+  PROCEDURE AddToVertexMap (    oldVertex : Vertex (*--in   *);
+                                                                newVertex : Vertex (*--in   *));
+  BEGIN
+        WITH vertexMap^[mapExtent] DO
+          old := oldVertex;
+          new := newVertex;
+        END (*--with*);
+    INC(mapExtent);
+  END AddToVertexMap;
+
+(*
+VertexInMap returns the mapping between the vertices of the source and target
+graphs. Since every vertex is represented failure to find a mapping is
+indicative of either a programming error in CopyVertices or a hardware/system
+software error at runtime.
+*)
+
+  PROCEDURE VertexInMap (    oldVertex : Vertex (*--in   *))
+                                                                           : Vertex (*--out  *);
+
+  VAR   index : CARDINAL; (*-- loop index over mapping entries *)
+
+  BEGIN
+    FOR index := 0 TO mapExtent-1 DO
+          WITH vertexMap^[index] DO
+        IF (oldVertex = old) THEN
+                  RETURN new;
+                END (*--if*);
+          END (*--with*);
+    END (*--for*);
+        RETURN NullVertex;
+  END VertexInMap;
+
+(*
+DestroyVertexMap frees up the memory used by the vertexMap when the Assign
+operation is complete. Remember that Deallocate automatically
+releases the proper amount of space.
+*)
+
+  PROCEDURE DestroyVertexMap;
+  BEGIN
+        Deallocate(vertexMap, SIZE(vertexMap^));
+  END DestroyVertexMap;
+
+
+(*
+CopyVertices duplicates the vertices from the source graph to the destination
+graph returning TRUE if every vertex was successfully copied and FALSE otherwise.
+This BOOLEAN result is used by the main body of Assign to control whether the
+graph assignment operation continues by copying the edges. The following local
+variables are used:
+        1. v:                   indicates the current vertex being copied from the source
+                                        graph. This is also used as a 'loop index' over the vertices
+                                        of the source graph.
+        2. newVertex:   temporary for a new vertex for the destination graph.
+        3. lastVertex:  last vertex inserted into the destination graph. This is
+                                        used by TailInsert to add a new vertex to the end of the
+                                        destination graph's adjacency list.
+        4. assignItem:  vertex label assignment routine.
+
+Assignment of the vertex label presents an interesting situation. When a vertex
+is added to a graph, the client module expects the given label to be copied using
+the Modula-2 assignment statement (even for dynamically allocated data items)
+since we simply need to store the value in the vertex object. This is known as
+'structural sharing'. But when a graph is duplicated using Assign, new copies
+of the vertex labels are necessary - avoiding the problems presented by structural
+sharing of dynamically allocated items as described in Volume 1. CopyVertices
+resolves this through the assignment procedure associated with the graph's label
+data type duplicating the label as a NewVertex is created. Complexity O(v) where
+v is the number of vertices in the source graph.
+*)
+
+  PROCEDURE CopyVertices () : BOOLEAN;
+
+  VAR   v : Vertex;     (*--loop index over vertices being copied *)
+  VAR   newVertex : Vertex; (*--new vertex in target graph *)
+  VAR   lastVertex: Vertex; (*--last vertex added to list of vertices *)
+  VAR   assignItem: AssignProc;
+
+(*
+TailInsert adds newVertex to the end of the target graph's adjacency list
+given pointers to the first and last elements of the list. Complexity O(1).
+*)
+
+    PROCEDURE TailInsert (VAR first : Vertex (*--inout *);
+                                                  VAR last  : Vertex (*--inout *));
+    BEGIN
+      IF (first = NullVertex) THEN
+            first := newVertex;
+          ELSE
+            last^.next := newVertex;
+          END (*--if*);
+          last := newVertex;
+    END TailInsert;
+
+  BEGIN
+        CreateVertexMap;
+        IF (vertexMap = NIL) THEN
+          RETURN FALSE;
+        END (*--if*);
+
+        assignItem := AssignOf(theGraph^.labelType);
+        v := theGraph^.firstVertex;
+        lastVertex := NullVertex;
+
+    WHILE (v # NullVertex) DO
+          newVertex := NewVertex(toGraph, assignItem(v^.data), assign);
+          IF (newVertex = NullVertex) THEN
+            DestroyVertexMap;
+                RETURN FALSE;
+          END (*--if*);
+
+          TailInsert(toGraph^.firstVertex, lastVertex);
+          INC(toGraph^.numVertices);
+          AddToVertexMap(v, newVertex);
+
+          v := v^.next;
+        END (*--while*);
+
+        RETURN TRUE;
+  END CopyVertices;
+
+  PROCEDURE CopyEdges;
+
+  VAR   theEdge   : EdgePtr; (*--loop index over edges in source graph *)
+  VAR   newEdge   : EdgePtr; (*--new edge for target graph *)
+  VAR   lastEdge  : EdgePtr; (*--last edge inserted into new list of edges *)
+  VAR   epRef1    : Edge;
+  VAR   epRef2    : Edge;
+  VAR   assignItem: AssignProc; (*--attribute assignment procedure *)
+  VAR   vertex1   : Vertex; (*--first vertex of theEdge in target graph *)
+  VAR   vertex2   : Vertex; (*--second vertex of theEdge in target graph *)
+
+  BEGIN
+        assignItem := AssignOf(theGraph^.attrType);
+        theEdge    := theGraph^.firstEdge;
+        lastEdge   := NullRef;
+        WHILE (theEdge # NullRef) DO
+          vertex1 := VertexInMap(theEdge^.first);
+          vertex2 := VertexInMap(theEdge^.second);
+          newEdge := NewEdge(vertex1,
+                                                 vertex2,
+                                                 assignItem(theEdge^.weight),
+                                                 assign);
+          IF (newEdge = NullRef) THEN
+                RETURN;
+          END (*--if*);
+          epRef1 := NewEdgeRef(newEdge, assign);
+          IF (epRef1 = NullEdge) THEN
+            Deallocate(newEdge, SIZE(newEdge^));
+            RETURN;
+          END (*--if*);
+          newEdge^.edgeRef1 := epRef1;
+
+          IF (vertex1 # vertex2) THEN
+            epRef2 := NewEdgeRef(newEdge, assign);
+            IF (epRef2 = NullEdge) THEN
+              Deallocate(newEdge, SIZE(newEdge^));
+              Deallocate(epRef1, SIZE(epRef1^));
+              RETURN;
+            END (*--if*);
+            newEdge^.edgeRef2 := epRef2;
+            AddEdgeRef(vertex2, epRef2);
+      END (*--if*);
+
+          AddEdgeRef(vertex1, epRef1);
+          AddEdge(toGraph, newEdge);
+
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END CopyEdges;
+
+BEGIN (*--Assign --*)
+  graphError := noerr;
+  IF RecreateTarget() & CopyVertices() THEN
+    CopyEdges;
+        DestroyVertexMap;
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+12.2.5  Vertex Constructors
+
+Insert adds a vertex to the given graph labeling the vertex with the given item.
+The first step is to allocate a new vertex node which, if successful,
+is followed by adding the vertex at the head of the adjacency list. If we cannot
+create a new vertex node the overflow exception is raised and the Insert operation
+aborted. Complexity O(1).
+*)
+
+PROCEDURE Insert   (VAR theGraph   : Graph     (*--inout *);
+                                        theItem    : Label     (*--in    *);
+                                        VAR theVertex  : Vertex    (*--out   *));
+BEGIN
+  graphError := noerr;
+  theVertex  := NullVertex;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(insert, undefined);
+  ELSE
+    theVertex := NewVertex(theGraph, theItem, insert);
+        IF (theVertex # NullVertex) THEN
+      AddVertex(theGraph, theVertex);
+    END (*--if*);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+(*
+Remove deletes the given vertex from the specified graph. If no such vertex
+can be found in the graph the novertex exception is raised and the routine
+aborted. After we have checked that no exceptions can occur we remove
+all edges incident on the vertex, remove the vertex from the adjacency list,
+release any dynamically allocated memory used by the vertex label, release the
+vertex itself, and update the count of vertices in the graph. Complexity
+O(degree(v)).
+*)
+
+PROCEDURE Remove   (VAR theGraph   : Graph     (*--inout*);
+                                    VAR theVertex  : Vertex    (*--inout*));
+
+(*
+Given a vertex and an edge reference, OtherVertex returns the other
+member of the unordered pair of vertices associated with the edge.
+For example, given the vertex v and the undirected edge {v, w}
+OtherVertex returns the vertex w. Complexity O(1)
+*)
+
+  PROCEDURE OtherVertex (    theVertex : Vertex (*--in   *);
+                                                     theEdge   : Edge   (*--in   *))
+                                                                           : Vertex (*--out  *);
+  BEGIN
+    WITH theEdge^.realEdge^ DO
+          IF (first = theVertex) THEN
+            RETURN second;
+          ELSE
+            RETURN first;
+          END (*--if*);
+    END (*--with*);
+  END OtherVertex;
+
+(*
+Given a directed edge reference, OtherEdge returns the
+other directed edge used in representing an undirected edge.
+Complexity O(1).
+*)
+
+  PROCEDURE OtherEdge (    theEdge : Edge (*--in   *))
+                                                                   : Edge (*--out  *);
+  BEGIN
+    WITH theEdge^.realEdge^ DO
+          IF (edgeRef1 = theEdge) THEN
+            RETURN edgeRef2;
+          ELSE
+            RETURN edgeRef1;
+          END (*--if*);
+    END (*--with*);
+  END OtherEdge;
+
+VAR   anEdge  : Edge;   (*--loop index over edges *)
+VAR   vertex2 : Vertex; (*--other endpoint in anEdge *)
+VAR   edge2   : Edge;   (*--edge in vertex2's edge list *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(remove, undefined);
+
+  ELSIF (theVertex = NullVertex) THEN
+    RaiseErrIn(remove, nullvertex);
+
+  ELSIF (theVertex^.inGraph # theGraph) THEN
+    RaiseErrIn(remove, novertex);
+
+  ELSE
+    anEdge := theVertex^.edges;
+        WHILE (anEdge # NullEdge) DO
+          vertex2 := OtherVertex(theVertex, anEdge);
+          edge2   := OtherEdge(anEdge);
+          FreeEdgeRef(vertex2, edge2);
+          FreeEdge(theGraph, anEdge^.realEdge);
+          anEdge := anEdge^.next;
+        END (*--while*);
+        ClearEdgeRefs(theVertex);
+        FreeVertex(theGraph, theVertex);
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+(*
+SetLabel assigns a new label to the given vertex of the graph. Prior to
+assigning a new vertex label we must release any dynamically allocated memory
+used by the old vertex label. Complexity O(1).
+*)
+
+PROCEDURE SetLabel (    theVertex  : Vertex    (*--inout*);
+                                            theItem    : Label     (*--in   *));
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(setlabel, nullvertex);
+  ELSE
+        FreeLabel(theVertex);
+    theVertex^.data := theItem;
+  END (*--if*);
+END SetLabel;
+(*-------------------------*)
+
+(*
+12.2.6  Edge Constructors
+
+Link adds an undirected edge between the from and to vertices labelling the
+edge with the given weight attribute. The first step creates a new edge. Secondly,
+new references for each vertices edge list are created (only one edge reference
+is created when endpoint1 = endpoint2). Lastly, the new edge references and the
+edge itself are added to their respective lists. If the memory allocation for
+any of the nodes fails, allocations performed prior to the one that failed are
+deallocated preventing needless clutter. Complexity O(1).
+*)
+
+PROCEDURE Link         (VAR theGraph   : Graph     (*--inout*);
+                                            endpoint1  : Vertex    (*--in   *);
+                                            endpoint2  : Vertex    (*--in   *);
+                                            theWeight  : Attribute (*--in   *);
+                                            VAR theEdge    : Edge      (*--out  *));
+
+VAR   newEdgePtr : EdgePtr;
+VAR   newEdge    : Edge;    (*-- edge ref for {ep2, ep1} *)
+
+BEGIN
+  graphError := noerr;
+  theEdge    := NullEdge;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(link, undefined);
+  ELSIF (endpoint1 = NullVertex) OR (endpoint2 = NullVertex) THEN
+    RaiseErrIn(link, nullvertex);
+  ELSIF (endpoint1^.inGraph # theGraph) OR
+                (endpoint2^.inGraph # theGraph) THEN
+    RaiseErrIn(link, novertex);
+  ELSE
+
+    newEdgePtr := NewEdge(endpoint1, endpoint2, theWeight, link);
+        IF (newEdgePtr = NullRef) THEN
+          RETURN;
+        END (*--if*);
+
+        theEdge := NewEdgeRef(newEdgePtr, link);
+        IF (theEdge = NullEdge) THEN
+          Deallocate(newEdgePtr, SIZE(newEdgePtr^));
+          RETURN;
+        END (*--if*);
+        newEdgePtr^.edgeRef1 := theEdge;
+
+        IF (endpoint1 # endpoint2) THEN
+          newEdge := NewEdgeRef(newEdgePtr, link);
+          IF (newEdge = NullEdge) THEN
+            Deallocate(newEdgePtr, SIZE(newEdgePtr^));
+            Deallocate(theEdge, SIZE(theEdge^));
+            RETURN;
+          END (*--if*);
+          newEdgePtr^.edgeRef2 := newEdge;
+          AddEdgeRef(endpoint2, newEdge);
+    END (*--if*);
+
+        AddEdge(theGraph, newEdgePtr);
+        AddEdgeRef(endpoint1, theEdge);
+  END (*--if*);
+END Link;
+(*-------------------------*)
+
+(*
+Unlink removes an undirected edge between the two vertices, fromVertex and
+toVertex. Complexity O(d) where d is the degree of the from vertex.
+*)
+
+PROCEDURE Unlink       (VAR theGraph   : Graph     (*--inout*);
+                                        VAR theEdge    : Edge      (*--inout*));
+
+VAR   theRealEdge  : EdgePtr;
+
+BEGIN
+  graphError := noerr;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(unlink, undefined);
+
+  ELSIF (theEdge = NullEdge) THEN
+        RaiseErrIn(unlink, nulledge);
+
+  ELSIF (theEdge^.realEdge^.first = NullVertex) THEN
+    RaiseErrIn(unlink, nullvertex);
+
+  ELSIF (theEdge^.realEdge^.first^.inGraph # theGraph) THEN
+    RaiseErrIn(unlink, noedge);
+
+  ELSE
+        theRealEdge := theEdge^.realEdge;
+    WITH theRealEdge^ DO
+          FreeEdgeRef(first, edgeRef1);
+          IF (edgeRef2 # NullEdge) THEN
+            FreeEdgeRef(second, edgeRef2);
+          END (*--if*);
+        END (*--with*);
+        FreeEdge(theGraph, theRealEdge);
+        theEdge := NullEdge;
+  END (*--if*);
+END Unlink;
+(*-------------------------*)
+
+(*
+SetAttribute assigns a new edge labeling to the given edge. Prior to assigning
+a new edge attribute we must release any dynamically allocated memory
+used by the old edge attribute. Complexity O(1).
+*)
+
+PROCEDURE SetAttribute (    theEdge    : Edge      (*--inout*);
+                                            theWeight  : Attribute (*--in   *));
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+        RaiseErrIn(setattr, nulledge);
+  ELSE
+    WITH theEdge^ DO
+      FreeAttribute(realEdge);
+      realEdge^.weight := theWeight;
+    END (*--with*);
+  END (*--if*);
+END SetAttribute;
+(*-------------------------*)
+
+(*
+12.2.7  Graph Selectors
+
+IsDefined verifies to the best of its ability whether theGraph has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theGraph  : Graph       (*--in   *))
+                                                                   : BOOLEAN     (*--out  *);
+BEGIN
+  RETURN (theGraph # NullGraph);
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theGraph is in the empty state, as indicated by
+the number of vertices being zero, and False otherwise.  As per the
+specification (û9.3) undefined graphs are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theGraph  : Graph       (*--in   *))
+                                                                   : BOOLEAN     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isempty, undefined);
+        RETURN TRUE;
+  END (*--if*);
+  RETURN theGraph^.numVertices = 0;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+TypeOf simply returns the vertex label and edge attribute data type IDs for
+the given graph. Undefined graphs, as always, raise the undefined exception
+and return a reasonable value, in this case the NullType. Complexity O(1).
+*)
+
+PROCEDURE TypeOf    (    theGraph  : Graph       (*--in   *);
+                                         VAR labelType : TypeID      (*--out  *);
+                                         VAR attrType  : TypeID      (*--out  *));
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(typeof, undefined);
+        labelType := NullType;
+        attrType  := NullType;
+  ELSE
+        labelType := theGraph^.labelType;
+        attrType  := theGraph^.attrType;
+  END (*--if*);
+END TypeOf;
+(*-------------------------*)
+
+(*
+OrderOf returns the number of vertices in the graph, or zero for an undefined
+graph. Complexity O(1).
+*)
+
+PROCEDURE OrderOf   (    theGraph  : Graph       (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(orderof, undefined);
+        RETURN 0;
+  END (*--if*);
+  RETURN theGraph^.numVertices;
+END OrderOf;
+(*-------------------------*)
+
+(*
+SizeOf returns the number of edges in the graph, or zero for an undefined
+graph. Complexity O(1).
+*)
+
+PROCEDURE SizeOf    (    theGraph  : Graph       (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(sizeof, undefined);
+        RETURN 0;
+  END (*--if*);
+  RETURN theGraph^.numEdges;
+END SizeOf;
+(*-------------------------*)
+
+(*
+12.2.8  Vertex Selectors
+
+DegreeOf returns the number of edges incident on the given vertex.
+We do this by simply returning the value maintained by Link and Unlink.
+Complexity O(1).
+*)
+
+PROCEDURE DegreeOf  (    theVertex : Vertex      (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF  (theVertex = NullVertex) THEN
+    RaiseErrIn(degreeof, nullvertex);
+    RETURN 0;
+  END (*--if*);
+  RETURN theVertex^.degree;
+END DegreeOf;
+(*-------------------------*)
+
+(*
+LabelOf returns the vertex label associated with the given vertex.
+If the vertex is undefined the NullItem is returned. Complexity O(1).
+*)
+
+PROCEDURE LabelOf   (    theVertex : Vertex      (*--in   *))
+                                                                   : Label       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(labelof, nullvertex);
+  ELSE
+    RETURN theVertex^.data;
+  END (*--if*);
+  RETURN NullItem;
+END LabelOf;
+(*-------------------------*)
+
+(*
+Since we have stored a copy of the graph object associated with each vertex
+as a field of the vertex itself, IsVertex simply needs to compare the given
+graph with its own local state. This saves us from having to search the graph.
+Complexity O(1).
+*)
+
+PROCEDURE IsVertex  (    theGraph  : Graph       (*--in   *);
+                                             theVertex : Vertex      (*--in   *))
+                                                           : BOOLEAN     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isvertex, undefined);
+  ELSIF (theVertex = NullVertex) THEN
+    RaiseErrIn(isvertex, nullvertex);
+  ELSE
+    RETURN theVertex^.inGraph = theGraph;
+  END (*--if*);
+  RETURN FALSE;
+END IsVertex;
+(*-------------------------*)
+
+(*
+GraphOf simply returns its copy of the enclosing graph or the NullGraph if the
+vertex is undefined. Complexity O(1).
+*)
+
+PROCEDURE GraphOf   (    theVertex : Vertex      (*--in   *))
+                                                                   : Graph       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(graphof, nullvertex);
+    RETURN NullGraph;
+  END (*--if*);
+  RETURN theVertex^.inGraph;
+END GraphOf;
+(*-------------------------*)
+
+(*
+12.2.9  Edge Selectors
+
+AttributeOf returns the edge attribute associated with the given edge.
+If the edge is undefined the NullItem is returned. Complexity O(1).
+*)
+
+PROCEDURE AttributeOf (    theEdge   : Edge        (*--in   *))
+                                                                 : Attribute   (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(attrof, nulledge);
+  ELSE
+    RETURN theEdge^.realEdge^.weight;
+  END (*--if*);
+  RETURN NullItem;
+END AttributeOf;
+(*-------------------------*)
+
+(*
+Given an edge, FirstOf returns the  first vertex in the set of vertices
+associated with the given edge or the NullVertex if the edge is undefined.
+Complexity O(1).
+*)
+
+PROCEDURE FirstOf        (    theEdge   : Edge       (*--in  *))
+                                                                : Vertex     (*--out *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(firstof, nulledge);
+  ELSE
+    RETURN theEdge^.realEdge^.first;
+  END (*--if*);
+  RETURN NullVertex;
+END FirstOf;
+(*-------------------------*)
+
+(*
+Given an edge, SecondOf returns the second vertex in the set of vertices
+associated with the given edge or the NullVertex if the edge is undefined.
+Complexity O(1).
+*)
+
+PROCEDURE SecondOf   (    theEdge   : Edge       (*--in  *))
+                                                                : Vertex     (*--out *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(secondof, nulledge);
+  ELSE
+    RETURN theEdge^.realEdge^.second;
+  END (*--if*);
+  RETURN NullVertex;
+END SecondOf;
+(*-------------------------*)
+
+(*
+IncidentOn is simply a combination of FirstOf and SecondOf.
+Complexity O(1).
+*)
+
+PROCEDURE IncidentOn  (    theEdge   : Edge       (*--in   *);
+                                           VAR endpoint1 : Vertex         (*--out  *);
+                                           VAR endpoint2 : Vertex         (*--out  *));
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(incidenton, nulledge);
+    endpoint1 := NullVertex;
+    endpoint2 := NullVertex;
+  ELSE
+    WITH theEdge^.realEdge^ DO
+      endpoint1 := first;
+      endpoint2 := second;
+    END (*--with*);
+  END (*--if*);
+END IncidentOn;
+(*-------------------------*)
+
+(*
+IsEdge returns true if there the given directed edge is an edge of the given
+graph and false otherwise. An advantage of having each vertex identify its
+enclosing graph object is use of this field in testing whether the edge is
+part of a specified graph. This saves use from having to search every edge in
+the graph. Complexity O(1).
+*)
+
+PROCEDURE IsEdge     (    theGraph  : Graph      (*--in *);
+                                              theEdge   : Edge       (*--in *))
+                                                            : BOOLEAN    (*--out *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isedge, undefined);
+  ELSIF (theEdge = NullEdge) THEN
+    RaiseErrIn(isedge, nulledge);
+  ELSIF (theEdge^.realEdge^.first = NullVertex) THEN
+    RaiseErrIn(isedge, nullvertex);
+  ELSE
+    RETURN theEdge^.realEdge^.first^.inGraph = theGraph;
+  END (*--if*);
+  RETURN FALSE;
+END IsEdge;
+(*-------------------------*)
+
+(*
+12.2.10 Passive Iterators
+
+LoopVertices simply iterates over the vertices of the given graph until every
+vertex has been examined or the process procedure parameter returns FALSE,
+whichever occurs first. Complexity O(|V|).
+*)
+
+PROCEDURE LoopVertices (    theGraph  : Graph          (*--in   *);
+                                                        process   : VertexLoopProc (*--in   *));
+
+VAR   theVertex : Vertex; (*--loop index over vertices *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(loopvertices, undefined);
+  ELSE
+        theVertex := theGraph^.firstVertex;
+        WHILE (theVertex # NullVertex) & process(theVertex) DO
+          theVertex := theVertex^.next;
+        END (*--while*);
+  END (*--if*);
+END LoopVertices;
+(*-------------------------*)
+
+(*
+LoopEdges loops over the vertices of the given graph to access the edges associated
+with each vertex. Once the process procedure parameter returns FALSE, we exit
+both WHILE statements through the use of a RETURN which exits the procedure.
+Complexity O(|E|).
+*)
+
+PROCEDURE LoopEdges    (    theGraph  : Graph          (*--in   *);
+                                                        process   : EdgeLoopProc   (*--in   *));
+
+VAR   theEdge : EdgePtr; (*--loop index over edges of a graph *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(loopedges, undefined);
+  ELSE
+        theEdge := theGraph^.firstEdge;
+        WHILE (theEdge # NullRef) & process(theEdge^.edgeRef1) DO
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END LoopEdges;
+(*-------------------------*)
+
+(*
+LoopIterate simply loops over the edges leaving a specified vertex. Complexity
+O(degree(v)).
+*)
+
+PROCEDURE LoopIterate  (    theVertex : Vertex         (*--in   *);
+                                                        process   : EdgeLoopProc   (*--in   *));
+
+VAR   theEdge : Edge;   (*--loop index over edges of the vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(loopiterate, nullvertex);
+  ELSE
+        theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) & process(theEdge) DO
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END LoopIterate;
+(*-------------------------*)
+
+(*
+TravVertices simply iterates over every vertex in the graph. Complexity O(|V|).
+*)
+
+PROCEDURE TravVertices (    theGraph  : Graph      (*--in   *);
+                                                        process   : VertexProc (*--in   *));
+
+VAR   theVertex : Vertex; (*--loop index over vertices *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(travvertices, undefined);
+  ELSE
+        theVertex := theGraph^.firstVertex;
+        WHILE (theVertex # NullVertex) DO
+          process(theVertex);
+          theVertex := theVertex^.next;
+        END (*--while*);
+  END (*--if*);
+END TravVertices;
+(*-------------------------*)
+
+(*
+TravEdges simply iterates over every edge in the graph using the
+set of all edges. Complexity O(|E|).
+*)
+
+PROCEDURE TravEdges    (    theGraph  : Graph      (*--in   *);
+                                                        process   : EdgeProc   (*--in   *));
+
+VAR   theEdge : EdgePtr;   (*--loop index over edges *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(travedges, undefined);
+  ELSE
+        theEdge := theGraph^.firstEdge;
+        WHILE (theEdge # NullRef) DO
+          process(theEdge^.edgeRef1);
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END TravEdges;
+(*-------------------------*)
+
+PROCEDURE Iterate      (    theVertex : Vertex     (*--in   *);
+                                                        process   : EdgeProc   (*--in   *));
+
+VAR   theEdge : Edge; (*--loop index over edges of the vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(iterate, nullvertex);
+  ELSE
+        theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) DO
+          process(theEdge);
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END Iterate;
+(*-------------------------*)
+
+(*
+12.2.11 Active Iterators
+
+Each of the active iterators are essentially selectors for the underlying
+representation of the adjacency list. Their complexity is O(1).
+*)
+
+PROCEDURE FirstVertex  (    theGraph  : Graph      (*--in   *))
+                                                                          : Vertex     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(firstvertex, undefined);
+  ELSE
+        RETURN theGraph^.firstVertex;
+  END (*--if*);
+  RETURN NullVertex;
+END FirstVertex;
+(*-------------------------*)
+
+PROCEDURE NextVertex   (    theVertex : Vertex     (*--in   *))
+                                                                          : Vertex     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(nextvertex, nullvertex);
+  ELSE
+        RETURN theVertex^.next;
+  END (*--if*);
+  RETURN NullVertex;
+END NextVertex;
+(*-------------------------*)
+
+PROCEDURE FirstEdge    (    theVertex : Vertex     (*--in   *))
+                                                                          : Edge       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(firstedge, nullvertex);
+  ELSE
+    RETURN theVertex^.edges;
+  END (*--if*);
+  RETURN NullEdge;
+END FirstEdge;
+(*-------------------------*)
+
+PROCEDURE NextEdge     (    theEdge   : Edge       (*--in   *))
+                                                                          : Edge       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(nextedge, nulledge);
+  ELSE
+    RETURN theEdge^.next;
+  END (*--if*);
+  RETURN NullEdge;
+END NextEdge;
+(*-------------------------*)
+
+(*
+12.2.12 Module Initialization
+
+The module's local variables are initialized to known states. graphError is
+used to fill the handler array with a routine that does nothing when an exception
+is raised (saving the declaration of a special loop control variable for this
+purpose). Applying MIN and MAX to cover all exceptions ensures that this
+initialization will be unaffected by any future changes to the number of
+Exceptions or their order of declaration within the enumeration. Since a FOR
+loop control variable is undefined following the loop, graphError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR graphError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(graphError, NullHandler);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  graphError := noerr;
+        NullGraph := NIL;
+        NullVertex := NIL;
+        NullEdge := NIL;
+END GrafSUMI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRAFSUUI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRAFSUUI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRAFSUUI.MOD
@@ -0,0 +1,1091 @@
+IMPLEMENTATION MODULE GrafSUUI;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: 6568 bytes
+    Component: Graph - Sequential Unbounded Unmanaged Iterator
+
+    REVISION HISTORY
+    v1.00  27 Jan 1989  C. Lins:
+        Initial implementation derived from GraphSUMI.
+    v1.01  10 Apr 1989  C. Lins:
+        Corrected initialization of handlers array.
+    v1.02  18 Apr 1989   C. Lins:
+        Added component id constant.
+    v2.00  24 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+        (*--proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+        (*--cons*) NullItem,
+        (*--type*) Item;
+
+FROM GraphTypes IMPORT
+        (*--type*) Operations, Exceptions, ComponentID;
+
+FROM ErrorHandling IMPORT
+        (*--cons*) NullHandler,
+        (*--type*) HandlerProc,
+        (*--proc*) Raise;
+
+        (*-------------------------*)
+
+TYPE  EdgePtr = POINTER TO EdgeNode;
+TYPE  Edge    = POINTER TO EdgeRefNode;
+TYPE  Vertex  = POINTER TO VertexNode;
+
+CONST NullRef = NIL;
+
+TYPE  EdgeRefNode = RECORD
+                realEdge : EdgePtr;     (*--link to the actual edge node *)
+                prior    : Edge;        (*--prior edge in this edge list *)
+                next     : Edge;        (*--next edge in this edge list *)
+          END (*--EdgeRefNode *);
+
+TYPE  VertexNode = RECORD
+                inGraph : Graph;   (*--graph in which this vertex is a member *)
+                data    : Label;   (*--data item (label) for this vertex *)
+                degree  : CARDINAL;(*--degree of this vertex *)
+                prior   : Vertex;  (*--prior vertex in adjacency list *)
+                next    : Vertex;  (*--next vertex in adjacency list *)
+                edges   : Edge;    (*--link to first edge of this vertex *)
+          END (*--VertexNode *);
+
+TYPE  EdgeNode = RECORD
+                first   : Vertex;       (*--first vertex for this edge *)
+                second  : Vertex;       (*--second vertex for this edge *)
+                weight  : Attribute;(*--weight/attribute for this edge *)
+                edgeRef1: Edge;     (*--link to edge in 1st vertex edge list *)
+                edgeRef2: Edge;     (*--link to edge in 2nd vertex edge list *)
+                prior   : EdgePtr;      (*--prior edge in the set of all edges *)
+                next    : EdgePtr;      (*--next edge in the set of all edges *)
+          END (*--EdgeNode *);
+
+TYPE  UnboundedGraph = RECORD
+                numVertices: CARDINAL;  (*--current number of vertices *)
+                numEdges   : CARDINAL;  (*--current number of edges *)
+                firstVertex: Vertex;    (*--first vertex in adjacency list *)
+                firstEdge  : EdgePtr;   (*--first edge in edge set *)
+          END (*--UnboundedGraph *);
+
+TYPE  Graph = POINTER TO UnboundedGraph;
+
+        (*-------------------------*)
+
+VAR   graphError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE GraphError () : Exceptions;
+BEGIN
+  RETURN graphError;
+END GraphError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                                                  theHandler : HandlerProc (*--in   *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                                                         : HandlerProc (*--out  *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*--in   *);
+                                                  theError   : Exceptions  (*--in   *));
+BEGIN
+  graphError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+PROCEDURE NewVertex (    theGraph   : Graph      (*--in   *);
+                                                 theItem    : Label      (*--in   *);
+                                                 theRoutine : Operations (*--in   *))
+                                                                    : Vertex     (*--out  *);
+
+VAR   newVertex : Vertex;               (*-- newly created vertex *)
+
+BEGIN
+  Allocate(newVertex, SIZE(VertexNode));
+  IF (newVertex = NullVertex) THEN
+        RaiseErrIn(theRoutine, overflow);
+  ELSE
+        WITH newVertex^ DO
+          inGraph := theGraph;
+          data    := theItem;
+          degree  := 0;
+          edges   := NullEdge;
+          prior   := NullVertex;
+          next    := NullVertex;
+        END (*--with*);
+  END (*--if*);
+  RETURN newVertex;
+END NewVertex;
+(*-------------------------*)
+
+PROCEDURE AddVertex (    theGraph  : Graph  (*--inout*);
+                                             theVertex : Vertex (*--inout*));
+BEGIN
+  WITH theGraph^ DO
+        IF (firstVertex # NullVertex) THEN
+          firstVertex^.prior := theVertex;
+        END (*--if*);
+        theVertex^.next := firstVertex;
+        firstVertex := theVertex;
+        INC(numVertices);
+  END (*--with*);
+END AddVertex;
+(*-------------------------*)
+
+PROCEDURE FreeVertex (    theGraph  : Graph  (*--inout*);
+                                          VAR theVertex : Vertex (*--inout*));
+BEGIN
+  WITH theVertex^ DO
+        IF (prior = NullVertex) THEN
+          theGraph^.firstVertex := next;
+        ELSE
+          prior^.next := next;
+        END (*--if*);
+        IF (next # NullVertex) THEN
+          next^.prior := prior;
+        END (*--if*);
+  END (*--with*);
+  DEC(theGraph^.numVertices);
+  Deallocate(theVertex, SIZE(theVertex^));
+END FreeVertex;
+(*-------------------------*)
+
+
+PROCEDURE NewEdge (    vertex1    : Vertex     (*--in   *);
+                                           vertex2    : Vertex     (*--in   *);
+                                           theWeight  : Attribute  (*--in   *);
+                                           theRoutine : Operations (*--in   *))
+                                                          : EdgePtr    (*--out  *);
+
+VAR       newEdgeRef : EdgePtr; (*--new edge being created *)
+
+BEGIN
+  Allocate(newEdgeRef, SIZE(EdgeNode));
+  IF (newEdgeRef = NullRef) THEN
+    RaiseErrIn(theRoutine, overflow);
+  ELSE
+        WITH newEdgeRef^ DO
+          first    := vertex1;
+          second   := vertex2;
+          weight   := theWeight;
+          edgeRef1 := NullEdge;
+          edgeRef2 := NullEdge;
+          next     := NullRef;
+          prior    := NullRef;
+        END (*--with*);
+  END (*--if*);
+  RETURN newEdgeRef;
+END NewEdge;
+(*-------------------------*)
+
+PROCEDURE AddEdge (    theGraph : Graph    (*--inout*);
+                                           theEdge  : EdgePtr  (*--inout*));
+BEGIN
+  WITH theGraph^ DO
+        IF (firstEdge # NullRef) THEN
+          firstEdge^.prior := theEdge;
+        END (*--if*);
+        theEdge^.next := firstEdge;
+        firstEdge := theEdge;
+        INC(numEdges);
+  END (*--with*);
+END AddEdge;
+(*-------------------------*)
+
+PROCEDURE FreeEdge (    theGraph : Graph    (*--inout*);
+                                        VAR theEdge  : EdgePtr  (*--inout*));
+BEGIN
+  WITH theEdge^ DO
+        IF (prior = NullRef) THEN
+          theGraph^.firstEdge := next;
+        ELSE
+          prior^.next := next;
+        END (*--if*);
+        IF (next # NullRef) THEN
+          next^.prior := prior;
+        END (*--if*);
+  END (*--with*);
+  DEC(theGraph^.numEdges);
+  Deallocate(theEdge, SIZE(theEdge^));
+END FreeEdge;
+(*-------------------------*)
+
+
+PROCEDURE NewEdgeRef (    theEdgePtr : EdgePtr    (*--in   *);
+                                              theRoutine : Operations (*--in   *))
+                                                             : Edge           (*--out  *);
+
+VAR       newEdge : Edge; (*--new edge reference being created *)
+
+BEGIN
+  Allocate(newEdge, SIZE(EdgeRefNode));
+  IF (newEdge = NullEdge) THEN
+    RaiseErrIn(theRoutine, overflow);
+  ELSE
+        WITH newEdge^ DO
+          realEdge := theEdgePtr;
+          next     := NullEdge;
+          prior    := NullEdge;
+        END (*--with*);
+  END (*--if*);
+  RETURN newEdge;
+END NewEdgeRef;
+(*-------------------------*)
+
+PROCEDURE AddEdgeRef (    theVertex : Vertex (*--inout*);
+                                                  theEdge   : Edge   (*--inout*));
+BEGIN
+  WITH theVertex^ DO
+        IF (edges # NullEdge) THEN
+          edges^.prior := theEdge;
+        END (*--if*);
+    theEdge^.next := edges;
+    edges := theEdge;
+        INC(degree);
+  END (*--with*);
+END AddEdgeRef;
+(*-------------------------*)
+
+PROCEDURE FreeEdgeRef (    theVertex : Vertex (*--inout*);
+                                           VAR theEdge   : Edge   (*--inout*));
+BEGIN
+  WITH theEdge^ DO
+        IF (prior = NullEdge) THEN
+          theVertex^.edges := next;
+        ELSE
+          prior^.next := next;
+        END (*--if*);
+        IF (next # NullEdge) THEN
+          next^.prior := prior;
+        END (*--if*);
+  END (*--with*);
+  DEC(theVertex^.degree);
+  Deallocate(theEdge, SIZE(theEdge^));
+END FreeEdgeRef;
+(*-------------------------*)
+
+PROCEDURE ClearEdgeRefs (VAR theVertex : Vertex    (*--inout*));
+
+VAR   theEdge : Edge; (*--edge reference being removed *)
+
+BEGIN
+  WITH theVertex^ DO
+        WHILE (edges # NIL) DO
+          theEdge := edges;
+          edges := edges^.next;
+          DEC(degree);
+          Deallocate(theEdge, SIZE(theEdge^));
+        END (*--while*);
+  END (*--with*);
+END ClearEdgeRefs;
+(*-------------------------*)
+
+
+PROCEDURE Create   ()                      : Graph     (*--out  *);
+
+VAR   newGraph : Graph; (*--temporary for new graph object *)
+
+BEGIN
+  graphError := noerr;
+  Allocate(newGraph, SIZE(UnboundedGraph));
+  IF (newGraph = NullGraph) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newGraph^ DO
+          numVertices := 0;
+          numEdges    := 0;
+          firstVertex := NullVertex;
+          firstEdge   := NullRef;
+        END (*--with*);
+  END (*--if*);
+  RETURN newGraph;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theGraph      : Graph     (*--inout *));
+BEGIN
+  Clear(theGraph);
+  IF (graphError = noerr) THEN
+    Deallocate(theGraph, SIZE(theGraph^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theGraph      : Graph    (*--inout *));
+
+  PROCEDURE ClearEdges (VAR theGraph : Graph    (*--inout *));
+
+  VAR   theEdge : EdgePtr; (*--edge to be removed *)
+
+  BEGIN
+    WITH theGraph^ DO
+          WHILE (firstEdge # NullRef) DO
+            theEdge := firstEdge;
+            firstEdge := firstEdge^.next;
+            DEC(numEdges);
+            Deallocate(theEdge, SIZE(theEdge^));
+          END (*--while*);
+    END (*--with*);
+  END ClearEdges;
+  (*-------------------------*)
+
+VAR   theVertex : Vertex;          (*--loop index over vertices *)
+VAR   oldVertex : Vertex;          (*--vertex to deallocate *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theGraph^ DO
+          theVertex := firstVertex;
+          WHILE (theVertex # NullVertex) DO
+            ClearEdgeRefs(theVertex);
+                oldVertex := theVertex;
+                theVertex := theVertex^.next;
+                Deallocate(oldVertex, SIZE(oldVertex^));
+          END (*--while*);
+          firstVertex := NullVertex;
+          numVertices := 0;
+        END (*--with*);
+        ClearEdges(theGraph);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theGraph      : Graph     (*--in   *);
+                                   VAR toGraph       : Graph     (*--inout *));
+
+
+  PROCEDURE RecreateTarget (): BOOLEAN (*--out  *);
+  BEGIN
+        IF (theGraph = NullGraph) THEN
+      RaiseErrIn(assign, undefined);
+
+        ELSIF (toGraph = NullGraph) THEN
+      WITH theGraph^ DO
+        toGraph := Create();
+          END (*--with*);
+
+        ELSIF (theGraph = toGraph) THEN
+      RETURN FALSE;
+
+        ELSE
+          Clear(toGraph);
+        END (*--if*);
+        RETURN (graphError = noerr);
+  END RecreateTarget;
+
+
+  TYPE  MapVertex = RECORD
+              old : Vertex; (*-- vertex from source graph *)
+              new : Vertex; (*-- corresponging vertex in target graph *)
+            END (*--MapVertex*);
+  TYPE  MapVertices = ARRAY [0..0] OF MapVertex;
+
+  VAR   vertexMap : POINTER TO MapVertices;
+  VAR   mapExtent : CARDINAL;
+
+
+  PROCEDURE CreateVertexMap;
+  BEGIN
+        Allocate(vertexMap,
+                         VAL(CARDINAL, SIZE(MapVertex)) * theGraph^.numVertices);
+        mapExtent := 0;
+  END CreateVertexMap;
+
+  PROCEDURE AddToVertexMap (    oldVertex : Vertex (*--in   *);
+                                                                newVertex : Vertex (*--in   *));
+  BEGIN
+        WITH vertexMap^[mapExtent] DO
+          old := oldVertex;
+          new := newVertex;
+        END (*--with*);
+    INC(mapExtent);
+  END AddToVertexMap;
+
+  PROCEDURE VertexInMap (    oldVertex : Vertex (*--in   *))
+                                                                           : Vertex (*--out  *);
+
+  VAR   index : CARDINAL; (*-- loop index over mapping entries *)
+
+  BEGIN
+    FOR index := 0 TO mapExtent-1 DO
+          WITH vertexMap^[index] DO
+        IF (oldVertex = old) THEN
+                  RETURN new;
+                END (*--if*);
+          END (*--with*);
+    END (*--for*);
+        RETURN NullVertex;
+  END VertexInMap;
+
+  PROCEDURE DestroyVertexMap;
+  BEGIN
+        Deallocate(vertexMap, SIZE(vertexMap^));
+  END DestroyVertexMap;
+
+
+  PROCEDURE CopyVertices () : BOOLEAN;
+
+  VAR   v : Vertex;     (*--loop index over vertices being copied *)
+  VAR   newVertex : Vertex; (*--new vertex in target graph *)
+  VAR   lastVertex: Vertex; (*--last vertex added to list of vertices *)
+
+
+    PROCEDURE TailInsert (VAR first : Vertex (*--inout *);
+                                                  VAR last  : Vertex (*--inout *));
+    BEGIN
+      IF (first = NullVertex) THEN
+            first := newVertex;
+          ELSE
+            last^.next := newVertex;
+          END (*--if*);
+          last := newVertex;
+    END TailInsert;
+
+  BEGIN
+        CreateVertexMap;
+        IF (vertexMap = NIL) THEN
+          RETURN FALSE;
+        END (*--if*);
+
+        v := theGraph^.firstVertex;
+        lastVertex := NullVertex;
+
+    WHILE (v # NullVertex) DO
+          newVertex := NewVertex(toGraph, v^.data, assign);
+          IF (newVertex = NullVertex) THEN
+            DestroyVertexMap;
+                RETURN FALSE;
+          END (*--if*);
+
+          TailInsert(toGraph^.firstVertex, lastVertex);
+          INC(toGraph^.numVertices);
+          AddToVertexMap(v, newVertex);
+
+          v := v^.next;
+        END (*--while*);
+
+        RETURN TRUE;
+  END CopyVertices;
+
+  PROCEDURE CopyEdges;
+
+  VAR   theEdge   : EdgePtr; (*--loop index over edges in source graph *)
+  VAR   newEdge   : EdgePtr; (*--new edge for target graph *)
+  VAR   lastEdge  : EdgePtr; (*--last edge inserted into new list of edges *)
+  VAR   epRef1    : Edge;
+  VAR   epRef2    : Edge;
+  VAR   vertex1   : Vertex; (*--first vertex of theEdge in target graph *)
+  VAR   vertex2   : Vertex; (*--second vertex of theEdge in target graph *)
+
+  BEGIN
+        theEdge    := theGraph^.firstEdge;
+        lastEdge   := NullRef;
+        WHILE (theEdge # NullRef) DO
+          vertex1 := VertexInMap(theEdge^.first);
+          vertex2 := VertexInMap(theEdge^.second);
+          newEdge := NewEdge(vertex1,
+                                                 vertex2,
+                                                 theEdge^.weight,
+                                                 assign);
+          IF (newEdge = NullRef) THEN
+                RETURN;
+          END (*--if*);
+          epRef1 := NewEdgeRef(newEdge, assign);
+          IF (epRef1 = NullEdge) THEN
+            Deallocate(newEdge, SIZE(newEdge^));
+            RETURN;
+          END (*--if*);
+          newEdge^.edgeRef1 := epRef1;
+
+          IF (vertex1 # vertex2) THEN
+            epRef2 := NewEdgeRef(newEdge, assign);
+            IF (epRef2 = NullEdge) THEN
+              Deallocate(newEdge, SIZE(newEdge^));
+              Deallocate(epRef1, SIZE(epRef1^));
+              RETURN;
+            END (*--if*);
+            newEdge^.edgeRef2 := epRef2;
+            AddEdgeRef(vertex2, epRef2);
+      END (*--if*);
+
+          AddEdgeRef(vertex1, epRef1);
+          AddEdge(toGraph, newEdge);
+
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END CopyEdges;
+
+BEGIN (*--Assign --*)
+  graphError := noerr;
+  IF RecreateTarget() & CopyVertices() THEN
+    CopyEdges;
+        DestroyVertexMap;
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+
+PROCEDURE Insert   (VAR theGraph   : Graph     (*--inout *);
+                                        theItem    : Label     (*--in    *);
+                                        VAR theVertex  : Vertex    (*--out   *));
+BEGIN
+  graphError := noerr;
+  theVertex  := NullVertex;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(insert, undefined);
+  ELSE
+    theVertex := NewVertex(theGraph, theItem, insert);
+        IF (theVertex # NullVertex) THEN
+      AddVertex(theGraph, theVertex);
+    END (*--if*);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+
+PROCEDURE Remove   (VAR theGraph   : Graph     (*--inout*);
+                                    VAR theVertex  : Vertex    (*--inout*));
+
+
+  PROCEDURE OtherVertex (    theVertex : Vertex (*--in   *);
+                                                     theEdge   : Edge   (*--in   *))
+                                                                           : Vertex (*--out  *);
+  BEGIN
+    WITH theEdge^.realEdge^ DO
+          IF (first = theVertex) THEN
+            RETURN second;
+          ELSE
+            RETURN first;
+          END (*--if*);
+    END (*--with*);
+  END OtherVertex;
+
+  PROCEDURE OtherEdge (    theEdge : Edge (*--in   *))
+                                                                   : Edge (*--out  *);
+  BEGIN
+    WITH theEdge^.realEdge^ DO
+          IF (edgeRef1 = theEdge) THEN
+            RETURN edgeRef2;
+          ELSE
+            RETURN edgeRef1;
+          END (*--if*);
+    END (*--with*);
+  END OtherEdge;
+
+VAR   anEdge  : Edge;   (*--loop index over edges *)
+VAR   vertex2 : Vertex; (*--other endpoint in anEdge *)
+VAR   edge2   : Edge;   (*--edge in vertex2's edge list *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(remove, undefined);
+
+  ELSIF (theVertex = NullVertex) THEN
+    RaiseErrIn(remove, nullvertex);
+
+  ELSIF (theVertex^.inGraph # theGraph) THEN
+    RaiseErrIn(remove, novertex);
+
+  ELSE
+    anEdge := theVertex^.edges;
+        WHILE (anEdge # NullEdge) DO
+          vertex2 := OtherVertex(theVertex, anEdge);
+          edge2   := OtherEdge(anEdge);
+          FreeEdgeRef(vertex2, edge2);
+          FreeEdge(theGraph, anEdge^.realEdge);
+          anEdge := anEdge^.next;
+        END (*--while*);
+        ClearEdgeRefs(theVertex);
+        FreeVertex(theGraph, theVertex);
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+PROCEDURE SetLabel (    theVertex  : Vertex    (*--inout*);
+                                            theItem    : Label     (*--in   *));
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(setlabel, nullvertex);
+  ELSE
+    theVertex^.data := theItem;
+  END (*--if*);
+END SetLabel;
+(*-------------------------*)
+
+
+PROCEDURE Link         (VAR theGraph   : Graph     (*--inout*);
+                                            endpoint1  : Vertex    (*--in   *);
+                                            endpoint2  : Vertex    (*--in   *);
+                                            theWeight  : Attribute (*--in   *);
+                                            VAR theEdge    : Edge      (*--out  *));
+
+VAR   newEdgePtr : EdgePtr;
+VAR   newEdge    : Edge;    (*-- edge ref for {ep2, ep1} *)
+
+BEGIN
+  graphError := noerr;
+  theEdge    := NullEdge;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(link, undefined);
+  ELSIF (endpoint1 = NullVertex) OR (endpoint2 = NullVertex) THEN
+    RaiseErrIn(link, nullvertex);
+  ELSIF (endpoint1^.inGraph # theGraph) OR
+                (endpoint2^.inGraph # theGraph) THEN
+    RaiseErrIn(link, novertex);
+  ELSE
+
+    newEdgePtr := NewEdge(endpoint1, endpoint2, theWeight, link);
+        IF (newEdgePtr = NullRef) THEN
+          RETURN;
+        END (*--if*);
+
+        theEdge := NewEdgeRef(newEdgePtr, link);
+        IF (theEdge = NullEdge) THEN
+          Deallocate(newEdgePtr, SIZE(newEdgePtr^));
+          RETURN;
+        END (*--if*);
+        newEdgePtr^.edgeRef1 := theEdge;
+
+        IF (endpoint1 # endpoint2) THEN
+          newEdge := NewEdgeRef(newEdgePtr, link);
+          IF (newEdge = NullEdge) THEN
+            Deallocate(newEdgePtr, SIZE(newEdgePtr^));
+            Deallocate(theEdge, SIZE(theEdge^));
+            RETURN;
+          END (*--if*);
+          newEdgePtr^.edgeRef2 := newEdge;
+          AddEdgeRef(endpoint2, newEdge);
+    END (*--if*);
+
+        AddEdge(theGraph, newEdgePtr);
+        AddEdgeRef(endpoint1, theEdge);
+  END (*--if*);
+END Link;
+(*-------------------------*)
+
+PROCEDURE Unlink       (VAR theGraph   : Graph     (*--inout*);
+                                        VAR theEdge    : Edge      (*--inout*));
+
+VAR   theRealEdge  : EdgePtr;
+
+BEGIN
+  graphError := noerr;
+
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(unlink, undefined);
+
+  ELSIF (theEdge = NullEdge) THEN
+        RaiseErrIn(unlink, nulledge);
+
+  ELSIF (theEdge^.realEdge^.first = NullVertex) THEN
+    RaiseErrIn(unlink, nullvertex);
+
+  ELSIF (theEdge^.realEdge^.first^.inGraph # theGraph) THEN
+    RaiseErrIn(unlink, noedge);
+
+  ELSE
+        theRealEdge := theEdge^.realEdge;
+    WITH theRealEdge^ DO
+          FreeEdgeRef(first, edgeRef1);
+          IF (edgeRef2 # NullEdge) THEN
+            FreeEdgeRef(second, edgeRef2);
+          END (*--if*);
+        END (*--with*);
+        FreeEdge(theGraph, theRealEdge);
+        theEdge := NullEdge;
+  END (*--if*);
+END Unlink;
+(*-------------------------*)
+
+PROCEDURE SetAttribute (    theEdge    : Edge      (*--inout*);
+                                            theWeight  : Attribute (*--in   *));
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+        RaiseErrIn(setattr, nulledge);
+  ELSE
+    WITH theEdge^ DO
+      realEdge^.weight := theWeight;
+    END (*--with*);
+  END (*--if*);
+END SetAttribute;
+(*-------------------------*)
+
+
+PROCEDURE IsDefined (    theGraph  : Graph       (*--in   *))
+                                                                   : BOOLEAN     (*--out  *);
+BEGIN
+  RETURN (theGraph # NullGraph);
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theGraph  : Graph       (*--in   *))
+                                                                   : BOOLEAN     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isempty, undefined);
+        RETURN TRUE;
+  END (*--if*);
+  RETURN theGraph^.numVertices = 0;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE OrderOf   (    theGraph  : Graph       (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(orderof, undefined);
+        RETURN 0;
+  END (*--if*);
+  RETURN theGraph^.numVertices;
+END OrderOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theGraph  : Graph       (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(sizeof, undefined);
+        RETURN 0;
+  END (*--if*);
+  RETURN theGraph^.numEdges;
+END SizeOf;
+(*-------------------------*)
+
+
+PROCEDURE DegreeOf  (    theVertex : Vertex      (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF  (theVertex = NullVertex) THEN
+    RaiseErrIn(degreeof, nullvertex);
+    RETURN 0;
+  END (*--if*);
+  RETURN theVertex^.degree;
+END DegreeOf;
+(*-------------------------*)
+
+PROCEDURE LabelOf   (    theVertex : Vertex      (*--in   *))
+                                                                   : Label       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(labelof, nullvertex);
+  ELSE
+    RETURN theVertex^.data;
+  END (*--if*);
+  RETURN NullItem;
+END LabelOf;
+(*-------------------------*)
+
+PROCEDURE IsVertex  (    theGraph  : Graph       (*--in   *);
+                                             theVertex : Vertex      (*--in   *))
+                                                           : BOOLEAN     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isvertex, undefined);
+  ELSIF (theVertex = NullVertex) THEN
+    RaiseErrIn(isvertex, nullvertex);
+  ELSE
+    RETURN theVertex^.inGraph = theGraph;
+  END (*--if*);
+  RETURN FALSE;
+END IsVertex;
+(*-------------------------*)
+
+PROCEDURE GraphOf   (    theVertex : Vertex      (*--in   *))
+                                                                   : Graph       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(graphof, nullvertex);
+    RETURN NullGraph;
+  END (*--if*);
+  RETURN theVertex^.inGraph;
+END GraphOf;
+(*-------------------------*)
+
+
+PROCEDURE AttributeOf (    theEdge   : Edge        (*--in   *))
+                                                                 : Attribute   (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(attrof, nulledge);
+  ELSE
+    RETURN theEdge^.realEdge^.weight;
+  END (*--if*);
+  RETURN NullItem;
+END AttributeOf;
+(*-------------------------*)
+
+PROCEDURE FirstOf        (    theEdge   : Edge       (*--in  *))
+                                                                : Vertex     (*--out *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(firstof, nulledge);
+  ELSE
+    RETURN theEdge^.realEdge^.first;
+  END (*--if*);
+  RETURN NullVertex;
+END FirstOf;
+(*-------------------------*)
+
+PROCEDURE SecondOf   (    theEdge   : Edge       (*--in  *))
+                                                                : Vertex     (*--out *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(secondof, nulledge);
+  ELSE
+    RETURN theEdge^.realEdge^.second;
+  END (*--if*);
+  RETURN NullVertex;
+END SecondOf;
+(*-------------------------*)
+
+PROCEDURE IncidentOn  (    theEdge   : Edge       (*--in   *);
+                                           VAR endpoint1 : Vertex         (*--out  *);
+                                           VAR endpoint2 : Vertex         (*--out  *));
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(incidenton, nulledge);
+    endpoint1 := NullVertex;
+    endpoint2 := NullVertex;
+  ELSE
+    WITH theEdge^.realEdge^ DO
+      endpoint1 := first;
+      endpoint2 := second;
+    END (*--with*);
+  END (*--if*);
+END IncidentOn;
+(*-------------------------*)
+
+PROCEDURE IsEdge     (    theGraph  : Graph      (*--in *);
+                                              theEdge   : Edge       (*--in *))
+                                                            : BOOLEAN    (*--out *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(isedge, undefined);
+  ELSIF (theEdge = NullEdge) THEN
+    RaiseErrIn(isedge, nulledge);
+  ELSIF (theEdge^.realEdge^.first = NullVertex) THEN
+    RaiseErrIn(isedge, nullvertex);
+  ELSE
+    RETURN theEdge^.realEdge^.first^.inGraph = theGraph;
+  END (*--if*);
+  RETURN FALSE;
+END IsEdge;
+(*-------------------------*)
+
+
+PROCEDURE LoopVertices (    theGraph  : Graph          (*--in   *);
+                                                        process   : VertexLoopProc (*--in   *));
+
+VAR   theVertex : Vertex; (*--loop index over vertices *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(loopvertices, undefined);
+  ELSE
+        theVertex := theGraph^.firstVertex;
+        WHILE (theVertex # NullVertex) & process(theVertex) DO
+          theVertex := theVertex^.next;
+        END (*--while*);
+  END (*--if*);
+END LoopVertices;
+(*-------------------------*)
+
+PROCEDURE LoopEdges    (    theGraph  : Graph          (*--in   *);
+                                                        process   : EdgeLoopProc   (*--in   *));
+
+VAR   theEdge : EdgePtr; (*--loop index over edges of a graph *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(loopedges, undefined);
+  ELSE
+        theEdge := theGraph^.firstEdge;
+        WHILE (theEdge # NullRef) & process(theEdge^.edgeRef1) DO
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END LoopEdges;
+(*-------------------------*)
+
+PROCEDURE LoopIterate  (    theVertex : Vertex         (*--in   *);
+                                                        process   : EdgeLoopProc   (*--in   *));
+
+VAR   theEdge : Edge;   (*--loop index over edges of the vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(loopiterate, nullvertex);
+  ELSE
+        theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) & process(theEdge) DO
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END LoopIterate;
+(*-------------------------*)
+
+PROCEDURE TravVertices (    theGraph  : Graph      (*--in   *);
+                                                        process   : VertexProc (*--in   *));
+
+VAR   theVertex : Vertex; (*--loop index over vertices *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(travvertices, undefined);
+  ELSE
+        theVertex := theGraph^.firstVertex;
+        WHILE (theVertex # NullVertex) DO
+          process(theVertex);
+          theVertex := theVertex^.next;
+        END (*--while*);
+  END (*--if*);
+END TravVertices;
+(*-------------------------*)
+
+PROCEDURE TravEdges    (    theGraph  : Graph      (*--in   *);
+                                                        process   : EdgeProc   (*--in   *));
+
+VAR   theEdge : EdgePtr;   (*--loop index over edges *)
+
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(travedges, undefined);
+  ELSE
+        theEdge := theGraph^.firstEdge;
+        WHILE (theEdge # NullRef) DO
+          process(theEdge^.edgeRef1);
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END TravEdges;
+(*-------------------------*)
+
+PROCEDURE Iterate      (    theVertex : Vertex     (*--in   *);
+                                                        process   : EdgeProc   (*--in   *));
+
+VAR   theEdge : Edge; (*--loop index over edges of the vertex *)
+
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(iterate, nullvertex);
+  ELSE
+        theEdge := theVertex^.edges;
+        WHILE (theEdge # NullEdge) DO
+          process(theEdge);
+          theEdge := theEdge^.next;
+        END (*--while*);
+  END (*--if*);
+END Iterate;
+(*-------------------------*)
+
+
+PROCEDURE FirstVertex  (    theGraph  : Graph      (*--in   *))
+                                                                          : Vertex     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theGraph = NullGraph) THEN
+    RaiseErrIn(firstvertex, undefined);
+  ELSE
+        RETURN theGraph^.firstVertex;
+  END (*--if*);
+  RETURN NullVertex;
+END FirstVertex;
+(*-------------------------*)
+
+PROCEDURE NextVertex   (    theVertex : Vertex     (*--in   *))
+                                                                          : Vertex     (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(nextvertex, nullvertex);
+  ELSE
+        RETURN theVertex^.next;
+  END (*--if*);
+  RETURN NullVertex;
+END NextVertex;
+(*-------------------------*)
+
+PROCEDURE FirstEdge    (    theVertex : Vertex     (*--in   *))
+                                                                          : Edge       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theVertex = NullVertex) THEN
+    RaiseErrIn(firstedge, nullvertex);
+  ELSE
+    RETURN theVertex^.edges;
+  END (*--if*);
+  RETURN NullEdge;
+END FirstEdge;
+(*-------------------------*)
+
+PROCEDURE NextEdge     (    theEdge   : Edge       (*--in   *))
+                                                                          : Edge       (*--out  *);
+BEGIN
+  graphError := noerr;
+  IF (theEdge = NullEdge) THEN
+    RaiseErrIn(nextedge, nulledge);
+  ELSE
+    RETURN theEdge^.next;
+  END (*--if*);
+  RETURN NullEdge;
+END NextEdge;
+(*-------------------------*)
+
+
+BEGIN
+  FOR graphError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(graphError, NullHandler);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  graphError := noerr;
+        NullGraph := NIL;
+        NullVertex := NIL;
+        NullEdge := NIL;
+END GrafSUUI.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRAPHTYP.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRAPHTYP.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRAPHTYP.MOD
@@ -0,0 +1,22 @@
+IMPLEMENTATION MODULE GraphTypes;
+(*====================================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: 3 bytes
+    Component: Graph Structure Utility - Standard Enumerations
+
+    THE ABSTRACTION
+    This module provides centralized definitions of the operations
+    and exceptions for all graph modules. The TML compiler requires an
+    empty implementation module.
+
+    REVISION HISTORY
+    v1.00  18 Apr 1988  C. Lins:
+      Initial TML Modula-2 implementation
+    v2.01  08 Dec 1989  I.S.C. Houston.
+      Adapted to JPI Compiler.
+
+====================================================================*)
+
+END GraphTypes.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRASBMIU.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRASBMIU.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRASBMIU.MOD
@@ -0,0 +1,300 @@
+(*
+14.4    GraphSBMI Utilities Implementation
+*)
+
+IMPLEMENTATION MODULE GraSBMIUtil;
+(*=============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: 1419 bytes
+    Component: GraphSBMI Utilities
+
+    REVISION HISTORY
+    v1.01  08 Oct 1988  C. Lins:
+        Initial TML Modula-2 implementation
+    v1.02  17 Feb 1989  C. Lins:
+        Removed Graph parameter from vertex selectors.
+        Added depth-first search, breadth-first search, and
+        HasPath operations.
+    v2.00  24 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+=============================================================*)
+
+FROM GrafSBMI IMPORT
+        (*--cons*) NullGraph, NullVertex, NullEdge,
+        (*--type*) Graph, Vertex, Edge, VertexLoopProc,
+        (*--proc*) FirstVertex, NextVertex, FirstEdge, NextEdge,
+                           DegreeOf, IncidentOn, TravVertices, FirstOf,
+                           SecondOf;
+
+FROM TypeManager IMPORT
+    (*--Proc*) Create, LongCardTypeID;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+IMPORT SetSUMN;
+IMPORT QSUMN;
+
+(*
+14.4.1  Graph Utility Operations
+*)
+
+
+VAR   minimum : CARDINAL; (*-- current minimum degree *)
+
+PROCEDURE FindMinDegree (    theVertex : Vertex (*--in   *));
+
+VAR   degree : CARDINAL; (*-- degree of the current vertex *)
+
+BEGIN
+  degree := DegreeOf(theVertex);
+  IF (degree < minimum) THEN
+        minimum := degree;
+  END (*--if*);
+END FindMinDegree;
+(*-------------------------*)
+
+PROCEDURE MinDegree (    theGraph  : Graph       (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  IF (theGraph = NullGraph) THEN
+        RETURN 0;
+  ELSE
+        minimum := MAX(CARDINAL);
+        TravVertices(theGraph, FindMinDegree);
+        RETURN minimum;
+  END (*--if*);
+END MinDegree;
+(*-------------------------*)
+
+
+VAR   maximum : CARDINAL; (*-- current minimum degree *)
+
+PROCEDURE FindMaxDegree (    theVertex : Vertex (*--in   *));
+
+VAR   degree : CARDINAL; (*-- degree of the current vertex *)
+
+BEGIN
+  degree := DegreeOf(theVertex);
+  IF (degree > maximum) THEN
+        maximum := degree;
+  END (*--if*);
+END FindMaxDegree;
+(*-------------------------*)
+
+PROCEDURE MaxDegree (    theGraph  : Graph       (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  maximum := MIN(CARDINAL);
+  IF (theGraph # NullGraph) THEN
+        TravVertices(theGraph, FindMaxDegree);
+  END (*--if*);
+  RETURN maximum;
+END MaxDegree;
+(*-------------------------*)
+
+(*
+14.4.2  Vertex Utility Operations
+*)
+
+PROCEDURE IsIsolated   (    theVertex : Vertex  (*-- in    *))
+                                                              : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN (DegreeOf(theVertex) = 0);
+END IsIsolated;
+(*-------------------------*)
+
+PROCEDURE HasSelfLoops (    theVertex : Vertex  (*-- in    *))
+                                                              : BOOLEAN (*-- out   *);
+
+VAR   e   : Edge;   (*-- loop pointer over edges of this vertex *)
+VAR   ep1 : Vertex; (*-- 1st endpoint of the edge *)
+VAR   ep2 : Vertex; (*-- 2nd endpoint of the edge *)
+
+BEGIN
+  e := FirstEdge(theVertex);
+  WHILE (e # NullEdge) DO
+    IncidentOn(e, ep1, ep2);
+        IF (ep1 = theVertex) & (ep2 = theVertex) THEN
+          RETURN TRUE;
+        END (*--if*);
+        e := NextEdge(e);
+  END (*--while*);
+  RETURN FALSE;
+END HasSelfLoops;
+(*-------------------------*)
+
+(*
+IsReachable uses a variation on the depth-first search given below. We create a
+set of vertices that have been visited and each time a vertex is processed
+it is added to the set. This way each vertex is examined only once. The traversal
+stops once the algorithm determines that there is a path between the fromVertex
+and the toVertex. Otherwise, the traversal completes without finding a path and
+FALSE is returned to the caller.
+*)
+
+PROCEDURE IsReachable (    fromVertex: Vertex      (*--in   *);
+                                                   toVertex  : Vertex      (*--in   *))
+                                                                         : BOOLEAN     (*--out  *);
+
+VAR   visited  : SetSUMN.Set; (*-- set of vertices already visited *)
+          pathFound: BOOLEAN;     (*-- true when path between vertices is found *)
+
+  PROCEDURE Visit (v : Vertex);
+
+  VAR   e   : Edge;   (*-- loop index over edges from v *)
+  VAR   ep1 : Vertex; (*-- 1st vertex of an edge *)
+  VAR   ep2 : Vertex; (*-- 2nd vertex of an edge *)
+
+  BEGIN
+    pathFound := (v = toVertex);
+        IF ~pathFound THEN
+          (*-- add v to the set of vertices already visited *)
+          SetSUMN.Include(Item(v), visited);
+
+          e := FirstEdge(v);
+          WHILE (e # NullEdge) & ~pathFound DO
+            IncidentOn(e, ep1, ep2);
+                IF (ep2 = v) THEN
+                  ep2 := ep1;
+                END (*--if*);
+            IF ~SetSUMN.IsAMember(Item(ep2), visited) THEN
+              Visit(ep2);
+            END (*--if*);
+            e := NextEdge(e);
+          END (*--while*);
+        END (*--if*);
+  END Visit;
+
+BEGIN
+  visited := SetSUMN.Create(LongCardTypeID());
+  Visit(fromVertex);
+  SetSUMN.Destroy(visited);
+  RETURN pathFound;
+END IsReachable;
+(*-------------------------*)
+
+
+(*
+12.4.3  Graph Traversal Utilities
+
+The two algorithms below implement the standard depth-first and breadth-first
+search for an undirected graph as given by Sedgewick [] and Mehlhorn []. Both
+algorithms stop whenever the VertexLoopProc returns FALSE.
+*)
+
+PROCEDURE DFS   (    theGraph   : Graph          (*--in   *);
+                                         process    : VertexLoopProc (*--in   *));
+
+VAR   v : Vertex; (*-- loop index over vertices *)
+          continue : BOOLEAN;     (*-- controls termination of DFS *)
+          visited  : SetSUMN.Set; (*-- set of vertices already visited *)
+
+  PROCEDURE Visit (v : Vertex);
+
+  VAR   e : Edge;   (*-- loop index over edges from v *)
+  VAR   w : Vertex; (*-- destination vertex of an edge (the vertex incident on e
+                                          -- that's not equal to v). *)
+  VAR   v1: Vertex; (*-- first vertex incident on e *)
+  VAR   v2: Vertex; (*-- second vertex incident on e *)
+
+  BEGIN
+    continue := process(v);
+        IF continue THEN
+          (*-- add v to the set of vertices already visited *)
+          SetSUMN.Include(Item(v), visited);
+
+          e := FirstEdge(v);
+          WHILE (e # NullEdge) & continue DO
+            IncidentOn(e, v1, v2);
+                IF (v1 = v) THEN
+                  w := v2;
+                ELSE
+                  w := v1;
+                END (*--if*);
+            IF ~SetSUMN.IsAMember(Item(w), visited) THEN
+              Visit(w);
+            END (*--if*);
+            e := NextEdge(e);
+          END (*--while*);
+        END (*--if*);
+  END Visit;
+
+BEGIN
+  continue := TRUE;
+  visited := SetSUMN.Create(LongCardTypeID());
+  v := FirstVertex(theGraph);
+  LOOP
+    IF (v = NullVertex) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+    IF ~SetSUMN.IsAMember(Item(v), visited) THEN
+          Visit(v);
+          IF ~continue THEN
+                EXIT (*--loop*);
+          END (*--if*);
+        END (*--if*);
+        v := NextVertex(v);
+  END (*--loop*);
+  SetSUMN.Destroy(visited);
+END DFS;
+(*-------------------------*)
+
+PROCEDURE BFS   (    theGraph   : Graph          (*--in   *);
+                                         process    : VertexLoopProc (*--in   *));
+
+VAR   u, v, w  : Vertex;      (*-- loop indexes over vertices *)
+          e        : Edge;                (*-- loop index over edges *)
+          continue : BOOLEAN;     (*-- controls termination of DFS *)
+          visited  : SetSUMN.Set; (*-- set of vertices already visited *)
+          toVisit  : QSUMN.Queue; (*-- vertices waiting to be visited *)
+
+BEGIN
+  continue := TRUE;
+  visited  := SetSUMN.Create(LongCardTypeID());
+  toVisit  := QSUMN.Create(LongCardTypeID());
+  u := FirstVertex(theGraph);
+
+  WHILE continue & (u # NullVertex) DO
+        IF ~SetSUMN.IsAMember(Item(u), visited) THEN
+          SetSUMN.Include(Item(u), visited);
+          QSUMN.Arrive(toVisit, Item(u));
+
+          WHILE continue & ~QSUMN.IsEmpty(toVisit) DO
+        v := Vertex(QSUMN.FrontOf(toVisit));
+                QSUMN.Depart(toVisit);
+
+                continue := process(v);
+
+                e := FirstEdge(v);
+                WHILE continue & (e # NullEdge) DO
+                  w := FirstOf(e);
+                  IF w = v THEN
+                        w := SecondOf(e);
+                  END (*--if*);
+                  IF ~SetSUMN.IsAMember(Item(w), visited) THEN
+                QSUMN.Arrive(toVisit, Item(w));
+                        SetSUMN.Include(Item(w), visited);
+                  END (*--if*);
+                  e := NextEdge(e);
+                END (*--while*);
+          END (*--while*);
+        END (*--if*);
+        u := NextVertex(u);
+  END (*--while*);
+
+  SetSUMN.Destroy(visited);
+  QSUMN.Destroy(toVisit);
+END BFS;
+(*-------------------------*)
+
+END GraSBMIUtil.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRASUMIU.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRASUMIU.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRASUMIU.MOD
@@ -0,0 +1,326 @@
+(*
+12.4    GraphSUMI Utilities Implementation
+
+This module provides the implementation of utility operations
+supporting the unbounded form of the graph abstract data type. Of
+course, these routines could have been included in the exported operations
+of the graph module itself. The reason we have not done so it that none
+of the operations in this module are primitive, i.e., require the internal
+representation of the graph in order to accomplish their function.
+*)
+
+IMPLEMENTATION MODULE GraSUMIUtil;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: 1419 bytes
+    Component: GraphSBMI Utilities
+
+    REVISION HISTORY
+    v1.01  08 Oct 1988  C. Lins:
+        Initial TML Modula-2 implementation
+    v1.02  10-13 Jan 1989  C. Lins:
+                Removed Graph parameter from vertex selectors.
+        Added depth-first search, breadth-first search, and
+                HasPath operations.
+    v2.00  24 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM GrafSUMI IMPORT
+        (*--cons*) NullGraph, NullVertex, NullEdge,
+        (*--type*) Graph, Vertex, Edge, VertexLoopProc,
+        (*--proc*) FirstVertex, NextVertex, FirstEdge, NextEdge,
+                           DegreeOf, IncidentOn, TravVertices, FirstOf,
+                           SecondOf;
+
+FROM TypeManager IMPORT
+    (*--Proc*) Create, LongCardTypeID;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+IMPORT SetSUMN;
+IMPORT QSUMN;
+
+(*
+12.4.1  Graph Utility Operations
+
+To find the minimum or maximum degree of a graph we must traverse the vertices of
+the given graph. Whenever a vertex is found having a degree smaller than the current
+minimum (or larger than the current maximum) we update the current value of the minimum
+(or maximum). For this algorithm to work correctly, we must initialize the current
+minimum to the largest possible minimum value (conversely, the maximum must be initialized
+to the smallest possible maximum). Since every vertex must be examined, the algorithmic
+complexity of both MinDegree and MaxDegree is O(|V|).
+*)
+
+VAR   minimum : CARDINAL; (*-- current minimum degree *)
+
+PROCEDURE FindMinDegree (    theVertex : Vertex (*--in   *));
+
+VAR   degree : CARDINAL; (*-- degree of the current vertex *)
+
+BEGIN
+  degree := DegreeOf(theVertex);
+  IF (degree < minimum) THEN
+        minimum := degree;
+  END (*--if*);
+END FindMinDegree;
+(*-------------------------*)
+
+PROCEDURE MinDegree (    theGraph  : Graph       (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  IF (theGraph = NullGraph) THEN
+        RETURN 0;
+  ELSE
+        minimum := MAX(CARDINAL);
+        TravVertices(theGraph, FindMinDegree);
+        RETURN minimum;
+  END (*--if*);
+END MinDegree;
+(*-------------------------*)
+
+
+VAR   maximum : CARDINAL; (*-- current minimum degree *)
+
+PROCEDURE FindMaxDegree (    theVertex : Vertex (*--in   *));
+
+VAR   degree : CARDINAL; (*-- degree of the current vertex *)
+
+BEGIN
+  degree := DegreeOf(theVertex);
+  IF (degree > maximum) THEN
+        maximum := degree;
+  END (*--if*);
+END FindMaxDegree;
+(*-------------------------*)
+
+PROCEDURE MaxDegree (    theGraph  : Graph       (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  maximum := MIN(CARDINAL);
+  IF (theGraph # NullGraph) THEN
+        TravVertices(theGraph, FindMaxDegree);
+  END (*--if*);
+  RETURN maximum;
+END MaxDegree;
+(*-------------------------*)
+
+(*
+12.4.2  Vertex Utility Operations
+
+An isolated vertex not only has no edges leaving the vertex but no edge is
+incident to the vertex. We can determine whether a vertex is isolated by
+testing the degree of the vertex being zero. Complexity O(DegreeOf(v)).
+*)
+
+PROCEDURE IsIsolated   (    theVertex : Vertex  (*--in   *))
+                                                              : BOOLEAN (*--out  *);
+BEGIN
+  RETURN (DegreeOf(theVertex) = 0);
+END IsIsolated;
+(*-------------------------*)
+
+(*
+A vertex has a self-loop is at least one edge leaving the vertex has that
+vertex as its destination. Thus we iterate over the edges seeking an edge
+that meets this criteria. As soon as such an edge is found we return True.
+If all edges leaving the vertex are examined without the routine exiting we
+know that the vertex has no self-loops. Complexity O(outdegree(v)).
+*)
+
+PROCEDURE HasSelfLoops (    theVertex : Vertex  (*--in   *))
+                                                              : BOOLEAN (*--out  *);
+
+VAR   e   : Edge;   (*-- loop pointer over edges of this vertex *)
+VAR   ep1 : Vertex; (*-- 1st endpoint of the edge *)
+VAR   ep2 : Vertex; (*-- 2nd endpoint of the edge *)
+
+BEGIN
+  e := FirstEdge(theVertex);
+  WHILE (e # NullEdge) DO
+    IncidentOn(e, ep1, ep2);
+        IF (ep1 = theVertex) & (ep2 = theVertex) THEN
+          RETURN TRUE;
+        END (*--if*);
+        e := NextEdge(e);
+  END (*--while*);
+  RETURN FALSE;
+END HasSelfLoops;
+(*-------------------------*)
+
+(*
+IsReachable uses a variation on the depth-first search given below. We create a
+set of vertices that have been visited and each time a vertex is processed
+it is added to the set. This way each vertex is examined only once. The traversal
+stops once the algorithm determines that there is a path between the fromVertex
+and the toVertex. Otherwise, the traversal completes without finding a path and
+FALSE is returned to the caller.
+*)
+
+PROCEDURE IsReachable (    fromVertex: Vertex      (*--in   *);
+                                                   toVertex  : Vertex      (*--in   *))
+                                                                         : BOOLEAN     (*--out  *);
+
+VAR   visited  : SetSUMN.Set; (*-- set of vertices already visited *)
+          pathFound: BOOLEAN;     (*-- true when path between vertices is found *)
+
+  PROCEDURE Visit (v : Vertex);
+
+  VAR   e   : Edge;   (*-- loop index over edges from v *)
+  VAR   ep1 : Vertex; (*-- 1st vertex of an edge *)
+  VAR   ep2 : Vertex; (*-- 2nd vertex of an edge *)
+
+  BEGIN
+    pathFound := (v = toVertex);
+        IF ~pathFound THEN
+          (*-- add v to the set of vertices already visited *)
+          SetSUMN.Include(Item(v), visited);
+
+          e := FirstEdge(v);
+          WHILE (e # NullEdge) & ~pathFound DO
+            IncidentOn(e, ep1, ep2);
+                IF (ep2 = v) THEN
+                  ep2 := ep1;
+                END (*--if*);
+            IF ~SetSUMN.IsAMember(Item(ep2), visited) THEN
+              Visit(ep2);
+            END (*--if*);
+            e := NextEdge(e);
+          END (*--while*);
+        END (*--if*);
+  END Visit;
+
+BEGIN
+  visited := SetSUMN.Create(LongCardTypeID());
+  Visit(fromVertex);
+  SetSUMN.Destroy(visited);
+  RETURN pathFound;
+END IsReachable;
+(*-------------------------*)
+
+
+(*
+12.4.3  Graph Traversal Utilities
+
+The two algorithms below implement the standard depth-first and breadth-first
+search for an undirected graph as given by Sedgewick [] and Mehlhorn []. Both
+algorithms stop whenever the VertexLoopProc returns FALSE.
+*)
+
+PROCEDURE DFS   (    theGraph   : Graph          (*--in   *);
+                                         process    : VertexLoopProc (*--in   *));
+
+VAR   v : Vertex; (*-- loop index over vertices *)
+          continue : BOOLEAN;     (*-- controls termination of DFS *)
+          visited  : SetSUMN.Set; (*-- set of vertices already visited *)
+
+  PROCEDURE Visit (v : Vertex);
+
+  VAR   e : Edge;   (*-- loop index over edges from v *)
+  VAR   w : Vertex; (*-- destination vertex of an edge (the vertex incident on e
+                                          -- that's not equal to v). *)
+  VAR   v1: Vertex; (*-- first vertex incident on e *)
+  VAR   v2: Vertex; (*-- second vertex incident on e *)
+
+  BEGIN
+    continue := process(v);
+        IF continue THEN
+          (*-- add v to the set of vertices already visited *)
+          SetSUMN.Include(Item(v), visited);
+
+          e := FirstEdge(v);
+          WHILE (e # NullEdge) & continue DO
+            IncidentOn(e, v1, v2);
+                IF (v1 = v) THEN
+                  w := v2;
+                ELSE
+                  w := v1;
+                END (*--if*);
+            IF ~SetSUMN.IsAMember(Item(w), visited) THEN
+              Visit(w);
+            END (*--if*);
+            e := NextEdge(e);
+          END (*--while*);
+        END (*--if*);
+  END Visit;
+
+BEGIN
+  continue := TRUE;
+  visited := SetSUMN.Create(LongCardTypeID());
+  v := FirstVertex(theGraph);
+  LOOP
+    IF (v = NullVertex) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+    IF ~SetSUMN.IsAMember(Item(v), visited) THEN
+          Visit(v);
+          IF ~continue THEN
+                EXIT (*--loop*);
+          END (*--if*);
+        END (*--if*);
+        v := NextVertex(v);
+  END (*--loop*);
+  SetSUMN.Destroy(visited);
+END DFS;
+(*-------------------------*)
+
+PROCEDURE BFS   (    theGraph   : Graph          (*--in   *);
+                                         process    : VertexLoopProc (*--in   *));
+
+VAR   u, v, w  : Vertex;      (*-- loop indexes over vertices *)
+          e        : Edge;                (*-- loop index over edges *)
+          continue : BOOLEAN;     (*-- controls termination of DFS *)
+          visited  : SetSUMN.Set; (*-- set of vertices already visited *)
+          toVisit  : QSUMN.Queue; (*-- vertices waiting to be visited *)
+
+BEGIN
+  continue := TRUE;
+  visited  := SetSUMN.Create(LongCardTypeID());
+  toVisit  := QSUMN.Create(LongCardTypeID());
+  u := FirstVertex(theGraph);
+
+  WHILE continue & (u # NullVertex) DO
+        IF ~SetSUMN.IsAMember(Item(u), visited) THEN
+          SetSUMN.Include(Item(u), visited);
+          QSUMN.Arrive(toVisit, Item(u));
+
+          WHILE continue & ~QSUMN.IsEmpty(toVisit) DO
+        v := Vertex(QSUMN.FrontOf(toVisit));
+                QSUMN.Depart(toVisit);
+
+                continue := process(v);
+
+                e := FirstEdge(v);
+                WHILE continue & (e # NullEdge) DO
+                  w := FirstOf(e);
+                  IF w = v THEN
+                        w := SecondOf(e);
+                  END (*--if*);
+                  IF ~SetSUMN.IsAMember(Item(w), visited) THEN
+                QSUMN.Arrive(toVisit, Item(w));
+                        SetSUMN.Include(Item(w), visited);
+                  END (*--if*);
+                  e := NextEdge(e);
+                END (*--while*);
+          END (*--while*);
+        END (*--if*);
+        u := NextVertex(u);
+  END (*--while*);
+
+  SetSUMN.Destroy(visited);
+  QSUMN.Destroy(toVisit);
+END BFS;
+(*-------------------------*)
+
+END GraSUMIUtil.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRASUUIU.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRASUUIU.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/GRAPHS/GRASUUIU.MOD
@@ -0,0 +1,272 @@
+IMPLEMENTATION MODULE GraSUUIUtil;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: 1410 bytes
+    Component: GraphSBMI Utilities
+
+    REVISION HISTORY
+    v1.00  27 Jan 1989  C. Lins:
+        Initial implementation derived from GraphSUMIUtil.
+    v1.01  14 Mar 1989  C. Lins:
+        Changed name of HasPath to IsReachable.
+    v2.00  24 Oct 1989  C. Lins
+        Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM GrafSUUI IMPORT
+        (*--cons*) NullGraph, NullVertex, NullEdge,
+        (*--type*) Graph, Vertex, Edge, VertexLoopProc,
+        (*--proc*) FirstVertex, NextVertex, FirstEdge, NextEdge,
+                           DegreeOf, IncidentOn, TravVertices, FirstOf,
+                           SecondOf;
+
+FROM TypeManager IMPORT
+    (*--Proc*) Create, LongCardTypeID;
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+IMPORT SetSUUN;
+IMPORT QSUUN;
+
+
+VAR   minimum : CARDINAL; (*-- current minimum degree *)
+
+PROCEDURE FindMinDegree (    theVertex : Vertex (*--in   *));
+
+VAR   degree : CARDINAL; (*-- degree of the current vertex *)
+
+BEGIN
+  degree := DegreeOf(theVertex);
+  IF (degree < minimum) THEN
+        minimum := degree;
+  END (*--if*);
+END FindMinDegree;
+(*-------------------------*)
+
+PROCEDURE MinDegree (    theGraph  : Graph       (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  IF (theGraph = NullGraph) THEN
+        RETURN 0;
+  ELSE
+        minimum := MAX(CARDINAL);
+        TravVertices(theGraph, FindMinDegree);
+        RETURN minimum;
+  END (*--if*);
+END MinDegree;
+(*-------------------------*)
+
+
+VAR   maximum : CARDINAL; (*-- current minimum degree *)
+
+PROCEDURE FindMaxDegree (    theVertex : Vertex (*--in   *));
+
+VAR   degree : CARDINAL; (*-- degree of the current vertex *)
+
+BEGIN
+  degree := DegreeOf(theVertex);
+  IF (degree > maximum) THEN
+        maximum := degree;
+  END (*--if*);
+END FindMaxDegree;
+(*-------------------------*)
+
+PROCEDURE MaxDegree (    theGraph  : Graph       (*--in   *))
+                                                                   : CARDINAL    (*--out  *);
+BEGIN
+  maximum := MIN(CARDINAL);
+  IF (theGraph # NullGraph) THEN
+        TravVertices(theGraph, FindMaxDegree);
+  END (*--if*);
+  RETURN maximum;
+END MaxDegree;
+(*-------------------------*)
+
+
+PROCEDURE IsIsolated   (    theVertex : Vertex  (*--in   *))
+                                                              : BOOLEAN (*--out  *);
+BEGIN
+  RETURN (DegreeOf(theVertex) = 0);
+END IsIsolated;
+(*-------------------------*)
+
+
+PROCEDURE HasSelfLoops (    theVertex : Vertex  (*--in   *))
+                                                              : BOOLEAN (*--out  *);
+
+VAR   e   : Edge;   (*-- loop pointer over edges of this vertex *)
+VAR   ep1 : Vertex; (*-- 1st endpoint of the edge *)
+VAR   ep2 : Vertex; (*-- 2nd endpoint of the edge *)
+
+BEGIN
+  e := FirstEdge(theVertex);
+  WHILE (e # NullEdge) DO
+    IncidentOn(e, ep1, ep2);
+        IF (ep1 = theVertex) & (ep2 = theVertex) THEN
+          RETURN TRUE;
+        END (*--if*);
+        e := NextEdge(e);
+  END (*--while*);
+  RETURN FALSE;
+END HasSelfLoops;
+(*-------------------------*)
+
+
+PROCEDURE IsReachable (    fromVertex: Vertex  (*--in   *);
+                                                   toVertex  : Vertex  (*--in   *))
+                                                                         : BOOLEAN (*--out  *);
+
+VAR   visited  : SetSUUN.Set; (*-- set of vertices already visited *)
+          pathFound: BOOLEAN;     (*-- true when path between vertices is found *)
+
+  PROCEDURE Visit (v : Vertex);
+
+  VAR   e   : Edge;   (*-- loop index over edges from v *)
+  VAR   ep1 : Vertex; (*-- 1st vertex of an edge *)
+  VAR   ep2 : Vertex; (*-- 2nd vertex of an edge *)
+
+  BEGIN
+    pathFound := (v = toVertex);
+        IF ~pathFound THEN
+          (*-- add v to the set of vertices already visited *)
+          SetSUUN.Include(Item(v), visited);
+
+          e := FirstEdge(v);
+          WHILE (e # NullEdge) & ~pathFound DO
+            IncidentOn(e, ep1, ep2);
+                IF (ep2 = v) THEN
+                  ep2 := ep1;
+                END (*--if*);
+            IF ~SetSUUN.IsAMember(Item(ep2), visited) THEN
+              Visit(ep2);
+            END (*--if*);
+            e := NextEdge(e);
+          END (*--while*);
+        END (*--if*);
+  END Visit;
+
+BEGIN
+  visited := SetSUUN.Create(LongCardTypeID());
+  Visit(fromVertex);
+  SetSUUN.Destroy(visited);
+  RETURN pathFound;
+END IsReachable;
+(*-------------------------*)
+
+
+PROCEDURE DFS   (    theGraph   : Graph          (*--in   *);
+                                         process    : VertexLoopProc (*--in   *));
+
+VAR   v : Vertex; (*-- loop index over vertices *)
+          continue : BOOLEAN;     (*-- controls termination of DFS *)
+          visited  : SetSUUN.Set; (*-- set of vertices already visited *)
+
+  PROCEDURE Visit (v : Vertex);
+
+  VAR   e : Edge;   (*-- loop index over edges from v *)
+  VAR   w : Vertex; (*-- destination vertex of an edge (the vertex incident on e
+                                          -- that's not equal to v). *)
+  VAR   v1: Vertex; (*-- first vertex incident on e *)
+  VAR   v2: Vertex; (*-- second vertex incident on e *)
+
+  BEGIN
+    continue := process(v);
+        IF continue THEN
+          (*-- add v to the set of vertices already visited *)
+          SetSUUN.Include(Item(v), visited);
+
+          e := FirstEdge(v);
+          WHILE (e # NullEdge) & continue DO
+            IncidentOn(e, v1, v2);
+                IF (v1 = v) THEN
+                  w := v2;
+                ELSE
+                  w := v1;
+                END (*--if*);
+            IF ~SetSUUN.IsAMember(Item(w), visited) THEN
+              Visit(w);
+            END (*--if*);
+            e := NextEdge(e);
+          END (*--while*);
+        END (*--if*);
+  END Visit;
+
+BEGIN
+  continue := TRUE;
+  visited := SetSUUN.Create(LongCardTypeID());
+  v := FirstVertex(theGraph);
+  LOOP
+    IF (v = NullVertex) THEN
+          EXIT (*--loop*);
+        END (*--if*);
+
+    IF ~SetSUUN.IsAMember(Item(v), visited) THEN
+          Visit(v);
+          IF ~continue THEN
+                EXIT (*--loop*);
+          END (*--if*);
+        END (*--if*);
+        v := NextVertex(v);
+  END (*--loop*);
+  SetSUUN.Destroy(visited);
+END DFS;
+(*-------------------------*)
+
+PROCEDURE BFS   (    theGraph   : Graph          (*--in   *);
+                                         process    : VertexLoopProc (*--in   *));
+
+VAR   u, v, w  : Vertex;      (*-- loop indexes over vertices *)
+          e        : Edge;                (*-- loop index over edges *)
+          continue : BOOLEAN;     (*-- controls termination of DFS *)
+          visited  : SetSUUN.Set; (*-- set of vertices already visited *)
+          toVisit  : QSUUN.Queue; (*-- vertices waiting to be visited *)
+
+BEGIN
+  continue := TRUE;
+  visited  := SetSUUN.Create(LongCardTypeID());
+  toVisit  := QSUUN.Create();
+  u := FirstVertex(theGraph);
+
+  WHILE continue & (u # NullVertex) DO
+        IF ~SetSUUN.IsAMember(Item(u), visited) THEN
+          SetSUUN.Include(Item(u), visited);
+          QSUUN.Arrive(toVisit, Item(u));
+
+          WHILE continue & ~QSUUN.IsEmpty(toVisit) DO
+        v := Vertex(QSUUN.FrontOf(toVisit));
+                QSUUN.Depart(toVisit);
+
+                continue := process(v);
+
+                e := FirstEdge(v);
+                WHILE continue & (e # NullEdge) DO
+                  w := FirstOf(e);
+                  IF w = v THEN
+                        w := SecondOf(e);
+                  END (*--if*);
+                  IF ~SetSUUN.IsAMember(Item(w), visited) THEN
+                QSUUN.Arrive(toVisit, Item(w));
+                        SetSUUN.Include(Item(w), visited);
+                  END (*--if*);
+                  e := NextEdge(e);
+                END (*--while*);
+          END (*--while*);
+        END (*--if*);
+        u := NextVertex(u);
+  END (*--while*);
+
+  SetSUUN.Destroy(visited);
+  QSUUN.Destroy(toVisit);
+END BFS;
+(*-------------------------*)
+
+END GraSUUIUtil.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/AVLSUMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/AVLSUMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/AVLSUMI.DEF
@@ -0,0 +1,409 @@
+(*
+6.1 Height Balanced Binary Search Tree Interface
+
+This module provides operations for a variant of the binary search
+tree abstract data type known as height-balanced or AVL trees. The shape
+of these trees is restricted through a mechanism called balancing.
+In this particular case, balancing yields a height (longest path
+from root to leaf) difference between the left and right subtrees of at
+most one. Because of this characteristic, the number of nodes examined
+during a search of the tree is in practice considerably less than that
+obtained using unbalanced binary trees. Further information on AVL trees
+can be obtained from Chapter 3 and references [Gonnet, Wirth, Wiener].
+
+Each node of a tree is assumed to consist of two data elements ≡ a key
+field and a data field. Keys are used to structure the tree, while the
+data field simply represents information associated with a key but is
+not a part of it. While this separation may be less efficient in operation,
+it does lead to a cleaner interface.
+
+Keys are assumed to have the following operations available:
+        * a routine that assigns key values;
+        * a routine that compares key values returning the ordering
+          relation between them (i.e., less, equal, or greater); and
+        * optionally, a routine that disposes of key values that have been
+          allocated on the heap.
+
+Data values are assumed to the the following operations:
+        * a routine that assigns data values; and
+        * optionally, a routine that disposes of data values stored on the
+          heap.
+
+In both cases, keys and data values, along with the above operations, are
+identified by a TypeID that is unique for a given data type. This data type
+may be a standard Modula-2 type or one formed by the programmer using data
+type forming operations (e.g., RECORDs).
+
+The subsections are divided as follows:
+        * 6.1.1 Type Declarations
+        * 6.1.2 Exception Handling
+        * 6.1.3 Tree Constructors
+        * 6.1.4 Tree Selectors
+        * 6.1.5 Passive Iterators
+        * 6.1.6 Active Iterators
+*)
+
+DEFINITION MODULE AVLSUMI;
+(*==============================================================
+    Version  : 1.06  18 Apr 1989  C. Lins
+    Compiler : JPI TopSpeed Modula-2
+    Component: Monolithic Structures - Tree (Opaque version)
+               Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.01  18 May 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.02  01 Oct 1988  C. Lins
+      Updated and improved comments.
+    v1.03  29 Jan 1989  C. Lins
+      Added aliases for generic Items as Keys and Data to enhance
+          readability.
+    v1.04  06 Feb 1989  C. Lins
+          Added use of InsertProc instead of FoundProc in Insert.
+    v1.05  09 Feb 1989  C. Lins
+          Removed VAR from Clear, Insert, & Remove (the tree itself
+          does not change).
+    v1.06  18 Apr 1989  C. Lins
+          Changed module id.
+    v2.00  08 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  Iain Houston.
+          Adapted to JPI Compiler:
+          Use of type transfer functions instead of VAL.
+          Use of shortened library module names.
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM TreeTypes IMPORT
+    (*--Type*) Exceptions, Key, Data,
+               AccessProc, InsertProc, FoundProc, NotFoundProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+    (*-----------------------*)
+
+(*
+6.1.1 Type Declarations
+
+Each instance of the Height-Balanced Binary Tree abstract data type is
+represented by the type, Tree, using Modula-2's opaque type definition
+facility. An undefined tree is represented by a Tree constant of NIL.
+*)
+
+TYPE  Tree;
+VAR   NullTree : Tree;
+
+
+(*
+6.1.2 Exception Handling
+
+The following types and routines are used to support the exception
+handling mechanism. This mechanism is consistent across all modules
+in this series.
+
+ModuleID        is a constant that uniquely identifies this module,
+                        in this case the number 2004. This allows exception
+                        handlers to know the module raising an exception.
+
+TreeError       returns the most recent exception condition from the last
+                tree operation or the constant noerr if an exception was
+                not raised.
+GetHandler      returns the exception handler for the given exception condition.
+
+SetHandler      allows client modules to assign an exception handling routine
+                for specific exceptions. In this way the client may override
+                he default exception handling mechanism (which does nothing).
+*)
+
+
+CONST ModuleID = 1;
+
+PROCEDURE TreeError  ()              : Exceptions  (*--out  *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+
+
+        (*-----------------------*)
+
+(*
+6.1.3   Tree Constructors
+
+Constructor operations update or change the state of a tree object. In
+this section we briefly describe each tree operation and its effect on
+a tree object. Exception conditions raised by these routines have been
+previously discussed in 3.3, Binary Search Tree Operations.
+
+Create  attempts to form a new, empty binary tree object having the given
+                key and data type identifiers.
+
+MakeTree does the same as Create, except that it also attempts to add
+         the given key and data items as the root of the new tree.
+
+Destroy attempts to demolish an existing tree object, clearing the tree
+        of all its contents and making the tree ≡undefined≡.
+
+Clear   empties an existing tree of its contents returning the tree to
+        an empty state.
+
+Assign  attempts to duplicate (e.g., make a copy) of an existing tree.
+        The target tree, where the copy is stored, is cleared of its
+        contents, if any, before the assignment commences.
+
+Insert  attempts to add a node having the given key and data values
+        to the given tree. The tree is rebalanced if necessary to ensure
+        that the height-balanced property is maintained. If a node
+        already exists in the tree with the given key the found procedure
+        parameter is invoked and the new element is not added to the tree.
+
+Remove  searches the given tree for the node containing the specified key
+        value and removing this node from the tree. If a node does not
+        exist in the tree with the given key the notFound procedure
+        parameter is invoked. Following the removal of the node, the
+        tree is rebalanced, if necessary, to maintain the height-balance
+        property.
+*)
+
+PROCEDURE Create    (    keyType  : TypeID       (*--in   *);
+                         dataType : TypeID       (*--in   *))
+                                  : Tree         (*--out  *);
+
+PROCEDURE MakeTree  (    keyType  : TypeID       (*--in   *);
+                         dataType : TypeID       (*--in   *);
+                         theKey   : Key          (*--in   *);
+                         theData  : Data         (*--in   *))
+                                  : Tree         (*--out  *);
+
+PROCEDURE Destroy   (VAR theTree  : Tree         (*--inout*));
+
+PROCEDURE Clear     (    theTree  : Tree         (*--inout*));
+
+PROCEDURE Assign    (    theTree  : Tree         (*--in   *);
+                     VAR toTree   : Tree         (*--inout*));
+
+PROCEDURE Insert    (    theTree  : Tree         (*--inout*);
+                         theKey   : Key          (*--in   *);
+                         theData  : Data         (*--in   *);
+                         found    : InsertProc   (*--in   *));
+
+PROCEDURE Remove    (    theTree  : Tree         (*--inout*);
+                         theKey   : Key          (*--in   *);
+                         notFound : NotFoundProc (*--in   *));
+
+
+        (*-----------------------*)
+
+(*
+6.1.4 Selectors
+
+Selector operations allow a client module to examine the state of a tree
+without changing that state.
+
+IsDefined       verifies whether theTree has been created and is still an
+                        active object. For our purposes, a tree object is considered
+                        defined if it is not equal to the NullTree.
+
+IsEmpty         returns true if the given tree does not contain any nodes, and
+                        false otherwise.
+
+IsEqual         returns true if and only if the two trees have the same key and
+                        data item types, contain the same items, and have the same
+                        relationships between each item.
+
+KeyTypeOf       simpy returns the data type ID of the keys associated with this tree.
+
+DataTypeOf      returns the data item type ID of the given tree.
+
+ExtentOf        returns a count indicating the total number of nodes in the tree.
+
+IsPresent       searches the given tree for the item with the given key value.
+                        If the item is found the found procedure parameter is called,
+                        otherwise the notFound procedure parameter is called.
+*)
+
+PROCEDURE IsDefined  (    theTree  : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+
+PROCEDURE IsEmpty    (    theTree  : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+
+PROCEDURE IsEqual    (    left     : Tree         (*--in   *);
+                          right    : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+
+PROCEDURE KeyTypeOf  (    theTree  : Tree         (*--in   *))
+                                   : TypeID       (*--out  *);
+
+PROCEDURE DataTypeOf (    theTree  : Tree         (*--in   *))
+                                   : TypeID       (*--out  *);
+
+PROCEDURE ExtentOf   (    theTree  : Tree         (*--in   *))
+                                   : CARDINAL     (*--out  *);
+
+PROCEDURE IsPresent  (    theTree  : Tree         (*--in   *);
+                          theKey   : Key          (*--in   *);
+                                                  found    : FoundProc    (*--in   *);
+                                                  notFound : NotFoundProc (*--in   *));
+
+
+        (*-----------------------*)
+
+(*
+6.1.5 Passive Iterators
+
+Three passive iterators are provided each implementing one of the standard
+tree traversal algorithms. Passive iterators allow the client module
+to traverse the tree as through it were a single, monolithic data structure.
+*)
+
+PROCEDURE Preorder  (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+PROCEDURE Inorder   (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+PROCEDURE Postorder (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+        (*-----------------------*)
+
+(*
+6.1.6 Active Iterators
+
+While passive iterators are most useful for tree objects, there may
+be situations when the client module requires more control over the
+iteration process (e.g., when printing the internal binary tree
+representation). In this case, it is necessary to use an active
+iteration mechanism, where the internal structure of a tree is made
+visible to the client in a controlled manner that ensures the safety
+of the abstraction.
+
+In the form presented here, the internal structure is made visible
+through the opaque type NodePtr, representing a subtree node of a tree.
+An empty subtree is modelled by the constant NullNode. Balance represents
+the number of external nodes rooted at a given subtree. If the subtree is
+empty by convention the balance is zero.
+
+The reader should note that none of the active iterator operations
+raise exceptions.
+
+NodePtr         is a type used to represent and individual node of the tree.
+
+NullNode        is a constant representing an empty subtree.
+
+Balance         represents the difference in height between the right and
+                        left subtrees of a given subtree.
+
+RootOf          returns a reference to the root node of the given tree. If
+                        the tree is empty then the NullNode is returned.
+
+LeftOf          returns the node that is the left subtree from the given
+                        node. If the given node has no left subtree then the NullNode
+                        is returned.
+
+RightOf         returns the node that is the right subtree from the given
+                        node. If the given node has no right subtree then the NullNode
+                        is returned.
+
+IsNull          returns true is the given node is equal to the NullNode and
+                        false otherwise.
+
+KeyOf           returns the key value associated with the given node. If the
+                        node is empty (i.e., equal to the NullNode) the NullItem is
+                        returned instead.
+
+DataOf          returns the data value associated with the given node. If the
+                        node is empty (i.e., equal to the NullNode) the NullItem is
+                        returned instead.
+
+BalanceOf       returns the balance factor for the given node. If the node is
+                        null, then a balance of zero (0) is returned.
+*)
+
+TYPE  NodePtr;
+CONST NullNode = NodePtr(NIL);
+
+TYPE  Balance  = INTEGER;
+
+
+PROCEDURE RootOf    (    theTree : Tree     (*--in   *))
+                                                             : NodePtr  (*--out  *);
+
+PROCEDURE LeftOf    (    theNode : NodePtr  (*--in   *))
+                                                             : NodePtr  (*--out  *);
+
+PROCEDURE RightOf   (    theNode : NodePtr  (*--in   *))
+                                                             : NodePtr  (*--out  *);
+
+PROCEDURE IsNull    (    theNode : NodePtr  (*--in   *))
+                                                             : BOOLEAN  (*--out  *);
+
+PROCEDURE KeyOf     (    theNode : NodePtr  (*--in   *))
+                                                             : Key      (*--out  *);
+
+PROCEDURE DataOf    (    theNode : NodePtr  (*--in   *))
+                                                             : Data     (*--out  *);
+
+PROCEDURE BalanceOf (    theNode : NodePtr  (*--in   *))
+                                                             : Balance  (*--out  *);
+
+END AVLSUMI.
+
+(*
+
+                                Algorithmic     Code
+Operation Name  Complexity      Size
+                                (bytes)
+TreeError               O(1)             26             Exception Handling Routines
+GetHandler              O(1)             42
+SetHandler              O(1)             38
+
+Create                  O(1)             88             Constructors
+Destroy                 O(1)             44
+MakeTree                O(1)            146
+Clear                   O(n)            218
+Assign                  O(m+n)          514
+Insert                  O(log2 n)       672
+Remove                  O(log2 n)  1074
+
+IsDefined               O(1)             36             Selectors
+IsEmpty                 O(1)             74
+IsEqual                 O(Min(m,n))     326
+ExtentOf                O(n)            144
+KeyTypeOf               O(1)             64
+DataTypeOf              O(1)             66
+IsPresent               O(log2 n)       212
+
+Inorder                 O(n)            146             Passive Iterators
+Preeorder               O(n)            146
+Postorder               O(n)            146
+
+RootOf                  O(1)             50             Active Iterators
+LeftOf                  O(1)             50
+RightOf                 O(1)             50
+IsNull                  O(1)             36
+KeyOf                   O(1)             48
+DataOf                  O(1)             50
+BalanceOf               O(1)             50
+
+RaiseErrIn              O(1)             58             Local Routines
+NewNode                 O(1)             76
+LeftRotation    O(1)             70
+RightRotation   O(1)             70
+RLRotation              O(1)            186
+LRRotation              O(1)            186
+Initialization  O(1)             92
+
+Grand Total                                5294
+
+Table 6.1 Unbounded AVL Tree Operations Summary
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/AVLSUMIU.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/AVLSUMIU.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/AVLSUMIU.DEF
@@ -0,0 +1,75 @@
+(*
+6.3 Height Balanced Binary Search Tree Utilities
+
+This module provides the facility for displaying the hierarchy of
+a binary tree on the terminal while presenting an example using
+active iterators. Printing the tree is also possible depending
+on whether standard output has been so redirected. Also provided
+is a routine to determine the height of a given tree.
+*)
+
+DEFINITION MODULE AVLSUMIU;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Component: AVL Tree SUMI Utilities
+
+    REVISION HISTORY
+    v1.00  17 Mar 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.01  01 Oct 1988  C. Lins
+      Cleanup of comments.
+          Changed PrintTree to use a single procedure parameter.
+          Added HeightOf selector.
+    v1.03  29 Jan 1989  C. Lins
+      Changed to use Key and Data aliases for generic Items.
+    v2.00  08 Oct 1989  C. Lins
+         Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Use of type transfer functions instead of VAL.
+          Use of shortened library module names.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM TreeTypes IMPORT
+    (*--Type*) Key, Data;
+
+FROM AVLSUMI IMPORT
+    (*--Type*) Tree, Balance;
+
+
+        (*-----------------------*)
+
+(*
+6.3.1 Utility Selectors
+
+HeightOf returns the height of the given tree.
+*)
+
+PROCEDURE HeightOf (    theTree : Tree     (*--in   *))
+                                                                : CARDINAL (*--out  *);
+
+(*
+6.3.2 Debugging Iterators
+
+PrintTree iterates over the given tree such that the nodes may be
+printed. Trees are normally displayed with the root at the top and
+the leaves at the bottom. To simplify the printing process, PrintTree
+displays the tree rotated 90Æ to the left. Thus the root is shown at
+the left of the page/screen with the leaves at the right. Furthermore,
+the left branches are shown towards the bottom of the display and the
+right branches at the top. The PrintProc routine is responsible for
+indenting the display appropriately based on the level parameter.
+*)
+
+TYPE  Level    = CARDINAL;
+
+TYPE  PrintProc  = PROCEDURE (Level, Key, Data, Balance);
+
+PROCEDURE PrintTree (    theTree: Tree       (*--in   *);
+                         print  : PrintProc  (*--in   *));
+
+END AVLSUMIU.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/AVLSUMIU.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/AVLSUMIU.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/AVLSUMIU.MOD
@@ -0,0 +1,116 @@
+(*
+6.4 Balanced Binary Search Tree Utilities
+
+Below is the implementation for the print tree routine whose
+interface was given above.
+*)
+
+IMPLEMENTATION MODULE AVLSUMIU;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Component: AVL Tree SUMI Utilities
+    Code size: OBJ file is 1613 bytes
+
+    REVISION HISTORY
+    v1.00  17 Mar 1988  C. Lins
+          Initial implementation for TML Modula-2.
+    v1.01  01 Oct 1988  C. Lins
+          Cleanup of comments.
+          Changed PrintTree to use a single procedure parameter.
+          Added HeightOf selector.
+    v2.00  08 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Use of type transfer functions instead of VAL.
+          Use of shortened library module names.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM AVLSUMI IMPORT
+        (*--Type*) Tree, NodePtr, Balance,
+        (*--Proc*) RootOf, LeftOf, RightOf, IsNull, KeyOf, DataOf,
+                           BalanceOf, IsEmpty;
+
+        (*-----------------------*)
+
+(*
+6.4.1 Utility Selectors
+
+HeightOf returns the height of the given tree. Height may be computed by
+subtracting the level of the ≡lowest≡ node in the tree from the level of
+the root.  Complexity O(log2 n).
+*)
+
+PROCEDURE HeightOf (    theTree : Tree     (*--in   *))
+                                                                : CARDINAL (*--out  *);
+
+VAR   maxLevel : CARDINAL; (*-- level of the lowest node so far *)
+
+  PROCEDURE CountLevels (    theNode : NodePtr  (*--in   *);
+                                                         theLevel: CARDINAL (*--in   *));
+  BEGIN
+    IF ~IsNull(theNode) THEN
+          IF (theLevel > maxLevel) THEN
+            maxLevel := theLevel;
+          END (*--if*);
+          CountLevels(LeftOf(theNode), theLevel+1);
+          CountLevels(RightOf(theNode), theLevel+1);
+        END (*--if*);
+  END CountLevels;
+
+BEGIN
+  maxLevel := 1;
+  IF ~IsEmpty(theTree) THEN
+    CountLevels(RootOf(theTree), 1);
+  END (*--if*);
+  RETURN maxLevel - 1;
+END HeightOf;
+(*-------------------------*)
+
+(*
+6.4.2 Debugging Iterators
+
+PrintTree iterates over the given tree such that the nodes may be
+printed. Trees are normally displayed with the root at the top and
+the leaves at the bottom. To simplify the printing process, PrintTree
+displays the tree rotated 90Æ to the left. Thus the root is shown at
+the left of the page/screen with the leaves at the right. Furthermore,
+the left branches are shown towards the bottom of the display and the
+right branches at the top. A constant indentation of two spaces between
+levels is used.
+
+The algorithm used here is a variation on the inorder tree traversal. So
+that the tree is displayed properly rotated, the processing of the left
+and right branches are reversed. This algorithm is derived from that
+given by Wirth in [8].
+*)
+
+PROCEDURE PrintTree (    theTree: Tree       (*--in   *);
+                         print  : PrintProc  (*--in   *));
+
+  PROCEDURE DoPrintTree (    theSubtree : NodePtr  (*--in   *);
+                                                         theLevel   : CARDINAL (*--in   *));
+  BEGIN
+    IF ~IsNull(theSubtree) THEN
+          DoPrintTree(RightOf(theSubtree), theLevel+1);
+          print(theLevel, KeyOf(theSubtree),
+                        DataOf(theSubtree), BalanceOf(theSubtree));
+          DoPrintTree(LeftOf(theSubtree), theLevel+1);
+        END (*--if*);
+  END DoPrintTree;
+
+BEGIN
+  IF ~IsEmpty(theTree) THEN
+    DoPrintTree(RootOf(theTree), 0);
+  END (*--if*);
+END PrintTree;
+(*-------------------------*)
+
+END AVLSUMIU.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/BBSUMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/BBSUMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/BBSUMI.DEF
@@ -0,0 +1,418 @@
+(*
+7.1 Weight Balanced Binary Search Tree Interface
+
+This module provides operations for weight balanced binary search
+tree as an abstract data type. These trees obey a balance criterion
+on the subtrees of every node. Each node of the tree has a weight
+attached to it. A tree is said to be of weighted balance "a" or of
+bounded balance "a", or in the set BB[a], for 0 <= a <= 1/2, if for
+every node in the tree has balance, p(t), between a and 1 - a. The
+balance of a node is defined as
+
+                number of leaves in t^.left
+        p(t) = -----------------------------
+                number of leaves in t
+
+The empty binary tree is in BB[a] by convention.
+
+This module trees are weight balanced trees with a = 1-Sqrt(2)/2 = 0.292893≡
+
+Each node of a tree is assumed to consist of two data elements ≡ a key
+field and a data field. Keys are used to structure the tree, while the
+data field simply represents information associated with a key but is
+not a part of it. While this separation may be less efficient in operation,
+it does lead to a cleaner interface.
+
+Keys are assumed to have the following operations available:
+        * a routine that assigns key values;
+        * a routine that compares key values returning the ordering
+          relation between them (i.e., less, equal, or greater); and
+        * optionally, a routine that disposes of key values that have been
+          allocated on the heap.
+
+Data values are assumed to the the following operations:
+        * a routine that assigns data values; and
+        * optionally, a routine that disposes of data values stored on the
+          heap.
+
+In both cases, keys and data values, along with the above operations, are
+identified by a TypeID that is unique for a given data type. This data type
+may be a standard Modula-2 type or one formed by the programmer using data
+type forming operations (e.g., RECORDs).
+
+The subsections are divided as follows:
+        * 7.1.1 Type Declarations
+        * 7.1.2 Exception Handling
+        * 7.1.3 Tree Constructors
+        * 7.1.4 Tree Selectors
+        * 7.1.5 Passive Iterators
+        * 7.1.6 Active Iterators
+*)
+
+DEFINITION MODULE BBSUMI;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Component: Monolithic Structures - Tree (Opaque version)
+               Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.01  18 May 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.02  01 Oct 1988  C. Lins
+      Updated and improved comments.
+    v1.03  29 Jan 1989  C. Lins
+      Added aliases for generic Items as Keys and Data to enhance
+          readability.
+    v1.04  06 Feb 1989  C. Lins
+          Added use of InsertProc instead of FoundProc in Insert.
+    v1.05  09 Feb 1989  C. Lins
+          Removed VAR from Clear, Insert, & Remove (the tree itself
+          does not change).
+    v1.06  18 Apr 1989  C. Lins
+          Changed module id.
+    v2.00  08 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Use of type transfer functions instead of VAL.
+          Use of shortened library module names.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM TreeTypes IMPORT
+    (*--Type*) Exceptions, Key, Data,
+               AccessProc, InsertProc, FoundProc, NotFoundProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+        (*-----------------------*)
+
+(*
+7.1.1 Type Declarations
+
+Each instance of the Weighted Binary Tree abstract data type is
+represented by the type, Tree, using Modula-2's opaque type definition
+facility. The undefined tree is represented by a Tree constant of NIL.
+*)
+
+TYPE  Tree;
+VAR   NullTree : Tree;
+
+
+        (*-----------------------*)
+
+(*
+7.1.2 Exceptions
+
+The following types and routines are used to support the exception
+handling mechanism. This mechanism is consistent across all modules
+in this series.
+
+ModuleID        is a constant that uniquely identifies this module,
+                        in this case the number 2008. This allows exception
+                        handlers to know the module raising an exception.
+
+TreeError       returns the most recent exception condition from the last
+                        tree operation or the constant noerr if an exception was
+                        not raised.
+GetHandler      returns the exception handler for the given exception condition.
+
+SetHandler      allows client modules to assign an exception handling routine
+                        for specific exceptions. In this way the client may override
+                        the default exception handling mechanism (which does nothing).
+*)
+
+CONST ModuleID = 3;
+
+PROCEDURE TreeError  ()              : Exceptions  (*--out  *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+
+
+        (*-----------------------*)
+
+(*
+7.1.3 Constructors
+
+Constructor operations update or change the state of a tree object. In
+this section we briefly describe each tree operation and its effect on
+a tree object. Exception conditions raised by these routines have been
+previously discussed in 3.3, Binary Search Tree Operations.
+
+Create  attempts to form a new, empty binary tree object having the given
+                key and data type identifiers.
+
+MakeTree does the same as Create, except that it also attempts to add
+                the given key and data items as the root of the new tree.
+
+Destroy attempts to demolish an existing tree object, clearing the tree
+                of all its contents and making the tree ≡undefined≡.
+
+Clear   empties an existing tree of its contents returning the tree to
+                an empty state.
+
+Assign  attempts to duplicate (e.g., make a copy) of an existing tree.
+                The target tree, where the copy is stored, is cleared of its
+                contents, if any, before the assignment commences.
+
+Insert  attempts to add a node having the given key and data values
+                to the given tree. The tree is rebalanced if necessary to ensure
+                that the weight-balanced property is maintained. If a node
+                already exists in the tree with the given key the found procedure
+                parameter is invoked and the new element is not added to the tree.
+
+Remove  searches the given tree for the node containing the specified key
+                value and removing this node from the tree. If a node does not
+                exist in the tree with the given key the notFound procedure
+                parameter is invoked. Following the removal of the node, the
+                tree is rebalanced, if necessary, to maintain the weight-balance
+                property.
+*)
+
+PROCEDURE Create    (    keyType  : TypeID       (*--in   *);
+                                                 dataType : TypeID       (*--in   *))
+                                  : Tree         (*--out  *);
+
+PROCEDURE MakeTree  (    keyType  : TypeID       (*--in   *);
+                                                 dataType : TypeID       (*--in   *);
+                         theKey   : Key          (*--in   *);
+                                                 theData  : Data         (*--in   *))
+                                  : Tree         (*--out  *);
+
+PROCEDURE Destroy   (VAR theTree  : Tree         (*--inout*));
+
+PROCEDURE Clear     (    theTree  : Tree         (*--inout*));
+
+PROCEDURE Assign    (    theTree  : Tree         (*--in   *);
+                     VAR toTree   : Tree         (*--inout*));
+
+PROCEDURE Insert    (    theTree  : Tree         (*--inout*);
+                         theKey   : Key          (*--in   *);
+                         theData  : Data         (*--in   *);
+                                                 found    : InsertProc   (*--in   *));
+
+PROCEDURE Remove    (    theTree  : Tree         (*--inout*);
+                         theKey   : Key          (*--in   *);
+                                                 notFound : NotFoundProc (*--in   *));
+
+
+        (*-----------------------*)
+
+(*
+7.1.4 Selectors
+
+Selector operations allow a client module to examine the state of a tree
+without changing that state.
+
+IsDefined       verifies whether theTree has been created and is still an
+                        active object. For our purposes, a tree object is considered
+                        defined if it is not equal to the NullTree.
+
+IsEmpty         returns true if the given tree does not contain any nodes, and
+                        false otherwise.
+
+IsEqual         returns true if and only if the two trees have the same key and
+                        data item types, contain the same items, and have the same
+                        relationships between each item.
+
+KeyTypeOf       simpy returns the data type ID of the keys associated with this tree.
+
+DataTypeOf      returns the data item type ID of the given tree.
+
+ExtentOf        returns a count indicating the total number of nodes in the tree.
+
+IsPresent       searches the given tree for the item with the given key value.
+                        If the item is found the found procedure parameter is called,
+                        otherwise the notFound procedure parameter is called.
+*)
+
+PROCEDURE IsDefined  (    theTree  : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+
+PROCEDURE IsEmpty    (    theTree  : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+
+PROCEDURE IsEqual    (    left     : Tree         (*--in   *);
+                          right    : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+
+PROCEDURE KeyTypeOf  (    theTree  : Tree         (*--in   *))
+                                   : TypeID       (*--out  *);
+
+PROCEDURE DataTypeOf (    theTree  : Tree         (*--in   *))
+                                   : TypeID       (*--out  *);
+
+PROCEDURE ExtentOf   (    theTree  : Tree         (*--in   *))
+                                   : CARDINAL     (*--out  *);
+
+PROCEDURE IsPresent  (    theTree  : Tree         (*--in   *);
+                          theKey   : Key          (*--in   *);
+                                                  found    : FoundProc    (*--in   *);
+                                                  notFound : NotFoundProc (*--in   *));
+
+
+        (*-----------------------*)
+
+(*
+7.1.5 Passive Iterators
+
+Three passive iterators are provided each implementing one of the standard
+tree traversal algorithms. Passive iterators allow the client module
+to traverse the tree as through it were a single, monolithic data structure.
+*)
+
+PROCEDURE Preorder  (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+PROCEDURE Inorder   (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+PROCEDURE Postorder (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+
+        (*-----------------------*)
+
+(*
+7.1.6 Active Iterators
+
+While passive iterators are most useful for tree objects, there may
+be situations when the client module requires more control over the
+iteration process (e.g., when printing the internal binary tree
+representation). In this case, it is necessary to use an active
+iteration mechanism, where the internal structure of a tree is made
+visible to the client in a controlled manner that ensures the safety
+of the abstraction.
+
+In the form presented here, the internal structure is made visible
+through the opaque type NodePtr, representing a subtree node of a tree.
+An empty subtree is modelled by the constant NullNode. Balance represents
+the number of external nodes rooted at a given subtree. If the subtree is
+empty, by convention, the balance is one.
+
+The reader should note that none of the active iterator operations
+raise exceptions.
+
+NodePtr         is a type used to represent and individual node of the tree.
+
+NullNode        is a constant representing an empty subtree.
+
+Weight          represents the number of nodes rooted at a given subtree.
+
+RootOf          returns a reference to the root node of the given tree. If
+                        the tree is empty then the NullNode is returned.
+
+LeftOf          returns the node that is the left subtree from the given
+                        node. If the given node has no left subtree then the NullNode
+                        is returned.
+
+RightOf         returns the node that is the right subtree from the given
+                        node. If the given node has no right subtree then the NullNode
+                        is returned.
+
+IsNull          returns true is the given node is equal to the NullNode and
+                        false otherwise.
+
+KeyOf           returns the key value associated with the given node. If the
+                        node is empty (i.e., equal to the NullNode) the NullItem is
+                        returned instead.
+
+DataOf          returns the data value associated with the given node. If the
+                        node is empty (i.e., equal to the NullNode) the NullItem is
+                        returned instead.
+
+WeightOf        returns the weight factor for the given node. If the node is
+                        null, then a balance of zero (0) is returned.
+*)
+
+TYPE  NodePtr;
+CONST NullNode = NodePtr(NIL);
+
+TYPE  Weight   = CARDINAL;
+
+
+PROCEDURE RootOf   (    theTree : Tree    (*--in   *))
+                                                            : NodePtr (*--out  *);
+
+PROCEDURE LeftOf   (    theNode : NodePtr (*--in   *))
+                                                            : NodePtr (*--out  *);
+
+PROCEDURE RightOf  (    theNode : NodePtr (*--in   *))
+                                                            : NodePtr (*--out  *);
+
+PROCEDURE IsNull   (    theNode : NodePtr (*--in   *))
+                                                            : BOOLEAN (*--out  *);
+
+PROCEDURE KeyOf    (    theNode : NodePtr (*--in   *))
+                                                            : Key     (*--out  *);
+
+PROCEDURE DataOf   (    theNode : NodePtr (*--in   *))
+                                                            : Data    (*--out  *);
+
+PROCEDURE WeightOf (    theNode : NodePtr (*--in   *))
+                                                            : Weight  (*--out  *);
+
+END BBSUMI.
+
+(*
+                                Algorithmic     Code
+Operation Name  Complexity      Size
+                                (bytes)
+TreeError               O(1)             26             Exception Handling Routines
+GetHandler              O(1)             42
+SetHandler              O(1)             38
+
+Create                  O(1)             88             Constructors
+Destroy                 O(1)             44
+MakeTree                O(1)            146
+Clear                   O(n)            218
+Assign                  O(m+n)          514
+Insert                  O(log2 n)       848
+Remove                  O(log2 n)       732
+
+IsDefined               O(1)             36             Selectors
+IsEmpty                 O(1)             74
+IsEqual                 O(Min(m,n))     326
+ExtentOf                O(n)            148
+KeyTypeOf               O(1)             64
+DataTypeOf              O(1)             66
+IsPresent               O(log2 n)       212
+
+Inorder                 O(n)            146             Passive Iterators
+Preorder                O(n)            146
+Postorder               O(n)            146
+
+RootOf                  O(1)             50             Active Iterators
+LeftOf                  O(1)             50
+RightOf                 O(1)             50
+IsNull                  O(1)             36
+KeyOf                   O(1)             48
+DataOf                  O(1)             50
+WeightOf                O(1)             50
+
+RaiseErrIn              O(1)             58      Local Routines
+NewNode                 O(1)             78
+Wt                              O(1)             52
+LeftRotation    O(1)            128
+RightRotation   O(1)            128
+Initialization  O(1)             92
+
+Grand Total                                4550
+
+Table 7.1 Unbounded Weight Balanced Binary Tree Operations Summary
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/BBSUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/BBSUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/BBSUMI.MOD
@@ -0,0 +1,1072 @@
+(*
+7.2 Unbounded Weight Balanced Binary Search Tree Implementation
+
+The internal structures used in representing a weight-balanced,
+unbounded binary search tree are described in this section along
+with the algorithms implementing the operations defined in the
+interface.
+
+This section is broken down as follows:
+        * 7.2.1 Internal Representation
+        * 7.2.2 Exception Handling
+        * 7.2.3 Local Operations
+        * 7.2.4 Tree Constructors
+        * 7.2.5 Tree Selectors
+        * 7.2.6 Passive Iterators
+        * 7.2.7 Active Iterators
+        * 7.2.8 Module Initialization
+*)
+
+IMPLEMENTATION MODULE BBSUMI;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code Size: OBJ file has 13602 bytes.
+    Component: Monolithic Structures - BB Tree (Opaque version)
+               Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.01  18 May 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.02  01 Oct 1988  C. Lins
+      Updated and improved comments.
+    v1.03  29 Jan 1989  C. Lins
+      Added aliases for generic Items as Keys and Data.
+        v1.04  03 Feb 1989  C. Lins
+          Optimized Assign to use NewNode instead of directly allocating
+          new nodes. Assumes that assignKey and assignItem never fail.
+    v1.05  06 Feb 1989  C. Lins
+          Added use of InsertProc instead of FoundProc in Insert.
+    v1.06  09 Feb 1989  C. Lins
+          Removed VAR from Clear, Insert, & Remove (the tree itself
+          does not change).
+    v1.07  17 Apr 1989  C. Lins:
+          Corrected IsEqual to use comparison routine derived
+          from the CompareOf routine associated with the stack's
+          TypeID.
+    v1.08  18 Apr 1989   C. Lins:
+          Added component id constant.
+    v2.00  08 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+===============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Relations IMPORT
+        (*--Type*) Relation;
+
+FROM Items IMPORT
+        (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM TreeTypes IMPORT
+    (*--Type*) Operations, Exceptions, Key, Data, ComponentID,
+                           AccessProc, InsertProc, FoundProc, NotFoundProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+        (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+
+    (*-----------------------*)
+
+(*
+7.2.1 Internal Unbounded Weight Balanced Tree Representation
+
+An unbounded weight-balanced binary search tree is represented using
+nodes for storing keys, data items, links between nodes the left
+and right subtrees, and the weight of each node.
+Figure 7.1 depicts graphically this structural organization.
+
+_Figure 7.1_
+
+Link    provides a mechanism for maintaining the lexicographical ordering
+                between nodes (i.e., the structure of the tree).
+
+Node    holds a key value and its associated data, if any, along with
+                links to the left and right subtrees. In addition, a weight field
+                is maintained in order to detect when rebalancing the tree is
+                necessary.
+
+UnboundedTree   defines a descriptor record for each unbounded tree
+                object. This record holds the data type IDs for the key and
+                data fields plus a link to the root node of the tree.
+
+Tree    completes the opaque definition of the abstract tree.
+*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD
+                key   : Key;    (*--key value for this node *)
+                data  : Data;   (*--data value for this node *)
+                weight: Weight; (*--# of external nodes rooted at this tree *)
+                left  : Link;   (*--link to left subtree *)
+                right : Link;   (*--link to right subtree*)
+          END (*--Node *);
+
+TYPE  Tree = POINTER TO UnboundedTree;
+
+TYPE  UnboundedTree = RECORD
+                keyID  : TypeID; (*--data type for the tree's keys *)
+        dataID : TypeID; (*--data type for this tree's items *)
+                root   : Link;   (*--link to root of this tree *)
+      END (*--UnboundedTree *);
+
+
+(*
+7.2.2 Exceptions
+
+treeError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+treeError before any other processing.
+
+The handler array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+7.2.8).
+
+TreeError       simply returns the current exception result stored
+                        in treeError and is used to determine whether a tree
+                        operation completed successfully.
+
+SetHandler      makes theHandler the current exception handler for theError
+                        by storing theHandler in the handler array.
+
+GetHandler      returns the current exception handler for theError from the
+                        handler array.
+*)
+
+VAR   treeError : Exceptions;
+VAR   handler   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE TreeError  ()              : Exceptions  (*--out  *);
+BEGIN
+  RETURN treeError;
+END TreeError;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*--in   *);
+                          theError   : Exceptions (*--in   *));
+BEGIN
+  treeError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+7.2.3 Local Operations
+
+NewNode allocates and initializes a new leaf node for a tree.
+By definition, the number of external nodes rooted at a given
+subtree is two, and thus, the weight factor is initialized to
+this value. Complexity O(1).
+*)
+
+PROCEDURE NewNode   (    theKey   : Key         (*--in   *);
+                                                 theData  : Data        (*--in   *);
+                                                 theWeight: Weight              (*--in   *))
+                                                          : Link        (*--out  *);
+
+VAR   theNode : Link; (*--link to new leaf node being created *)
+
+BEGIN
+  Allocate(theNode, SIZE(Node));
+  IF (theNode # NIL) THEN
+    WITH theNode^ DO
+      key   := theKey;
+      data  := theData;
+          weight:= theWeight;
+      left  := NIL;
+      right := NIL;
+    END (*--with*);
+  END (*--if*);
+  RETURN theNode;
+END NewNode;
+(*-------------------------*)
+
+
+(*
+Wt returns the weight value for a given node, which is the number of
+external nodes in the subtree rooted at the node. A subtree of NIL
+returns 1, otherwise t^.weight.
+*)
+
+PROCEDURE Wt (    theSubtree : Link   (*--in   *))
+                                                         : Weight (*--out  *);
+BEGIN
+  IF (theSubtree = NIL) THEN
+    RETURN 1;
+  END (*--if*);
+  RETURN theSubtree^.weight;
+END Wt;
+(*-------------------------*)
+
+(*
+The routines LeftRotation and RightRotation perform a single left
+rotation and single right rotation of the given subtree, respectively.
+Rotations were previously described in section 3.3.6, Tree Rotations.
+Both routines have an algorithmic complexity of O(1).
+*)
+
+PROCEDURE LeftRotation (VAR theSubtree : Link (*--inout *));
+
+VAR   temporary : Link;
+
+BEGIN
+  temporary  := theSubtree;
+  theSubtree := theSubtree^.right;
+  temporary^.right := theSubtree^.left;
+  theSubtree^.left := temporary;
+
+  (*--adjust weights --*)
+
+  WITH temporary^ DO
+    theSubtree^.weight := weight;
+    weight := Wt(left) + Wt(right);
+  END (*--with*);
+END LeftRotation;
+(*-------------------------*)
+
+PROCEDURE RightRotation (VAR theSubtree : Link (*--inout *));
+
+VAR   temporary : Link;
+
+BEGIN
+  temporary  := theSubtree;
+  theSubtree := theSubtree^.left;
+  temporary^.left   := theSubtree^.right;
+  theSubtree^.right := temporary;
+
+  (*--adjust weights --*)
+
+  WITH temporary^ DO
+    theSubtree^.weight := weight;
+    weight := Wt(left) + Wt(right);
+  END (*--with*);
+END RightRotation;
+(*-------------------------*)
+
+
+(*
+7.2.4 Constructors
+
+Create attempts to build a new empty tree of the given type.
+First, the tree header is allocated and the key and data type IDs are
+stored in the header. The pointer to the root node is initialized
+to the empty state (NIL). If the header allocation fails the
+overflow exception is raised and the NullTree is returned.
+Complexity O(1).
+*)
+
+PROCEDURE Create    (    keyType  : TypeID       (*--in   *);
+                                                 dataType : TypeID       (*--in   *))
+                                  : Tree         (*--out  *);
+
+VAR   newTree : Tree; (*--temporary for new tree *)
+
+BEGIN
+  treeError := noerr;
+  Allocate(newTree, SIZE(UnboundedTree));
+  IF (newTree = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newTree^ DO
+          keyID  := keyType;
+      dataID := dataType;
+          root   := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newTree;
+END Create;
+(*-------------------------*)
+
+
+(*
+MakeTree is a combination of Create(keyType, dataType) immediately
+followed by Insert(theKey, theData). Complexity O(1).
+*)
+
+PROCEDURE MakeTree  (    keyType  : TypeID       (*--in   *);
+                                                 dataType : TypeID       (*--in   *);
+                         theKey   : Key          (*--in   *);
+                                                 theData  : Data         (*--in   *))
+                                  : Tree         (*--out  *);
+
+VAR   newTree : Tree; (*--new tree being created *)
+
+BEGIN
+  treeError := noerr;
+  Allocate(newTree, SIZE(UnboundedTree));
+  IF (newTree = NIL) THEN
+    RaiseErrIn(maketree, overflow);
+  ELSE
+    WITH newTree^ DO
+          keyID  := keyType;
+      dataID := dataType;
+          root   := NewNode(theKey, theData, 2);
+          IF (root = NIL) THEN
+            RaiseErrIn(maketree, overflow);
+                Deallocate(newTree, SIZE(newTree^));
+          END (*--if*);
+    END (*--with*);
+  END(*--if*);
+  RETURN newTree;
+END MakeTree;
+(*-------------------------*)
+
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theTree back to the system.
+SCLStorage.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullTree). Complexity: O(n).
+*)
+
+PROCEDURE Destroy   (VAR theTree  : Tree         (*--inout *));
+BEGIN
+  Clear(theTree);
+  IF (treeError = noerr) THEN
+    Deallocate(theTree, SIZE(theTree^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+
+(*
+Clear uses a postorder traversal of theTree, clearing the nodes of
+both subtrees before clearing the tree itself. After disposing the
+subtrees the key and data values can be disposed followed by the node.
+The routine takes advantage of the fact that this version of Deallocate
+sets the pointer to NIL after releasing the proper amount of memory.
+This saves us from having to explicitly set the root to NIL.
+Complexity O(n).
+*)
+
+PROCEDURE Clear     (    theTree  : Tree         (*--inout *));
+
+VAR   freeData : DisposeProc; (*--data value disposal routine *)
+          freeKey  : DisposeProc; (*--key value disposal routine *)
+
+  PROCEDURE ClearNodes (VAR theSubtree : Link (*--inout *));
+  BEGIN
+    IF (theSubtree # NIL) THEN
+          WITH theSubtree^ DO
+            ClearNodes(left);
+            ClearNodes(right);
+                freeKey(key);
+                freeData(data);
+          END (*--with*);
+          Deallocate(theSubtree, SIZE(theSubtree^));
+        END (*--if*);
+  END ClearNodes;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theTree^ DO
+      freeKey  := DisposeOf(keyID);
+      freeData := DisposeOf(dataID);
+      ClearNodes(root);
+        END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+
+(*
+Assign uses a preorder traversal of the source tree to generate a
+copy in the destination tree. Preliminary to the actual copying,
+we must ensure that the source tree is defined and clear or create
+the destination tree as necessary. This step is accomplished by the
+RecreateTarget routine which must accomodate the following cases:
+        * the source tree is undefined, and thus, the target tree must be
+          left unchanged;
+        * the source tree and target tree are the same and therefore the
+          postcondition of the Assign operation is already met;
+        * the source tree is defined but the target tree is undefined, so
+          the target tree must be created with the same key and data type
+          id's as the source tree; and
+        * both the source and target trees are defined, and thus the target
+          tree must be cleared of its contents followed by its key and data
+          key id's being set to the same as the source tree.
+
+In the second case, we automatically return FALSE so that Assign will
+bypass the node copying operation. While in the other three instances,
+success depends on whether treeError remains set to noerr.
+
+The main body of Assign uses the result from RecreateTarget to determine
+whether to continue with the copy operation after recreating the target tree.
+Complexity O(m+n) where m is the number of nodes in the destination
+tree and n is the number of nodes in the source tree.
+*)
+
+PROCEDURE Assign    (    theTree  : Tree         (*--in   *);
+                     VAR toTree   : Tree         (*--inout *));
+
+VAR   assignKey  : AssignProc; (*--key item assignment routine *)
+          assignItem : AssignProc; (*--data item assignment routine *)
+
+  PROCEDURE RecreateTarget () : BOOLEAN (*--out *);
+  BEGIN
+    IF (theTree = NIL) THEN
+          RaiseErrIn(assign, undefined);
+    ELSIF (toTree = NIL) THEN
+          WITH theTree^ DO
+            toTree := Create(keyID, dataID);
+          END (*--with*);
+    ELSIF (toTree = theTree) THEN
+          RETURN FALSE;
+    ELSE
+          Clear(toTree);
+          WITH theTree^ DO
+            toTree^.keyID  := keyID;
+            toTree^.dataID := dataID;
+          END (*--with*);
+    END (*--if*);
+        RETURN treeError = noerr;
+  END RecreateTarget;
+
+  PROCEDURE DoAssign (    theSubtree : Link (*--in   *);
+                                          VAR toSubtree  : Link (*--out  *));
+  BEGIN
+    IF (theSubtree = NIL) THEN
+          toSubtree := NIL;
+        ELSE
+          WITH theSubtree^ DO
+            toSubtree := NewNode(assignKey(key), assignItem(data), weight);
+          END (*--with*);
+          IF (toSubtree = NIL) THEN
+            RaiseErrIn(assign, overflow);
+          ELSE
+            DoAssign(theSubtree^.left, toSubtree^.left);
+            DoAssign(theSubtree^.right, toSubtree^.right);
+          END (*--if*);
+        END (*--if*);
+  END DoAssign;
+
+BEGIN
+  treeError := noerr;
+  IF RecreateTarget() THEN
+    WITH theTree^ DO
+      assignKey  := AssignOf(keyID);
+      assignItem := AssignOf(dataID);
+      DoAssign(root, toTree^.root);
+        END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+
+(*
+Insert adds a node with theKey and theData to theTree and places the
+node within its proper position maintaining the search tree property and
+weight balance constraints of the tree. Double rotations are accomplished
+by two successive single rotations. As noted by Gonnet, it is possible
+to remove the use of real arithmetic since the ≡2/2 can be approximated
+by its convergents. Complexity O(log2 n).
+*)
+
+PROCEDURE Insert    (    theTree  : Tree         (*--inout *);
+                         theKey   : Key          (*--in   *);
+                         theData  : Data         (*--in   *);
+                                                 found    : InsertProc   (*--in   *));
+
+VAR   compare : CompareProc; (*--key comparison routine *)
+
+  PROCEDURE DoInsert (VAR theSubtree : Link (*--inout *));
+
+  VAR   wtBalance : REAL;
+
+  BEGIN
+    IF (theSubtree = NIL) THEN
+          theSubtree := NewNode(theKey, theData, 2);
+          IF (theSubtree = NIL) THEN
+            RaiseErrIn(insert, overflow);
+          END (*--if*);
+
+        ELSE
+          WITH theSubtree^ DO
+            CASE compare(key, theKey) OF
+              less    : DoInsert(right);
+            | greater : DoInsert(left);
+            ELSE
+              found(key, data, theData);
+                  RETURN;
+            END (*--case*);
+            weight := Wt(left) + Wt(right);
+                wtBalance := FLOAT(Wt(left)) / FLOAT(Wt(theSubtree));
+
+                IF (wtBalance > 0.707011) THEN
+
+                  (*--left subtree too heavy: right rotation needed --*)
+
+                  IF FLOAT(Wt(left^.left)) / FLOAT(Wt(left)) > 0.414213 THEN
+                    RightRotation(theSubtree);
+                  ELSE
+                    LeftRotation(left);
+                    RightRotation(theSubtree);
+                  END (*--if*);
+                ELSIF (wtBalance < 0.292893) THEN
+
+                  (*--right subtree too heavy: left rotation needed --*)
+
+                  IF FLOAT(Wt(right^.left)) / FLOAT(Wt(right)) < 0.585786 THEN
+                    LeftRotation(theSubtree);
+                  ELSE
+                    RightRotation(right);
+                    LeftRotation(theSubtree);
+                  END (*--if*);
+                END (*--if*);
+          END (*--with*);
+        END (*--if*);
+  END DoInsert;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(insert, undefined);
+  ELSE
+    WITH theTree^ DO
+      compare := CompareOf(keyID);
+      DoInsert(root);
+        END (*--with*);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+(*
+Remove searches theTree for the nodes with theKey and deletes the
+node from the key. The below algorithm is derived from that given
+by Gonnet [3] for deletions for weight balanced and path balanced
+trees. The search for the key is a recursive inorder tree traversal.
+If the node being deleted has one null descendant deletion is simply
+accomplished by replacing it with the other descendant. Otherwise,
+the node must be moved down the tree until it has a non-null
+descendant. The strategy employed here, which is better suited for
+balanced trees, is to use rotations to gradually move the node
+towards the fringe (e.g. leaves) of the tree. In this way the weight
+information of each node is automatically reconstructed for us.
+*)
+
+PROCEDURE Remove    (    theTree  : Tree         (*--inout *);
+                         theKey   : Key          (*--in   *);
+                                                 notFound : NotFoundProc (*--in   *));
+
+VAR   compare  : CompareProc; (*--key comparison routine *)
+          freeKey  : DisposeProc; (*--key disposal routine *)
+          freeData : DisposeProc; (*--data disposal routine *)
+
+  PROCEDURE DoRemove (VAR subTree : Link (*--inout *));
+
+  VAR   oldTree : Link; (*--link to subtree to dispose *)
+
+  BEGIN
+    IF (subTree = NIL) THEN
+
+          notFound(theKey); (*--ERROR key not found in the tree *)
+
+        ELSE
+          CASE compare(theKey, subTree^.key) OF
+            less    : DoRemove(subTree^.left);
+          | greater : DoRemove(subTree^.right);
+          ELSE
+
+                (*--key found, delete it *)
+
+                IF (subTree^.right = NIL) THEN
+                  oldTree := subTree;
+                  subTree := subTree^.left;
+                  freeKey(oldTree^.key);
+                  freeData(oldTree^.data);
+                  Deallocate(oldTree, SIZE(oldTree^));
+                ELSIF (subTree^.left = NIL) THEN
+                  oldTree := subTree;
+                  subTree := subTree^.right;
+                  freeKey(oldTree^.key);
+                  freeData(oldTree^.data);
+                  Deallocate(oldTree, SIZE(oldTree^));
+
+                (*--no descendant is null, rotate on heavier side --*)
+
+                ELSIF Wt(subTree^.left) > Wt(subTree^.right) THEN
+
+                  (*--left side is heavier, do a right rotation --*)
+
+                  IF Wt(subTree^.left^.left) < Wt(subTree^.left^.right) THEN
+                    LeftRotation(subTree^.left);
+                  END (*--if*);
+                  RightRotation(subTree);
+                  DoRemove(subTree^.right);
+                ELSE
+
+                  (*--right side is heavier, do a left rotation --*)
+
+                  IF Wt(subTree^.right^.left) < Wt(subTree^.right^.right) THEN
+                    RightRotation(subTree^.right);
+                  END (*--if*);
+                  LeftRotation(subTree);
+                  DoRemove(subTree^.left);
+                END (*--if*);
+          END (*--case*);
+
+          (*--reconstruct weight information --*)
+
+          IF (subTree # NIL) THEN
+                WITH subTree^ DO
+                  weight := Wt(left) + Wt(right);
+                END (*--with*);
+          END (*--if*);
+        END (*--if*);
+  END DoRemove;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(remove, undefined);
+  ELSE
+    WITH theTree^ DO
+      compare := CompareOf(keyID);
+          freeKey := DisposeOf(keyID);
+          freeData:= DisposeOf(dataID);
+      DoRemove(root);
+        END (*--with*);
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+
+(*
+7.2.5 Selectors
+
+IsDefined verifies to the best of its ability whether theTree has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theTree  : Tree         (*--in   *))
+                                  : BOOLEAN      (*--out  *);
+BEGIN
+  RETURN theTree # NullTree;
+END IsDefined;
+(*-------------------------*)
+
+
+(*
+IsEmpty returns True if theTree is in the empty state, as indicated by
+the root being NIL, and False otherwise.  As per the specification
+(section 3.3) undefined trees are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theTree  : Tree         (*--in   *))
+                                  : BOOLEAN      (*--out  *);
+BEGIN
+  treeError := noerr;
+  IF (theTree # NIL) THEN
+    RETURN (theTree^.root = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+
+(*
+IsEqual uses a preorder traversal of both left and right trees. As soon
+as an inequality between keys is found we can return false as the trees
+cannot be equal. Complexity O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left     : Tree         (*--in   *);
+                         right    : Tree         (*--in   *))
+                                  : BOOLEAN      (*--out  *);
+
+VAR       compare : CompareProc;        (*-- item comparison routine *)
+
+  PROCEDURE DoIsEqual (    leftSubtree  : Link    (*--in   *);
+                                                   rightSubtree : Link    (*--in   *))
+                                                                                : BOOLEAN (*--out  *);
+  BEGIN
+    IF (leftSubtree = NIL) OR (rightSubtree = NIL) THEN
+          RETURN (leftSubtree = NIL) & (rightSubtree = NIL);
+    ELSIF compare(leftSubtree^.key, rightSubtree^.key) # equal THEN
+          RETURN FALSE;
+        ELSE
+          RETURN (DoIsEqual(leftSubtree^.left, rightSubtree^.left) &
+                          DoIsEqual(leftSubtree^.right, rightSubtree^.right));
+        END (*--if*);
+  END DoIsEqual;
+
+BEGIN
+  treeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) OR
+                (left^.keyID # right^.keyID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSE
+        compare := CompareOf(left^.keyID);
+    RETURN DoIsEqual(left^.root, right^.root);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+
+(*
+The two TypeOf routines simply return the key data ID or data ID for the given tree.
+Undefined trees, as always, raise the undefined exception and return a reasonable value,
+in this case the NullType. Complexity O(1).
+*)
+
+PROCEDURE KeyTypeOf (    theTree  : Tree         (*--in   *))
+                                  : TypeID       (*--out  *);
+BEGIN
+  treeError := noerr;
+  IF (theTree # NIL) THEN
+    RETURN theTree^.keyID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END KeyTypeOf;
+(*-------------------------*)
+
+PROCEDURE DataTypeOf (    theTree  : Tree         (*--in   *))
+                                   : TypeID       (*--out  *);
+BEGIN
+  treeError := noerr;
+  IF (theTree # NIL) THEN
+    RETURN theTree^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END DataTypeOf;
+(*-------------------------*)
+
+
+(*
+ExtentOf returns the number of nodes present in the given tree or zero
+for an undefined tree. We simply employ an inorder traversal of the tree
+counting the nodes along the way. Complexity O(n).
+*)
+
+PROCEDURE ExtentOf   (    theTree  : Tree         (*--in   *))
+                                   : CARDINAL     (*--out  *);
+
+VAR   count : CARDINAL; (*--running count of nodes in tree *)
+
+  PROCEDURE CountNodes (    theSubtree : Link (*--in   *));
+  BEGIN
+    IF (theSubtree # NIL) THEN
+          WITH theSubtree^ DO
+            CountNodes(left);
+            INC(count);
+            CountNodes(right);
+          END (*--with*);
+        END (*--if*);
+  END CountNodes;
+
+BEGIN
+  treeError := noerr;
+  count     := 0;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(extentof, undefined);
+  ELSE
+    CountNodes(theTree^.root);
+  END (*--if*);
+  RETURN count;
+END ExtentOf;
+(*-------------------------*)
+
+(*
+IsPresent uses an iterative traversal of the given tree attempting
+to find node in theTree containing theKey value. The search path
+begins at the root switching to the left or right subtree based on
+examination of each node's key. As noted by Wirth [8] and others, as
+few as log2 n comparisons may be needed to find theKey if theTree is
+perfectly balanced. The algorithmic complexity of the search is
+therefore O(log2 n). It is assumed that all keys are comparable and
+the compare procedure is not NIL.
+*)
+
+PROCEDURE IsPresent (    theTree  : Tree         (*--in   *);
+                         theKey   : Key          (*--in   *);
+                                                 found    : FoundProc    (*--in   *);
+                                                 notFound : NotFoundProc (*--in   *));
+
+VAR   treeIndex : Link;
+      compare   : CompareProc; (*--key comparison routine *)
+
+BEGIN
+  treeError := noerr;
+  IF (theTree # NIL) THEN
+    WITH theTree^ DO
+      treeIndex := root;
+          compare   := CompareOf(keyID);
+        END (*--with*);
+
+        LOOP
+          IF (treeIndex = NIL) THEN
+            notFound(theKey);
+                EXIT (*--loop*);
+          END (*--if*);
+          CASE compare(treeIndex^.key, theKey) OF
+            equal   : found(theKey, treeIndex^.data);
+                                  EXIT (*--loop*);
+          | less    : treeIndex := treeIndex^.right;
+          | greater : treeIndex := treeIndex^.left;
+          END (*--case*);
+        END (*--loop*);
+
+  ELSE
+    RaiseErrIn(ispresent, undefined);
+  END (*--if*);
+END IsPresent;
+(*-------------------------*)
+
+
+(*
+7.2.6 Passive Iterators
+
+Each of the three iterator routines accomplish recursively Preorder,
+Inorder, and Postorder traversals of the given tree. If the tree is
+not defined, the undefined exception is raised and the traversal is
+aborted. Otherwise, traversal begins with the root of the tree following
+the specifications given in section 3.1.6.2. The complexity is O(n) for
+all three traversals. Once again these are elementary tree algorithms that
+can be found is any college textbook on data structures.
+*)
+
+PROCEDURE Preorder  (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+  PROCEDURE DoPreorder (    theSubtree : Link (*--in   *));
+  BEGIN
+    IF (theSubtree # NIL) THEN
+          WITH theSubtree^ DO
+            theProcess(key, data);
+            DoPreorder(left);
+            DoPreorder(right);
+          END (*--with*);
+        END (*--if*);
+  END DoPreorder;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(preorder, undefined);
+  ELSE
+    DoPreorder(theTree^.root);
+  END (*--if*);
+END Preorder;
+(*-------------------------*)
+
+PROCEDURE Inorder   (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+  PROCEDURE DoInorder (    theSubtree : Link (*--in   *));
+  BEGIN
+    IF (theSubtree # NIL) THEN
+          WITH theSubtree^ DO
+            DoInorder(left);
+            theProcess(key, data);
+            DoInorder(right);
+          END (*--with*);
+        END (*--if*);
+  END DoInorder;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(inorder, undefined);
+  ELSE
+    DoInorder(theTree^.root);
+  END (*--if*);
+END Inorder;
+(*-------------------------*)
+
+PROCEDURE Postorder (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+  PROCEDURE DoPostorder (    theSubtree : Link (*--in   *));
+  BEGIN
+    IF (theSubtree # NIL) THEN
+          WITH theSubtree^ DO
+            DoPostorder(left);
+            DoPostorder(right);
+            theProcess(key, data);
+          END (*--with*);
+        END (*--if*);
+  END DoPostorder;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(postorder, undefined);
+  ELSE
+    DoPostorder(theTree^.root);
+  END (*--if*);
+END Postorder;
+(*-------------------------*)
+
+
+(*
+7.2.7 Active Iterators
+
+The active iterators given below simply return eomponents of tree nodes
+and are thus, for the most part, self-explanatory.
+
+The TML Modula-2 compiler prohibits us from redeclaring an opaque
+type as equal to another type. (We cannot define a NodePtr = Link).
+Thus, we must explicitly define NodePtr and then use the type transfer
+facility provided by VAL to coerce the tree links into iterator nodes.
+*)
+
+TYPE  NodePtr = POINTER TO Node;
+
+PROCEDURE RootOf   (    theTree : Tree    (*--in   *))
+                                                            : NodePtr (*--out  *);
+BEGIN
+  IF (theTree = NIL) THEN
+    RETURN NullNode;
+  END (*--if*);
+  RETURN NodePtr(theTree^.root);
+END RootOf;
+(*-------------------------*)
+
+PROCEDURE LeftOf   (    theNode : NodePtr (*--in   *))
+                                                            : NodePtr (*--out  *);
+BEGIN
+  IF (theNode = NIL) THEN
+    RETURN NullNode;
+  END (*--if*);
+  RETURN NodePtr(theNode^.left);
+END LeftOf;
+(*-------------------------*)
+
+PROCEDURE RightOf  (    theNode : NodePtr (*--in   *))
+                                                            : NodePtr (*--out  *);
+BEGIN
+  IF (theNode = NIL) THEN
+    RETURN NullNode;
+  END (*--if*);
+  RETURN      NodePtr(theNode^.right);
+END RightOf;
+(*-------------------------*)
+
+PROCEDURE IsNull   (    theNode : NodePtr (*--in   *))
+                                                            : BOOLEAN (*--out  *);
+BEGIN
+  RETURN theNode = NIL;
+END IsNull;
+(*-------------------------*)
+
+PROCEDURE KeyOf    (    theNode : NodePtr (*--in   *))
+                                                            : Key     (*--out  *);
+BEGIN
+  IF (theNode = NIL) THEN
+    RETURN NullItem;
+  END (*--if*);
+  RETURN theNode^.key;
+END KeyOf;
+(*-------------------------*)
+
+PROCEDURE DataOf   (    theNode : NodePtr (*--in   *))
+                                                            : Data    (*--out  *);
+BEGIN
+  IF (theNode = NIL) THEN
+    RETURN NullItem;
+  END (*--if*);
+  RETURN theNode^.data;
+END DataOf;
+(*-------------------------*)
+
+PROCEDURE WeightOf (    theNode : NodePtr (*--in   *))
+                                                            : Weight  (*--out  *);
+BEGIN
+  IF (theNode = NIL) THEN
+    RETURN 0;
+  END (*--if*);
+  RETURN theNode^.weight;
+END WeightOf;
+(*-------------------------*)
+
+
+(*
+7.2.8 Module Initialization
+
+The module's local variables are initialized to known states.
+treeError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, treeError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR treeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(treeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  treeError := noerr;
+        NullTree := NIL;
+END BBSUMI.
+
+(*
+References
+
+
+[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983.
+[2] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+        Benjamin/Cummings, Menlo Park, CA 1987.
+[3]     G.H. Gonnet, Handbook of Algorithms and Data Structures, Addison-Wesley,
+        Reading, MA 1984.
+[4] K. John Gough, ≡Writing Generic Utilities in Modula-2≡, Journal of
+    Pascal, Ada, and Modula-2, Vol. 5(3), (May/June 1986), pp 53-62.
+[5] T.A. Standish, Data Structure Techniques, Addison-Wesley, Reading, MA 1980.
+[6] R.S. Wiener and G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons, New York, NY 1985.
+[7] R.S. Wiener and R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986.
+[8]     N. Wirth, Algorithms and Data Structures, Prentice-Hall, Englewood Cliffs,
+        NJ 1986.
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/BBSUMIU.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/BBSUMIU.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/BBSUMIU.DEF
@@ -0,0 +1,68 @@
+(*
+7.3 Weight-Balanced Binary Search Tree Utilities
+*)
+
+DEFINITION MODULE BBSUMIU;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Component: BB Tree SUMI Utilities - Print Tree Tool
+
+    REVISION HISTORY
+    v1.00  17 Mar 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.01  01 Oct 1988  C. Lins
+      Cleanup of comments.
+          Changed PrintTree to use a single procedure parameter.
+          Added HeightOf selector.
+    v1.02  29 Jan 1989  C. Lins
+          Changed to use Key and Data aliases for generic items.
+    v2.00  08 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM TreeTypes IMPORT
+    (*--Type*) Key, Data;
+
+FROM BBSUMI IMPORT
+    (*--Type*) Tree, Weight;
+
+
+        (*-----------------------*)
+
+(*
+7.3.1 Utility Selectors
+
+HeightOf returns the height of the given tree.
+*)
+
+PROCEDURE HeightOf (    theTree : Tree     (*--in   *))
+                                                                : CARDINAL (*--out  *);
+
+(*
+7.3.2 Debugging Iterators
+
+PrintTree iterates over the given tree such that the nodes may be
+printed. Trees are normally displayed with the root at the top and
+the leaves at the bottom. To simplify the printing process, PrintTree
+displays the tree rotated 90Æ to the left. Thus the root is shown at
+the left of the page/screen with the leaves at the right. Furthermore,
+the left branches are shown towards the bottom of the display and the
+right branches at the top. The PrintProc routine is responsible for
+indenting the display appropriately based on the level parameter.
+*)
+
+TYPE  Level     = CARDINAL;
+TYPE  PrintProc = PROCEDURE (Level, Key, Data, Weight);
+
+PROCEDURE PrintTree (    theTree: Tree       (*--in   *);
+                         print  : PrintProc  (*--in   *));
+
+END BBSUMIU.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/BBSUMIU.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/BBSUMIU.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/BBSUMIU.MOD
@@ -0,0 +1,114 @@
+(*
+7.4 Weight-Balanced Binary Search Tree Utilities
+*)
+
+IMPLEMENTATION MODULE BBSUMIU;
+(*====================================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: OBJ file has 1531 bytes.
+    Component: BB Tree SUMI Utilities - Print Tree Tool
+
+    INTRODUCTION
+        This module provides the facility for printing a binary tree.
+
+    REVISION HISTORY
+    v1.00  17 Mar 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.01  29 Jan 1989  C. Lins
+          Changed to use Key and Data aliases for generic items.
+    v2.00  08 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+=====================================================================*)
+
+FROM TreeTypes IMPORT
+    (*--Type*) Key, Data;
+
+FROM BBSUMI IMPORT
+        (*--Type*) Tree, NodePtr, Weight,
+        (*--Proc*) RootOf, LeftOf, RightOf, IsNull, KeyOf, DataOf,
+                           WeightOf, IsEmpty;
+
+        (*-----------------------*)
+
+(*
+7.4.1 Utility Selectors
+
+HeightOf returns the height of the given tree. Height may be computed by
+subtracting the level of the ≡lowest≡ node in the tree from the level of
+the root.  Complexity O(log2 n).
+*)
+
+PROCEDURE HeightOf (    theTree : Tree     (*-- in    *))
+                                                                : CARDINAL (*-- out   *);
+
+VAR   maxLevel : CARDINAL; (*-- level of the lowest node so far *)
+
+  PROCEDURE CountLevels (    theNode : NodePtr  (*-- in    *);
+                                                         theLevel: CARDINAL (*-- in    *));
+  BEGIN
+    IF ~IsNull(theNode) THEN
+          IF (theLevel > maxLevel) THEN
+            maxLevel := theLevel;
+          END (*--if*);
+          CountLevels(LeftOf(theNode), theLevel+1);
+          CountLevels(RightOf(theNode), theLevel+1);
+        END (*--if*);
+  END CountLevels;
+
+BEGIN
+  maxLevel := 1;
+  IF ~IsEmpty(theTree) THEN
+    CountLevels(RootOf(theTree), 1);
+  END (*--if*);
+  RETURN maxLevel - 1;
+END HeightOf;
+(*-------------------------*)
+
+(*
+7.4.2 Debugging Iterators
+
+PrintTree iterates over the given tree such that the nodes may be
+printed. Trees are normally displayed with the root at the top and
+the leaves at the bottom. To simplify the printing process, PrintTree
+displays the tree rotated 90Æ to the left. Thus the root is shown at
+the left of the page/screen with the leaves at the right. Furthermore,
+the left branches are shown towards the bottom of the display and the
+right branches at the top. A constant indentation of two spaces between
+levels is used.
+
+The algorithm used here is a variation on the inorder tree traversal. So
+that the tree is displayed properly rotated, the processing of the left
+and right branches are reversed. This algorithm is derived from that
+given by Wirth in [8].
+*)
+
+PROCEDURE PrintTree (    theTree: Tree       (*--in   *);
+                         print  : PrintProc  (*--in   *));
+
+  PROCEDURE DoPrintTree (    theSubtree : NodePtr  (*--in   *);
+                                                         theLevel   : CARDINAL (*--in   *));
+  BEGIN
+    IF ~IsNull(theSubtree) THEN
+          DoPrintTree(RightOf(theSubtree), theLevel+1);
+          print(theLevel, KeyOf(theSubtree), DataOf(theSubtree),
+                        WeightOf(theSubtree));
+          DoPrintTree(LeftOf(theSubtree), theLevel+1);
+        END (*--if*);
+  END DoPrintTree;
+
+BEGIN
+  IF ~IsEmpty(theTree) THEN
+    DoPrintTree(RootOf(theTree), 0);
+  END (*--if*);
+END PrintTree;
+(*-------------------------*)
+
+END BBSUMIU.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/IPBSUMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/IPBSUMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/IPBSUMI.DEF
@@ -0,0 +1,400 @@
+(*
+8.1 Path k-Balanced Unbounded Binary Search Tree Interface
+
+This module provides operations for the binary search tree abstract
+data type. Trees created by this module are balanced by internal
+path reduction algorithms due to Gonnet [1, 2].
+
+Each node of a tree is assumed to consist of two data elements ≡ a key
+field and a data field. Keys are used to structure the tree, while the
+data field simply represents information associated with a key but is
+not a part of it. While this separation may be less efficient in operation,
+it does lead to a cleaner interface.
+
+Keys are assumed to have the following operations available:
+        * a routine that assigns key values;
+        * a routine that compares key values returning the ordering
+          relation between them (i.e., less, equal, or greater); and
+        * optionally, a routine that disposes of key values that have been
+          allocated on the heap.
+
+Data values are assumed to the the following operations:
+        * a routine that assigns data values; and
+        * optionally, a routine that disposes of data values stored on the
+          heap.
+
+In both cases, keys and data values, along with the above operations, are
+identified by a TypeID that is unique for a given data type. This data type
+may be a standard Modula-2 type or one formed by the programmer using data
+type forming operations (e.g., RECORDs).
+
+The subsections are divided as follows:
+        * 8.1.1 Type Declarations
+        * 8.1.2 Exception Handling
+        * 8.1.3 Tree Constructors
+        * 8.1.4 Tree Selectors
+        * 8.1.5 Passive Iterators
+        * 8.1.6 Active Iterators
+*)
+
+DEFINITION MODULE IPBSUMI;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Component: Monolithic Structures - Tree (Opaque version)
+               Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.01  19 May 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.02  01 Oct 1988  C. Lins
+      Updated and improved comments.
+        v1.03  29 Jan 1989  C. Lins
+          Added use of Key and Data aliases for generic Items.
+    v1.04  06 Feb 1989  C. Lins
+          Added use of InsertProc instead of FoundProc in Insert.
+    v1.05  09 Feb 1989  C. Lins
+          Removed VAR from Clear, Insert, & Remove (the tree itself
+          does not change).
+    v1.06  18 Apr 1989  C. Lins
+                Changed module id
+     v2.00  08 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM TreeTypes IMPORT
+    (*--Type*) Exceptions, Key, Data,
+                           AccessProc, InsertProc, FoundProc, NotFoundProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+        (*-----------------------*)
+
+(*
+8.1.1 Type Declarations
+
+Each instance of the Path-Balanced Binary Tree abstract data type is
+represented by the type, Tree, using Modula-2's opaque type definition
+facility. The undefined tree is represented by a Tree constant of NIL.
+*)
+
+TYPE  Tree;
+VAR   NullTree : Tree;
+
+        (*-----------------------*)
+
+(*
+8.1.2 Exceptions
+
+The following types and routines are used to support the exception
+handling mechanism. This mechanism is consistent across all modules
+in this series.
+
+ModuleID        is a constant that uniquely identifies this module,
+                        in this case the number 2016. This allows exception
+                        handlers to know the module raising an exception.
+
+TreeError       returns the most recent exception condition from the last
+                        tree operation or the constant noerr if an exception was
+                        not raised.
+GetHandler      returns the exception handler for the given exception condition.
+
+SetHandler      allows client modules to assign an exception handling routine
+                        for specific exceptions. In this way the client may override
+                        the default exception handling mechanism (which does nothing).
+*)
+
+CONST ModuleID = 6;
+
+PROCEDURE TreeError  ()              : Exceptions  (*--out  *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+
+
+        (*-----------------------*)
+
+(*
+8.1.3 Constructors
+
+Constructor operations update or change the state of a tree object. In
+this section we briefly describe each tree operation and its effect on
+a tree object. Exception conditions raised by these routines have been
+previously discussed in 3.3, Binary Search Tree Operations.
+
+Create  attempts to form a new, empty binary tree object having the given
+                key and data type identifiers and given balancing factor.
+
+MakeTree does the same as Create, except that it also attempts to add
+                the given key and data items as the root of the new tree.
+
+Destroy attempts to demolish an existing tree object, clearing the tree
+                of all its contents and making the tree ≡undefined≡.
+
+Clear   empties an existing tree of its contents returning the tree to
+                an empty state.
+
+Assign  attempts to duplicate (e.g., make a copy) of an existing tree.
+                The target tree, where the copy is stored, is cleared of its
+                contents, if any, before the assignment commences.
+
+Insert  attempts to add a node having the given key and data values
+                to the given tree. The tree is rebalanced if necessary to ensure
+                that the path-balanced property is maintained. If a node
+                already exists in the tree with the given key the found procedure
+                parameter is invoked and the new element is not added to the tree.
+
+Remove  searches the given tree for the node containing the specified key
+                value and removing this node from the tree. If a node does not
+                exist in the tree with the given key the notFound procedure
+                parameter is invoked. Following the removal of the node, the
+                tree is rebalanced, if necessary, to maintain the path-balance
+                property.
+*)
+
+PROCEDURE Create    (    keyType  : TypeID       (*--in   *);
+                                                 dataType : TypeID       (*--in   *);
+                                                 kBalance : CARDINAL     (*--in   *))
+                                  : Tree         (*--out  *);
+
+PROCEDURE MakeTree  (    keyType  : TypeID       (*--in   *);
+                                                 dataType : TypeID       (*--in   *);
+                                                 kBalance : CARDINAL     (*--in   *);
+                         theKey   : Key          (*--in   *);
+                                                 theData  : Data         (*--in   *))
+                                  : Tree         (*--out  *);
+
+PROCEDURE Destroy   (VAR theTree  : Tree         (*--inout*));
+
+PROCEDURE Clear     (    theTree  : Tree         (*--inout*));
+
+PROCEDURE Assign    (    theTree  : Tree         (*--in   *);
+                     VAR toTree   : Tree         (*--inout*));
+
+PROCEDURE Insert    (    theTree  : Tree         (*--inout*);
+                         theKey   : Key          (*--in   *);
+                         theData  : Data         (*--in   *);
+                                                 found    : InsertProc   (*--in   *));
+
+PROCEDURE Remove    (    theTree  : Tree         (*--inout*);
+                         theKey   : Key          (*--in   *);
+                                                 notFound : NotFoundProc (*--in   *));
+
+        (*-----------------------*)
+
+(*
+8.1.4 Selectors
+
+Selector operations allow a client module to examine the state of a tree
+without changing that state.
+
+IsDefined       verifies whether theTree has been created and is still an
+                        active object. For our purposes, a tree object is considered
+                        defined if it is not equal to the NullTree.
+
+IsEmpty         returns true if the given tree does not contain any nodes, and
+                        false otherwise.
+
+IsEqual         returns true if and only if the two trees have the same key and
+                        data item types, contain the same items, and have the same
+                        relationships between each item.
+
+KeyTypeOf       simpy returns the data type ID of the keys associated with this tree.
+
+DataTypeOf      returns the data item type ID of the given tree.
+
+ExtentOf        returns a count indicating the total number of nodes in the tree.
+
+IsPresent       searches the given tree for the item with the given key value.
+                        If the item is found the found procedure parameter is called,
+                        otherwise the notFound procedure parameter is called.
+*)
+
+PROCEDURE IsDefined  (    theTree  : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+
+PROCEDURE IsEmpty    (    theTree  : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+
+PROCEDURE IsEqual    (    left     : Tree         (*--in   *);
+                          right    : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+
+PROCEDURE KeyTypeOf  (    theTree  : Tree         (*--in   *))
+                                   : TypeID       (*--out  *);
+
+PROCEDURE DataTypeOf (    theTree  : Tree         (*--in   *))
+                                   : TypeID       (*--out  *);
+
+PROCEDURE ExtentOf   (    theTree  : Tree         (*--in   *))
+                                   : CARDINAL     (*--out  *);
+
+PROCEDURE IsPresent  (    theTree  : Tree         (*--in   *);
+                          theKey   : Key          (*--in   *);
+                                                  found    : FoundProc    (*--in   *);
+                                                  notFound : NotFoundProc (*--in   *));
+
+        (*-----------------------*)
+
+(*
+8.1.5 Passive Iterators
+
+Three passive iterators are provided each implementing one of the standard
+tree traversal algorithms. Passive iterators allow the client module
+to traverse the tree as through it were a single, monolithic data structure.
+*)
+
+PROCEDURE Preorder  (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+PROCEDURE Inorder   (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+PROCEDURE Postorder (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+        (*-----------------------*)
+
+(*
+8.1.6 Active Iterators
+
+While passive iterators are most useful for tree objects, there may
+be situations when the client module requires more control over the
+iteration process (e.g., when printing the internal binary tree
+representation). In this case, it is necessary to use an active
+iteration mechanism, where the internal structure of a tree is made
+visible to the client in a controlled manner that ensures the safety
+of the abstraction.
+
+In the form presented here, the internal structure is made visible
+through the opaque type NodePtr, representing a subtree node of a tree.
+An empty subtree is modelled by the constant NullNode. Weight represents
+the number of external nodes rooted at a given subtree. If the subtree is
+empty by convention the weight is one.
+
+The reader should note that none of the active iterator operations
+raise exceptions.
+
+NodePtr         is a type used to represent an individual node of the tree.
+
+NullNode        is a constant representing an empty subtree.
+
+Weight          represents the number of external nodes rooted at a given subtree.
+
+RootOf          returns a reference to the root node of the given tree. If
+                        the tree is empty then the NullNode is returned.
+
+LeftOf          returns the node that is the left subtree from the given
+                        node. If the given node has no left subtree then the NullNode
+                        is returned.
+
+RightOf         returns the node that is the right subtree from the given
+                        node. If the given node has no right subtree then the NullNode
+                        is returned.
+
+IsNull          returns true is the given node is equal to the NullNode and
+                        false otherwise.
+
+KeyOf           returns the key value associated with the given node. If the
+                        node is empty (i.e., equal to the NullNode) the NullItem is
+                        returned instead.
+
+DataOf          returns the data value associated with the given node. If the
+                        node is empty (i.e., equal to the NullNode) the NullItem is
+                        returned instead.
+
+WeightOf        returns the weight factor for the given node. If the node is
+                        null, then a weight of one (1) is returned.
+*)
+
+TYPE  NodePtr;
+CONST NullNode = NodePtr(NIL);
+TYPE  Weight   = CARDINAL;
+
+
+PROCEDURE RootOf    (    theTree : Tree     (*--in   *))
+                                                             : NodePtr  (*--out  *);
+
+PROCEDURE LeftOf    (    theNode : NodePtr  (*--in   *))
+                                                             : NodePtr  (*--out  *);
+
+PROCEDURE RightOf   (    theNode : NodePtr  (*--in   *))
+                                                             : NodePtr  (*--out  *);
+
+PROCEDURE IsNull    (    theNode : NodePtr  (*--in   *))
+                                                             : BOOLEAN  (*--out  *);
+
+PROCEDURE KeyOf     (    theNode : NodePtr  (*--in   *))
+                                                             : Key      (*--out  *);
+
+PROCEDURE DataOf    (    theNode : NodePtr  (*--in   *))
+                                                             : Data     (*--out  *);
+
+PROCEDURE WeightOf  (    theNode : NodePtr  (*--in   *))
+                                                             : Weight   (*--out  *);
+
+END IPBSUMI.
+
+(*
+
+                                Algorithmic     Code
+Operation Name  Complexity      Size
+                                (bytes)
+TreeError               O(1)             26             Exception Handling Routines
+GetHandler              O(1)             42
+SetHandler              O(1)             38
+
+Create                  O(1)            110             Constructors
+Destroy                 O(1)             44
+MakeTree                O(1)            166
+Clear                   O(n)            218
+Assign                  O(m+n)          534
+Insert                  O(log2 n)       376
+Remove                  O(log2 n)       760
+
+IsDefined               O(1)             36             Selectors
+IsEmpty                 O(1)             74
+IsEqual                 O(Min(m,n))     326
+ExtentOf                O(n)            148
+KeyTypeOf               O(1)             64
+DataTypeOf              O(1)             66
+IsPresent               O(log2 n)       212
+
+Inorder                 O(n)            146             Passive Iterators
+Preorder                O(n)            146
+Postorder               O(n)            146
+
+RootOf                  O(1)             50             Active Iterators
+LeftOf                  O(1)             50
+RightOf                 O(1)             50
+IsNull                  O(1)             36
+KeyOf                   O(1)             48
+DataOf                  O(1)             50
+WeightOf                O(1)             52
+
+RaiseErrIn              O(1)             58             Local Routines
+NewNode                 O(1)             78
+Wt                              O(1)             52
+LeftRotation    O(1)            128
+RightRotation   O(1)            128
+CheckRotations  O(1)            392
+Initialization  O(1)             92
+
+Grand Total                                4942
+
+Table 8.1 Unbounded k-Balanced Binary Tree Operations Summary
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/IPBSUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/IPBSUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/IPBSUMI.MOD
@@ -0,0 +1,1117 @@
+(*
+8.2 Unbounded Path k-Balanced Binary Search Tree Implementation
+
+The internal structures used in representing a path-balanced,
+unbounded binary search tree are described in this section along
+with the algorithms implementing the operations defined in the
+interface.
+
+This section is broken down as follows:
+        * 8.2.1 Internal Representation
+        * 8.2.2 Exception Handling
+        * 8.2.3 Local Operations
+        * 8.2.4 Tree Constructors
+        * 8.2.5 Tree Selectors
+        * 8.2.6 Passive Iterators
+        * 8.2.7 Active Iterators
+        * 8.2.8 Module Initialization
+*)
+
+IMPLEMENTATION MODULE IPBSUMI;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code Size: OBJ file is 14272 bytes
+    Component: Monolithic Structures - IPBk Tree (Opaque version)
+               Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.01  19 May 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.02  01 Oct 1988  C. Lins
+      Updated and improved comments.
+    v1.03  29 Jan 1989  C. Lins
+          Added use of Key and Data aliases for generic Items.
+    v1.04  03 Feb 1989  C. Lins
+          Optimized Assign to use NewNode instead of directly allocating
+          new nodes. Assumes that assignKey and assignItem never fail.
+    v1.05  06 Feb 1989  C. Lins
+          Added use of InsertProc instead of FoundProc in Insert.
+    v1.06  09 Feb 1989  C. Lins
+          Removed VAR from Clear, Insert, & Remove (the tree itself
+          does not change).
+    v1.07  17 Apr 1989  C. Lins:
+          Corrected IsEqual to use comparison routine derived
+          from the CompareOf routine associated with the stack's
+          TypeID.
+    v1.04  18 Apr 1989   C. Lins:
+          Added component id constant.
+    v2.00  08 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Relations IMPORT
+        (*--Type*) Relation;
+
+FROM Items IMPORT
+        (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM TreeTypes IMPORT
+    (*--Type*) Operations, Exceptions, AccessProc, FoundProc,
+                           NotFoundProc, InsertProc, Key, Data, ComponentID;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+        (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+    (*-----------------------*)
+
+(*
+8.2.1 Internal Unbounded IPB Binary Search Tree Representation
+
+An unbounded path-balanced binary search tree is represented using
+nodes for storing keys, data items, links between nodes the left
+and right subtrees, and the weight of each node.
+Figure 8.1 depicts graphically this structural organization.
+
+_Figure 8.1_
+
+Link    provides a mechanism for maintaining the lexicographical ordering
+                between nodes (i.e., the structure of the tree).
+
+Node    holds a key value and its associated data, if any, along with
+                links to the left and right subtrees. In addition, a weight field
+                is maintained in order to detect when rebalancing the tree is
+                necessary.
+
+UnboundedTree   defines a descriptor record for each unbounded tree
+                object. This record holds the data type IDs for the key and
+                data fields plus a link to the root node of the tree. Furthermore,
+                we must keep track of the balancing control factor, k, which
+                describes how far out of balance a path may become before
+                rebalancing is necessary.
+
+Tree    completes the opaque definition of the abstract tree.
+*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD
+                key   : Key;    (*-- key value for this node *)
+                data  : Data;   (*-- data value for this node *)
+                weight: Weight; (*-- # of external nodes rooted at this tree *)
+                left  : Link;   (*-- link to left subtree *)
+                right : Link;   (*-- link to right subtree*)
+          END (*-- Node *);
+
+TYPE  Tree = POINTER TO UnboundedTree;
+
+TYPE  UnboundedTree = RECORD
+                keyID  : TypeID;   (*-- data type for the tree's keys *)
+        dataID : TypeID;   (*-- data type for this tree's items *)
+                k      : CARDINAL; (*-- k-Balance rotation control factor *)
+                root   : Link;     (*-- link to root of this tree *)
+      END (*-- UnboundedTree *);
+
+
+(*
+8.2.2 Exceptions
+
+treeError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+treeError before any other processing.
+
+The handler array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+8.2.8).
+
+TreeError       simply returns the current exception result stored
+                        in treeError and is used to determine whether a tree
+                        operation completed successfully.
+
+SetHandler      makes theHandler the current exception handler for theError
+                        by storing theHandler in the handler array.
+
+GetHandler      returns the current exception handler for theError from the
+                        handler array.
+*)
+
+VAR   treeError : Exceptions;
+VAR   handler   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE TreeError  ()              : Exceptions  (*-- out   *);
+BEGIN
+  RETURN treeError;
+END TreeError;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  treeError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+8.2.3 Local Operations
+
+NewNode allocates and initializes a new leaf node for a tree.
+By definition, the number of external nodes rooted at a given
+subtree is two, and thus, the weight factor is initialized to
+this value. Complexity O(1).
+*)
+
+PROCEDURE NewNode   (    theKey   : Key         (*-- in    *);
+                                                 theData  : Data        (*-- in    *);
+                                                 theWeight: Weight      (*-- in    *))
+                                                          : Link        (*-- out   *);
+
+VAR   theNode : Link; (*-- link to new leaf node being created *)
+
+BEGIN
+  Allocate(theNode, SIZE(Node));
+  IF (theNode # NIL) THEN
+    WITH theNode^ DO
+      key   := theKey;
+      data  := theData;
+          weight:= theWeight;
+      left  := NIL;
+      right := NIL;
+    END (*--with*);
+  END (*--if*);
+  RETURN theNode;
+END NewNode;
+(*-------------------------*)
+
+(*
+Wt returns the weight value for a given node, which is the number of
+external nodes in the subtree rooted at the node. A subtree of NIL
+returns 1, otherwise t^.weight.
+*)
+
+PROCEDURE Wt (    theSubtree : Link   (*-- in    *))
+                                                         : Weight (*-- out   *);
+BEGIN
+  IF (theSubtree = NIL) THEN
+    RETURN 1;
+  END (*--if*);
+  RETURN theSubtree^.weight;
+END Wt;
+(*-------------------------*)
+
+(*
+The routines LeftRotation and RightRotation perform a single left
+rotation and single right rotation of the given subtree, respectively.
+Rotations were previously described in section 3.3.6, Tree Rotations.
+Both routines have an algorithmic complexity of O(1).
+*)
+
+PROCEDURE LeftRotation (VAR theSubtree : Link (*-- inout *));
+
+VAR   temporary : Link;
+
+BEGIN
+  temporary  := theSubtree;
+  theSubtree := theSubtree^.right;
+  temporary^.right := theSubtree^.left;
+  theSubtree^.left := temporary;
+
+  (*-- adjust weights --*)
+
+  WITH temporary^ DO
+    theSubtree^.weight := weight;
+    weight := Wt(left) + Wt(right);
+  END (*--with*);
+END LeftRotation;
+(*-------------------------*)
+
+PROCEDURE RightRotation (VAR theSubtree : Link (*-- inout *));
+
+VAR   temporary : Link;
+
+BEGIN
+  temporary  := theSubtree;
+  theSubtree := theSubtree^.left;
+  temporary^.left   := theSubtree^.right;
+  theSubtree^.right := temporary;
+
+  (*-- adjust weights --*)
+
+  WITH temporary^ DO
+    theSubtree^.weight := weight;
+    weight := Wt(left) + Wt(right);
+  END (*--with*);
+END RightRotation;
+(*-------------------------*)
+
+(*
+CheckRotations checks the balancing in the tree, performs any necessary
+rotation, and checks whether further rotations may be needed. The global
+parameter kBalance controls the frequency of rotations on the tree. The
+higher the value of kBalance the fewer number of rotations. A single
+rotation occurs only when Nc - Na >= kBalance, while a double rotation
+occurs only when Nb - Na >= kBalance. The
+value of kBalance should be tailored as necessary for particular real applications.
+kBalance is an INTEGER (though it is never less than one) as the comparison
+between the number of nodes in the subtrees may yield a negative result.
+*)
+
+VAR   kBalance : INTEGER; (*-- rotation control factor *)
+
+PROCEDURE CheckRotations (VAR theSubtree : Link    (*--inout *));
+
+VAR   wtLeft : Weight;
+      wtRight: Weight;
+
+BEGIN
+  IF (theSubtree # NIL) THEN
+    WITH theSubtree^ DO
+      wtLeft := Wt(left);
+          wtRight:= Wt(right);
+        END (*--with*);
+
+        IF (wtRight > wtLeft) THEN
+
+          (*-- left rotation needed --*)
+
+          IF VAL(INTEGER, Wt(theSubtree^.right^.right)) -
+                 VAL(INTEGER, wtLeft) >= kBalance THEN
+            LeftRotation(theSubtree);
+                CheckRotations(theSubtree^.left);
+
+          ELSIF VAL(INTEGER, Wt(theSubtree^.right^.left)) -
+                        VAL(INTEGER, wtLeft) >= kBalance THEN
+            RightRotation(theSubtree^.right);
+            LeftRotation(theSubtree);
+                CheckRotations(theSubtree^.left);
+                CheckRotations(theSubtree^.right);
+          END (*--if*);
+
+        ELSIF (wtLeft > wtRight) THEN
+
+          (*-- right rotation needed --*)
+
+          IF VAL(INTEGER, Wt(theSubtree^.left^.left)) -
+                 VAL(INTEGER, wtRight) >= kBalance THEN
+            RightRotation(theSubtree);
+                CheckRotations(theSubtree^.right);
+
+          ELSIF VAL(INTEGER, Wt(theSubtree^.left^.right)) -
+                        VAL(INTEGER, wtRight) >= kBalance THEN
+            LeftRotation(theSubtree^.left);
+            RightRotation(theSubtree);
+                CheckRotations(theSubtree^.left);
+                CheckRotations(theSubtree^.right);
+          END (*--if*);
+        END (*--if*);
+  END (*--if*);
+END CheckRotations;
+(*-------------------------*)
+
+
+(*
+8.2.4 Constructors
+
+Create attempts to build a new empty tree of the given type.
+First, the tree header is allocated and the key and data type IDs are
+stored in the header. The pointer to the root node is initialized
+to the empty state (NIL). If the header allocation fails the
+overflow exception is raised and the NullTree is returned.
+Complexity O(1).
+*)
+
+PROCEDURE Create    (    keyType  : TypeID       (*-- in    *);
+                                                 dataType : TypeID       (*-- in    *);
+                                                 kBalance : CARDINAL     (*-- in    *))
+                                  : Tree         (*-- out   *);
+
+VAR   newTree : Tree; (*-- temporary for new tree *)
+
+BEGIN
+  treeError := noerr;
+  Allocate(newTree, SIZE(UnboundedTree));
+  IF (newTree = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newTree^ DO
+          keyID  := keyType;
+      dataID := dataType;
+          IF (kBalance = 0) THEN
+            kBalance := 1;
+          END (*--if*);
+          k    := kBalance;
+          root := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newTree;
+END Create;
+(*-------------------------*)
+
+(*
+MakeTree is a combination of Create(keyType, dataType) immediately
+followed by Insert(theKey, theData). Complexity O(1).
+*)
+
+PROCEDURE MakeTree  (    keyType  : TypeID       (*-- in    *);
+                                                 dataType : TypeID       (*-- in    *);
+                                                 kBalance : CARDINAL     (*-- in    *);
+                         theKey   : Key          (*-- in    *);
+                                                 theData  : Data         (*-- in    *))
+                                  : Tree         (*-- out   *);
+
+VAR   newTree : Tree; (*-- new tree being created *)
+
+BEGIN
+  treeError := noerr;
+  Allocate(newTree, SIZE(UnboundedTree));
+  IF (newTree = NIL) THEN
+    RaiseErrIn(maketree, overflow);
+  ELSE
+    WITH newTree^ DO
+          keyID  := keyType;
+      dataID := dataType;
+          IF (kBalance = 0) THEN
+            kBalance := 1;
+          END (*--if*);
+          k    := kBalance;
+          root := NewNode(theKey, theData, 2);
+          IF (root = NIL) THEN
+            RaiseErrIn(maketree, overflow);
+                Deallocate(newTree, SIZE(newTree^));
+          END (*--if*);
+    END(*--with*);
+  END(*--if*);
+  RETURN newTree;
+END MakeTree;
+(*-------------------------*)
+
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theTree back to the system.
+SCLStorage.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullTree). Complexity: O(n).
+*)
+
+PROCEDURE Destroy   (VAR theTree  : Tree         (*-- inout *));
+BEGIN
+  Clear(theTree);
+  IF (treeError = noerr) THEN
+    Deallocate(theTree, SIZE(theTree^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+
+(*
+Clear uses a postorder traversal of theTree, clearing the nodes of
+both subtrees before clearing the tree itself. After disposing the
+subtrees the key and data values can be disposed followed by the node.
+The routine takes advantage of the fact that this version of Deallocate
+sets the pointer to NIL after releasing the proper amount of memory.
+This saves us from having to explicitly set the root to NIL.
+Complexity O(n).
+*)
+
+PROCEDURE Clear     (    theTree  : Tree         (*-- inout *));
+
+VAR   freeData : DisposeProc; (*-- data value disposal routine *)
+          freeKey  : DisposeProc; (*-- key value disposal routine *)
+
+  PROCEDURE ClearNodes (VAR theSubtree : Link (*-- inout *));
+  BEGIN
+    IF (theSubtree # NIL) THEN
+          WITH theSubtree^ DO
+            ClearNodes(left);
+            ClearNodes(right);
+                freeKey(key);
+                freeData(data);
+          END (*--with*);
+          Deallocate(theSubtree, SIZE(theSubtree^));
+        END (*--if*);
+  END ClearNodes;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theTree^ DO
+      freeKey  := DisposeOf(keyID);
+      freeData := DisposeOf(dataID);
+      ClearNodes(root);
+        END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+
+(*
+Assign uses a preorder traversal of the source tree to generate a
+copy in the destination tree. Preliminary to the actual copying,
+we must ensure that the source tree is defined and clear or create
+the destination tree as necessary. This step is accomplished by the
+RecreateTarget routine which must accomodate the following cases:
+        * the source tree is undefined, and thus, the target tree must be
+          left unchanged;
+        * the source tree and target tree are the same and therefore the
+          postcondition of the Assign operation is already met;
+        * the source tree is defined but the target tree is undefined, so
+          the target tree must be created with the same key and data type
+          id's as the source tree; and
+        * both the source and target trees are defined, and thus the target
+          tree must be cleared of its contents followed by its key and data
+          key id's being set to the same as the source tree.
+
+In the second case, we automatically return FALSE so that Assign will
+bypass the node copying operation. While in the other three instances,
+success depends on whether treeError remains set to noerr.
+
+The main body of Assign uses the result from RecreateTarget to determine
+whether to continue with the copy operation after recreating the target tree.
+Complexity O(m+n) where m is the number of nodes in the destination
+tree and n is the number of nodes in the source tree.
+*)
+
+PROCEDURE Assign    (    theTree  : Tree         (*-- in    *);
+                     VAR toTree   : Tree         (*-- inout *));
+
+VAR   assignKey  : AssignProc; (*-- key item assignment routine *)
+          assignItem : AssignProc; (*-- data item assignment routine *)
+
+  PROCEDURE RecreateTarget () : BOOLEAN (*--out *);
+  BEGIN
+    IF (theTree = NIL) THEN
+          RaiseErrIn(assign, undefined);
+    ELSIF (toTree = NIL) THEN
+          WITH theTree^ DO
+            toTree := Create(keyID, dataID, k);
+          END (*--with*);
+    ELSIF (toTree = theTree) THEN
+          RETURN FALSE;
+    ELSE
+          Clear(toTree);
+          WITH theTree^ DO
+            toTree^.keyID  := keyID;
+            toTree^.dataID := dataID;
+            toTree^.k      := k;
+          END (*--with*);
+    END (*--if*);
+        RETURN treeError = noerr;
+  END RecreateTarget;
+
+  PROCEDURE DoAssign (    theSubtree : Link (*-- in    *);
+                                          VAR toSubtree  : Link (*-- out   *));
+  BEGIN
+    IF (theSubtree = NIL) THEN
+          toSubtree := NIL;
+        ELSE
+          WITH theSubtree^ DO
+            toSubtree := NewNode(assignKey(key), assignItem(data), weight);
+          END (*--with*);
+          IF (toSubtree = NIL) THEN
+            RaiseErrIn(assign, overflow);
+          ELSE
+            DoAssign(theSubtree^.left, toSubtree^.left);
+            DoAssign(theSubtree^.right, toSubtree^.right);
+          END (*--if*);
+        END (*--if*);
+  END DoAssign;
+
+BEGIN
+  treeError := noerr;
+  IF RecreateTarget() THEN
+    WITH theTree^ DO
+      assignKey  := AssignOf(keyID);
+      assignItem := AssignOf(dataID);
+      DoAssign(root, toTree^.root);
+        END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+
+(*
+Insert adds a node with theKey and theData to theTree and places the
+node within its proper position to maintain the search tree property.
+Complexity worst case number of rotations is O(n) but the amortized
+worst case per insertion is O(log2 n).
+*)
+
+PROCEDURE Insert    (    theTree  : Tree         (*-- inout *);
+                         theKey   : Key          (*-- in    *);
+                         theData  : Data         (*-- in    *);
+                                                 found    : InsertProc   (*-- in    *));
+
+VAR   compare : CompareProc; (*-- key comparison routine *)
+
+  PROCEDURE DoInsert (VAR theSubtree : Link (*-- inout *));
+  BEGIN
+    IF (theSubtree = NIL) THEN
+          theSubtree := NewNode(theKey, theData, 2);
+          IF (theSubtree = NIL) THEN
+            RaiseErrIn(insert, overflow);
+          END (*--if*);
+        ELSE
+          CASE compare(theSubtree^.key, theKey) OF
+            less    : DoInsert(theSubtree^.right);
+          | greater : DoInsert(theSubtree^.left);
+          ELSE
+            found(theSubtree^.key, theSubtree^.data, theData);
+                RETURN;
+          END (*--case*);
+          WITH theSubtree^ DO
+            weight := Wt(left) + Wt(right);
+          END (*--with*);
+          CheckRotations(theSubtree);
+        END (*--if*);
+  END DoInsert;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(insert, undefined);
+  ELSE
+    WITH theTree^ DO
+      compare  := CompareOf(keyID);
+          kBalance := k;
+      DoInsert(root);
+        END (*--with*);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+(*
+Remove searches theTree for the nodes with theKey and deletes the
+node from the key. The below algorithm is derived from that given
+by Gonnet [2] for deletions for weight balanced and path balanced
+trees. The search for the key is a recursive inorder tree traversal.
+If the node being deleted has one null descendant deletion is simply
+accomplished by replacing it with the other descendant. Otherwise,
+the node must be moved down the tree until it has a non-null
+descendant. The strategy employed here, which is better suited for
+balanced trees, is to use rotations to gradually move the node
+towards the fringe (e.g. leaves) of the tree. The disadvantage of
+k-balanced trees when compared to AVL trees is that rotations could
+occur all the way back to the root of the tree.
+*)
+
+PROCEDURE Remove    (    theTree  : Tree         (*-- inout *);
+                         theKey   : Key          (*-- in    *);
+                                                 notFound : NotFoundProc (*-- in    *));
+
+VAR   compare  : CompareProc; (*-- key comparison routine *)
+          freeKey  : DisposeProc; (*-- key disposal routine *)
+          freeData : DisposeProc; (*-- data disposal routine *)
+
+  PROCEDURE DoRemove (VAR subTree : Link (*-- inout *));
+
+  VAR   oldTree : Link; (*-- link to subtree to dispose *)
+
+  BEGIN
+    IF (subTree = NIL) THEN
+
+          (*-- ERROR key not found in the tree *)
+
+          notFound(theKey);
+
+        ELSE
+          CASE compare(theKey, subTree^.key) OF
+            less    : DoRemove(subTree^.left);
+          | greater : DoRemove(subTree^.right);
+          ELSE
+
+                (*-- key found, delete it *)
+
+                IF (subTree^.right = NIL) THEN
+                  oldTree := subTree;
+                  subTree := subTree^.left;
+                  freeKey(oldTree^.key);
+                  freeData(oldTree^.data);
+                  Deallocate(oldTree, SIZE(oldTree^));
+                ELSIF (subTree^.left = NIL) THEN
+                  oldTree := subTree;
+                  subTree := subTree^.right;
+                  freeKey(oldTree^.key);
+                  freeData(oldTree^.data);
+                  Deallocate(oldTree, SIZE(oldTree^));
+
+                (*-- no descendant is null, rotate on heavier side --*)
+
+                ELSIF Wt(subTree^.left) > Wt(subTree^.right) THEN
+
+                  (*-- left side is heavier, do a right rotation --*)
+
+                  IF VAL(INTEGER, Wt(subTree^.left^.right)) -
+                         VAL(INTEGER, Wt(subTree^.left^.left)) >=
+                         VAL(INTEGER, theTree^.k) THEN
+                    LeftRotation(subTree^.left);
+                  END (*--if*);
+                  RightRotation(subTree);
+                  DoRemove(subTree^.right);
+                ELSE
+
+                  (*-- right side is heavier, do a left rotation --*)
+
+                  IF VAL(INTEGER, Wt(subTree^.right^.left)) -
+                         VAL(INTEGER, Wt(subTree^.right^.right)) >=
+                         VAL(INTEGER, theTree^.k) THEN
+                    RightRotation(subTree^.right);
+                  END (*--if*);
+                  LeftRotation(subTree);
+                  DoRemove(subTree^.left);
+                END (*--if*);
+          END (*--case*);
+
+          (*-- reconstruct weight information --*)
+
+          IF (subTree # NIL) THEN
+                WITH subTree^ DO
+                  weight := Wt(left) + Wt(right);
+                END (*--with*);
+          END (*--if*);
+        END (*--if*);
+  END DoRemove;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(remove, undefined);
+  ELSE
+    WITH theTree^ DO
+      compare := CompareOf(keyID);
+          freeKey := DisposeOf(keyID);
+          freeData:= DisposeOf(dataID);
+      DoRemove(root);
+        END (*--with*);
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+
+(*
+8.2.5 Selectors
+
+IsDefined verifies to the best of its ability whether theTree has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theTree  : Tree         (*-- in    *))
+                                  : BOOLEAN      (*-- out   *);
+BEGIN
+  RETURN theTree # NullTree;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theTree is in the empty state, as indicated by
+the root being NIL, and False otherwise.  As per the specification
+(section 3.3) undefined trees are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theTree  : Tree         (*-- in    *))
+                                  : BOOLEAN      (*-- out   *);
+BEGIN
+  treeError := noerr;
+  IF (theTree # NIL) THEN
+    RETURN (theTree^.root = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual uses a preorder traversal of both left and right trees. As soon
+as an inequality between keys is found we can return false as the trees
+cannot be equal. Complexity O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left     : Tree         (*-- in    *);
+                         right    : Tree         (*-- in    *))
+                                  : BOOLEAN      (*-- out   *);
+
+VAR       compare : CompareProc;        (*-- item comparison routine *)
+
+  PROCEDURE DoIsEqual (    leftSubtree  : Link    (*-- in    *);
+                                                   rightSubtree : Link    (*-- in    *))
+                                                                                : BOOLEAN (*-- out   *);
+  BEGIN
+    IF (leftSubtree = NIL) OR (rightSubtree = NIL) THEN
+          RETURN (leftSubtree = NIL) & (rightSubtree = NIL);
+    ELSIF compare(leftSubtree^.key, rightSubtree^.key) # equal THEN
+          RETURN FALSE;
+        ELSE
+          RETURN (DoIsEqual(leftSubtree^.left, rightSubtree^.left) &
+                          DoIsEqual(leftSubtree^.right, rightSubtree^.right));
+        END (*--if*);
+  END DoIsEqual;
+
+BEGIN
+  treeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) OR
+                (left^.keyID # right^.keyID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSE
+        compare := CompareOf(left^.keyID);
+    RETURN DoIsEqual(left^.root, right^.root);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+The two TypeOf routines simply return the key data ID or data ID for the given tree.
+Undefined trees, as always, raise the undefined exception and return a reasonable value,
+in this case the NullType. Complexity O(1).
+*)
+
+PROCEDURE KeyTypeOf (    theTree  : Tree         (*-- in    *))
+                                  : TypeID       (*-- out   *);
+BEGIN
+  treeError := noerr;
+  IF (theTree # NIL) THEN
+    RETURN theTree^.keyID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END KeyTypeOf;
+(*-------------------------*)
+
+PROCEDURE DataTypeOf (    theTree  : Tree         (*-- in    *))
+                                   : TypeID       (*-- out   *);
+BEGIN
+  treeError := noerr;
+  IF (theTree # NIL) THEN
+    RETURN theTree^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END DataTypeOf;
+(*-------------------------*)
+
+(*
+ExtentOf returns the number of nodes present in the given tree or zero
+for an undefined tree. We simply employ an inorder traversal of the tree
+counting the nodes along the way. Complexity O(n).
+*)
+
+PROCEDURE ExtentOf   (    theTree  : Tree         (*-- in    *))
+                                   : CARDINAL     (*-- out   *);
+
+VAR   count : CARDINAL; (*-- running count of nodes in tree *)
+
+  PROCEDURE CountNodes (    theSubtree : Link (*-- in    *));
+  BEGIN
+    IF (theSubtree # NIL) THEN
+          WITH theSubtree^ DO
+            CountNodes(left);
+            INC(count);
+            CountNodes(right);
+          END (*--with*);
+        END (*--if*);
+  END CountNodes;
+
+BEGIN
+  treeError := noerr;
+  count     := 0;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(extentof, undefined);
+  ELSE
+    CountNodes(theTree^.root);
+  END (*--if*);
+  RETURN count;
+END ExtentOf;
+(*-------------------------*)
+
+(*
+IsPresent uses an iterative traversal of the given tree attempting
+to find node in theTree containing theKey value. The search path
+begins at the root switching to the left or right subtree based on
+examination of each node's key. As noted by Wirth [4] and others, as
+few as log2 n comparisons may be needed to find theKey if theTree is
+perfectly balanced. The algorithmic complexity of the search is
+therefore O(log2 n). It is assumed that all keys are comparable and
+the compare procedure is not NIL.
+*)
+
+PROCEDURE IsPresent (    theTree  : Tree         (*-- in    *);
+                         theKey   : Key          (*-- in    *);
+                                                 found    : FoundProc    (*-- in    *);
+                                                 notFound : NotFoundProc (*-- in    *));
+
+VAR   treeIndex : Link;
+      compare   : CompareProc; (*-- key comparison routine *)
+
+BEGIN
+  treeError := noerr;
+  IF (theTree # NIL) THEN
+    WITH theTree^ DO
+      treeIndex := root;
+          compare   := CompareOf(keyID);
+        END (*--with*);
+
+        LOOP
+          IF (treeIndex = NIL) THEN
+            notFound(theKey);
+                EXIT (*--loop*);
+          END (*--if*);
+          CASE compare(treeIndex^.key, theKey) OF
+            equal   : found(theKey, treeIndex^.data);
+                                  EXIT (*--loop*);
+          | less    : treeIndex := treeIndex^.right;
+          | greater : treeIndex := treeIndex^.left;
+          END (*--case*);
+        END (*--loop*);
+
+  ELSE
+    RaiseErrIn(ispresent, undefined);
+  END (*--if*);
+END IsPresent;
+(*-------------------------*)
+
+
+(*
+8.2.6 Passive Iterators
+
+Each of the three iterator routines accomplish recursively Preorder,
+Inorder, and Postorder traversals of the given tree. If the tree is
+not defined, the undefined exception is raised and the traversal is
+aborted. Otherwise, traversal begins with the root of the tree following
+the specifications given in section 3.1.6.2. The complexity is O(n) for
+all three traversals. Once again these are elementary tree algorithms that
+can be found is any college textbook on data structures.
+*)
+
+PROCEDURE Preorder  (    theTree   : Tree       (*-- in    *);
+                         theProcess: AccessProc (*-- in    *));
+
+  PROCEDURE DoPreorder (    theSubtree : Link (*-- in    *));
+  BEGIN
+    IF (theSubtree # NIL) THEN
+          WITH theSubtree^ DO
+            theProcess(key, data);
+            DoPreorder(left);
+            DoPreorder(right);
+          END (*--with*);
+        END (*--if*);
+  END DoPreorder;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(preorder, undefined);
+  ELSE
+    DoPreorder(theTree^.root);
+  END (*--if*);
+END Preorder;
+(*-------------------------*)
+
+PROCEDURE Inorder   (    theTree   : Tree       (*-- in    *);
+                         theProcess: AccessProc (*-- in    *));
+
+  PROCEDURE DoInorder (    theSubtree : Link (*-- in    *));
+  BEGIN
+    IF (theSubtree # NIL) THEN
+          WITH theSubtree^ DO
+            DoInorder(left);
+            theProcess(key, data);
+            DoInorder(right);
+          END (*--with*);
+        END (*--if*);
+  END DoInorder;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(inorder, undefined);
+  ELSE
+    DoInorder(theTree^.root);
+  END (*--if*);
+END Inorder;
+(*-------------------------*)
+
+PROCEDURE Postorder (    theTree   : Tree       (*-- in    *);
+                         theProcess: AccessProc (*-- in    *));
+
+  PROCEDURE DoPostorder (    theSubtree : Link (*-- in    *));
+  BEGIN
+    IF (theSubtree # NIL) THEN
+          WITH theSubtree^ DO
+            DoPostorder(left);
+            DoPostorder(right);
+            theProcess(key, data);
+          END (*--with*);
+        END (*--if*);
+  END DoPostorder;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(postorder, undefined);
+  ELSE
+    DoPostorder(theTree^.root);
+  END (*--if*);
+END Postorder;
+(*-------------------------*)
+
+
+(*
+8.2.7 Active Iterators
+
+The active iterators given below simply return eomponents of tree nodes
+and are thus, for the most part, self-explanatory.
+
+The TML Modula-2 compiler prohibits us from redeclaring an opaque
+type as equal to another type. (We cannot define a NodePtr = Link).
+Thus, we must explicitly define NodePtr and then use the type transfer
+facility provided by VAL to coerce the tree links into iterator nodes.
+*)
+
+TYPE  NodePtr = POINTER TO Node;
+
+PROCEDURE RootOf   (    theTree : Tree    (*-- in    *))
+                                                            : NodePtr (*-- out   *);
+BEGIN
+  IF (theTree = NIL) THEN
+    RETURN NullNode;
+  END (*--if*);
+  RETURN NodePtr(theTree^.root);
+END RootOf;
+(*-------------------------*)
+
+PROCEDURE LeftOf   (    theNode : NodePtr (*-- in    *))
+                                                            : NodePtr (*-- out   *);
+BEGIN
+  IF (theNode = NIL) THEN
+    RETURN NullNode;
+  END (*--if*);
+  RETURN NodePtr(theNode^.left);
+END LeftOf;
+(*-------------------------*)
+
+PROCEDURE RightOf  (    theNode : NodePtr (*-- in    *))
+                                                            : NodePtr (*-- out   *);
+BEGIN
+  IF (theNode = NIL) THEN
+    RETURN NullNode;
+  END (*--if*);
+  RETURN NodePtr(theNode^.right);
+END RightOf;
+(*-------------------------*)
+
+PROCEDURE IsNull   (    theNode : NodePtr (*-- in    *))
+                                                            : BOOLEAN (*-- out   *);
+BEGIN
+  RETURN theNode = NIL;
+END IsNull;
+(*-------------------------*)
+
+PROCEDURE KeyOf    (    theNode : NodePtr (*-- in    *))
+                                                            : Key     (*-- out   *);
+BEGIN
+  IF (theNode = NIL) THEN
+    RETURN NullItem;
+  END (*--if*);
+  RETURN theNode^.key;
+END KeyOf;
+(*-------------------------*)
+
+PROCEDURE DataOf   (    theNode : NodePtr (*-- in    *))
+                                                            : Data    (*-- out   *);
+BEGIN
+  IF (theNode = NIL) THEN
+    RETURN NullItem;
+  END (*--if*);
+  RETURN theNode^.data;
+END DataOf;
+(*-------------------------*)
+
+PROCEDURE WeightOf  (    theNode : NodePtr  (*-- in    *))
+                                                             : Weight   (*-- out   *);
+BEGIN
+  IF (theNode = NIL) THEN
+    RETURN 1;
+  END (*--if*);
+  RETURN theNode^.weight;
+END WeightOf;
+(*-------------------------*)
+
+
+(*
+8.2.8 Module Initialization
+
+The module's local variables are initialized to known states.
+treeError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, treeError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR treeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(treeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  treeError := noerr;
+        NullTree := NIL;
+END IPBSUMI.
+
+(*
+References
+
+
+[1]     G.H. Gonnet, Balancing Binary Trees by Internal Path Reduction,
+        Communications of the ACM, Vol. 26 (12), (Dec. 1983), pp. 1074-1081.
+[2]     G.H. Gonnet, Handbook of Algorithms and Data Structures, Addison-Wesley,
+        Reading, MA 1984.
+[3] R.S. Wiener and R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986.
+[4]     N. Wirth, Algorithms and Data Structures, Prentice-Hall, Englewood Cliffs,
+        NJ 1986.
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/IPBSUMIU.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/IPBSUMIU.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/IPBSUMIU.DEF
@@ -0,0 +1,72 @@
+(*
+8.3 k-Balanced Binary Search Tree Utilities
+
+This module provides the utility routines for k-Balanced binary
+search trees. The following facilities are provided:
+  a) printing a binary tree; and
+  b) determining the height of a tree.
+*)
+
+DEFINITION MODULE IPBSUMIU;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Component: k-Balanced Tree SUMI Utilities
+
+    REVISION HISTORY
+    v1.00  17 Mar 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.01  01 Oct 1988  C. Lins
+      Cleaned up comments.
+      Changed PrintTree to use a single procedure parameter.
+    v1.02  29 Jan 1989  C. Lins
+      Added use of Key and Data aliases for generic Items.
+    v2.00  08 Oct 1989  C. Lins
+      Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM TreeTypes IMPORT
+    (*--Type*) Key, Data;
+
+FROM IPBSUMI IMPORT
+    (*--Type*) Tree, Weight;
+
+
+        (*-----------------------*)
+
+(*
+8.3.1 Utility Selectors
+
+HeightOf returns the height of the given tree.
+*)
+
+PROCEDURE HeightOf (    theTree : Tree     (*--in   *))
+                                                                : CARDINAL (*--out  *);
+
+
+(*
+8.3.2 Debugging Iterators
+
+PrintTree iterates over the given tree such that the nodes may be
+printed. Trees are normally displayed with the root at the top and
+the leaves at the bottom. To simplify the printing process, PrintTree
+displays the tree rotated 90Æ to the left. Thus the root is shown at
+the left of the page/screen with the leaves at the right. Furthermore,
+the left branches are shown towards the bottom of the display and the
+right branches at the top. The PrintProc routine is responsible for
+indenting the display appropriately based on the level parameter.
+*)
+TYPE  Level      = CARDINAL;
+TYPE  PrintProc  = PROCEDURE (Level, Key, Data, Weight);
+
+PROCEDURE PrintTree (    theTree: Tree       (*--in   *);
+                         print  : PrintProc  (*--in   *));
+
+END IPBSUMIU.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/IPBSUMIU.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/IPBSUMIU.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/IPBSUMIU.MOD
@@ -0,0 +1,117 @@
+(*
+8.4 k-Balanced Binary Search Tree Utilities
+
+Below is the implementation for the print tree routine whose
+interface was given above.
+*)
+
+IMPLEMENTATION MODULE IPBSUMIU;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: OBJ file has 1570 bytes
+    Component: IPBk Tree SUMI Utilities
+
+    REVISION HISTORY
+    v1.00  17 Mar 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.01  01 Oct 1988  C. Lins
+      Cleaned up comments.
+          Changed PrintTree to use a single procedure parameter.
+    v1.02  29 Jan 1989  C. Lins
+          Added use of Key and Data aliases for generic Items.
+    v2.00  08 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM TreeTypes IMPORT
+    (*--Type*) Key, Data;
+
+FROM IPBSUMI IMPORT
+        (*--Type*) Tree, NodePtr, Weight,
+        (*--Proc*) IsEmpty, RootOf, LeftOf, RightOf, IsNull, KeyOf,
+                           DataOf, WeightOf;
+
+        (*-----------------------*)
+
+(*
+8.4.1 Utility Selectors
+
+HeightOf returns the height of the given tree. Height may be computed by
+subtracting the level of the ≡lowest≡ node in the tree from the level of
+the root.  Complexity O(log2 n).
+*)
+
+PROCEDURE HeightOf (    theTree : Tree     (*-- in    *))
+                                                                : CARDINAL (*-- out   *);
+
+VAR   maxLevel : CARDINAL; (*-- level of the lowest node so far *)
+
+  PROCEDURE CountLevels (    theNode : NodePtr  (*-- in    *);
+                                                         theLevel: CARDINAL (*-- in    *));
+  BEGIN
+    IF ~IsNull(theNode) THEN
+          IF (theLevel > maxLevel) THEN
+            maxLevel := theLevel;
+          END (*--if*);
+          CountLevels(LeftOf(theNode), theLevel+1);
+          CountLevels(RightOf(theNode), theLevel+1);
+        END (*--if*);
+  END CountLevels;
+
+BEGIN
+  maxLevel := 1;
+  IF ~IsEmpty(theTree) THEN
+    CountLevels(RootOf(theTree), 1);
+  END (*--if*);
+  RETURN maxLevel - 1;
+END HeightOf;
+(*-------------------------*)
+
+
+(*
+8.4.2 Debugging Iterators
+
+PrintTree iterates over the given tree such that the nodes may be
+printed. Trees are normally displayed with the root at the top and
+the leaves at the bottom. To simplify the printing process, PrintTree
+displays the tree rotated 90Æ to the left. Thus the root is shown at
+the left of the page/screen with the leaves at the right. Furthermore,
+the left branches are shown towards the bottom of the display and the
+right branches at the top.
+
+The algorithm used here is a variation on the inorder tree traversal. So
+that the tree is displayed properly rotated, the processing of the left
+and right branches are reversed. This algorithm is derived from that
+given by Wirth in [4].
+*)
+
+PROCEDURE PrintTree (    theTree: Tree       (*--in   *);
+                         print  : PrintProc  (*--in   *));
+
+  PROCEDURE DoPrintTree (    theSubtree : NodePtr  (*--in   *);
+                                                         theLevel   : CARDINAL (*--in   *));
+  BEGIN
+    IF ~IsNull(theSubtree) THEN
+          DoPrintTree(RightOf(theSubtree), theLevel+1);
+          print(theLevel, KeyOf(theSubtree), DataOf(theSubtree),
+                        WeightOf(theSubtree));
+          DoPrintTree(LeftOf(theSubtree), theLevel+1);
+        END (*--if*);
+  END DoPrintTree;
+
+BEGIN
+  IF ~IsEmpty(theTree) THEN
+    DoPrintTree(RootOf(theTree), 0);
+  END (*--if*);
+END PrintTree;
+(*-------------------------*)
+
+END IPBSUMIU.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TREETYPE.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TREETYPE.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TREETYPE.DEF
@@ -0,0 +1,92 @@
+DEFINITION MODULE TreeTypes;
+(*=============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Component: Tree Structure Utility - Standard Types
+
+    THE ABSTRACTION
+    This module provides centralized definitions of the operations
+    and exceptions for all tree modules.
+
+    REVISION HISTORY
+    v1.01  18 Mar 1988  C. Lins:
+        Initial TML Modula-2 implementation
+    v1.02  03 Oct 1988  C. Lins:
+        Added operations for multiway trees.
+    v1.03  06 Feb 1989   C. Lins:
+        Added InsertProc procedure type for use as the FoundProc
+        in an Insert operation (the new data item is needed as
+        well as the old data).
+    v1.04  18 Apr 1989   C. Lins:
+        Added component id constant.
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+=============================================================*)
+
+FROM Items IMPORT
+        (*--type*) Item;
+
+
+CONST ComponentID = 256 * 9;
+
+
+    (*---------------------------------*)
+    (*--       TREE OPERATIONS       --*)
+
+TYPE  Operations = (
+                    (*-- Module Initialization *)
+                    modinit,
+
+                    (*-- Constructors *)
+                    create, destroy, clear, assign, maketree,
+                                        insert, remove, setitem,
+
+                    (*-- Selectors *)
+                    isdefined, isempty, isequal, sizeof, typeof,
+                    extentof, ispresent, itemof, childrenof, childof,
+
+                    (*-- Iterators *)
+                    preorder, inorder, postorder, iterate,
+
+                    (*-- Guarded Concurrent Operations *)
+                    seize, release
+                   );
+
+TYPE  Constructors = Operations [ create    .. setitem   ];
+TYPE  Selectors    = Operations [ isdefined .. childof   ];
+TYPE  Iterators    = Operations [ preorder  .. iterate   ];
+TYPE  GuardedOps   = Operations [ seize     .. release   ];
+
+
+    (*---------------------------------*)
+    (*--       TREE EXCEPTIONS       --*)
+
+TYPE  Exceptions = (noerr,      (*-- Nothing went wrong. *)
+                    initfailed, (*-- Initialization failure. *)
+                    overflow,   (*-- Tree cannot grow big enough
+                                  -- for the requested operation.*)
+                    treeisnull, (*-- Tree is empty *)
+                    typeerror,  (*-- Type mismatch between trees *)
+                    undefined   (*-- Tree has not been Created, or
+                                  -- the tree has been Destroyed.*)
+                   );
+
+TYPE  ExceptionSet = SET OF Exceptions;
+
+
+    (*---------------------------------*)
+    (*--    TREE PROCEDURE TYPES     --*)
+
+TYPE  Key  = Item;
+TYPE  Data = Item;
+
+TYPE  AccessProc   = PROCEDURE (Key, VAR Data);
+TYPE  InsertProc   = PROCEDURE (Key, VAR Data, Data);
+TYPE  FoundProc    = PROCEDURE (Key, VAR Data);
+TYPE  NotFoundProc = PROCEDURE (Key);
+
+END TreeTypes.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TREETYPE.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TREETYPE.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TREETYPE.MOD
@@ -0,0 +1,21 @@
+IMPLEMENTATION MODULE TreeTypes;
+(*====================================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: OBJ file has 580 bytes
+    Component: Tree Structure Utility - Standard Enumerations
+
+    THE ABSTRACTION
+    This module provides centralized definitions of the operations
+    and exceptions for all tree modules. The TML compiler requires an
+        empty implementation module.
+
+    REVISION HISTORY
+    v1.00  01 Mar 1988  C. Lins:
+      Initial TML Modula-2 implementation
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler.
+====================================================================*)
+
+END TreeTypes.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESBMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESBMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESBMI.DEF
@@ -0,0 +1,417 @@
+(*
+5.1 Bounded Binary Search Tree Interface
+
+This module provides the interface to operations on the binary search
+tree abstract data type. The particular form provided herein is bounded,
+i.e., each tree is constrained to a given maximum number of nodes when
+a tree is created.
+
+Other attributes of this particular component form are:
+
+Sequential:     can only be used in a non-tasking environment;
+Managed:        space for items ≡ the data components of a tree ≡ is returned
+                        to the system when a node is destroyed; and
+Iterator:       looping facilities are provided over tree objects.
+
+Each node of a tree is assumed to consist of two data elements ≡ a key
+field and a data field. Keys are used to structure the tree, while the
+data field simply represents information associated with a key but is
+not a part of it. While this separation may be less efficient in operation,
+it does lead to a cleaner interface.
+
+Keys are assumed to have the following operations available:
+        * a routine that assigns key values;
+        * a routine that compares key values returning the ordering
+          relation between them (i.e., less, equal, or greater); and
+        * optionally, a routine that disposes of key values that have been
+          allocated on the heap.
+
+Data values are assumed to the the following operations:
+        * a routine that assigns data values; and
+        * optionally, a routine that disposes of data values stored on the
+          heap.
+
+In both cases, keys and data values, along with the above operations, are
+identified by a TypeID that is unique for a given data type. This data type
+may be a standard Modula-2 type or one formed by the programmer using data
+type forming operations (e.g., RECORDs).
+
+The subsections are divided as follows:
+        * 5.1.1 Type Declarations
+        * 5.1.2 Exception Handling
+        * 5.1.3 Tree Constructors
+        * 5.1.4 Tree Selectors
+        * 5.1.5 Passive Iterators
+        * 5.1.6 Active Iterators
+*)
+
+DEFINITION MODULE TreSBMI;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Component: Monolithic Structures - Tree (Opaque version)
+               Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.01  18 Mar 1988  C. Lins
+          Initial implementation for TML Modula-2.
+    v1.02  01 Oct 1988  C. Lins
+          Updated and improved comments.
+    v1.03  29 Jan 1989  C. Lins
+          Added aliases for generic Items as Keys and Data to enhance
+          readability.
+    v1.04  06 Feb 1989  C. Lins
+          Added use of InsertProc instead of FoundProc in Insert.
+    v1.05  09 Feb 1989  C. Lins
+          Removed VAR from Clear, Insert, & Remove (the tree itself
+          does not change).
+    v1.06  18 Apr 1989  C. Lins
+          Changed module id.
+    v2.00  08 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM TreeTypes IMPORT
+    (*--Type*) Exceptions, Key, Data,
+                           AccessProc, InsertProc, FoundProc, NotFoundProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+    (*-----------------------*)
+
+(*
+5.1.1   Type Declarations
+
+Each instance of the Binary Tree abstract data type is represented by
+the type, Tree, using Modula-2's opaque type definition facility. The
+undefined tree is represented by a Tree constant of NIL. Since a bounded
+tree is limited in the maximum number of component nodes the type TreeSize
+is used to the range of legal values for this size constraint. Due to
+compiler constraints, our specific implementation technique, and reasons
+of portability to other Modula-2 compilers we are limited to a maximum
+of 2350 nodes in any given bounded tree.
+*)
+
+TYPE  Tree;
+VAR   NullTree : Tree;
+TYPE  TreeSize = [1..2350];
+
+        (*-----------------------*)
+
+
+(*
+5.1.2 Exceptions
+
+ModuleID        uniquely identifies this module interface. This allows
+                        exception handlers to know the module raising an exception.
+
+TreeError       returns the most recent exception condition or the constant
+                        noerr if an exception has not been raised.
+
+GetHandler      retrieves the current exception handler for the given
+                        exception enumeration constant.
+
+SetHandler      allows client modules to assign an exception handling
+                        routine for specific exceptions. In this way the client may
+                        override the default exception handling mechanism.
+*)
+
+CONST ModuleID = 4;
+
+PROCEDURE TreeError  ()              : Exceptions  (*--out  *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+
+        (*-----------------------*)
+
+
+(*
+5.1.3 Constructors
+
+Constructor operations update or change the state of a tree object. In
+this section we briefly describe each tree operation and its effect on
+a tree object. Exception conditions raised by these routines have been
+previously discussed in 3.3, Binary Search Tree Operations.
+
+Create  attempts to form a new, empty binary tree object having the given
+                key and data type identifiers and the specified maximum number of
+                nodes.
+
+MakeTree does the same as Create, except that it also attempts to add
+                the given key and data items as the root of the new tree.
+
+Destroy attempts to demolish an existing tree object, clearing the tree
+                of all its contents and making the tree ≡undefined≡.
+
+Clear   empties an existing tree of its contents returning the tree to
+                an empty state.
+
+Assign  attempts to duplicate (e.g., make a copy) of an existing tree.
+                The target tree, where the copy is stored, is cleared of its
+                contents, if any, before the assignment commences.
+
+Insert  attempts to add a node having the given key and data values
+                to the given tree. If a node already exists in the tree with
+                the given key the found procedure parameter is invoked and the
+                new element is not added to the tree.
+
+Remove  searches the given tree for the node containing the specified key
+                value and removing this node from the tree. If a node does not
+                exist in the tree with the given key the notFound procedure
+                parameter is invoked.
+*)
+
+PROCEDURE Create    (    keyType  : TypeID       (*--in   *);
+                                                 dataType : TypeID       (*--in   *);
+                                                 theSize  : TreeSize     (*--in   *))
+                                  : Tree         (*--out  *);
+
+PROCEDURE MakeTree  (    keyType  : TypeID       (*--in   *);
+                                                 dataType : TypeID       (*--in   *);
+                                                 theSize  : TreeSize     (*--in   *);
+                         theKey   : Key          (*--in   *);
+                                                 theData  : Data         (*--in   *))
+                                  : Tree         (*--out  *);
+
+PROCEDURE Destroy   (VAR theTree  : Tree         (*--inout*));
+
+PROCEDURE Clear     (    theTree  : Tree         (*--inout*));
+
+PROCEDURE Assign    (    theTree  : Tree         (*--in   *);
+                     VAR toTree   : Tree         (*--inout*));
+
+PROCEDURE Insert    (    theTree  : Tree         (*--inout*);
+                         theKey   : Key          (*--in   *);
+                         theData  : Data         (*--in   *);
+                                                 found    : InsertProc   (*--in   *));
+
+PROCEDURE Remove    (    theTree  : Tree         (*--inout*);
+                         theKey   : Key          (*--in   *);
+                                                 notFound : NotFoundProc (*--in   *));
+
+        (*-----------------------*)
+
+
+(*
+5.1.4 Selectors
+
+Selector operations allow a client module to examine the state of a tree
+without changing that state.
+
+IsDefined       verifies whether theTree has been created and is still an
+                        active object. For our purposes, a tree object is considered
+                        defined if it is not equal to the NullTree.
+
+IsEmpty         returns true if the given tree does not contain any nodes, and
+                        false otherwise.
+
+SizeOf          returns the current maximum size of the given tree.
+
+IsEqual         returns true if and only if the two trees have the same key and
+                        data item types, contain the same items, and have the same
+                        relationships between each item.
+
+KeyTypeOf       simpy returns the data type ID of the keys associated with this tree.
+
+DataTypeOf      returns the data item type ID of the given tree.
+
+ExtentOf        returns a count indicating the total number of nodes in the tree.
+
+IsPresent       searches the given tree for the item with the given key value.
+                        If the item is found the found procedure parameter is called,
+                        otherwise the notFound procedure parameter is called.
+*)
+
+PROCEDURE IsDefined  (    theTree  : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+
+PROCEDURE IsEmpty    (    theTree  : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+
+PROCEDURE IsEqual    (    left     : Tree         (*--in   *);
+                          right    : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+
+PROCEDURE SizeOf     (    theTree  : Tree         (*--in   *))
+                                   : CARDINAL     (*--out  *);
+
+PROCEDURE ExtentOf   (    theTree  : Tree         (*--in   *))
+                                   : CARDINAL     (*--out  *);
+
+PROCEDURE KeyTypeOf  (    theTree  : Tree         (*--in   *))
+                                   : TypeID       (*--out  *);
+
+PROCEDURE DataTypeOf (    theTree  : Tree         (*--in   *))
+                                   : TypeID       (*--out  *);
+
+PROCEDURE IsPresent  (    theTree  : Tree         (*--in   *);
+                          theKey   : Key          (*--in   *);
+                                                  found    : FoundProc    (*--in   *);
+                                                  notFound : NotFoundProc (*--in   *));
+
+        (*-----------------------*)
+
+
+(*
+5.1.5 Passive Iterators
+
+Three passive iterators are provided each implementing one of the standard
+tree traversal algorithms. Passive iterators allow the client module
+to traverse the tree as through it were a single, monolithic data structure.
+*)
+
+PROCEDURE Preorder  (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+PROCEDURE Inorder   (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+PROCEDURE Postorder (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+        (*-----------------------*)
+
+
+(*
+5.1.6 Active Iterators
+
+While passive iterators are most useful for tree objects, there may
+be situations when the client module requires more control over the
+iteration process (e.g., when printing the internal binary tree
+representation). In this case, it is necessary to use an active
+iteration mechanism, where the internal structure of a tree is made
+visible to the client in a controlled manner that ensures the safety
+of the abstraction.
+
+In the form presented here, the internal structure is made visible
+through the transparent type NodePtr, representing a subtree node of a tree.
+An empty subtree is modelled by the constant NullNode.
+
+The reader should note that none of the active iterator operations
+raise exceptions.
+
+NodePtr         is a type used to represent and individual node of the tree.
+
+NullNode        is a constant representing an empty subtree.
+
+RootOf          returns a reference to the root node of the given tree. If
+                        the tree is empty then the NullNode is returned.
+
+LeftOf          returns the node that is the left subtree from the given
+                        node. If the given node has no left subtree then the NullNode
+                        is returned.
+
+RightOf         returns the node that is the right subtree from the given
+                        node. If the given node has no right subtree then the NullNode
+                        is returned.
+
+IsNull          returns true is the given node is equal to the NullNode and
+                        false otherwise.
+
+KeyOf           returns the key value associated with the given node. If the
+                        node is empty (i.e., equal to the NullNode) the NullItem is
+                        returned instead.
+
+DataOf          returns the data value associated with the given node. If the
+                        node is empty (i.e., equal to the NullNode) the NullItem is
+                        returned instead.
+*)
+
+TYPE  NodePtr  = CARDINAL;
+CONST NullNode = 0;
+
+PROCEDURE RootOf  (    theTree : Tree    (*--in   *))
+                                                           : NodePtr (*--out  *);
+
+PROCEDURE LeftOf  (    theTree : Tree    (*--in   *);
+                                           theNode : NodePtr (*--in   *))
+                                                           : NodePtr (*--out  *);
+
+PROCEDURE RightOf (    theTree : Tree    (*--in   *);
+                                           theNode : NodePtr (*--in   *))
+                                                           : NodePtr (*--out  *);
+
+PROCEDURE IsNull  (    theNode : NodePtr (*--in   *))
+                                                           : BOOLEAN (*--out  *);
+
+PROCEDURE KeyOf   (    theTree : Tree    (*--in   *);
+                                           theNode : NodePtr (*--in   *))
+                                                           : Key     (*--out  *);
+
+PROCEDURE DataOf  (    theTree : Tree    (*--in   *);
+                                           theNode : NodePtr (*--in   *))
+                                                           : Data    (*--out  *);
+
+END TreSBMI.
+
+(*
+
+                                Algorithmic     Code
+Operation Name  Complexity      Size
+                                (bytes)
+TreeError               O(1)             18             Exception Handling Routines
+GetHandler              O(1)             34
+SetHandler              O(1)             30
+
+Create                  O(1)            112             Constructors
+Destroy                 O(1)             36
+MakeTree                O(1)             96
+Clear                   O(n)            246
+Assign                  O(m+n)          632
+Insert                  O(log2 n)       322
+Remove                  O(log2 n)       686
+
+IsDefined               O(1)             28             Selectors
+IsEmpty                 O(1)             66
+IsEqual                 O(Min(m,n))     420
+ExtentOf                O(n)            154
+SizeOf                  O(1)             58
+KeyTypeOf               O(1)             56
+DataTypeOf              O(1)             58
+IsPresent               O(log2 n)       228
+
+Inorder                 O(n)            152             Passive Iterators
+Preorder                O(n)            152
+Postorder               O(n)            152
+
+RootOf                  O(1)             42             Active Iterators
+LeftOf                  O(1)             64
+RightOf                 O(1)             64
+IsNull                  O(1)             28
+KeyOf                   O(1)             66
+DataOf                  O(1)             66
+
+RaiseErrIn              O(1)             50             Local Routines
+InitFreeList    O(s)             98
+GetNode                 O(1)             72
+FreeNode                O(1)             42
+NewNode                 O(1)             86
+Initialization  O(1)             84
+
+Grand Total                                4498
+
+Table 5.1 Bounded Binary Search Tree Operations Summary
+
+1       With debugging labels turned on (the -gx option of the
+        TML compiler) the code sizes are slightly greater than
+        the figures given above.
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESBMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESBMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESBMI.MOD
@@ -0,0 +1,1036 @@
+(*
+5.2 Bounded Binary Search Tree Implementation
+
+The internal structures used in representing an unbalanced, bounded
+binary search tree are described in this section along with the
+algorithms implementing the operations defined in the interface. All
+routines in this module are simply tranformations of their unbounded
+counterparts to use a bounded tree representation.
+
+This section is broken down as follows:
+        * 5.2.1 Internal Representation
+        * 5.2.2 Exception Handling
+        * 5.2.3 Free List Management
+        * 5.2.4 Local Operations
+        * 5.2.5 Tree Constructors
+        * 5.2.6 Tree Selectors
+        * 5.2.7 Passive Iterators
+        * 5.2.8 Active Iterators
+        * 5.2.9 Module Initialization
+*)
+
+IMPLEMENTATION MODULE TreSBMI;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code Size: OBJ file has 13187 bytes.
+    Component: Monolithic Structures - Tree (Opaque version)
+               Sequential Bounded Managed Iterator
+
+    REVISION HISTORY
+    v1.01  18 Mar 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.02  01 Oct 1988  C. Lins
+      Updated and improved comments.
+    v1.03  29 Jan 1989  C. Lins
+      Added aliases for generic Items as Keys and Data to enhance
+          readability.
+    v1.04  06 Feb 1989  C. Lins
+          Added use of InsertProc instead of FoundProc in Insert.
+    v1.05  09 Feb 1989  C. Lins
+          Removed VAR from Clear, Insert, & Remove (the tree itself
+          does not change).
+    v1.06  21 Feb 1989  C. Lins
+          Corrected Inorder, Preorder, & Postorder routine names
+          being passed to RaiseErrIn when an exception was raised.
+    v1.07  17 Apr 1989  C. Lins:
+          Corrected IsEqual to use comparison routine derived
+          from the CompareOf routine associated with the stack's
+          TypeID.
+    v1.04  18 Apr 1989   C. Lins:
+          Added component id constant.
+    v2.00  08 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Relations IMPORT
+        (*--Type*) Relation;
+
+FROM Items IMPORT
+        (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM TreeTypes IMPORT
+    (*--Type*) Operations, Exceptions, AccessProc, FoundProc,
+                           InsertProc, NotFoundProc, Key, Data, ComponentID;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+        (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+
+    (*-----------------------*)
+
+(*
+5.2.1 Internal Bounded Binary Search Tree Representation
+
+To represent a bounded tree we use a pool of nodes for each bounded
+tree, shown graphically in Figure 5.1, below.
+
+_Figure 5.1_
+
+Link    defines an index into the node pool and is used to maintain the
+                relationships between nodes of the tree. The constant nil is
+                used to represent an empty subtree.
+
+Node    defines an entry in the tree consisting of a key value, a data
+                value, and links to the left and right subtrees, if any.
+
+NodePool        defines a pool of nodes of the largest size supported by
+                the module.
+
+BoundedTree     defines a descriptor for a bounded tree. The nodes array is
+                allocated dynamically in size when the bounded tree descriptor
+                is created and is only as large as needed for the specified
+                size of the node pool.
+
+Tree    defines a reference to the tree descriptor and its node pool as
+                required by Modula-2.
+*)
+
+TYPE  Link = [0 .. MAX(TreeSize)];
+CONST nil  = MIN(Link);
+TYPE  Node = RECORD
+                key   : Key ; (*--key value for this node *)
+                data  : Data; (*--data value for this node *)
+                left  : Link; (*--link to left subtree *)
+                right : Link; (*--link to right subtree*)
+          END (*--Node *);
+
+TYPE  NodePool = ARRAY TreeSize OF Node;
+
+TYPE  BoundedTree = RECORD
+                keyID  : TypeID;   (*--data type for the tree's keys *)
+        dataID : TypeID;   (*--data type for this tree's items *)
+                size   : TreeSize; (*--maximum number of nodes *)
+                root   : Link;     (*--link to root of this tree *)
+                avail  : Link;     (*--link to available list of nodes *)
+                nodes  : NodePool; (*--dynamic array [1..size] of node *)
+      END (*--BoundedTree *);
+
+TYPE  Tree = POINTER TO BoundedTree;
+
+
+(*
+5.2.2 Exception Handling
+
+treeError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+treeError before any other processing.
+
+The handler array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+5.2.9).
+
+TreeError       simply returns the current exception result stored
+                        in treeError and is used to determine whether a tree
+                        operation completed successfully.
+
+SetHandler      makes theHandler the current exception handler for theError
+                        by storing theHandler in the handler array.
+
+GetHandler      returns the current exception handler for theError from the
+                        handler array.
+*)
+
+VAR   treeError : Exceptions;
+VAR   handler   : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE TreeError  ()              : Exceptions  (*--out  *);
+BEGIN
+  RETURN treeError;
+END TreeError;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*--in   *);
+                          theError   : Exceptions (*--in   *));
+BEGIN
+  treeError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+5.2.3 Free List Management
+
+The following routines manage a tree's free list of available nodes.
+The head of the free list is kept in the avail field of the tree's
+descriptor record. None of the routines check for invalid (i.e., NIL)
+trees as they are all local of the module; nor do they raise any exceptions.
+The algorithms used are all quite old (in computer science terms) and thus
+should not require much explanation.
+
+InitFreeList    initializes a tree's free list by linking together all of
+                        the nodes of the pool.
+
+GetNode         attempts to retrieve a node from the free list if one is available,
+                        otherwise nil is returned.
+
+FreeNode        returns a node to a tree's free list.
+*)
+
+PROCEDURE InitFreeList (VAR theTree : Tree   (*--inout*));
+
+VAR   index : TreeSize; (*--loop index over nodes in the free list *)
+
+BEGIN
+  WITH theTree^ DO
+    FOR index := MIN(TreeSize) TO size-1 DO
+          nodes[index].left := index + 1;
+        END (*--for*);
+        nodes[size].left := nil;
+        avail := MIN(TreeSize);
+  END (*--with*);
+END InitFreeList;
+(*-------------------------*)
+
+PROCEDURE GetNode (    theTree : Tree       (*--in   *)): Link  (*--out  *);
+
+VAR   oldAvail : Link; (*--link to node from free list *)
+
+BEGIN
+  WITH theTree^ DO
+    IF (avail = nil) THEN
+          RETURN nil;
+        ELSE
+          oldAvail := avail;
+          avail    := nodes[oldAvail].left;
+          RETURN oldAvail;
+        END (*--if*);
+  END (*--with*);
+END GetNode;
+(*-------------------------*)
+
+PROCEDURE FreeNode ( theTree : Tree (*--in   *); theNode : Link (*--in   *));
+BEGIN
+  WITH theTree^ DO
+    nodes[theNode].left := avail;
+    avail := theNode;
+  END (*--with*);
+END FreeNode;
+(*-------------------------*)
+
+
+(*
+5.2.4 Local Operations
+
+NewNode allocates and initializes a new leaf node for a tree.
+Complexity O(1).
+*)
+
+PROCEDURE NewNode   (    theTree  : Tree     (*--in   *);
+                                                 theKey   : Key      (*--in   *);
+                                                 theData  : Data     (*--in   *))
+                                                          : Link     (*--out  *);
+
+VAR   theNode : Link; (*--link to new leaf node being created *)
+
+BEGIN
+  theNode := GetNode(theTree);
+  IF (theNode # nil) THEN
+    WITH theTree^.nodes[theNode] DO
+      key   := theKey;
+      data  := theData;
+      left  := nil;
+      right := nil;
+    END (*--with*);
+  END (*--if*);
+  RETURN theNode;
+END NewNode;
+(*-------------------------*)
+
+
+(*
+5.2.5 Constructors
+
+Create attempts to build a new empty tree of the given type.
+First, the tree header is allocated and the key and data type IDs are
+stored in the header. The pointer to the root node is initialized
+to the empty state (0). If the header allocation fails the
+overflow exception is raised and the NullTree is returned.
+Complexity O(1).
+*)
+
+PROCEDURE Create    (    keyType  : TypeID    (*--in   *);
+                         dataType : TypeID    (*--in   *);
+                         theSize  : TreeSize  (*--in   *))
+                                  : Tree      (*--out  *);
+
+CONST minSize  = SIZE(BoundedTree) - SIZE(NodePool);
+CONST nodeSize = SIZE(Node);
+
+VAR   newTree : Tree;
+
+BEGIN
+  treeError := noerr;
+  Allocate(newTree, minSize + nodeSize * VAL(INTEGER, theSize));
+  IF (newTree = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newTree^ DO
+          keyID  := keyType;
+          dataID := dataType;
+          size   := theSize;
+          root   := nil;
+          InitFreeList(newTree);
+    END(*--with*);
+  END(*--if*);
+  RETURN newTree;
+END Create;
+(*-------------------------*)
+
+(*
+MakeTree is a combination of Create(keyType, dataType, theSize)
+immediately followed by Insert(theKey, theData). Complexity O(1).
+*)
+
+PROCEDURE MakeTree  (    keyType  : TypeID    (*--in   *);
+                                                 dataType : TypeID    (*--in   *);
+                                                 theSize  : TreeSize  (*--in   *);
+                         theKey   : Key       (*--in   *);
+                                                 theData  : Data      (*--in   *))
+                                  : Tree      (*--out  *);
+
+VAR   newTree : Tree;
+
+BEGIN
+  newTree := Create(keyType, dataType, theSize);
+  IF (treeError = noerr) THEN
+    newTree^.root := NewNode(newTree, theKey, theData);
+  ELSE
+    RaiseErrIn(maketree, overflow);
+  END (*--if*);
+  RETURN newTree;
+END MakeTree;
+(*-------------------------*)
+
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theTree back to the system.
+The amount of space originally allocated is released back to the system
+and the pointer is altered by JPIStorage.Deallocate to NIL
+(which is also the value of the NullTree). Complexity: O(n).
+*)
+
+PROCEDURE Destroy   (VAR theTree  : Tree      (*--inout*));
+
+CONST minSize  = SIZE(BoundedTree) - SIZE(NodePool);
+CONST nodeSize = SIZE(Node);
+
+BEGIN
+  Clear(theTree);
+  IF (treeError = noerr) THEN
+    Deallocate(theTree, minSize + nodeSize * theTree^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+
+(*
+Clear uses a postorder traversal of theTree, clearing the nodes of
+both subtrees before clearing the tree itself. After disposing the
+subtrees the key and data values can be disposed followed by the node.
+Complexity O(n).
+*)
+
+PROCEDURE Clear     (    theTree  : Tree      (*--inout*));
+
+VAR   freeData : DisposeProc; (*--data value disposal routine *)
+          freeKey  : DisposeProc; (*--key value disposal routine *)
+
+  PROCEDURE ClearNodes (VAR theSubtree : Link (*--inout*));
+  BEGIN
+    IF (theSubtree # nil) THEN
+          WITH theTree^.nodes[theSubtree] DO
+            ClearNodes(left);
+            ClearNodes(right);
+                freeKey(key);
+                freeData(data);
+                FreeNode(theTree, theSubtree);
+          END (*--with*);
+        END (*--if*);
+  END ClearNodes;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theTree^ DO
+      freeKey  := DisposeOf(keyID);
+      freeData := DisposeOf(dataID);
+      ClearNodes(root);
+          root := nil;
+        END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+
+(*
+Assign uses a preorder traversal of the source tree to generate a
+copy in the destination tree. Preliminary to the actual copying,
+we must ensure that the source tree is defined and clear or create
+the destination tree as necessary. This step is accomplished by the
+RecreateTarget routine which must accomodate the following cases:
+        * the source tree is undefined, and thus, the target tree must be
+          left unchanged;
+        * the source tree and target tree are the same and therefore the
+          postcondition of the Assign operation is already met;
+        * the source tree is defined but the target tree is undefined, so
+          the target tree must be created with the same key and data type
+          id's as the source tree; and
+        * both the source and target trees are defined, and thus the target
+          tree must be cleared of its contents followed by its key and data
+          key id's being set to the same as the source tree.
+
+In the second case, we automatically return FALSE so that Assign will
+bypass the node copying operation. While in the other three instances,
+success depends on whether treeError remains set to noerr.
+
+The main body of Assign uses the result from RecreateTarget to determine
+whether to continue with the copy operation after recreating the target tree.
+Complexity O(m+n) where m is the number of nodes in the destination
+tree and n is the number of nodes in the source tree.
+*)
+
+PROCEDURE Assign    (    theTree  : Tree      (*--in   *);
+                     VAR toTree   : Tree      (*--inout*));
+
+VAR   assignKey  : AssignProc; (*--key item assignment routine *)
+          assignItem : AssignProc; (*--data item assignment routine *)
+
+  PROCEDURE RecreateTarget () : BOOLEAN (*--out *);
+  BEGIN
+    IF (theTree = NIL) THEN
+      RaiseErrIn(assign, undefined);
+    ELSIF (toTree = NIL) THEN
+      WITH theTree^ DO
+        toTree := Create(keyID, dataID, size);
+          END (*--with*);
+    ELSIF (toTree = theTree) THEN
+      RETURN FALSE;
+    ELSE
+      Clear(toTree);
+      WITH theTree^ DO
+            toTree^.keyID  := keyID;
+            toTree^.dataID := dataID;
+          END (*--with*);
+    END (*--if*);
+        RETURN treeError = noerr;
+  END RecreateTarget;
+
+  PROCEDURE DoAssign (    theSubtree : Link (*--in   *);
+                                          VAR toSubtree  : Link (*--out  *));
+  BEGIN
+    IF (theSubtree = nil) THEN
+          toSubtree := nil;
+        ELSE
+          toSubtree := GetNode(toTree);
+          IF (toSubtree = nil) THEN
+            RaiseErrIn(assign, overflow);
+          ELSE
+            WITH toTree^.nodes[toSubtree] DO
+                  key   := assignKey(theTree^.nodes[theSubtree].key);
+                  data  := assignItem(theTree^.nodes[theSubtree].data);
+                  left  := nil;
+                  right := nil;
+                END (*--with*);
+            DoAssign(theTree^.nodes[theSubtree].left,
+                                 toTree^.nodes[toSubtree].left);
+            DoAssign(theTree^.nodes[theSubtree].right,
+                                 toTree^.nodes[toSubtree].right);
+          END (*--if*);
+        END (*--if*);
+  END DoAssign;
+
+BEGIN
+  treeError := noerr;
+  IF RecreateTarget() THEN
+    WITH theTree^ DO
+      assignKey  := AssignOf(keyID);
+      assignItem := AssignOf(dataID);
+      DoAssign(root, toTree^.root);
+        END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Insert adds a node with theKey and theData to theTree and places the
+node within its proper position maintaining the search tree property.
+This algorithm is the standard recursive one for binary tree insertion
+converted to use the pool of nodes instead of the heap.
+Complexity O(log2 n).
+*)
+
+PROCEDURE Insert    (    theTree  : Tree       (*--inout*);
+                         theKey   : Key        (*--in   *);
+                         theData  : Data       (*--in   *);
+                                                 found    : InsertProc (*--in   *));
+
+VAR   compare : CompareProc; (*--key comparison routine *)
+
+  PROCEDURE DoInsert (VAR theSubtree : Link (*--inout*));
+  BEGIN
+    IF (theSubtree = nil) THEN
+          theSubtree := NewNode(theTree, theKey, theData);
+          IF (theSubtree = nil) THEN
+            RaiseErrIn(insert, overflow);
+          END (*--if*);
+        ELSE
+          WITH theTree^.nodes[theSubtree] DO
+            CASE compare(key, theKey) OF
+              less    : DoInsert(right);
+            | greater : DoInsert(left);
+            ELSE
+              found(key, data, theData);
+            END (*--case*);
+          END (*--with*);
+        END (*--if*);
+  END DoInsert;
+
+BEGIN (*--Insert --*)
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(insert, undefined);
+  ELSE
+    WITH theTree^ DO
+      compare := CompareOf(keyID);
+      DoInsert(root);
+        END (*--with*);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+
+(*
+Remove searches theTree for the first node containing theKey. If no such
+node exists the notFound procedure parameter is called. Otherwise, we
+use the standard binary tree deletion algorithm as given by Wirth [8] and
+many others (see references).
+Complexity O(log2 n).
+*)
+
+PROCEDURE Remove    (    theTree  : Tree         (*--inout*);
+                         theKey   : Key          (*--in   *);
+                                                 notFound : NotFoundProc (*--in   *));
+
+VAR   compare  : CompareProc; (*--key comparison routine *)
+          freeKey  : DisposeProc; (*--key disposal routine *)
+          freeData : DisposeProc; (*--data disposal routine *)
+
+  PROCEDURE DoRemove (VAR subTree : Link (*--inout*));
+
+  VAR   oldTree : Link; (*--link to subtree to be disposed *)
+
+    PROCEDURE SwapRemove (VAR subTree : Link (*--inout*));
+        BEGIN
+          WITH theTree^ DO
+            WITH nodes[subTree] DO
+              IF (right # nil) THEN
+                SwapRemove(right);
+              ELSE
+                nodes[oldTree].key  := key;
+                    nodes[oldTree].data := data;
+                    oldTree := subTree;
+                    subTree := left;
+              END (*--if*);
+            END (*--with*);
+          END (*--with*);
+        END SwapRemove;
+
+  BEGIN (*--DoRemove --*)
+    IF (subTree = nil) THEN
+
+          notFound(theKey); (*--ERROR key not found in the tree *)
+
+        ELSE
+          WITH theTree^ DO
+            CASE compare(theKey, nodes[subTree].key) OF
+              less    : DoRemove(nodes[subTree].left);
+            | greater : DoRemove(nodes[subTree].right);
+            ELSE
+                  (*--key found, delete it *)
+                  oldTree := subTree;
+                  IF (nodes[oldTree].right = nil) THEN
+                    subTree := nodes[oldTree].left;
+                  ELSIF (nodes[oldTree].left = nil) THEN
+                    subTree := nodes[oldTree].right;
+                  ELSE
+                    SwapRemove(nodes[oldTree].left);
+                  END (*--if*);
+                  WITH nodes[oldTree] DO
+                    freeKey(key);
+                    freeData(data);
+                  END (*--with*);
+                  FreeNode(theTree, oldTree);
+            END (*--case*);
+          END (*--with*);
+        END (*--if*);
+  END DoRemove;
+
+BEGIN (*--Remove --*)
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(remove, undefined);
+  ELSE
+    WITH theTree^ DO
+      compare := CompareOf(keyID);
+          freeKey := DisposeOf(keyID);
+          freeData:= DisposeOf(dataID);
+      DoRemove(root);
+        END (*--with*);
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+
+(*
+5.2.6 Selectors
+
+IsDefined verifies to the best of its ability whether theTree has been
+created and is still an active object. Complexity O(1).
+*)
+
+PROCEDURE IsDefined  (    theTree  : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+BEGIN
+  RETURN theTree # NullTree;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns True if theTree is in the empty state, as indicated by
+the root being nil (0), and False otherwise.  As per the specification
+(section 3.3) undefined trees are considered empty. Complexity O(1).
+*)
+
+PROCEDURE IsEmpty    (    theTree  : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+BEGIN
+  treeError := noerr;
+  IF (theTree # NIL) THEN
+    RETURN (theTree^.root = nil);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual uses a preorder traversal of both left and right trees. As soon
+as an inequality between keys is found we can return false as the trees
+cannot be equal. Complexity O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual    (    left     : Tree         (*--in   *);
+                          right    : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+
+VAR       compare : CompareProc;        (*-- item comparison routine *)
+
+  PROCEDURE DoIsEqual (    leftSubtree  : Link    (*--in   *);
+                                                   rightSubtree : Link    (*--in   *))
+                                                                                : BOOLEAN (*--out  *);
+  BEGIN
+    IF (leftSubtree = nil) OR (rightSubtree = nil) THEN
+          RETURN (leftSubtree = nil) & (rightSubtree = nil);
+    ELSIF compare(left^.nodes[leftSubtree].key,
+                                  right^.nodes[rightSubtree].key) # equal THEN
+          RETURN FALSE;
+        ELSE
+          RETURN (DoIsEqual(left^.nodes[leftSubtree].left,
+                                                right^.nodes[rightSubtree].left) &
+                          DoIsEqual(left^.nodes[leftSubtree].right,
+                                                right^.nodes[rightSubtree].right));
+        END (*--if*);
+  END DoIsEqual;
+
+BEGIN
+  treeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) OR
+                (left^.keyID # right^.keyID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSE
+        compare := CompareOf(left^.keyID);
+    RETURN DoIsEqual(left^.root, right^.root);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+SizeOf simply returns the defined size for the given tree. KeyTypeOf and
+DataTypeOf return the key type ID and data type ID, respectively, for the
+given tree. Undefined trees, as always, raise the undefined exception and
+return a reasonable value, in this case either zero for SizeOf or the
+NullType for the TypeOf routines. All three routines have complexity O(1).
+*)
+
+PROCEDURE SizeOf     (    theTree  : Tree         (*--in   *))
+                                   : CARDINAL     (*--out  *);
+BEGIN
+  treeError := noerr;
+  IF (theTree # NIL) THEN
+    RETURN theTree^.size;
+  END (*--if*);
+  RaiseErrIn(sizeof, undefined);
+  RETURN 0;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE KeyTypeOf  (    theTree  : Tree         (*--in   *))
+                                   : TypeID       (*--out  *);
+BEGIN
+  treeError := noerr;
+  IF (theTree # NIL) THEN
+    RETURN theTree^.keyID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END KeyTypeOf;
+(*-------------------------*)
+
+PROCEDURE DataTypeOf (    theTree  : Tree         (*--in   *))
+                                   : TypeID       (*--out  *);
+BEGIN
+  treeError := noerr;
+  IF (theTree # NIL) THEN
+    RETURN theTree^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END DataTypeOf;
+(*-------------------------*)
+
+(*
+ExtentOf returns the number of nodes present in the given tree or zero
+for an undefined tree. We simply employ an inorder traversal of the tree
+counting the nodes along the way. Complexity O(n).
+*)
+
+PROCEDURE ExtentOf   (    theTree  : Tree         (*--in   *))
+                                   : CARDINAL     (*--out  *);
+
+VAR   count : CARDINAL; (*--running count of nodes in tree *)
+
+  PROCEDURE CountNodes (    theSubtree : Link (*--in   *));
+  BEGIN
+    IF (theSubtree # nil) THEN
+          WITH theTree^.nodes[theSubtree] DO
+            CountNodes(left);
+            INC(count);
+            CountNodes(right);
+          END (*--with*);
+        END (*--if*);
+  END CountNodes;
+
+BEGIN
+  treeError := noerr;
+  count     := 0;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(extentof, undefined);
+  ELSE
+    CountNodes(theTree^.root);
+  END (*--if*);
+  RETURN count;
+END ExtentOf;
+(*-------------------------*)
+
+(*
+IsPresent uses an iterative traversal of the given tree attempting
+to find node in theTree containing theKey value. The search path
+begins at the root switching to the left or right subtree based on
+examination of each node's key. As noted by Wirth [9] and others, as
+few as log2 n comparisons may be needed to find theKey if theTree is
+perfectly balanced. The algorithmic complexity of the search is
+therefore O(log2 n) where n is the number of nodes in the tree.
+It is assumed that
+all keys are comparable and the compare procedure is not NIL.
+*)
+
+PROCEDURE IsPresent  (    theTree  : Tree         (*--in   *);
+                          theKey   : Key          (*--in   *);
+                                                  found    : FoundProc    (*--in   *);
+                                                  notFound : NotFoundProc (*--in   *));
+
+VAR   treeIndex : Link;
+      compare   : CompareProc; (*--key comparison routine *)
+
+BEGIN
+  treeError := noerr;
+  IF (theTree # NIL) THEN
+    WITH theTree^ DO
+      treeIndex := root;
+          compare   := CompareOf(keyID);
+          LOOP
+            IF (treeIndex = nil) THEN
+              notFound(theKey);
+                  EXIT (*--loop*);
+            END (*--if*);
+            WITH nodes[treeIndex] DO
+              CASE compare(key, theKey) OF
+                equal   : found(theKey, data);
+                                      EXIT (*--loop*);
+              | less    : treeIndex := right;
+              | greater : treeIndex := left;
+              END (*--case*);
+            END (*--with*);
+          END (*--loop*);
+        END (*--with*);
+
+  ELSE
+    RaiseErrIn(ispresent, undefined);
+  END (*--if*);
+END IsPresent;
+(*-------------------------*)
+
+
+(*
+5.2.7 Passive Iterators
+
+Each of the three iterator routines accomplish recursively Preorder,
+Inorder, and Postorder traversals of the given tree. If the tree is
+not defined, the undefined exception is raised and the traversal is
+aborted. Otherwise, traversal begins with the root of the tree following
+the specifications given in section 3.1.6.2. The complexity is O(n) for
+all three traversals.
+*)
+
+PROCEDURE Preorder  (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+  PROCEDURE DoPreorder (    theSubtree : Link (*--in   *));
+  BEGIN
+    IF (theSubtree # nil) THEN
+          WITH theTree^.nodes[theSubtree] DO
+            theProcess(key, data);
+            DoPreorder(left);
+            DoPreorder(right);
+          END (*--with*);
+        END (*--if*);
+  END DoPreorder;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(preorder, undefined);
+  ELSE
+    DoPreorder(theTree^.root);
+  END (*--if*);
+END Preorder;
+(*-------------------------*)
+
+PROCEDURE Inorder   (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+  PROCEDURE DoInorder (    theSubtree : Link (*--in   *));
+  BEGIN
+    IF (theSubtree # nil) THEN
+          WITH theTree^.nodes[theSubtree] DO
+            DoInorder(left);
+            theProcess(key, data);
+            DoInorder(right);
+          END (*--with*);
+        END (*--if*);
+  END DoInorder;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(inorder, undefined);
+  ELSE
+    DoInorder(theTree^.root);
+  END (*--if*);
+END Inorder;
+(*-------------------------*)
+
+PROCEDURE Postorder (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+  PROCEDURE DoPostorder (    theSubtree : Link (*--in   *));
+  BEGIN
+    IF (theSubtree # nil) THEN
+          WITH theTree^.nodes[theSubtree] DO
+            DoPostorder(left);
+            DoPostorder(right);
+            theProcess(key, data);
+          END (*--with*);
+        END (*--if*);
+  END DoPostorder;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(postorder, undefined);
+  ELSE
+    DoPostorder(theTree^.root);
+  END (*--if*);
+END Postorder;
+(*-------------------------*)
+
+
+(*
+5.2.8 Active Iterators
+
+The active iterators given below simply return eomponents of tree nodes
+and are thus self-explanatory.
+*)
+
+PROCEDURE RootOf  (    theTree : Tree    (*--in   *))
+                                                           : NodePtr (*--out  *);
+BEGIN
+  IF (theTree = NIL) THEN
+    RETURN nil;
+  END (*--if*);
+  RETURN theTree^.root;
+END RootOf;
+(*-------------------------*)
+
+PROCEDURE LeftOf  (    theTree : Tree    (*--in   *);
+                                           theNode : NodePtr (*--in   *))
+                                                           : NodePtr (*--out  *);
+BEGIN
+  IF (theTree = NIL) OR (theNode = nil) THEN
+    RETURN nil;
+  END (*--if*);
+  RETURN theTree^.nodes[theNode].left;
+END LeftOf;
+(*-------------------------*)
+
+PROCEDURE RightOf (    theTree : Tree    (*--in   *);
+                                           theNode : NodePtr (*--in   *))
+                                                           : NodePtr (*--out  *);
+BEGIN
+  IF (theTree = NIL) OR (theNode = nil) THEN
+    RETURN nil;
+  END (*--if*);
+  RETURN theTree^.nodes[theNode].right;
+END RightOf;
+(*-------------------------*)
+
+PROCEDURE IsNull  (    theNode : NodePtr (*--in   *))
+                                                           : BOOLEAN (*--out  *);
+BEGIN
+  RETURN theNode = nil;
+END IsNull;
+(*-------------------------*)
+
+PROCEDURE KeyOf   (    theTree : Tree    (*--in   *);
+                                           theNode : NodePtr (*--in   *))
+                                                           : Key     (*--out  *);
+BEGIN
+  IF (theTree = NIL) OR (theNode = nil) THEN
+    RETURN NullItem;
+  END (*--if*);
+  RETURN theTree^.nodes[theNode].key;
+END KeyOf;
+(*-------------------------*)
+
+PROCEDURE DataOf  (    theTree : Tree    (*--in   *);
+                                           theNode : NodePtr (*--in   *))
+                                                           : Data    (*--out  *);
+BEGIN
+  IF (theTree = NIL) OR (theNode = nil) THEN
+    RETURN NullItem;
+  END (*--if*);
+  RETURN theTree^.nodes[theNode].data;
+END DataOf;
+(*-------------------------*)
+
+
+(*
+5.2.9 Module Initialization
+
+The module's local variables are initialized to known states.
+treeError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, treeError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR treeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(treeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  treeError := noerr;
+        NullTree := NIL;
+END TreSBMI.
+
+(*
+References
+
+
+[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983.
+[2] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+        Benjamin/Cummings, Menlo Park, CA 1987.
+[3]     G.H. Gonnet, Handbook of Algorithms and Data Structures, Addison-Wesley,
+        Reading, MA 1984.
+[4] K. John Gough, ≡Writing Generic Utilities in Modula-2≡, Journal of
+    Pascal, Ada, and Modula-2, Vol. 5(3), (May/June 1986), pp 53-62.
+[5] T.A. Standish, Data Structure Techniques, Addison-Wesley, Reading, MA 1980.
+[6] A. Tenenbaum and M.J. Augenstein, Data Structures Using Pascal, Prentice-Hall,
+        Englewood Cliffs, NJ 1981.
+[7] R.S. Wiener and G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons, New York, NY 1985.
+[8] R.S. Wiener and R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986.
+[9]     N. Wirth, Algorithms and Data Structures, Prentice-Hall, Englewood Cliffs,
+        NJ 1986.
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESBMIU.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESBMIU.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESBMIU.DEF
@@ -0,0 +1,91 @@
+(*
+5.3 Bounded Binary Search Tree Utilities
+
+This module provides the facility for displaying the hierarchy of
+a binary tree on the terminal while presenting an example using
+active iterators. Printing the tree is also possible depending
+on whether standard output has been so redirected.
+*)
+
+DEFINITION MODULE TreSBMIU;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Component: Binary Tree SBMI Utilities - Print Tree Tool
+
+    REVISION HISTORY
+    v1.00  18 May 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.01  01 Oct 1988  C. Lins
+      Cleanup of comments.
+          Changed PrintTree is use a single procedure parameter.
+          Added HeightOf selector.
+    v1.02  29 Jan 1989  C. Lins
+          Changed to use Key and Data aliases for generic Items.
+    v2.00  08 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+===============================================================*)
+
+FROM TreeTypes IMPORT
+    (*--Type*) Key, Data;
+
+FROM TreSBMI IMPORT
+    (*--Type*) Tree;
+
+
+        (*-----------------------*)
+
+(*
+6.3.1 Utility Selectors
+
+HeightOf returns the height of the given tree.
+*)
+
+PROCEDURE HeightOf (    theTree : Tree     (*--in   *))
+                                                                : CARDINAL (*--out  *);
+
+(*
+5.3.2 Debugging Iterators
+
+PrintTree iterates over the given tree such that the nodes may be
+printed. Trees are normally displayed with the root at the top and
+the leaves at the bottom. To simplify the printing process, PrintTree
+displays the tree rotated 90Æ to the left. Thus the root is shown at
+the left of the page/screen with the leaves at the right. Furthermore,
+the left branches are shown towards the bottom of the display and the
+right branches at the top. The PrintProc routine is responsible for
+indenting the display appropriately based on the level parameter.
+*)
+
+TYPE  Level      = CARDINAL;
+TYPE  PrintProc  = PROCEDURE (Level, Key, Data);
+
+PROCEDURE PrintTree (    theTree: Tree       (*--in   *);
+                         print  : PrintProc  (*--in   *));
+
+END TreSBMIU.
+
+(*
+
+                                Algorithmic     Code
+Operation Name  Complexity      Size
+                                (bytes)
+HeightOf             O(n)            206
+PrintTree            O(n)            208
+Initialization       O(1)             48
+
+Grand Total                                     462
+
+Table 5.2 Bounded Binary Search Tree Utilities Summary
+
+1       With debugging labels turned off (the -gx option of the
+        TML compiler) the code sizes are slightly less than
+        the figures given above.
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESBMIU.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESBMIU.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESBMIU.MOD
@@ -0,0 +1,118 @@
+
+(*
+5.4 Bounded Binary Search Tree Utilities
+
+Below is the implementation for the print tree routine whose
+interface was given above.
+*)
+
+IMPLEMENTATION MODULE TreSBMIU;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: 328 bytes.
+    Component: Binary Tree SBMI Utilities - Print Tree Tool
+
+    REVISION HISTORY
+    v1.00  18 May 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.01  01 Oct 1988  C. Lins
+      Cleanup of comments.
+          Changed PrintTree to use a single procedure parameter.
+          Added HeightOf selector.
+    v1.02  29 Jan 1989  C. Lins
+          Changed to use Key and Data aliases for generic Items.
+    v2.00  08 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM TreeTypes IMPORT
+    (*--Type*) Key, Data;
+
+FROM TreSBMI IMPORT
+        (*--Type*) Tree, NodePtr,
+        (*--Proc*) RootOf, LeftOf, RightOf, IsNull, KeyOf, DataOf,
+                           IsEmpty;
+
+        (*-----------------------*)
+
+(*
+5.4.1 Utility Selectors
+
+HeightOf returns the height of the given tree. Height may be computed by
+subtracting the level of the ≡lowest≡ node in the tree from the level of
+the root.  Complexity O(log2 n).
+*)
+
+PROCEDURE HeightOf (    theTree : Tree     (*--in   *))
+                                : CARDINAL (*--out  *);
+
+VAR   maxLevel : CARDINAL; (*-- level of the lowest node so far *)
+
+  PROCEDURE CountLevels (    theNode : NodePtr  (*--in   *);
+                                                         theLevel: CARDINAL (*--in   *));
+  BEGIN
+    IF ~IsNull(theNode) THEN
+          IF (theLevel > maxLevel) THEN
+            maxLevel := theLevel;
+          END (*--if*);
+          CountLevels(LeftOf(theTree, theNode), theLevel+1);
+          CountLevels(RightOf(theTree, theNode), theLevel+1);
+        END (*--if*);
+  END CountLevels;
+
+BEGIN
+  maxLevel := 1;
+  IF ~IsEmpty(theTree) THEN
+    CountLevels(RootOf(theTree), 1);
+  END (*--if*);
+  RETURN maxLevel - 1;
+END HeightOf;
+(*-------------------------*)
+
+(*
+5.4.2 Debugging Iterators
+
+PrintTree iterates over the given tree such that the nodes may be
+printed. Trees are normally displayed with the root at the top and
+the leaves at the bottom. To simplify the printing process, PrintTree
+displays the tree rotated 90Æ to the left. Thus the root is shown at
+the left of the page/screen with the leaves at the right. Furthermore,
+the left branches are shown towards the bottom of the display and the
+right branches at the top.
+
+The algorithm used here is a variation on the inorder tree traversal. So
+that the tree is displayed properly rotated, the processing of the left
+and right branches are reversed. This algorithm is derived from that
+given by Wirth [8].
+*)
+
+PROCEDURE PrintTree (    theTree: Tree       (*--in   *);
+                         print  : PrintProc  (*--in   *));
+
+  PROCEDURE DoPrintTree (    theSubtree : NodePtr  (*--in   *);
+                             theLevel   : CARDINAL (*--in   *));
+  BEGIN
+    IF ~IsNull(theSubtree) THEN
+          DoPrintTree(RightOf(theTree, theSubtree), theLevel+1);
+          print(theLevel, KeyOf(theTree, theSubtree),
+                        DataOf(theTree, theSubtree));
+          DoPrintTree(LeftOf(theTree, theSubtree), theLevel+1);
+        END (*--if*);
+  END DoPrintTree;
+
+BEGIN
+  IF ~IsEmpty(theTree) THEN
+    DoPrintTree(RootOf(theTree), 0);
+  END (*--if*);
+END PrintTree;
+(*-------------------------*)
+
+END TreSBMIU.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESUMI.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESUMI.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESUMI.DEF
@@ -0,0 +1,388 @@
+(*
+4.2 Unbounded Binary Search Tree Interface
+
+This module provides the interface to operations on the binary search
+tree abstract data type. The particular form provided herein is unbounded,
+i.e., each tree grows and shrinks in size as elements are added and
+removed from the tree. Thus, the tree is not constrained to a given
+maximum number of nodes (other than the limits of available memory).
+
+Other attributes of this particular component form are:
+
+Sequential:     can only be used in a non-tasking environment;
+Managed:        space for items ≡ the data components of a tree ≡ is returned
+                        to the system when a node is destroyed; and
+Iterator:       looping facilities are provided over tree objects.
+
+Each node of a tree is assumed to consist of two data elements ≡ a key
+field and a data field. Keys are used to structure the tree, while the
+data field simply represents information associated with a key but is
+not a part of it. While this separation may be less efficient in operation,
+it does lead to a cleaner interface.
+
+Keys are assumed to have the following operations available:
+        * a routine that assigns key values;
+        * a routine that compares key values returning the ordering
+          relation between them (i.e., less, equal, or greater); and
+        * optionally, a routine that disposes of key values that have been
+          allocated on the heap.
+
+Data values are assumed to the the following operations:
+        * a routine that assigns data values; and
+        * optionally, a routine that disposes of data values stored on the
+          heap.
+
+In both cases, keys and data values, along with the above operations, are
+identified by a TypeID that is unique for a given data type. This data type
+may be a standard Modula-2 type or one formed by the programmer using data
+type forming operations (e.g., RECORDs).
+
+The subsections are divided as follows:
+        * 4.2.1 Type Declarations
+        * 4.2.2 Exception Handling
+        * 4.2.3 Tree Constructors
+        * 4.2.4 Tree Selectors
+        * 4.2.5 Passive Iterators
+        * 4.2.6 Active Iterators
+*)
+
+DEFINITION MODULE TreSUMI;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Component: Monolithic Structures - Tree (Opaque version)
+               Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.01  18 Mar 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.02  01 Oct 1988  C. Lins
+      Updated and improved comments.
+        v1.03  29 Jan 1989  C. Lins
+          Added use of Key and Data aliases for generic Items.
+    v1.04  06 Feb 1989  C. Lins
+          Added use of InsertProc instead of FoundProc in Insert.
+    v1.05  09 Feb 1989  C. Lins
+          Removed VAR from Clear, Insert, & Remove (the tree itself
+          does not change).
+    v1.06  18 Apr 1989  C. Lins
+                Changed module id
+    v2.00  08 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM TreeTypes IMPORT
+    (*--Type*) Exceptions, Key, Data,
+                           AccessProc, InsertProc, FoundProc, NotFoundProc;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+        (*-----------------------*)
+
+(*
+4.2.1 Type Declarations
+
+Each instance of the Binary Tree abstract data type is represented by
+the type, Tree, using Modula-2's opaque type definition facility. The
+undefined tree is represented by a Tree constant of NIL.
+*)
+
+TYPE  Tree;
+VAR   NullTree : Tree;
+
+
+        (*-----------------------*)
+
+(*
+4.2.2 Exception Handling
+
+ModuleID        uniquely identifies this module interface. This allows
+                        exception handlers to know the module raising an exception.
+
+TreeError       returns the most recent exception condition or the constant
+                        noerr if an exception has not been raised.
+
+GetHandler      retrieves the current exception handler for the given
+                        exception enumeration constant.
+
+SetHandler      allows client modules to assign an exception handling
+                        routine for specific exceptions. In this way the client may
+                        override the default exception handling mechanism.
+*)
+
+CONST ModuleID = 5;
+
+PROCEDURE TreeError  ()              : Exceptions  (*--out  *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+
+        (*-----------------------*)
+
+
+(*
+4.2.3 Constructors
+
+Constructor operations update or change the state of a tree object. In
+this section we briefly describe each tree operation and its effect on
+a tree object. Exception conditions raised by these routines have been
+previously discussed in 3.3, Binary Search Tree Operations.
+
+Create  attempts to form a new, empty binary tree object having the given
+                key and data type identifiers.
+
+MakeTree does the same as Create, except that it also attempts to add
+                the given key and data items as the root of the new tree.
+
+Destroy attempts to demolish an existing tree object, clearing the tree
+                of all its contents and making the tree ≡undefined≡.
+
+Clear   empties an existing tree of its contents returning the tree to
+                an empty state.
+
+Assign  attempts to duplicate (e.g., make a copy) of an existing tree.
+                The target tree, where the copy is stored, is cleared of its
+                contents, if any, before the assignment commences.
+
+Insert  attempts to add a node having the given key and data values
+                to the given tree. If a node already exists in the tree with
+                the given key the found procedure parameter is invoked and the
+                new element is not added to the tree.
+
+Remove  searches the given tree for the node containing the specified key
+                value and removing this node from the tree. If a node does not
+                exist in the tree with the given key the notFound procedure
+                parameter is invoked.
+*)
+
+PROCEDURE Create    (    keyType  : TypeID       (*--in   *);
+                                                 dataType : TypeID       (*--in   *))
+                                  : Tree         (*--out  *);
+
+PROCEDURE MakeTree  (    keyType  : TypeID       (*--in   *);
+                                                 dataType : TypeID       (*--in   *);
+                         theKey   : Key          (*--in   *);
+                                                 theData  : Data         (*--in   *))
+                                  : Tree         (*--out  *);
+
+PROCEDURE Destroy   (VAR theTree  : Tree         (*--inout*));
+
+PROCEDURE Clear     (    theTree  : Tree         (*--inout*));
+
+PROCEDURE Assign    (    theTree  : Tree         (*--in   *);
+                     VAR toTree   : Tree         (*--inout*));
+
+PROCEDURE Insert    (    theTree  : Tree         (*--inout*);
+                         theKey   : Key          (*--in   *);
+                         theData  : Data         (*--in   *);
+                                                 found    : InsertProc   (*--in   *));
+
+PROCEDURE Remove    (    theTree  : Tree         (*--inout*);
+                         theKey   : Key          (*--in   *);
+                                                 notFound : NotFoundProc (*--in   *));
+
+        (*-----------------------*)
+
+
+(*
+4.2.4 Selectors
+
+Selector operations allow a client module to examine the state of a tree
+without changing that state.
+
+IsDefined       verifies whether theTree has been created and is still an
+                        active object. For our purposes, a tree object is considered
+                        defined if it is not equal to the NullTree.
+
+IsEmpty         returns true if the given tree does not contain any nodes, and
+                        false otherwise.
+
+IsEqual         returns true if and only if the two trees have the same key and
+                        data item types, contain the same items, and have the same
+                        relationships between each item.
+
+KeyTypeOf       simpy returns the data type ID of the keys associated with this tree.
+
+DataTypeOf      returns the data item type ID of the given tree.
+
+ExtentOf        returns a count indicating the total number of nodes in the tree.
+
+IsPresent       searches the given tree for the item with the given key value.
+                        If the item is found the found procedure parameter is called,
+                        otherwise the notFound procedure parameter is called.
+*)
+
+PROCEDURE IsDefined  (    theTree  : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+
+PROCEDURE IsEmpty    (    theTree  : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+
+PROCEDURE IsEqual    (    left     : Tree         (*--in   *);
+                          right    : Tree         (*--in   *))
+                                   : BOOLEAN      (*--out  *);
+
+PROCEDURE KeyTypeOf  (    theTree  : Tree         (*--in   *))
+                                   : TypeID       (*--out  *);
+
+PROCEDURE DataTypeOf (    theTree  : Tree         (*--in   *))
+                                   : TypeID       (*--out  *);
+
+PROCEDURE ExtentOf   (    theTree  : Tree         (*--in   *))
+                                   : CARDINAL     (*--out  *);
+
+PROCEDURE IsPresent  (    theTree  : Tree         (*--in   *);
+                          theKey   : Key          (*--in   *);
+                                                  found    : FoundProc    (*--in   *);
+                                                  notFound : NotFoundProc (*--in   *));
+
+        (*-----------------------*)
+
+
+(*
+4.2.5 Passive Iterators
+
+Three passive iterators are provided each implementing one of the standard
+tree traversal algorithms. Passive iterators allow the client module
+to traverse the tree as through it were a single, monolithic data structure.
+*)
+
+PROCEDURE Preorder  (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+PROCEDURE Inorder   (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+PROCEDURE Postorder (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+        (*-----------------------*)
+
+
+(*
+4.2.6 Active Iterators
+
+While passive iterators are most useful for tree objects, there may
+be situations when the client module requires more control over the
+iteration process (e.g., when printing the internal binary tree
+representation). In this case, it is necessary to use an active
+iteration mechanism, where the internal structure of a tree is made
+visible to the client in a controlled manner that ensures the safety
+of the abstraction.
+
+In the form presented here, the internal structure is made visible
+through the opaque type NodePtr, representing a subtree node of a tree.
+An empty subtree is modelled by the constant NullNode.
+
+The reader should note that none of the active iterator operations
+raise exceptions.
+
+NodePtr         is a type used to represent and individual node of the tree.
+
+NullNode        is a constant representing an empty subtree.
+
+RootOf          returns a reference to the root node of the given tree. If
+                        the tree is empty then the NullNode is returned.
+
+LeftOf          returns the node that is the left subtree from the given
+                        node. If the given node has no left subtree then the NullNode
+                        is returned.
+
+RightOf         returns the node that is the right subtree from the given
+                        node. If the given node has no right subtree then the NullNode
+                        is returned.
+
+IsNull          returns true is the given node is equal to the NullNode and
+                        false otherwise.
+
+KeyOf           returns the key value associated with the given node. If the
+                        node is empty (i.e., equal to the NullNode) the NullItem is
+                        returned instead.
+
+DataOf          returns the data value associated with the given node. If the
+                        node is empty (i.e., equal to the NullNode) the NullItem is
+                        returned instead.
+*)
+
+TYPE  NodePtr;
+CONST NullNode = NodePtr(NIL);
+
+PROCEDURE RootOf  (    theTree : Tree    (*--in   *))
+                                                           : NodePtr (*--out  *);
+
+PROCEDURE LeftOf  (    theNode : NodePtr (*--in   *))
+                                                           : NodePtr (*--out  *);
+
+PROCEDURE RightOf (    theNode : NodePtr (*--in   *))
+                                                           : NodePtr (*--out  *);
+
+PROCEDURE IsNull  (    theNode : NodePtr (*--in   *))
+                                                           : BOOLEAN (*--out  *);
+
+PROCEDURE KeyOf   (    theNode : NodePtr (*--in   *))
+                                                           : Key     (*--out  *);
+
+PROCEDURE DataOf  (    theNode : NodePtr (*--in   *))
+                                                           : Data    (*--out  *);
+
+END TreSUMI.
+
+(*
+
+                                Algorithmic     Code
+Operation Name  Complexity      Size
+                                (bytes)
+TreeError               O(1)             18             Exception Handling Routines
+GetHandler              O(1)             34
+SetHandler              O(1)             30
+
+Create                  O(1)             80             Constructors
+Destroy                 O(1)             36
+MakeTree                O(1)            138
+Clear                   O(n)            202
+Assign                  O(m+n)          480
+Insert                  O(log2 n)       294
+Remove                  O(log2 n)       500
+
+IsDefined               O(1)             28             Selectors
+IsEmpty                 O(1)             66
+IsEqual                 O(Min(m,n))     310
+ExtentOf                O(n)            132
+KeyTypeOf               O(1)             58
+DataTypeOf              O(1)             58
+IsPresent               O(log2 n)       212
+
+Inorder                 O(n)            130             Passive Iterators
+Preorder                O(n)            130
+Postorder               O(n)            130
+
+RootOf                  O(1)             42             Active Iterators
+LeftOf                  O(1)             42
+RightOf                 O(1)             42
+IsNull                  O(1)             28
+KeyOf                   O(1)             40
+DataOf                  O(1)             42
+
+RaiseErrIn              O(1)             50             Local Routines
+NewNode                 O(1)             68
+Initialization  O(1)             84
+
+Grand Total                                3504
+
+Table 4.1 Unbounded Binary Search Tree Operations Summary
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESUMI.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESUMI.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESUMI.MOD
@@ -0,0 +1,937 @@
+(*
+4.3 Unbounded Binary Search Tree Implementation
+
+The internal structures used in representing an unbalanced, unbounded
+binary search tree are described in this section along with the
+algorithms implementing the operations defined in the interface.
+
+This section is broken down as follows:
+        * 4.3.1 Internal Representation
+        * 4.3.2 Exception Handling
+        * 4.3.3 Local Operations
+        * 4.3.4 Tree Constructors
+        * 4.3.5 Tree Selectors
+        * 4.3.6 Passive Iterators
+        * 4.3.7 Active Iterators
+        * 4.3.8 Module Initialization
+*)
+
+IMPLEMENTATION MODULE TreSUMI;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: OBJ file has 12075 bytes
+    Component: Monolithic Structures - Tree (Opaque version)
+               Sequential Unbounded Managed Iterator
+
+    REVISION HISTORY
+    v1.01  18 Mar 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.02  01 Oct 1988  C. Lins
+      Updated and improved comments.
+        v1.03  29 Jan 1989  C. Lins
+          Changed to use Key and Data aliases for generic Items.
+        v1.04  02 Feb 1989  C. Lins
+          Optimized Assign to use NewNode instead of directly allocating
+          new nodes. Assumes that assignKey and assignItem never fail.
+    v1.05  06 Feb 1989  C. Lins
+          Added use of InsertProc instead of FoundProc in Insert.
+    v1.06  09 Feb 1989  C. Lins
+          Removed VAR from Clear, Insert, & Remove (the tree itself
+          does not change).
+    v1.07  17 Apr 1989  C. Lins:
+                Corrected IsEqual to use comparison routine derived
+                from the CompareOf routine associated with the stack's
+                TypeID.
+    v1.04  18 Apr 1989   C. Lins:
+                Added component id constant.
+    v2.00  08 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM JPIStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Relations IMPORT
+        (*--Type*) Relation;
+
+FROM Items IMPORT
+        (*--Cons*) NullItem,
+    (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM TreeTypes IMPORT
+    (*--Type*) Operations, Exceptions, AccessProc, FoundProc,
+                           NotFoundProc, InsertProc, Key, Data, ComponentID;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+        (*--Proc*) AssignOf, DisposeOf, CompareOf;
+
+
+    (*-----------------------*)
+
+(*
+
+4.3.1 Internal Representation
+
+An unbounded binary search tree is represented using nodes for storing
+keys, data items, and links between nodes the left and right subtrees.
+Figure 4.1 depicts graphically this structural organization.
+
+_Figure 4.1_
+
+Link    provides a mechanism for maintaining the lexicographical ordering
+                between nodes (i.e., the structure of the tree).
+
+Node    holds a key value and its associated data, if any, along with
+                links to the left and right subtrees.
+
+UnboundedTree   defines a descriptor record for each unbounded tree
+                object. This record holds the data type IDs for the key and
+                data fields plus a link to the root node of the tree.
+
+Tree    completes the opaque definition of the abstract tree.
+*)
+
+TYPE  Link = POINTER TO Node;
+TYPE  Node = RECORD
+                key   : Key;  (*--key value for this node *)
+                data  : Data; (*--data value for this node *)
+                left  : Link; (*--link to left subtree *)
+                right : Link; (*--link to right subtree*)
+          END (*--Node *);
+
+TYPE  UnboundedTree = RECORD
+                keyID  : TypeID; (*--data type for the tree's keys *)
+        dataID : TypeID; (*--data type for this tree's items *)
+                root   : Link;   (*--link to root of this tree *)
+      END (*--UnboundedTree *);
+
+TYPE  Tree = POINTER TO UnboundedTree;
+
+
+        (*-----------------------*)
+
+(*
+4.3.2 Exception Handling
+
+treeError holds the exception result from the most recently
+invoked operation of this module. The Exceptions enumeration
+constant noerr indicates successful completion of the operation and
+all operations that may raise an exception assign this value to
+treeError before any other processing.
+
+The handler array holds the current exception handler for the
+possible exceptions that may be raised from within this module.
+
+Both are initialized by the module initialization (see section
+4.3.8).
+
+TreeError       simply returns the current exception result stored
+                        in treeError and is used to determine whether a tree
+                        operation completed successfully.
+
+SetHandler      makes theHandler the current exception handler for theError
+                        by storing theHandler in the handler array.
+
+GetHandler      returns the current exception handler for theError from the
+                        handler array.
+*)
+
+VAR   treeError : Exceptions;
+VAR   handler   : ARRAY Exceptions OF HandlerProc;
+
+
+PROCEDURE TreeError  ()              : Exceptions  (*--out  *);
+BEGIN
+  RETURN treeError;
+END TreeError;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*--in   *);
+                          theError   : Exceptions (*--in   *));
+BEGIN
+  treeError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+4.3.3 Local Operations
+
+NewNode allocates and initializes a new leaf node for a tree.
+Complexity O(1).
+*)
+
+PROCEDURE NewNode   (    theKey   : Key         (*--in   *);
+                                                 theData  : Data        (*--in   *))
+                                                          : Link        (*--out  *);
+
+VAR   theNode : Link; (*--link to new leaf node being created *)
+
+BEGIN
+  Allocate(theNode, SIZE(Node));
+  IF (theNode # NIL) THEN
+    WITH theNode^ DO
+      key   := theKey;
+      data  := theData;
+      left  := NIL;
+      right := NIL;
+    END (*--with*);
+  END (*--if*);
+  RETURN theNode;
+END NewNode;
+(*-------------------------*)
+
+
+(*
+4.3.4 Constructors
+
+Create attempts to build a new empty tree of the given type (keyType
+and dataType). First, the tree descriptor is allocated and the key
+and data type IDs are stored there. The pointer to the root node is
+initialized to the empty state (NIL). If the descriptor allocation
+fails the overflow exception is raised and the NullTree is returned,
+otherwise we return the newly allocated tree. Complexity O(1).
+*)
+
+PROCEDURE Create    (    keyType  : TypeID       (*--in   *);
+                                                 dataType : TypeID       (*--in   *))
+                                  : Tree         (*--out  *);
+
+VAR   newTree : Tree; (*--temporary for new tree *)
+
+BEGIN
+  treeError := noerr;
+  Allocate(newTree, SIZE(UnboundedTree));
+  IF (newTree = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newTree^ DO
+          keyID  := keyType;
+      dataID := dataType;
+          root   := NIL;
+    END(*--with*);
+  END(*--if*);
+  RETURN newTree;
+END Create;
+(*-------------------------*)
+
+
+(*
+MakeTree is a combination of Create(keyType, dataType) immediately
+followed by Insert(theKey, theData). Complexity O(1).
+*)
+
+PROCEDURE MakeTree  (    keyType  : TypeID       (*--in   *);
+                                                 dataType : TypeID       (*--in   *);
+                         theKey   : Key          (*--in   *);
+                                                 theData  : Data         (*--in   *))
+                                  : Tree         (*--out  *);
+
+VAR   newTree : Tree; (*--new tree being created *)
+
+BEGIN
+  treeError := noerr;
+  Allocate(newTree, SIZE(UnboundedTree));
+  IF (newTree = NIL) THEN
+    RaiseErrIn(maketree, overflow);
+  ELSE
+    WITH newTree^ DO
+          keyID  := keyType;
+      dataID := dataType;
+          root   := NewNode(theKey, theData);
+          IF (root = NIL) THEN
+            RaiseErrIn(maketree, overflow);
+                Deallocate(newTree, SIZE(newTree^));
+          END (*--if*);
+    END(*--with*);
+  END(*--if*);
+  RETURN newTree;
+END MakeTree;
+(*-------------------------*)
+
+
+(*
+Destroy lets Clear raise the undefined exception and simply releases
+dynamically allocated memory resources for theTree back to the system.
+SCLStorage.Deallocate automatically releases the proper amount of space
+originally allocated and alters the pointer to NIL (which is also the
+value of the NullTree). Complexity: O(n).
+*)
+
+PROCEDURE Destroy   (VAR theTree  : Tree         (*--inout*));
+BEGIN
+  Clear(theTree);
+  IF (treeError = noerr) THEN
+    Deallocate(theTree, SIZE(theTree^));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+
+(*
+Clear uses a postorder traversal of theTree, clearing the nodes of
+both subtrees before clearing the tree itself. After disposing the
+subtrees the key and data values can be disposed followed by the node.
+The routine takes advantage of the fact that this version of Deallocate
+sets the pointer to NIL after releasing the proper amount of memory.
+This saves us from having to explicitly set the root to NIL.
+Complexity O(n).
+*)
+
+PROCEDURE Clear     (    theTree  : Tree         (*--inout*));
+
+VAR   freeData : DisposeProc; (*--data value disposal routine *)
+          freeKey  : DisposeProc; (*--key value disposal routine *)
+
+  PROCEDURE ClearNodes (VAR theSubtree : Link (*--inout*));
+  BEGIN
+    IF (theSubtree # NIL) THEN
+          WITH theSubtree^ DO
+            ClearNodes(left);
+            ClearNodes(right);
+                freeKey(key);
+                freeData(data);
+          END (*--with*);
+          Deallocate(theSubtree, SIZE(theSubtree^));
+        END (*--if*);
+  END ClearNodes;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theTree^ DO
+      freeKey  := DisposeOf(keyID);
+      freeData := DisposeOf(dataID);
+      ClearNodes(root);
+        END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+
+(*
+Assign uses a preorder traversal of the source tree to generate a
+copy in the destination tree. Preliminary to the actual copying,
+we must ensure that the source tree is defined and clear or create
+the destination tree as necessary. This step is accomplished by the
+RecreateTarget routine which must accomodate the following cases:
+        * the source tree is undefined, and thus, the target tree must be
+          left unchanged;
+        * the source tree and target tree are the same and therefore the
+          postcondition of the Assign operation is already met;
+        * the source tree is defined but the target tree is undefined, so
+          the target tree must be created with the same key and data type
+          id's as the source tree; and
+        * both the source and target trees are defined, and thus the target
+          tree must be cleared of its contents followed by its key and data
+          key id's being set to the same as the source tree.
+
+In the second case, we automatically return FALSE so that Assign will
+bypass the node copying operation. While in the other three instances,
+success depends on whether treeError remains set to noerr.
+
+The main body of Assign uses the result from RecreateTarget to determine
+whether to continue with the copy operation after recreating the target tree.
+Complexity O(m+n) where m is the number of nodes in the destination
+tree and n is the number of nodes in the source tree.
+*)
+
+PROCEDURE Assign    (    theTree  : Tree         (*--in   *);
+                     VAR toTree   : Tree         (*--inout*));
+
+VAR   assignKey  : AssignProc; (*--key item assignment routine *)
+          assignItem : AssignProc; (*--data item assignment routine *)
+
+  PROCEDURE RecreateTarget () : BOOLEAN (*--out *);
+  BEGIN
+    IF (theTree = NIL) THEN
+          RaiseErrIn(assign, undefined);
+    ELSIF (toTree = NIL) THEN
+          WITH theTree^ DO
+            toTree := Create(keyID, dataID);
+          END (*--with*);
+    ELSIF (toTree = theTree) THEN
+          RETURN FALSE;
+    ELSE
+          Clear(toTree);
+          WITH theTree^ DO
+            toTree^.keyID  := keyID;
+            toTree^.dataID := dataID;
+          END (*--with*);
+    END (*--if*);
+        RETURN treeError = noerr;
+  END RecreateTarget;
+
+  PROCEDURE DoAssign (    theSubtree : Link (*--in   *);
+                                          VAR toSubtree  : Link (*--out  *));
+  BEGIN
+    IF (theSubtree = NIL) THEN
+          toSubtree := NIL;
+        ELSE
+          WITH theSubtree^ DO
+            toSubtree := NewNode(assignKey(key), assignItem(data));
+          END (*--with*);
+          IF (toSubtree = NIL) THEN
+            RaiseErrIn(assign, overflow);
+          ELSE
+            DoAssign(theSubtree^.left, toSubtree^.left);
+            DoAssign(theSubtree^.right, toSubtree^.right);
+          END (*--if*);
+        END (*--if*);
+  END DoAssign;
+
+BEGIN
+  treeError := noerr;
+  IF RecreateTarget() THEN
+    WITH theTree^ DO
+      assignKey  := AssignOf(keyID);
+      assignItem := AssignOf(dataID);
+      DoAssign(root, toTree^.root);
+        END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+
+(*
+Insert adds a node with theKey and theData to theTree and places the
+node within its proper position maintaining the search tree property.
+This algorithm is the standard recursive one for binary tree insertion.
+Complexity O(log2 n).
+*)
+
+PROCEDURE Insert    (    theTree  : Tree         (*--inout*);
+                         theKey   : Key          (*--in   *);
+                         theData  : Data         (*--in   *);
+                                                 found    : InsertProc   (*--in   *));
+
+VAR   compare : CompareProc; (*--key comparison routine *)
+
+  PROCEDURE DoInsert (VAR theSubtree : Link (*--inout*));
+  BEGIN
+    IF (theSubtree = NIL) THEN
+          theSubtree := NewNode(theKey, theData);
+          IF (theSubtree = NIL) THEN
+            RaiseErrIn(insert, overflow);
+          END (*--if*);
+        ELSE
+          CASE compare(theSubtree^.key, theKey) OF
+            less    : DoInsert(theSubtree^.right);
+          | greater : DoInsert(theSubtree^.left);
+          ELSE
+            found(theSubtree^.key, theSubtree^.data, theData);
+          END (*--case*);
+        END (*--if*);
+  END DoInsert;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(insert, undefined);
+  ELSE
+    WITH theTree^ DO
+      compare := CompareOf(keyID);
+      DoInsert(root);
+        END (*--with*);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+
+(*
+Remove searches theTree for the first node containing theKey. If no such
+node exists the notFound procedure parameter is called. Otherwise, we
+use the standard binary tree deletion algorithm as given by Wirth [8] and
+many others (see references).
+Complexity O(log2 n).
+*)
+
+PROCEDURE Remove    (    theTree  : Tree         (*--inout*);
+                         theKey   : Key          (*--in   *);
+                                                 notFound : NotFoundProc (*--in   *));
+
+VAR   compare  : CompareProc; (*--key comparison routine *)
+          freeKey  : DisposeProc; (*--key disposal routine *)
+          freeData : DisposeProc; (*--data disposal routine *)
+
+  PROCEDURE DoRemove (VAR subTree : Link (*--inout*));
+
+  VAR   oldTree : Link; (*--link to subtree to be disposed *)
+
+    PROCEDURE SwapRemove (VAR subTree : Link (*--inout*));
+        BEGIN
+          IF (subTree^.right # NIL) THEN
+            SwapRemove(subTree^.right);
+          ELSE
+            oldTree^.key := subTree^.key;
+                oldTree^.data := subTree^.data;
+                oldTree := subTree;
+                subTree := subTree^.left;
+          END (*--if*);
+        END SwapRemove;
+
+  BEGIN
+    IF (subTree = NIL) THEN
+
+          notFound(theKey); (*--ERROR key not found in the tree *)
+
+        ELSE
+          CASE compare(theKey, subTree^.key) OF
+            less    : DoRemove(subTree^.left);
+          | greater : DoRemove(subTree^.right);
+          ELSE
+                (*--key found, delete it *)
+                oldTree := subTree;
+                IF (oldTree^.right = NIL) THEN
+                  subTree := oldTree^.left;
+                ELSIF (oldTree^.left = NIL) THEN
+                  subTree := oldTree^.right;
+                ELSE
+                  SwapRemove(oldTree^.left);
+                END (*--if*);
+                freeKey(oldTree^.key);
+                freeData(oldTree^.data);
+                Deallocate(oldTree, SIZE(oldTree^));
+          END (*--case*);
+        END (*--if*);
+  END DoRemove;
+
+BEGIN  (*-- Remove --*)
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(remove, undefined);
+  ELSE
+    WITH theTree^ DO
+      compare := CompareOf(keyID);
+          freeKey := DisposeOf(keyID);
+          freeData:= DisposeOf(dataID);
+      DoRemove(root);
+        END (*--with*);
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+
+(*
+4.3.5 Selectors
+
+IsDefined verifies to the best of its ability whether theTree has been
+created and is still an active object. Complexity: O(1).
+*)
+
+PROCEDURE IsDefined (    theTree  : Tree         (*--in   *))
+                                  : BOOLEAN      (*--out  *);
+BEGIN
+  RETURN theTree # NullTree;
+END IsDefined;
+(*-------------------------*)
+
+
+(*
+IsEmpty returns True if theTree is in the empty state, as indicated by
+the root being NIL, and False otherwise.  As per the specification
+(section 3.3) undefined trees are considered empty. Complexity: O(1).
+*)
+
+PROCEDURE IsEmpty   (    theTree  : Tree         (*--in   *))
+                                  : BOOLEAN      (*--out  *);
+BEGIN
+  treeError := noerr;
+  IF (theTree # NIL) THEN
+    RETURN (theTree^.root = NIL);
+  END (*--if*);
+  RaiseErrIn(isempty, undefined);
+  RETURN TRUE;
+END IsEmpty;
+(*-------------------------*)
+
+
+(*
+IsEqual uses a preorder traversal of both left and right trees. As soon
+as an inequality between keys is found we can return false as the trees
+cannot be equal. Complexity O(Min(m,n)).
+*)
+
+PROCEDURE IsEqual   (    left     : Tree         (*--in   *);
+                         right    : Tree         (*--in   *))
+                                  : BOOLEAN      (*--out  *);
+
+VAR       compare : CompareProc;        (*-- item comparison routine *)
+
+  PROCEDURE DoIsEqual (    leftSubtree  : Link    (*--in   *);
+                                                   rightSubtree : Link    (*--in   *))
+                                                                                : BOOLEAN (*--out  *);
+  BEGIN
+    IF (leftSubtree = NIL) OR (rightSubtree = NIL) THEN
+          RETURN (leftSubtree = NIL) & (rightSubtree = NIL);
+    ELSIF compare(leftSubtree^.key, rightSubtree^.key) # equal THEN
+          RETURN FALSE;
+        ELSE
+          RETURN (DoIsEqual(leftSubtree^.left, rightSubtree^.left) &
+                          DoIsEqual(leftSubtree^.right, rightSubtree^.right));
+        END (*--if*);
+  END DoIsEqual;
+
+BEGIN
+  treeError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.dataID # right^.dataID) OR
+                (left^.keyID # right^.keyID) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSE
+        compare := CompareOf(left^.keyID);
+    RETURN DoIsEqual(left^.root, right^.root);
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+
+(*
+The two TypeOf routines simply return the key data ID or data ID for the given tree.
+Undefined trees, as always, raise the undefined exception and return a reasonable value,
+in this case the NullType. Complexity O(1).
+*)
+
+PROCEDURE KeyTypeOf (    theTree  : Tree         (*--in   *))
+                                  : TypeID       (*--out  *);
+BEGIN
+  treeError := noerr;
+  IF (theTree # NIL) THEN
+    RETURN theTree^.keyID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END KeyTypeOf;
+(*-------------------------*)
+
+PROCEDURE DataTypeOf (    theTree  : Tree         (*--in   *))
+                                   : TypeID       (*--out  *);
+BEGIN
+  treeError := noerr;
+  IF (theTree # NIL) THEN
+    RETURN theTree^.dataID;
+  END (*--if*);
+  RaiseErrIn(typeof, undefined);
+  RETURN NullType;
+END DataTypeOf;
+(*-------------------------*)
+
+
+(*
+ExtentOf returns the number of nodes present in the given tree or zero
+for an undefined tree. We simply employ an inorder traversal of the tree
+counting the nodes along the way. Complexity O(n).
+*)
+
+PROCEDURE ExtentOf   (    theTree  : Tree         (*--in   *))
+                                   : CARDINAL     (*--out  *);
+
+VAR   count : CARDINAL; (*--running count of nodes in tree *)
+
+  PROCEDURE CountNodes (    theSubtree : Link (*--in   *));
+  BEGIN
+    IF (theSubtree # NIL) THEN
+          WITH theSubtree^ DO
+            CountNodes(left);
+            INC(count);
+            CountNodes(right);
+          END (*--with*);
+        END (*--if*);
+  END CountNodes;
+
+BEGIN
+  treeError := noerr;
+  count     := 0;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(extentof, undefined);
+  ELSE
+    CountNodes(theTree^.root);
+  END (*--if*);
+  RETURN count;
+END ExtentOf;
+(*-------------------------*)
+
+
+(*
+IsPresent uses an iterative traversal of the given tree attempting
+to find node in theTree containing theKey value. The search path
+begins at the root switching to the left or right subtree based on
+examination of each node's key. As noted by Wirth [8] and others, as
+few as log2 n comparisons may be needed to find theKey if theTree is
+perfectly balanced. The algorithmic complexity of the search is
+therefore O(log2 n) where n is the number of nodes in the tree. It is
+assumed that all keys are comparable and the compare procedure is not NIL.
+*)
+
+PROCEDURE IsPresent (    theTree  : Tree         (*--in   *);
+                         theKey   : Key          (*--in   *);
+                                                 found    : FoundProc    (*--in   *);
+                                                 notFound : NotFoundProc (*--in   *));
+
+VAR   treeIndex : Link;
+      compare   : CompareProc; (*--key comparison routine *)
+
+BEGIN
+  treeError := noerr;
+  IF (theTree # NIL) THEN
+    WITH theTree^ DO
+      treeIndex := root;
+          compare   := CompareOf(keyID);
+        END (*--with*);
+
+        LOOP
+          IF (treeIndex = NIL) THEN
+            notFound(theKey);
+                EXIT (*--loop*);
+          END (*--if*);
+
+          CASE compare(treeIndex^.key, theKey) OF
+            equal   : found(theKey, treeIndex^.data);
+                                  EXIT (*--loop*);
+          | less    : treeIndex := treeIndex^.right;
+          | greater : treeIndex := treeIndex^.left;
+          END (*--case*);
+        END (*--loop*);
+
+  ELSE
+    RaiseErrIn(ispresent, undefined);
+  END (*--if*);
+END IsPresent;
+(*-------------------------*)
+
+
+(*
+4.3.6 Passive Iterators
+
+Each of the three iterator routines accomplish recursively Preorder,
+Inorder, and Postorder traversals of the given tree. If the tree is
+not defined, the undefined exception is raised and the traversal is
+aborted. Otherwise, traversal begins with the root of the tree following
+the specifications given in section 3.1.6.2. The complexity is O(n) for
+all three traversals. Once again these are elementary tree algorithms that
+can be found is any college textbook on data structures.
+*)
+
+PROCEDURE Preorder  (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+  PROCEDURE DoPreorder (    theSubtree : Link (*--in   *));
+  BEGIN
+    IF (theSubtree # NIL) THEN
+          WITH theSubtree^ DO
+            theProcess(key, data);
+            DoPreorder(left);
+            DoPreorder(right);
+          END (*--with*);
+        END (*--if*);
+  END DoPreorder;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(preorder, undefined);
+  ELSE
+    DoPreorder(theTree^.root);
+  END (*--if*);
+END Preorder;
+(*-------------------------*)
+
+PROCEDURE Inorder   (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+  PROCEDURE DoInorder (    theSubtree : Link (*--in   *));
+  BEGIN
+    IF (theSubtree # NIL) THEN
+          WITH theSubtree^ DO
+            DoInorder(left);
+            theProcess(key, data);
+            DoInorder(right);
+          END (*--with*);
+        END (*--if*);
+  END DoInorder;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(inorder, undefined);
+  ELSE
+    DoInorder(theTree^.root);
+  END (*--if*);
+END Inorder;
+(*-------------------------*)
+
+PROCEDURE Postorder (    theTree   : Tree       (*--in   *);
+                         theProcess: AccessProc (*--in   *));
+
+  PROCEDURE DoPostorder (    theSubtree : Link (*--in   *));
+  BEGIN
+    IF (theSubtree # NIL) THEN
+          WITH theSubtree^ DO
+            DoPostorder(left);
+            DoPostorder(right);
+            theProcess(key, data);
+          END (*--with*);
+        END (*--if*);
+  END DoPostorder;
+
+BEGIN
+  treeError := noerr;
+  IF (theTree = NIL) THEN
+    RaiseErrIn(postorder, undefined);
+  ELSE
+    DoPostorder(theTree^.root);
+  END (*--if*);
+END Postorder;
+(*-------------------------*)
+
+
+(*
+4.3.7 Active Iterators
+
+The active iterators given below simply return eomponents of tree nodes
+and are thus, for the most part, self-explanatory.
+
+The TML Modula-2 compiler prohibits us from redeclaring an opaque
+type as equal to another type. (We cannot define a NodePtr = Link).
+Thus, we must explicitly define NodePtr and then use the type transfer
+facility provided by VAL to coerce the tree links into iterator nodes.
+*)
+
+TYPE  NodePtr  = POINTER TO Node;
+
+PROCEDURE RootOf  (    theTree : Tree    (*--in   *))
+                                                           : NodePtr (*--out  *);
+BEGIN
+  IF (theTree = NIL) THEN
+    RETURN NullNode;
+  END (*--if*);
+  RETURN NodePtr( theTree^.root);
+END RootOf;
+(*-------------------------*)
+
+PROCEDURE LeftOf  (    theNode : NodePtr (*--in   *))
+                                                           : NodePtr (*--out  *);
+BEGIN
+  IF (theNode = NIL) THEN
+    RETURN NullNode;
+  END (*--if*);
+  RETURN NodePtr(theNode^.left);
+END LeftOf;
+(*-------------------------*)
+
+PROCEDURE RightOf (    theNode : NodePtr (*--in   *))
+                                                           : NodePtr (*--out  *);
+BEGIN
+  IF (theNode = NIL) THEN
+    RETURN NullNode;
+  END (*--if*);
+  RETURN NodePtr(theNode^.right);
+END RightOf;
+(*-------------------------*)
+
+PROCEDURE IsNull  (    theNode : NodePtr (*--in   *))
+                                                           : BOOLEAN (*--out  *);
+BEGIN
+  RETURN theNode = NIL;
+END IsNull;
+(*-------------------------*)
+
+PROCEDURE KeyOf   (    theNode : NodePtr (*--in   *))
+                                                           : Key     (*--out  *);
+BEGIN
+  IF (theNode = NIL) THEN
+    RETURN NullItem;
+  END (*--if*);
+  RETURN theNode^.key;
+END KeyOf;
+(*-------------------------*)
+
+PROCEDURE DataOf  (    theNode : NodePtr (*--in   *))
+                                                           : Data    (*--out  *);
+BEGIN
+  IF (theNode = NIL) THEN
+    RETURN NullItem;
+  END (*--if*);
+  RETURN theNode^.data;
+END DataOf;
+(*-------------------------*)
+
+
+(*
+4.3.8 Module Initialization
+
+The module's local variables are initialized to known states.
+treeError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, treeError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR treeError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(treeError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  treeError := noerr;
+        NullTree := NIL;
+END TreSUMI.
+
+(*
+References
+
+
+[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms,
+    Addison-Wesley, Reading, MA 1983.
+[2] G. Booch, Software Components in Ada Structures, Tools, and Subsystems,
+        Benjamin/Cummings, Menlo Park, CA 1987.
+[3]     G.H. Gonnet, Handbook of Algorithms and Data Structures, Addison-Wesley,
+        Reading, MA 1984.
+[4] K. John Gough, ≡Writing Generic Utilities in Modula-2≡, Journal of
+    Pascal, Ada, and Modula-2, Vol. 5(3), (May/June 1986), pp 53-62.
+[5] T.A. Standish, Data Structure Techniques, Addison-Wesley, Reading, MA 1980.
+[6] R.S. Wiener and G.A. Ford, Modula-2 A Software Development Approach,
+    John Wiley & Sons, New York, NY 1985.
+[7] R.S. Wiener and R.F. Sincovec, Data Structures Using Modula-2,
+    John Wiley & Sons, New York, NY 1986.
+[8]     N. Wirth, Algorithms and Data Structures, Prentice-Hall, Englewood Cliffs,
+        NJ 1986.
+*)
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESUMIU.DEF b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESUMIU.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESUMIU.DEF
@@ -0,0 +1,75 @@
+(*
+4.4 Unbounded Binary Search Tree Utilities
+
+This module provides the facility for displaying the hierarchy of
+a binary tree on the terminal while presenting an example using
+active iterators. Printing the tree is also possible depending
+on whether standard output has been so redirected.
+*)
+
+DEFINITION MODULE TreSUMIU;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Component: Binary Tree SUMI Utilities
+
+    REVISION HISTORY
+    v1.00  17 Mar 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.01  01 Oct 1988  C. Lins
+      Cleanup of comments.
+          Added procedure parameter for handling the separator between
+          levels in the tree.
+          Added HeightOf selector.
+    v1.02  29 Jan 1989  C. Lins
+          Changed to use Key and Data aliases for generic Items.
+    v2.00  08 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+===============================================================*)
+
+FROM TreeTypes IMPORT
+    (*--Type*) Key, Data;
+
+FROM TreSUMI IMPORT
+    (*--Type*) Tree;
+
+
+        (*-----------------------*)
+
+(*
+4.4.1 Utility Selectors
+
+HeightOf returns the height of the given tree.
+*)
+
+PROCEDURE HeightOf (    theTree : Tree     (*--in   *))
+                                : CARDINAL (*--out  *);
+
+
+(*
+4.4.2 Debugging Iterators
+
+PrintTree iterates over the given tree such that the nodes may be
+printed. Trees are normally displayed with the root at the top and
+the leaves at the bottom. To simplify the printing process, PrintTree
+displays the tree rotated 90Æ to the left. Thus the root is shown at
+the left of the page/screen with the leaves at the right. Furthermore,
+the left branches are shown towards the bottom of the display and the
+right branches at the top. The PrintProc routine is responsible for
+indenting the display appropriately based on the level parameter.
+*)
+
+TYPE  Level      = CARDINAL;
+TYPE  PrintProc  = PROCEDURE (Level, Key, Data);
+
+PROCEDURE PrintTree (    theTree: Tree       (*--in   *);
+                         print  : PrintProc  (*--in   *));
+
+END TreSUMIU.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESUMIU.MOD b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESUMIU.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol3/TREES/TRESUMIU.MOD
@@ -0,0 +1,117 @@
+(*
+4.5 Unbounded Binary Search Tree Utilities
+
+Below is the implementation for the print tree and height routine
+whose interface was given above in section 4.4.
+*)
+
+IMPLEMENTATION MODULE TreSUMIU;
+(*==============================================================
+    Version  : V2.01  08 December 1989.
+    Compiler : JPI TopSpeed Modula-2
+    Code size: OBJ file has 1536 bytes
+
+    REVISION HISTORY
+    v1.00  17 Mar 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.01  01 Oct 1988  C. Lins
+      Cleanup of comments.
+          Added procedure parameter for handling the separator between
+          levels in the tree.
+          Added HeightOf selector.
+    v1.02  29 Jan 1989  C. Lins
+          Changed to use Key and Data aliases for generic Items.
+     v2.00  08 Oct 1989  C. Lins
+          Created generic pc version
+    v2.01  08 Dec 1989  I.S.C. Houston.
+          Adapted to JPI Compiler:
+          Used type transfer functions instead of VAL.
+          Used shortened library module names for DOS and OS/2.
+
+        (C) Copyright 1989 Charles A. Lins
+===============================================================*)
+
+FROM TreeTypes IMPORT
+    (*--Type*) Key, Data;
+
+FROM TreSUMI IMPORT
+        (*--Type*) Tree, NodePtr,
+        (*--Proc*) RootOf, LeftOf, RightOf, IsNull, KeyOf, DataOf,
+                           IsEmpty;
+
+        (*-----------------------*)
+
+(*
+4.5.1 Utility Selectors
+
+HeightOf returns the height of the given tree. Height may be computed by
+subtracting the level of the ≡lowest≡ node in the tree from the level of
+the root. Complexity O(log2 n).
+*)
+
+PROCEDURE HeightOf (    theTree : Tree     (*--in   *))
+                                                                : CARDINAL (*--out  *);
+
+VAR   maxLevel : CARDINAL; (*-- level of the lowest node so far *)
+
+  PROCEDURE CountLevels (    theNode : NodePtr  (*--in   *);
+                                                         theLevel: CARDINAL (*--in   *));
+  BEGIN
+    IF ~IsNull(theNode) THEN
+          IF (theLevel > maxLevel) THEN
+            maxLevel := theLevel;
+          END (*--if*);
+          CountLevels(LeftOf(theNode), theLevel+1);
+          CountLevels(RightOf(theNode), theLevel+1);
+        END (*--if*);
+  END CountLevels;
+
+BEGIN
+  maxLevel := 1;
+  IF ~IsEmpty(theTree) THEN
+    CountLevels(RootOf(theTree), 1);
+  END (*--if*);
+  RETURN maxLevel - 1;
+END HeightOf;
+(*-------------------------*)
+
+(*
+4.5.2 Debugging Iterators
+
+PrintTree iterates over the given tree such that the nodes may be
+printed. Trees are normally displayed with the root at the top and
+the leaves at the bottom. To simplify the printing process, PrintTree
+displays the tree rotated 90Æ to the left. Thus the root is shown at
+the left of the page/screen with the leaves at the right. Furthermore,
+the left branches are shown towards the bottom of the display and the
+right branches at the top. A constant indentation of two spaces between
+levels is used.
+
+The algorithm used here is a variation on the inorder tree traversal. So
+that the tree is displayed properly rotated, the processing of the left
+and right branches are reversed. This algorithm is derived from that
+given by Wirth [8].
+*)
+
+PROCEDURE PrintTree (    theTree: Tree       (*--in   *);
+                         print  : PrintProc  (*--in   *));
+
+  PROCEDURE DoPrintTree (    theSubtree : NodePtr  (*--in   *);
+                                                         theLevel   : CARDINAL (*--in   *));
+  BEGIN
+    IF ~IsNull(theSubtree) THEN
+          DoPrintTree(RightOf(theSubtree), theLevel+1);
+          print(theLevel, KeyOf(theSubtree), DataOf(theSubtree));
+          DoPrintTree(LeftOf(theSubtree), theLevel+1);
+        END (*--if*);
+  END DoPrintTree;
+
+BEGIN
+  IF ~IsEmpty(theTree) THEN
+    DoPrintTree(RootOf(theTree), 0);
+  END (*--if*);
+END PrintTree;
+(*-------------------------*)
+
+END TreSUMIU.
+
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/bhash.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/bhash.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/bhash.def
@@ -0,0 +1,119 @@
+DEFINITION MODULE BHash;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Hash Table - Sequential Bounded Managed Iterator
+              Collision resolution using double hashing and
+              Brent's Reorganization scheme
+
+    REVISION HISTORY
+    v1.00  13 May 1989  C. Lins:
+        Initial Modula-2 implementation
+    v1.01  30 Jun 1989  C. Lins:
+       Eliminated separation of key and data.
+    v1.02  21 Aug 1989  C. Lins:
+       Added selector HashOf to return hashing function.
+    v1.03  29 Aug 1989  C. Lins:
+       Separate of key and data.
+       Remove increment function from Create.
+
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+==============================================================*)
+
+FROM HashTypes IMPORT
+   (*--type*) Exceptions, FoundProc, NotFoundProc,
+              UpdateProc, LoopProc, AccessProc, HashFunction,
+              States, Key, Data;
+
+FROM ErrorHandling IMPORT
+   (*--type*) HandlerProc;
+
+FROM TypeManager IMPORT
+   (*--type*) TypeID;
+
+   (*-------------------------*)
+
+
+CONST ModuleID = 10;
+
+PROCEDURE TableError () : Exceptions               (*--out  *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                         theHandler : HandlerProc  (*--in   *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                    : HandlerProc  (*--out  *);
+
+
+TYPE  HashTable;
+VAR NullTable : HashTable;
+
+
+PROCEDURE Create   (    keyTypeID  : TypeID        (*--in   *);
+                        dataTypeID : TypeID        (*--in   *);
+                        theSize    : CARDINAL      (*--in   *);
+                        hashFunc   : HashFunction  (*--in   *))
+                                   : HashTable     (*--out  *);
+
+PROCEDURE Destroy  (VAR theTable   : HashTable     (*--inout*));
+
+PROCEDURE Clear    (    theTable   : HashTable     (*--inout*));
+
+PROCEDURE Assign   (    theTable   : HashTable     (*--in   *);
+                    VAR toTable    : HashTable     (*--inout*));
+
+PROCEDURE Insert   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *));
+
+PROCEDURE Remove   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+PROCEDURE Update   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *);
+                        updateEntry: UpdateProc    (*--in   *));
+
+
+PROCEDURE IsDefined (    theTable  : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+
+PROCEDURE IsEmpty  (    theTable   : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+
+PROCEDURE KeyTypeOf (    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+
+PROCEDURE DataTypeOf(    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+
+PROCEDURE HashOf    (    theTable  : HashTable     (*--in   *))
+                                   : HashFunction  (*--out  *);
+
+PROCEDURE SizeOf    (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+
+PROCEDURE ExtentOf  (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+
+PROCEDURE IsPresent    (    theTable   : HashTable     (*--in   *);
+                        theKey     : Key           (*--in   *);
+                        found      : FoundProc     (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+
+PROCEDURE LoopOver (    theTable   : HashTable     (*--in   *);
+                        process    : LoopProc      (*--in   *));
+
+PROCEDURE Traverse (    theTable   : HashTable     (*--in   *);
+                        process    : AccessProc    (*--in   *));
+
+TYPE  IterateProc = PROCEDURE (CARDINAL, States, Key, Data);
+
+PROCEDURE Iterate  (    theTable   : HashTable     (*--in   *);
+                        process    : IterateProc   (*--in   *));
+
+END BHash.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/bhash.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/bhash.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/bhash.mod
@@ -0,0 +1,593 @@
+IMPLEMENTATION MODULE BHash;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Hash Table - Sequential Bounded Managed Iterator
+              Collision resolution using double hashing and
+              Brent's Reorganization scheme
+
+    REVISION HISTORY
+    v1.00  13 May 1989  C. Lins:
+        Initial Modula-2 implementation
+    v1.01  30 Jun 1989  C. Lins:
+       Eliminated separation of key and data.
+    v1.02  21 Aug 1989  C. Lins:
+       Added HashOf selector.
+    v1.03  29 Aug 1989  C. Lins:
+       Separate of key and data.
+       Remove increment function from Create.
+    v1.04  03 Sep 1989  C. Lins:
+       Copy hashing function to target hash table in Assign.
+    v1.05  19 Sep 1989  C. Lins:
+       Pass back result from hash table for key from searches
+       instead of key parameter.
+
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+==============================================================*)
+
+FROM SCLStorage IMPORT
+   (*--proc*) Allocate, Deallocate;
+
+FROM Relations IMPORT
+   (*--type*) Relation;
+
+FROM HashTypes IMPORT
+   (*--type*) Exceptions, Operations, ComponentID,
+              FoundProc, NotFoundProc, UpdateProc, LoopProc,
+              AccessProc, HashFunction, States, Key, Data;
+
+FROM Items IMPORT
+   (*--cons*) NullItem,
+   (*--type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM ErrorHandling IMPORT
+   (*--cons*) NullHandler,
+   (*--type*) HandlerProc,
+   (*--proc*) Raise;
+
+FROM TypeManager IMPORT
+   (*--cons*) NullType,
+   (*--type*) TypeID,
+   (*--proc*) AssignOf, CompareOf, DisposeOf;
+
+   (*-------------------------*)
+
+VAR   tableError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE TableError () : Exceptions               (*--out  *);
+BEGIN
+  RETURN tableError;
+END TableError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                         theHandler : HandlerProc  (*--in   *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                    : HandlerProc  (*--out  *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*--in   *);
+                         theError   : Exceptions  (*--in   *));
+BEGIN
+  tableError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+TYPE  HashTable  = POINTER TO BoundedHashTable;
+TYPE  TableEntry = RECORD
+       state : States;
+       key   : Key;
+       data  : Data;
+     END (*-- TableEntry --*);
+TYPE  HashingTable = ARRAY [0..0] OF TableEntry;
+
+TYPE  BoundedHashTable = RECORD
+       keyID   : TypeID;
+       dataID  : TypeID;
+       h       : HashFunction;
+       size    : CARDINAL;
+       extent  : CARDINAL;
+       table   : HashingTable;
+     END (*-- BoundedHashTable --*);
+
+
+PROCEDURE InitToEmpty (    theTable : HashTable (*--inout*));
+
+VAR   index : CARDINAL;
+
+BEGIN
+  WITH theTable^ DO
+    FOR index := 0 TO size-1 DO
+      table[index].state := empty;
+    END (*--for*);
+  END (*--with*);
+END InitToEmpty;
+(*-------------------------*)
+
+PROCEDURE FreeTableEntry (    theTable : HashTable  (*--in   *);
+                             theEntry : TableEntry (*--inout*));
+
+VAR   free : DisposeProc;  (*-- key/data disposal routine *)
+
+BEGIN
+  free := DisposeOf(theTable^.keyID);
+  free(theEntry.key);
+  free := DisposeOf(theTable^.dataID);
+  free(theEntry.data);
+END FreeTableEntry;
+(*-------------------------*)
+
+PROCEDURE Hash (    hashAddress: CARDINAL  (*--in   *);
+                    tableSize  : CARDINAL  (*--in   *);
+                VAR theBucket  : CARDINAL  (*--out  *);
+                VAR increment  : CARDINAL  (*--out  *));
+BEGIN
+   theBucket   := hashAddress MOD tableSize;
+   increment   := hashAddress DIV tableSize;
+   IF (increment = 0) THEN
+       increment := 1;
+   END (*--if*);
+END Hash;
+(*-------------------------*)
+
+(*
+Search the given hash table for the given key returning the index
+into the hash table where the key was found. Finding an empty
+slot in the table causes the index to the last empty or deleted
+slot encountered during the search.
+*)
+
+PROCEDURE Search   (    theTable   : HashTable     (*--in   *);
+                        theKey     : Key           (*--in   *);
+                    VAR theBucket  : CARDINAL      (*--out  *))
+                                   : BOOLEAN       (*--out  *);
+
+VAR   index    : CARDINAL;     (*-- loop index over table entries *)
+     incr      : CARDINAL;     (*-- increment *)
+     last      : CARDINAL;     (*-- last table entry to examine *)
+     compare   : CompareProc;  (*-- key comparison routine *)
+
+BEGIN
+  theBucket := 0;
+  WITH theTable^ DO
+    compare := CompareOf(keyID);
+   Hash(h(theKey), size, index, incr);
+   last    := (index + (size - 1) * incr) MOD size;
+   WHILE (index # last) DO
+     WITH table[index] DO
+       CASE state OF
+         empty:
+           IF (theBucket = 0) THEN
+             theBucket := index;
+           END (*--if*);
+           RETURN FALSE;
+       | deleted:
+           IF (theBucket = 0) THEN
+             theBucket := index;
+           END (*--if*);
+       | used:
+           IF (compare(theKey, key) = equal) THEN
+             theBucket := index;
+             RETURN TRUE;
+           END (*--if*);
+       END (*--case*);
+     END (*--with*);
+     index := (index + incr) MOD size;
+   END (*--while*);
+  END (*--with*);
+  RETURN FALSE;
+END Search;
+(*-------------------------*)
+
+
+PROCEDURE AddTableEntry (    theTable : HashTable  (*--inout*);
+                            theKey   : Key         (*--in   *);
+                            theData  : Data        (*--in   *);
+                            theProc  : Operations  (*--in   *));
+
+VAR   index    : CARDINAL;     (*-- loop index over buckets *)
+     jndex     : CARDINAL;
+     index1    : CARDINAL;
+     jndex1    : CARDINAL;
+     hashjndex1: CARDINAL;     (*-- increment *)
+     incrjndex1: CARDINAL;     (*-- increment *)
+     initial   : CARDINAL;     (*-- initial hash bucket *)
+     incr      : CARDINAL;     (*-- double hashing increment *)
+
+BEGIN
+  WITH theTable^ DO
+   Hash(h(theKey), size, initial, incr);
+   FOR index := 0 TO extent DO
+     FOR jndex := index TO 0 BY -1 DO
+       jndex1 := (initial + incr * jndex) MOD size;
+       Hash(h(table[jndex1].key), size, hashjndex1, incrjndex1);
+       index1 := ((jndex1 + incrjndex1) * (index-jndex)) MOD size;
+       IF (table[index1].state # used) THEN
+         (*-- move table entry forward *)
+         table[index1] := table[jndex1];
+
+         (*-- insert new table entry at table[jndex1] *)
+         WITH table[jndex1] DO
+           state := used;
+           key   := theKey;
+           data  := theData;
+         END (*--with*);
+         INC(extent);
+         RETURN;
+       END (*--if*);
+     END (*--for*);
+   END (*--for*);
+  END (*--with*);
+  RaiseErrIn(theProc, overflow);
+END AddTableEntry;
+(*-------------------------*)
+
+PROCEDURE Create   (    keyTypeID  : TypeID        (*--in   *);
+                        dataTypeID : TypeID        (*--in   *);
+                        theSize    : CARDINAL      (*--in   *);
+                        hashFunc   : HashFunction  (*--in   *))
+                                   : HashTable     (*--out  *);
+
+CONST baseSize  = SIZE(BoundedHashTable) - SIZE(HashingTable);
+CONST entrySize = SIZE(TableEntry);
+
+VAR   newTable : HashTable; (*--temporary for new hash table object *)
+
+BEGIN
+  tableError := noerr;
+  Allocate(newTable, baseSize + theSize * entrySize);
+  IF (newTable = NullTable) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newTable^ DO
+     keyID  := keyTypeID;
+     dataID := dataTypeID;
+     extent := 0;
+     size   := theSize;
+     h      := hashFunc;
+   END (*--with*);
+   InitToEmpty(newTable);
+  END (*--if*);
+  RETURN newTable;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy  (VAR theTable   : HashTable     (*--inout*));
+CONST baseSize  = SIZE(BoundedHashTable) - SIZE(HashingTable);
+CONST entrySize = SIZE(TableEntry);
+BEGIN
+  Clear(theTable);
+  IF (tableError = noerr) THEN
+    Deallocate(theTable, baseSize + theTable^.size * entrySize);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear        (    theTable   : HashTable     (*--inout*));
+
+VAR   index : CARDINAL;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+   WITH theTable^ DO
+     FOR index := 0 TO size-1 DO
+       IF (table[index].state = used) THEN
+         FreeTableEntry(theTable, table[index]);
+       END (*--if*);
+     END (*--for*);
+     extent := 0;
+   END (*--with*);
+   InitToEmpty(theTable);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign   (    theTable   : HashTable     (*--in   *);
+                    VAR toTable    : HashTable     (*--inout*));
+
+  PROCEDURE RecreateTarget () : BOOLEAN (*--out *);
+  BEGIN
+    IF (theTable = NullTable) THEN
+     RaiseErrIn(assign, undefined);
+    ELSIF (toTable = NullTable) THEN
+     WITH theTable^ DO
+       toTable := Create(keyID, dataID, size, h);
+     END (*--with*);
+    ELSIF (toTable = theTable) THEN
+     RETURN FALSE;
+    ELSIF (toTable^.size >= theTable^.extent) THEN
+     Clear(toTable);
+     WITH theTable^ DO
+       toTable^.keyID  := keyID;
+       toTable^.dataID := dataID;
+       toTable^.h      := h;
+     END (*--with*);
+   ELSE
+     RaiseErrIn(assign, overflow);
+    END (*--if*);
+   RETURN tableError = noerr;
+  END RecreateTarget;
+
+VAR   assignKey  : AssignProc; (*-- key assignment routine *)
+     assignData : AssignProc; (*-- data assignment routine *)
+     index      : CARDINAL;   (*-- loop index over table entries *)
+
+BEGIN
+  tableError := noerr;
+  IF RecreateTarget() THEN
+    WITH theTable^ DO
+      assignKey  := AssignOf(keyID);
+      assignData := AssignOf(dataID);
+     FOR index := 0 TO size-1 DO
+       WITH table[index] DO
+         IF (state = used) THEN
+           Insert(toTable, assignKey(key), assignData(data));
+         END (*--if*);
+       END (*--with*);
+     END (*--for*);
+   END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Adapted from Gonnet. This version detects insertion of duplicates
+by first searching for the given key.
+*)
+
+PROCEDURE Insert   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *));
+
+VAR   index : CARDINAL;        (*-- bucket where item was found, if any *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(insert, undefined);
+  ELSIF Search(theTable, theKey, index) THEN
+   RaiseErrIn(insert, duplicatekey);
+  ELSE
+   AddTableEntry(theTable, theKey, theData, insert);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+PROCEDURE Remove   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+VAR   index    : CARDINAL;     (*-- bucket where key was found *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(remove, undefined);
+  ELSIF Search(theTable, theKey, index) THEN
+   WITH theTable^ DO
+     FreeTableEntry(theTable, table[index]);
+     table[index].state := deleted;
+     DEC(extent);
+   END (*--with*);
+  ELSE
+   notFound(theKey);
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+PROCEDURE Update   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *);
+                        updateEntry: UpdateProc    (*--in   *));
+
+VAR   index : CARDINAL;        (*-- bucket where key was found *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(remove, undefined);
+  ELSIF Search(theTable, theKey, index) THEN
+    updateEntry(theTable^.table[index].key, theTable^.table[index].data, theData);
+  ELSE
+    AddTableEntry(theTable, theKey, theData, update);
+  END (*--if*);
+END Update;
+(*-------------------------*)
+
+
+PROCEDURE IsDefined (    theTable  : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+BEGIN
+  RETURN (theTable # NullTable);
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty  (    theTable   : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(isempty, undefined);
+   RETURN TRUE;
+  END (*--if*);
+  RETURN theTable^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE KeyTypeOf(    theTable   : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(typeof, undefined);
+   RETURN NullType;
+  END (*--if*);
+  RETURN theTable^.keyID;
+END KeyTypeOf;
+(*-------------------------*)
+
+PROCEDURE DataTypeOf(    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(typeof, undefined);
+   RETURN NullType;
+  END (*--if*);
+  RETURN theTable^.dataID;
+END DataTypeOf;
+(*-------------------------*)
+
+PROCEDURE HashOf    (    theTable  : HashTable     (*--in   *))
+                                   : HashFunction  (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(hashof, undefined);
+   RETURN VAL(HashFunction, NIL);
+  END (*--if*);
+  RETURN theTable^.h;
+END HashOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(sizeof, undefined);
+   RETURN 0;
+  END (*--if*);
+  RETURN theTable^.size;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE ExtentOf  (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(extentof, undefined);
+   RETURN 0;
+  END (*--if*);
+  RETURN theTable^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+PROCEDURE IsPresent    (    theTable   : HashTable     (*--in   *);
+                        theKey     : Key           (*--in   *);
+                        found      : FoundProc     (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+VAR   index    : CARDINAL;     (*-- bucket where item was found *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(ispresent, undefined);
+  ELSIF Search(theTable, theKey, index) THEN
+   found(theTable^.table[index].key, theTable^.table[index].data);
+  ELSE
+   notFound(theKey);
+  END (*--if*);
+END IsPresent;
+(*-------------------------*)
+
+
+PROCEDURE LoopOver (    theTable   : HashTable     (*--in   *);
+                        process    : LoopProc      (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+   WITH theTable^ DO
+     FOR index := 0 TO size-1 DO
+       WITH table[index] DO
+         IF (state = used) & ~process(key, data) THEN
+           RETURN;
+         END (*--if*);
+       END (*--with*);
+     END (*--for*);
+   END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theTable   : HashTable     (*--in   *);
+                        process    : AccessProc    (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+   WITH theTable^ DO
+     FOR index := 0 TO size-1 DO
+       WITH table[index] DO
+         IF (state = used) THEN
+           process(key, data);
+         END (*--if*);
+       END (*--with*);
+     END (*--for*);
+   END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+PROCEDURE Iterate  (    theTable   : HashTable     (*--in   *);
+                        process    : IterateProc   (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+   WITH theTable^ DO
+     FOR index := 0 TO size-1 DO
+       WITH table[index] DO
+         CASE state OF
+           used:
+             process(index, state, key, data);
+         | empty, deleted:
+             process(index, state, NullItem, NullItem);
+         END (*--case*);
+       END (*--with*);
+     END (*--for*);
+   END (*--with*);
+  END (*--if*);
+END Iterate;
+(*-------------------------*)
+
+
+BEGIN
+  FOR tableError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(tableError, NullHandler);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  tableError := noerr;
+  NullTable := NIL;
+END BHash.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/dchash.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/dchash.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/dchash.def
@@ -0,0 +1,137 @@
+DEFINITION MODULE DCHash;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Hash Table - Sequential Bounded Managed Iterator
+              Collision resolution using direct chaining
+
+    REVISION HISTORY
+    v1.00  22 Apr 1989  C. Lins:
+        Initial Modula-2 implementation
+    v1.01  12 Jun 1989  C. Lins:
+       Removed notFound procedure parameter from Update. Changed
+       semantics to automatically insert the new entry if not
+       found in the table.
+    v1.02  18 Jun 1989  C. Lins:
+       Eliminated separation of key and data.
+    v1.03  22 Jul 1989  C. Lins:
+       Revised active hash table iterator.
+    v1.04  21 Aug 1989  C. Lins:
+       Added selector HashOf to return hashing function.
+    v1.05  29 Aug 1989  C. Lins:
+       Separate key and data.
+
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+==============================================================*)
+
+FROM HashTypes IMPORT
+   (*--type*) Exceptions, FoundProc, NotFoundProc, States,
+              UpdateProc, LoopProc, AccessProc, HashFunction,
+              Key, Data;
+
+FROM ErrorHandling IMPORT
+   (*--type*) HandlerProc;
+
+FROM TypeManager IMPORT
+   (*--type*) TypeID;
+
+   (*-------------------------*)
+
+
+CONST ModuleID = 2;
+
+PROCEDURE TableError () : Exceptions               (*--out  *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+
+
+TYPE  HashTable;
+VAR   NullTable : HashTable;
+
+
+PROCEDURE Create   (    keyTypeID  : TypeID        (*--in   *);
+                        dataTypeID : TypeID        (*--in   *);
+                        theSize    : CARDINAL      (*--in   *);
+                        hashFunc   : HashFunction  (*--in   *))
+                                   : HashTable     (*--out  *);
+
+PROCEDURE Destroy  (VAR theTable   : HashTable     (*--inout*));
+
+PROCEDURE Clear    (    theTable   : HashTable     (*--inout*));
+
+PROCEDURE Assign   (    theTable   : HashTable     (*--in   *);
+                    VAR toTable    : HashTable     (*--inout*));
+
+PROCEDURE Insert   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *));
+
+PROCEDURE Remove   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+PROCEDURE Update   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *);
+                        updateEntry: UpdateProc    (*--in   *));
+
+
+PROCEDURE IsDefined (    theTable  : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+
+PROCEDURE IsEmpty  (    theTable   : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+
+PROCEDURE KeyTypeOf (    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+
+PROCEDURE DataTypeOf(    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+
+PROCEDURE HashOf    (    theTable  : HashTable     (*--in   *))
+                                   : HashFunction  (*--out  *);
+
+PROCEDURE SizeOf    (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+
+PROCEDURE ExtentOf  (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+
+PROCEDURE IsPresent    (    theTable   : HashTable     (*--in   *);
+                        theKey     : Key           (*--in   *);
+                        found      : FoundProc     (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+
+PROCEDURE LoopOver (    theTable   : HashTable     (*--in   *);
+                        process    : LoopProc      (*--in   *));
+
+PROCEDURE Traverse (    theTable   : HashTable     (*--in   *);
+                        process    : AccessProc    (*--in   *));
+
+
+TYPE  HashTableEntry;
+TYPE  IterateProc = PROCEDURE (CARDINAL, States, HashTableEntry);
+
+PROCEDURE Iterate  (    theTable   : HashTable     (*--in   *);
+                        process    : IterateProc   (*--in   *));
+
+PROCEDURE IsNull   (    theEntry   : HashTableEntry(*--in   *))
+                                   : BOOLEAN       (*--out  *);
+
+PROCEDURE KeyOf    (    theEntry   : HashTableEntry(*--in   *))
+                                   : Key           (*--out  *);
+
+PROCEDURE DataOf   (    theEntry   : HashTableEntry(*--in   *))
+                                   : Data          (*--out  *);
+
+PROCEDURE NextOf   (    theEntry   : HashTableEntry(*--in   *))
+                                   : HashTableEntry(*--out  *);
+
+END DCHash.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/dchash.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/dchash.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/dchash.mod
@@ -0,0 +1,617 @@
+IMPLEMENTATION MODULE DCHash;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Hash Table - Sequential Bounded Managed Iterator
+              Collision resolution using direct chaining.
+              The list of pointers is unordered.
+
+    REVISION HISTORY
+    v1.00  22 Apr 1989  C. Lins:
+        Initial Modula-2 implementation
+    v1.01  12 Jun 1989  C. Lins:
+       Removed notFound procedure parameter from Update. Changed
+       semantics to automatically insert the new entry if not
+       found in the table.
+    v1.02  18 Jun 1989  C. Lins:
+       Eliminated separation of key and data.
+    v1.03  22 Jul 1989  C. Lins:
+       Revised active hash table iterator.
+    v1.04  21 Aug 1989  C. Lins:
+       Add HashOf selector.
+    v1.05  29 Aug 1989  C. Lins:
+       Separate key and data.
+    v1.06  03 Sep 1989  C. Lins:
+       Copy hashing function to target hash table in Assign..
+    v1.07  19 Sep 1989  C. Lins:
+       Pass back result from hash table for key from searches
+       instead of key parameter.
+
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+==============================================================*)
+
+FROM SCLStorage IMPORT
+   (*--proc*) Allocate, Deallocate;
+
+FROM Relations IMPORT
+   (*--type*) Relation;
+
+FROM HashTypes IMPORT
+   (*--type*) Exceptions, Operations, ComponentID, States,
+              FoundProc, NotFoundProc, UpdateProc, LoopProc,
+              AccessProc, HashFunction, Key, Data;
+
+FROM Items IMPORT
+   (*--cons*) NullItem,
+   (*--type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM ErrorHandling IMPORT
+   (*--cons*) NullHandler,
+   (*--type*) HandlerProc,
+   (*--proc*) Raise;
+
+FROM TypeManager IMPORT
+   (*--cons*) NullType,
+   (*--type*) TypeID,
+   (*--proc*) AssignOf, CompareOf, DisposeOf;
+
+   (*-------------------------*)
+
+VAR   tableError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE TableError () : Exceptions               (*--out  *);
+BEGIN
+  RETURN tableError;
+END TableError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*--in   *);
+                         theError   : Exceptions  (*--in   *));
+BEGIN
+  tableError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+TYPE  HashTable  = POINTER TO BoundedHashTable;
+TYPE  TableEntryPtr = POINTER TO TableEntry;
+TYPE  TableEntry = RECORD
+       key   : Key;
+       data  : Data;
+       next  : TableEntryPtr;
+     END (*-- TableEntry --*);
+TYPE  HashingTable = ARRAY [0..0] OF TableEntryPtr;
+
+TYPE  BoundedHashTable = RECORD
+       keyID   : TypeID;
+       dataID  : TypeID;
+       h       : HashFunction;
+       size    : CARDINAL;     (*-- table size *)
+       extent  : CARDINAL;     (*-- # of items in table *)
+       table   : HashingTable; (*-- array [1..size] *)
+     END (*-- BoundedHashTable --*);
+
+
+PROCEDURE InitToEmpty (    theTable : HashTable (*--inout*));
+
+VAR   index : CARDINAL;
+
+BEGIN
+  WITH theTable^ DO
+    FOR index := 0 TO size-1 DO
+      table[index] := NIL;
+    END (*--for*);
+  END (*--with*);
+END InitToEmpty;
+(*-------------------------*)
+
+PROCEDURE FreeTableEntry (    theTable : HashTable  (*--in   *);
+                              theEntry : TableEntry (*--inout*));
+
+VAR   free : DisposeProc;  (*-- Item disposal routine *)
+
+BEGIN
+  free := DisposeOf(theTable^.keyID);
+  free(theEntry.key);
+  free := DisposeOf(theTable^.dataID);
+  free(theEntry.data);
+END FreeTableEntry;
+(*-------------------------*)
+
+(*
+Search the given hash table for the given key returning the index
+into the hash table where the key was found along with pointers
+to the current and prior nodes in the list.
+*)
+
+PROCEDURE Search   (    theTable   : HashTable     (*--in   *);
+                        theKey     : Key           (*--in   *);
+                    VAR theIndex   : CARDINAL      (*--out  *);
+                    VAR priorNode  : TableEntryPtr (*--out  *);
+                    VAR currNode   : TableEntryPtr (*--out  *))
+                                   : BOOLEAN       (*--out  *);
+
+VAR   compare  : CompareProc;  (*-- key comparison routine *)
+
+BEGIN
+  priorNode := NIL;
+  WITH theTable^ DO
+    compare   := CompareOf(keyID);
+    theIndex  := h(theKey) MOD size;
+    currNode  := table[theIndex];
+  END (*--with*);
+  WHILE (currNode # NIL) DO
+   IF (compare(theKey, currNode^.key) = equal) THEN
+     RETURN TRUE;
+   END (*--if*);
+   priorNode:= currNode;
+   currNode := currNode^.next;
+  END (*--while*);
+  RETURN FALSE;
+END Search;
+(*-------------------------*)
+
+PROCEDURE AddTableEntry (    theTable : HashTable  (*--inout*);
+                            theIndex : CARDINAL    (*--in   *);
+                            theKey   : Key         (*--in   *);
+                            theData  : Data        (*--in   *);
+                            theProc  : Operations  (*--in   *));
+
+VAR      newEntry  : TableEntryPtr;
+
+BEGIN
+  Allocate(newEntry, SIZE(TableEntry));
+  IF (newEntry = NIL) THEN
+    RaiseErrIn(theProc, overflow);
+  ELSE
+    WITH newEntry^ DO
+     key  := theKey;
+     data := theData;
+     next := theTable^.table[theIndex];
+    END (*--with*);
+    WITH theTable^ DO
+      table[theIndex] := newEntry;
+      INC(extent);
+    END (*--with*);
+  END (*--if*);
+END AddTableEntry;
+(*-------------------------*)
+
+
+PROCEDURE Create   (    keyTypeID  : TypeID        (*--in   *);
+                        dataTypeID : TypeID        (*--in   *);
+                        theSize    : CARDINAL      (*--in   *);
+                        hashFunc   : HashFunction  (*--in   *))
+                                   : HashTable     (*--out  *);
+
+CONST baseSize  = SIZE(BoundedHashTable) - SIZE(HashingTable);
+CONST entrySize = SIZE(TableEntryPtr);
+
+VAR   newTable : HashTable; (*--temporary for new hash table object *)
+
+BEGIN
+  tableError := noerr;
+  Allocate(newTable, baseSize + theSize * entrySize);
+  IF (newTable = NullTable) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newTable^ DO
+      keyID  := keyTypeID;
+      dataID := dataTypeID;
+      extent := 0;
+      size   := theSize;
+      h      := hashFunc;
+   END (*--with*);
+   InitToEmpty(newTable);
+  END (*--if*);
+  RETURN newTable;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy  (VAR theTable   : HashTable     (*--inout*));
+CONST baseSize  = SIZE(BoundedHashTable) - SIZE(HashingTable);
+CONST entrySize = SIZE(TableEntryPtr);
+BEGIN
+  Clear(theTable);
+  IF (tableError = noerr) THEN
+    Deallocate(theTable, baseSize + theTable^.size * entrySize);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear        (    theTable   : HashTable     (*--inout*));
+
+VAR   index : CARDINAL;
+      curr  : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO size-1 DO
+        WHILE (table[index] # NIL) DO
+          curr := table[index];
+          table[index] := table[index]^.next;
+          FreeTableEntry(theTable, curr^);
+          Deallocate(curr);
+        END (*--while*);
+      END (*--for*);
+      extent := 0;
+    END (*--with*);
+    InitToEmpty(theTable);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign   (    theTable   : HashTable     (*--in   *);
+                    VAR toTable    : HashTable     (*--inout*));
+
+  PROCEDURE RecreateTarget () : BOOLEAN (*--out *);
+  BEGIN
+    IF (theTable = NullTable) THEN
+      RaiseErrIn(assign, undefined);
+    ELSIF (toTable = NullTable) THEN
+      WITH theTable^ DO
+        toTable := Create(keyID, dataID, size, h);
+      END (*--with*);
+    ELSIF (toTable = theTable) THEN
+      RETURN FALSE;
+    ELSIF (toTable^.size >= theTable^.extent) THEN
+      Clear(toTable);
+      WITH theTable^ DO
+        toTable^.keyID  := keyID;
+        toTable^.dataID := dataID;
+        toTable^.h      := h;
+      END (*--with*);
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    RETURN tableError = noerr;
+  END RecreateTarget;
+
+VAR   assignKey  : AssignProc; (*-- key assignment routine *)
+      assignData : AssignProc; (*-- data assignment routine *)
+      index      : CARDINAL;   (*-- loop index over table entries *)
+      current    : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF RecreateTarget() THEN
+    WITH theTable^ DO
+      assignKey  := AssignOf(keyID);
+      assignData := AssignOf(dataID);
+      FOR index := 0 TO size-1 DO
+        current := table[index];
+        WHILE (current # NIL) DO
+          WITH current^ DO
+            Insert(toTable, assignKey(key), assignData(data));
+          END (*--with*);
+          current := current^.next;
+        END (*--while*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Insert   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *));
+
+VAR   index    : CARDINAL;     (*-- bucket where to insert *)
+      prior    : TableEntryPtr;
+      current  : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(insert, undefined);
+  ELSIF Search(theTable, theKey, index, prior, current) THEN
+    RaiseErrIn(insert, duplicatekey);
+  ELSE
+    AddTableEntry(theTable, index, theKey, theData, insert);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+PROCEDURE Remove   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+VAR  index     : CARDINAL;     (*-- bucket where key was found *)
+     prior     : TableEntryPtr;
+     current   : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(remove, undefined);
+  ELSIF Search(theTable, theKey, index, prior, current) THEN
+    IF (prior = NIL) THEN
+      (*-- current is at the head of the list *)
+      theTable^.table[index] := current^.next;
+    ELSE
+      prior^.next := current^.next;
+    END (*--if*);
+    FreeTableEntry(theTable, current^);
+    Deallocate(current);
+    DEC(theTable^.extent);
+  ELSE
+    notFound(theKey);
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+PROCEDURE Update   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *);
+                        updateEntry: UpdateProc    (*--in   *));
+
+VAR  index     : CARDINAL;     (*-- bucket where key was found *)
+     prior     : TableEntryPtr;
+     current   : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(update, undefined);
+  ELSIF Search(theTable, theKey, index, prior, current) THEN
+    updateEntry(current^.key, current^.data, theData);
+  ELSE
+    AddTableEntry(theTable, index, theKey, theData, update);
+  END (*--if*);
+END Update;
+(*-------------------------*)
+
+
+PROCEDURE IsDefined (    theTable  : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+BEGIN
+  RETURN (theTable # NullTable);
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty  (    theTable   : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(isempty, undefined);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN theTable^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE KeyTypeOf (    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(typeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theTable^.keyID;
+END KeyTypeOf;
+(*-------------------------*)
+
+PROCEDURE DataTypeOf(    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(typeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theTable^.dataID;
+END DataTypeOf;
+(*-------------------------*)
+
+PROCEDURE HashOf    (    theTable  : HashTable     (*--in   *))
+                                   : HashFunction  (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(hashof, undefined);
+    RETURN VAL(HashFunction, NIL);
+  END (*--if*);
+  RETURN theTable^.h;
+END HashOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(sizeof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theTable^.size;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE ExtentOf  (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(extentof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theTable^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+PROCEDURE IsPresent    (    theTable   : HashTable     (*--in   *);
+                            theKey     : Key           (*--in   *);
+                            found      : FoundProc     (*--in   *);
+                            notFound   : NotFoundProc  (*--in   *));
+
+VAR  index     : CARDINAL;     (*-- bucket where item was found *)
+     prior     : TableEntryPtr;
+     current   : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(ispresent, undefined);
+  ELSIF Search(theTable, theKey, index, prior, current) THEN
+    found(current^.key, current^.data);
+  ELSE
+    notFound(theKey);
+  END (*--if*);
+END IsPresent;
+(*-------------------------*)
+
+
+PROCEDURE LoopOver (    theTable   : HashTable     (*--in   *);
+                        process    : LoopProc      (*--in   *));
+
+VAR  index : CARDINAL;        (*-- loop index over hashing table *)
+     curr  : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO size-1 DO
+        curr := table[index];
+        WHILE (curr # NIL) DO
+          WITH curr^ DO
+            IF ~process(key, data) THEN
+              RETURN;
+            END (*--if*);
+            curr := next;
+          END (*--with*);
+        END (*--while*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theTable   : HashTable     (*--in   *);
+                        process    : AccessProc    (*--in   *));
+
+VAR  index : CARDINAL;        (*-- loop index over hashing table *)
+     curr  : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO size-1 DO
+        curr := table[index];
+        WHILE (curr # NIL) DO
+          WITH curr^ DO
+            process(key, data);
+            curr := next;
+          END (*--with*);
+        END (*--while*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+TYPE  HashTableEntry = POINTER TO TableEntry;
+CONST NullTableEntry = NIL;
+
+VAR   entryState : ARRAY BOOLEAN OF States;
+
+PROCEDURE Iterate  (    theTable   : HashTable     (*--in   *);
+                        process    : IterateProc   (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO size-1 DO
+        process(index, entryState[table[index] # NIL],
+                       VAL(HashTableEntry, table[index]));
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Iterate;
+(*-------------------------*)
+
+PROCEDURE IsNull   (    theEntry   : HashTableEntry    (*--in   *))
+                                   : BOOLEAN           (*--out  *);
+BEGIN
+  RETURN theEntry = NullTableEntry;
+END IsNull;
+(*-------------------------*)
+
+PROCEDURE KeyOf        (    theEntry   : HashTableEntry(*--in   *))
+                                       : Key           (*--out  *);
+BEGIN
+  IF (theEntry = NullTableEntry) THEN
+   RETURN NullItem;
+  ELSE
+    RETURN theEntry^.key;
+  END (*--if*);
+END KeyOf;
+(*-------------------------*)
+
+PROCEDURE DataOf   (    theEntry   : HashTableEntry    (*--in   *))
+                                   : Data              (*--out  *);
+BEGIN
+  IF (theEntry = NullTableEntry) THEN
+    RETURN NullItem;
+  ELSE
+    RETURN theEntry^.data;
+  END (*--if*);
+END DataOf;
+(*-------------------------*)
+
+PROCEDURE NextOf   (    theEntry   : HashTableEntry    (*--in   *))
+                                   : HashTableEntry    (*--out  *);
+
+BEGIN
+  IF (theEntry = NullTableEntry) THEN
+    RETURN NullTableEntry;
+  ELSE
+    RETURN VAL(HashTableEntry, theEntry^.next);
+  END (*--if*);
+END NextOf;
+(*-------------------------*)
+
+BEGIN
+  FOR tableError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(tableError, NullHandler);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  tableError := noerr;
+  entryState[FALSE] := empty;
+  entryState[TRUE ] := used;
+  NullTable := NIL;
+END DCHash.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/dhash.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/dhash.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/dhash.def
@@ -0,0 +1,122 @@
+DEFINITION MODULE DHash;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Hash Table - Sequential Bounded Managed Iterator
+              Collision resolution using double hashing
+
+    REVISION HISTORY
+    v1.00  22 Apr 1989  C. Lins:
+        Initial Modula-2 implementation
+    v1.01  13 Jun 1989  C. Lins:
+       Removed notFound procedure parameter from Update. Changed
+       semantics to automatically insert the new entry if not
+       found in the table.
+    v1.02  30 Jun 1989  C. Lins:
+       Removed separation of key and data.
+    v1.03  21 Aug 1989  C. Lins:
+       Removed increment function from Create.
+       Added selector HashOf to return hashing function.
+    v1.04  29 Aug 1989  C. Lins:
+       Separate of key and data.
+
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+==============================================================*)
+
+FROM HashTypes IMPORT
+   (*--type*) Exceptions, FoundProc, NotFoundProc,
+              UpdateProc, LoopProc, AccessProc, HashFunction,
+              States, Key, Data;
+
+FROM ErrorHandling IMPORT
+   (*--type*) HandlerProc;
+
+FROM TypeManager IMPORT
+   (*--type*) TypeID;
+
+   (*-------------------------*)
+
+
+CONST ModuleID = 3;
+
+PROCEDURE TableError () : Exceptions               (*--out  *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                         theHandler : HandlerProc  (*--in   *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                    : HandlerProc  (*--out  *);
+
+
+TYPE  HashTable;
+VAR   NullTable : HashTable;
+
+
+PROCEDURE Create   (    keyTypeID  : TypeID        (*--in   *);
+                        dataTypeID : TypeID        (*--in   *);
+                        theSize    : CARDINAL      (*--in   *);
+                        hashFunc   : HashFunction  (*--in   *))
+                                   : HashTable     (*--out  *);
+
+PROCEDURE Destroy  (VAR theTable   : HashTable     (*--inout*));
+
+PROCEDURE Clear    (    theTable   : HashTable     (*--inout*));
+
+PROCEDURE Assign   (    theTable   : HashTable     (*--in   *);
+                    VAR toTable    : HashTable     (*--inout*));
+
+PROCEDURE Insert   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *));
+
+PROCEDURE Remove   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+PROCEDURE Update   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *);
+                        updateEntry: UpdateProc    (*--in   *));
+
+
+PROCEDURE IsDefined (    theTable  : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+
+PROCEDURE IsEmpty  (    theTable   : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+
+PROCEDURE KeyTypeOf (    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+
+PROCEDURE DataTypeOf(    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+
+PROCEDURE HashOf    (    theTable  : HashTable     (*--in   *))
+                                   : HashFunction  (*--out  *);
+
+PROCEDURE SizeOf    (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+
+PROCEDURE ExtentOf  (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+
+PROCEDURE IsPresent (    theTable   : HashTable    (*--in   *);
+                         theKey     : Key          (*--in   *);
+                         found      : FoundProc    (*--in   *);
+                         notFound   : NotFoundProc (*--in   *));
+
+
+PROCEDURE LoopOver  (    theTable   : HashTable    (*--in   *);
+                         process    : LoopProc     (*--in   *));
+
+PROCEDURE Traverse  (    theTable   : HashTable    (*--in   *);
+                         process    : AccessProc   (*--in   *));
+
+TYPE  IterateProc = PROCEDURE (CARDINAL, States, Key, Data);
+
+PROCEDURE Iterate   (    theTable   : HashTable    (*--in   *);
+                         process    : IterateProc  (*--in   *));
+
+END DHash.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/dhash.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/dhash.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/dhash.mod
@@ -0,0 +1,565 @@
+IMPLEMENTATION MODULE DHash;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Hash Table - Sequential Bounded Managed Iterator
+              Collision resolution using double hashing
+
+    REVISION HISTORY
+    v1.00  22 Apr 1989  C. Lins:
+        Initial Modula-2 implementation
+    v1.01  13 Jun 1989  C. Lins:
+       Removed notFound procedure parameter from Update. Changed
+       semantics to automatically insert the new entry if not
+       found in the table.
+    v1.02  30 Jun 1989  C. Lins:
+       Removed separation of key and data.
+    v1.03  21 Aug 1989  C. Lins:
+       Removed increment function from Create.
+       Added selector HashOf to return hashing function.
+    v1.04  29 Aug 1989  C. Lins:
+       Separate of key and data.
+    v1.05  03 Sep 1989  C. Lins:
+       Copy hashing function to target hash table in Assign.
+    v1.06  19 Sep 1989  C. Lins:
+       Pass back result from hash table for key from searches
+       instead of key parameter.
+
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+==============================================================*)
+
+FROM SCLStorage IMPORT
+   (*--proc*) Allocate, Deallocate;
+
+FROM Relations IMPORT
+   (*--type*) Relation;
+
+FROM HashTypes IMPORT
+   (*--type*) Exceptions, Operations, ComponentID,
+              FoundProc, NotFoundProc, UpdateProc, LoopProc,
+              AccessProc, HashFunction, States, Key, Data;
+
+FROM Items IMPORT
+   (*--cons*) NullItem,
+   (*--type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM ErrorHandling IMPORT
+   (*--cons*) NullHandler,
+   (*--type*) HandlerProc,
+   (*--proc*) Raise;
+
+FROM TypeManager IMPORT
+   (*--cons*) NullType,
+   (*--type*) TypeID,
+   (*--proc*) AssignOf, CompareOf, DisposeOf;
+
+   (*-------------------------*)
+
+
+TYPE  HashTable  = POINTER TO BoundedHashTable;
+TYPE  TableEntry = RECORD
+        state : States;
+        key   : Key;
+        data  : Data;
+      END (*-- TableEntry --*);
+TYPE  HashingTable = ARRAY [0..0] OF TableEntry;
+
+TYPE  BoundedHashTable = RECORD
+        keyID   : TypeID;
+        dataID  : TypeID;
+        h       : HashFunction;
+        size    : CARDINAL;
+        extent  : CARDINAL;
+        table   : HashingTable;
+      END (*-- BoundedHashTable --*);
+
+   (*-------------------------*)
+
+
+VAR   tableError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE TableError () : Exceptions               (*--out  *);
+BEGIN
+  RETURN tableError;
+END TableError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*--in   *);
+                          theError   : Exceptions  (*--in   *));
+BEGIN
+  tableError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+PROCEDURE InitToEmpty (    theTable : HashTable (*--inout*));
+
+VAR   index : CARDINAL;
+
+BEGIN
+  WITH theTable^ DO
+    FOR index := 0 TO size-1 DO
+      table[index].state := empty;
+    END (*--for*);
+  END (*--with*);
+END InitToEmpty;
+(*-------------------------*)
+
+PROCEDURE FreeTableEntry (    theTable : HashTable  (*--in   *);
+                              theEntry : TableEntry (*--inout*));
+
+VAR   free : DisposeProc;  (*-- key/data disposal routine *)
+
+BEGIN
+  free := DisposeOf(theTable^.keyID);
+  free(theEntry.key);
+  free := DisposeOf(theTable^.dataID);
+  free(theEntry.data);
+END FreeTableEntry;
+(*-------------------------*)
+
+PROCEDURE AddTableEntry (    theTable : HashTable   (*--inout*);
+                             theIndex : CARDINAL    (*--in   *);
+                             theKey   : Key         (*--in   *);
+                             theData  : Data        (*--in   *));
+BEGIN
+  WITH theTable^ DO
+    WITH table[theIndex] DO
+      state := used;
+      key   := theKey;
+      data  := theData;
+    END (*--with*);
+    INC(extent);
+  END (*--with*);
+END AddTableEntry;
+(*-------------------------*)
+
+(*
+Search the given hash table for the given key returning the index
+into the hash table where the key was found. Finding an empty
+slot in the table causes the index to the last empty or deleted
+slot encountered during the search.
+*)
+
+PROCEDURE Search   (    theTable   : HashTable     (*--in   *);
+                        theKey     : Key           (*--in   *);
+                    VAR theBucket  : CARDINAL      (*--out  *))
+                                   : BOOLEAN       (*--out  *);
+
+VAR  index     : CARDINAL;     (*-- loop index over table entries *)
+     inc       : CARDINAL;     (*-- increment *)
+     last      : CARDINAL;     (*-- last table entry to examine *)
+     hashAddr  : CARDINAL;     (*-- hash address *)
+     compare   : CompareProc;  (*-- key comparison routine *)
+
+BEGIN
+  theBucket := 0;
+  WITH theTable^ DO
+    compare := CompareOf(keyID);
+    hashAddr:= h(theKey);
+    index   := hashAddr MOD size;
+    inc     := hashAddr DIV size;
+    IF (inc = 0) THEN
+      inc := 1;
+    END (*--if*);
+    last := (index + (size - 1) * inc) MOD size;
+    WHILE (index # last) DO
+      WITH table[index] DO
+        CASE state OF
+          empty:
+            IF (theBucket = 0) THEN
+              theBucket := index;
+            END (*--if*);
+            RETURN FALSE;
+        | deleted:
+            IF (theBucket = 0) THEN
+              theBucket := index;
+            END (*--if*);
+        | used:
+            IF (compare(theKey, key) = equal) THEN
+              theBucket := index;
+              RETURN TRUE;
+            END (*--if*);
+        END (*--case*);
+      END (*--with*);
+      index := (index+inc) MOD size;
+    END (*--while*);
+  END (*--with*);
+  RETURN FALSE;
+END Search;
+(*-------------------------*)
+
+
+PROCEDURE Create   (    keyTypeID  : TypeID        (*--in   *);
+                        dataTypeID : TypeID        (*--in   *);
+                        theSize    : CARDINAL      (*--in   *);
+                        hashFunc   : HashFunction  (*--in   *))
+                                   : HashTable     (*--out  *);
+
+CONST baseSize  = SIZE(BoundedHashTable) - SIZE(HashingTable);
+CONST entrySize = SIZE(TableEntry);
+
+VAR   newTable : HashTable; (*--temporary for new hash table object *)
+
+BEGIN
+  tableError := noerr;
+  Allocate(newTable, baseSize + theSize * entrySize);
+  IF (newTable = NullTable) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newTable^ DO
+      keyID  := keyTypeID;
+      dataID := dataTypeID;
+      extent := 0;
+      size   := theSize;
+      h      := hashFunc;
+    END (*--with*);
+    InitToEmpty(newTable);
+  END (*--if*);
+  RETURN newTable;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy  (VAR theTable   : HashTable     (*--inout*));
+CONST baseSize  = SIZE(BoundedHashTable) - SIZE(HashingTable);
+CONST entrySize = SIZE(TableEntry);
+BEGIN
+  Clear(theTable);
+  IF (tableError = noerr) THEN
+    Deallocate(theTable, baseSize + theTable^.size * entrySize);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear        (    theTable   : HashTable     (*--inout*));
+
+VAR   index : CARDINAL;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO size-1 DO
+        IF (table[index].state = used) THEN
+          FreeTableEntry(theTable, table[index]);
+        END (*--if*);
+      END (*--for*);
+      extent := 0;
+    END (*--with*);
+    InitToEmpty(theTable);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign   (    theTable   : HashTable     (*--in   *);
+                    VAR toTable    : HashTable     (*--inout*));
+
+  PROCEDURE RecreateTarget () : BOOLEAN (*--out *);
+  BEGIN
+    IF (theTable = NullTable) THEN
+      RaiseErrIn(assign, undefined);
+    ELSIF (toTable = NullTable) THEN
+      WITH theTable^ DO
+        toTable := Create(keyID, dataID, size, h);
+      END (*--with*);
+    ELSIF (toTable = theTable) THEN
+      RETURN FALSE;
+    ELSIF (toTable^.size >= theTable^.extent) THEN
+      Clear(toTable);
+      WITH theTable^ DO
+        toTable^.keyID  := keyID;
+        toTable^.dataID := dataID;
+        toTable^.h      := h;
+      END (*--with*);
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    RETURN tableError = noerr;
+  END RecreateTarget;
+
+VAR   assignKey  : AssignProc; (*-- key assignment routine *)
+      assignData : AssignProc; (*-- data assignment routine *)
+      index      : CARDINAL;   (*-- loop index over table entries *)
+
+BEGIN
+  tableError := noerr;
+  IF RecreateTarget() THEN
+    WITH theTable^ DO
+      assignKey  := AssignOf(keyID);
+      assignData := AssignOf(dataID);
+      FOR index := 0 TO size-1 DO
+        WITH table[index] DO
+          IF (state = used) THEN
+            Insert(toTable, assignKey(key), assignData(data));
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Insert   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *));
+
+VAR   index : CARDINAL;        (*-- bucket where to insert *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(insert, undefined);
+  ELSIF (theTable^.extent = theTable^.size) THEN
+    RaiseErrIn(insert, overflow);
+  ELSIF Search(theTable, theKey, index) THEN
+    RaiseErrIn(insert, duplicatekey);
+  ELSE
+    AddTableEntry(theTable, index, theKey, theData);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+PROCEDURE Remove   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+VAR   index : CARDINAL;        (*-- bucket where key was found *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(remove, undefined);
+  ELSIF Search(theTable, theKey, index) THEN
+    WITH theTable^ DO
+      FreeTableEntry(theTable, table[index]);
+      table[index].state := deleted;
+      DEC(extent);
+    END (*--with*);
+  ELSE
+    notFound(theKey);
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+PROCEDURE Update   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *);
+                        updateEntry: UpdateProc    (*--in   *));
+
+VAR   index : CARDINAL;        (*-- bucket where key was found *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(update, undefined);
+  ELSIF Search(theTable, theKey, index) THEN
+    updateEntry(theTable^.table[index].key, theTable^.table[index].data, theData);
+  ELSIF (theTable^.extent = theTable^.size) THEN
+    RaiseErrIn(insert, overflow);
+  ELSE
+    AddTableEntry(theTable, index, theKey, theData);
+  END (*--if*);
+END Update;
+(*-------------------------*)
+
+
+PROCEDURE IsDefined (    theTable  : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+BEGIN
+  RETURN (theTable # NullTable);
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty  (    theTable   : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(isempty, undefined);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN theTable^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE KeyTypeOf (    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(typeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theTable^.keyID;
+END KeyTypeOf;
+(*-------------------------*)
+
+PROCEDURE DataTypeOf(    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(typeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theTable^.dataID;
+END DataTypeOf;
+(*-------------------------*)
+
+PROCEDURE HashOf    (    theTable  : HashTable     (*--in   *))
+                                   : HashFunction  (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(hashof, undefined);
+    RETURN VAL(HashFunction, NIL);
+  END (*--if*);
+  RETURN theTable^.h;
+END HashOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(sizeof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theTable^.size;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE ExtentOf  (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(extentof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theTable^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+PROCEDURE IsPresent(    theTable   : HashTable     (*--in   *);
+                        theKey     : Key           (*--in   *);
+                        found      : FoundProc     (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+VAR   index : CARDINAL;        (*-- bucket where item was found *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(ispresent, undefined);
+  ELSIF Search(theTable, theKey, index) THEN
+    found(theTable^.table[index].key, theTable^.table[index].data);
+  ELSE
+    notFound(theKey);
+  END (*--if*);
+END IsPresent;
+(*-------------------------*)
+
+
+PROCEDURE LoopOver (    theTable   : HashTable     (*--in   *);
+                        process    : LoopProc      (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO size-1 DO
+        WITH table[index] DO
+          IF (state = used) & ~process(key, data) THEN
+            RETURN;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theTable   : HashTable     (*--in   *);
+                        process    : AccessProc    (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO size-1 DO
+        WITH table[index] DO
+          IF (state = used) THEN
+            process(key, data);
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+PROCEDURE Iterate  (    theTable   : HashTable     (*--in   *);
+                        process    : IterateProc   (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO size-1 DO
+        WITH table[index] DO
+          CASE state OF
+            used:
+              process(index, state, key, data);
+          | empty, deleted:
+              process(index, state, NullItem, NullItem);
+          END (*--case*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Iterate;
+(*-------------------------*)
+
+
+BEGIN
+  FOR tableError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(tableError, NullHandler);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  tableError := noerr;
+  NullTable := NIL;
+END DHash.

diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/hashhand.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/hashhand.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/hashhand.def
@@ -0,0 +1,24 @@
+(*
+This module provides standard exception handlers for the various Hast Table
+ADT modules. WriteHandler issues a message to standard output identifying
+the module, exception and routine.
+*)
+
+DEFINITION MODULE HashHand; 
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Hash Table Exception Handlers Utility
+
+    REVISION HISTORY
+    v1.00  20 Apr 1989  C. Lins:
+        Initial implementation
+==============================================================*)
+
+FROM ErrorHandling IMPORT
+   (*--type*) ErrorCode;
+
+
+PROCEDURE WriteHandler (    theError : ErrorCode (*--in   *));
+
+END HashHand.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/hashhand.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/hashhand.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/hashhand.mod
@@ -0,0 +1,84 @@
+IMPLEMENTATION MODULE HashHand; 
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Hash Table Exception Handlers Utility
+
+    REVISION HISTORY
+    v1.00  20 Apr 1989  C. Lins:
+        Initial implementation
+    v1.01  22 Apr 1989  C. Lins:
+        Added Iterate operation.
+    v1.02  21 Aug 1989  C. Lins:
+        Added HashOf to list of operations.
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+==============================================================*)
+
+FROM ErrorHandling IMPORT
+   (*--type*) ErrorCode,
+   (*--proc*) Unpack;
+
+FROM HashTypes IMPORT
+   (*--type*) Exceptions, Operations;
+
+FROM Utilities IMPORT
+   (*--proc*) SysBeep;
+
+FROM InOut IMPORT
+   (*--proc*) WriteString, WriteLn, WriteCard;
+
+
+PROCEDURE WriteHandler (    theError : ErrorCode (*--in   *));
+
+VAR   theModule   : CARDINAL;
+      theOperation: Operations;
+      theException: Exceptions;
+
+BEGIN
+  SysBeep(0);
+  Unpack(theError, theModule, theOperation, theException);
+
+  WriteString('### Error "');
+
+  CASE theException OF
+    noerr        : WriteString('No Error');
+  | duplicatekey : WriteString('Duplicate Key');
+  | overflow     : WriteString('Overflow');
+  | notfound     : WriteString('Key not found');
+  | undefined    : WriteString('Undefined Hash Table');
+  END (*--case*);
+
+  WriteString('" raised in Routine "');
+
+  CASE theOperation OF
+    assign   : WriteString('Assign');
+  | create   : WriteString('Create');
+  | destroy  : WriteString('Destroy');
+  | clear    : WriteString('Clear');
+  | insert   : WriteString('Insert');
+  | remove   : WriteString('Remove');
+  | update   : WriteString('Update');
+ 
+  | isempty    : WriteString('IsEmpty');
+  | typeof     : WriteString('TypeOf');
+  | hashof     : WriteString('HashOf');
+  | sizeof     : WriteString('SizeOf');
+  | extentof   : WriteString('ExtentOf');
+  | ispresent  : WriteString('IsPresent');
+   
+  | loopover   : WriteString('LoopOver');
+  | traverse   : WriteString('Traverse');
+  | iterate    : WriteString('Iterate');
+  ELSE
+    WriteString('Unknown');
+  END (*--case*);
+
+  WriteString('" in Module ');
+  WriteCard(theModule, 1);
+  WriteLn;
+END WriteHandler;
+(*-------------------------*)
+
+END HashHand.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/hashtype.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/hashtype.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/hashtype.def
@@ -0,0 +1,99 @@
+DEFINITION MODULE HashType; 
+(*=============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Hash Table Structure Utility - Standard Types
+
+    THE ABSTRACTION
+    This module provides centralized definitions of the operations
+    and exceptions for all hash table modules.
+
+    REVISION HISTORY
+    v1.00  19 Apr 1989  C. Lins:
+        Initial implementation
+    v1.01  22 Apr 1989  C. Lins:
+        Added iterate to Operations enumeration.
+       Added notprime to Exceptions enumeration.
+    v1.02  18 Jun 1989  C. Lins:
+       Eliminated separate key and data items. It's now assumed
+       that they're part of a larger structure. This is more
+       in keeping with how hash tables are typically used.
+    v1.03  21 Aug 1989  C. Lins:
+       Added hashof to operations enumeration.
+    v1.04  29 Aug 1989  C. Lins:
+       Separate key and data.
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+=============================================================*)
+
+FROM Items IMPORT
+   (*--type*) Item;
+
+
+CONST ComponentID = 256 * 12;
+
+
+    (*---------------------------------*)
+    (*--    HASH TABLE OPERATIONS    --*)
+
+TYPE  Operations = (
+                    (*-- Module Initialization *)
+                    modinit,
+
+                    (*-- Constructors *)
+                    create, destroy, clear, assign,
+                    insert, remove, update,
+
+                    (*-- Selectors *)
+                    isdefined, isempty, sizeof, typeof, hashof,
+                    extentof, ispresent,
+
+                    (*-- Iterators *)
+                    loopover, traverse, iterate,
+
+                    (*-- Guarded Concurrent Operations *)
+                    seize, release
+                   );
+
+TYPE  Constructors = Operations [ create    .. update    ];
+TYPE  Selectors    = Operations [ isdefined .. ispresent ];
+TYPE  Iterators    = Operations [ loopover  .. iterate   ];
+TYPE  GuardedOps   = Operations [ seize     .. release   ];
+
+
+    (*---------------------------------*)
+    (*--    HASH TABLE EXCEPTIONS    --*)
+
+TYPE  Exceptions = (noerr,        (*-- Nothing went wrong. *)
+                    initfailed,   (*-- Initialization failure. *)
+                    duplicatekey, (*-- key exists in table *)
+                    notfound,     (*-- key not in table *)
+                    overflow,     (*-- Table cannot grow big enough
+                                    -- for the requested operation.*)
+                    undefined     (*-- Table has not been Created, or
+                                    -- the tree has been Destroyed.*)
+                   );
+
+TYPE  ExceptionSet = SET OF Exceptions;
+
+
+    (*---------------------------------*)
+    (*--  HASH TABLE UTILITY TYPES   --*)
+
+TYPE  States = (empty, deleted, used);
+
+TYPE  Key  = Item;
+TYPE  Data = Item;
+
+    (*---------------------------------*)
+    (*-- HASH TABLE PROCEDURE TYPES  --*)
+
+TYPE  AccessProc   = PROCEDURE (Key, VAR Data);
+TYPE  FoundProc    = PROCEDURE (Key, VAR Data);
+TYPE  HashFunction = PROCEDURE (Key) : CARDINAL;
+TYPE  LoopProc     = PROCEDURE (Key, VAR Data) : BOOLEAN;
+TYPE  NotFoundProc = PROCEDURE (Key);
+TYPE  UpdateProc   = PROCEDURE (Key, VAR Data, Data);
+
+END HashType.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/hashtype.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/hashtype.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/hashtype.mod
@@ -0,0 +1,3 @@
+IMPLEMENTATION MODULE HashType;
+
+END HashType.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/lhash.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/lhash.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/lhash.def
@@ -0,0 +1,138 @@
+DEFINITION MODULE LHash;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Hash Table - Sequential Unbounded Managed Iterator
+              Linear hashing
+
+    REVISION HISTORY
+    v1.00  23 Apr 1989  C. Lins:
+        Initial Modula-2 implementation
+    v1.01  30 Jun 1989  C. Lins:
+        Removed separation of key and data.
+    v1.02  12 Aug 1989  C. Lins:
+        Change table to VAR parameter in Insert, Remove, Update.
+    v1.03  13 Aug 1989  C. Lins:
+        Changed active iteration mechanism to match that for
+       Direct Chaining.
+    v1.04  21 Aug 1989  C. Lins:
+       Added HashOf selector.
+    v1.05  29 Aug 1989  C. Lins:
+       Separate key and data.
+
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+==============================================================*)
+
+FROM HashTypes IMPORT
+   (*--type*) Exceptions, States, FoundProc, NotFoundProc,
+              UpdateProc, LoopProc, AccessProc, HashFunction,
+              Key, Data;
+
+FROM ErrorHandling IMPORT
+   (*--type*) HandlerProc;
+
+FROM TypeManager IMPORT
+   (*--type*) TypeID;
+
+   (*-------------------------*)
+
+
+CONST ModuleID = 9;
+
+PROCEDURE TableError () : Exceptions               (*--out  *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+
+
+TYPE  HashTable;
+VAR   NullTable : HashTable;
+
+
+PROCEDURE Create   (    keyTypeID  : TypeID        (*--in   *);
+                        dataTypeID : TypeID        (*--in   *);
+                        theSize    : CARDINAL      (*--in   *);
+                        minLoadFact: REAL          (*--in   *);
+                        maxLoadFact: REAL          (*--in   *);
+                        hashFunc   : HashFunction  (*--in   *))
+                                   : HashTable     (*--out  *);
+
+PROCEDURE Destroy  (VAR theTable   : HashTable     (*--inout*));
+
+PROCEDURE Clear    (    theTable   : HashTable     (*--inout*));
+
+PROCEDURE Assign   (    theTable   : HashTable     (*--in   *);
+                    VAR toTable    : HashTable     (*--inout*));
+
+PROCEDURE Insert   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *));
+
+PROCEDURE Remove   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+PROCEDURE Update   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *);
+                        updateEntry: UpdateProc    (*--in   *));
+
+
+PROCEDURE IsDefined (    theTable  : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+
+PROCEDURE IsEmpty  (    theTable   : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+
+PROCEDURE KeyTypeOf (    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+
+PROCEDURE DataTypeOf(    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+
+PROCEDURE HashOf    (    theTable  : HashTable     (*--in   *))
+                                   : HashFunction  (*--out  *);
+
+PROCEDURE SizeOf    (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+
+PROCEDURE ExtentOf  (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+
+PROCEDURE IsPresent(    theTable   : HashTable     (*--in   *);
+                        theKey     : Key           (*--in   *);
+                        found      : FoundProc     (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+
+PROCEDURE LoopOver (    theTable   : HashTable     (*--in   *);
+                        process    : LoopProc      (*--in   *));
+
+PROCEDURE Traverse (    theTable   : HashTable     (*--in   *);
+                        process    : AccessProc    (*--in   *));
+
+
+TYPE  HashTableEntry;
+TYPE  IterateProc = PROCEDURE (CARDINAL, States, HashTableEntry);
+
+PROCEDURE Iterate  (    theTable   : HashTable     (*--in   *);
+                        process    : IterateProc   (*--in   *));
+
+PROCEDURE IsNull   (    theEntry   : HashTableEntry(*--in   *))
+                                   : BOOLEAN       (*--out  *);
+
+PROCEDURE KeyOf    (    theEntry   : HashTableEntry(*--in   *))
+                                   : Key           (*--out  *);
+
+PROCEDURE DataOf   (    theEntry   : HashTableEntry(*--in   *))
+                                   : Data          (*--out  *);
+
+PROCEDURE NextOf   (    theEntry   : HashTableEntry(*--in   *))
+                                   : HashTableEntry(*--out  *);
+
+END LHash.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/lhash.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/lhash.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/lhash.mod
@@ -0,0 +1,826 @@
+IMPLEMENTATION MODULE LHash;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Hash Table - Sequential Unbounded Managed Iterator
+              Linear hashing
+
+    REVISION HISTORY
+    v1.00  23 Apr 1989  C. Lins:
+        Initial Modula-2 implementation
+    v1.01  30 Jun 1989  C. Lins:
+        Removed separation of key and data.
+    v1.02  12 Aug 1989  C. Lins:
+        Change table to VAR parameter in Insert, Remove, Update.
+       Fixed setting of currSize in Clear.
+       Optimized Assign to directly call AddTableEntry.
+    v1.03  13 Aug 1989  C. Lins:
+        Changed active iteration mechanism to match that for
+       Direct Chaining.
+    v1.04  21 Aug 1989  C. Lins:
+       Added HashOf selector.
+       Removed calls to HUnlock since HSetState restores the
+       handle bits correctly.
+    v1.05  29 Aug 1989  C. Lins:
+       Separate key and data.
+    v1.06  03 Sep 1989  C. Lins:
+       Copy hashing function to target hash table in Assign.
+    v1.07  09 Sep 1989  C. Lins:
+       Pass back result from hash table for key from searches
+       instead of key parameter.
+
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+==============================================================*)
+
+FROM SCLStorage IMPORT
+   (*--proc*) Allocate, Deallocate;
+
+FROM MacTypes IMPORT
+   (*--type*) SignedByte;
+
+FROM MemoryManager IMPORT
+   (*--cons*) noErr,
+   (*--type*) Size,
+   (*--proc*) MemError, SetHandleSize, GetHandleSize,
+              NewHandle, DisposHandle, HLock,
+              HSetState, HGetState;
+
+FROM Relations IMPORT
+   (*--type*) Relation;
+
+FROM HashTypes IMPORT
+   (*--type*) Exceptions, Operations, States, ComponentID,
+              FoundProc, NotFoundProc, UpdateProc, LoopProc,
+              AccessProc, HashFunction, Key, Data;
+
+FROM Items IMPORT
+   (*--cons*) NullItem,
+   (*--type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM ErrorHandling IMPORT
+   (*--cons*) NullHandler,
+   (*--type*) HandlerProc,
+   (*--proc*) Raise;
+
+FROM TypeManager IMPORT
+   (*--cons*) NullType,
+   (*--type*) TypeID,
+   (*--proc*) AssignOf, CompareOf, DisposeOf;
+
+   (*-------------------------*)
+
+
+TYPE  TableEntryPtr = POINTER TO TableEntry;
+TYPE  TableEntry = RECORD
+        key   : Key;
+        data  : Data;
+        next  : TableEntryPtr;
+     END (*-- TableEntry --*);
+TYPE  HashingTable = ARRAY [0..0] OF TableEntryPtr;
+
+TYPE  UnboundedHashTable = RECORD
+        keyID   : TypeID;
+        dataID  : TypeID;
+        hash    : HashFunction;
+        initSize: CARDINAL;     (*-- initial number of buckets *)
+        currSize: CARDINAL;     (*-- current number of buckets *)
+        minLoad : REAL;         (*-- lower bound on load factor *)
+        maxLoad : REAL;         (*-- upper bound on load factor *)
+        extent  : CARDINAL;     (*-- number of items in table *)
+        p       : CARDINAL;     (*-- next bucket to be split *)
+        maxp    : CARDINAL;     (*-- upper bound on p during this expansion *)
+        table   : HashingTable; (*-- array [1..size] *)
+     END (*-- UnboundedHashTable --*);
+
+TYPE  HashTablePtr = POINTER TO UnboundedHashTable;
+TYPE  HashTable  = POINTER TO HashTablePtr;
+
+(*-------------------------*)
+
+VAR   tableError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE TableError () : Exceptions               (*--out  *);
+BEGIN
+  RETURN tableError;
+END TableError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*--in   *);
+                          theError   : Exceptions  (*--in   *));
+BEGIN
+  tableError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+PROCEDURE InitToEmpty (    theTable : HashTable (*--inout*));
+
+VAR   index : CARDINAL;
+
+BEGIN
+  WITH theTable^^ DO
+    FOR index := 0 TO currSize-1 DO
+      table[index] := NIL;
+    END (*--for*);
+  END (*--with*);
+END InitToEmpty;
+(*-------------------------*)
+
+PROCEDURE FreeTableEntry (    theTable : HashTable  (*--in   *);
+                              theEntry : TableEntry (*--inout*));
+
+VAR   free : DisposeProc;  (*-- key/data disposal routine *)
+      oldState : SignedByte;
+
+BEGIN
+  oldState := HGetState(theTable);
+  HLock(theTable);
+  free := DisposeOf(theTable^^.keyID);
+  free(theEntry.key);
+  free := DisposeOf(theTable^^.dataID);
+  free(theEntry.data);
+  HSetState(theTable, oldState);
+END FreeTableEntry;
+(*-------------------------*)
+
+PROCEDURE Hash (    theTable : HashTable    (*--in   *);
+                    theKey   : Key          (*--in   *))
+                             : CARDINAL     (*--out  *);
+
+CONST prime = 1048583;
+
+VAR  h     : LONGCARD;
+     addr  : CARDINAL;
+     oldState : SignedByte;
+
+BEGIN
+  oldState := HGetState(theTable);
+  HLock(theTable);
+  WITH theTable^^ DO
+    h := VAL(LONGCARD, hash(theKey)) MOD prime;
+    addr := h MOD VAL(LONGCARD, maxp);
+   IF (addr < p) THEN
+     addr := h MOD VAL(LONGCARD, (2 * maxp));
+   END (*--if*);
+  END (*--with*);
+  HSetState(theTable, oldState);
+  RETURN addr;
+END Hash;
+(*-------------------------*)
+
+(*
+Expand the hash table by one bucket. p is the bucket to be split.
+*)
+
+PROCEDURE ExpandTable (    theTable : HashTable        (*--inout*);
+                          routine  : Operations    (*--in   *));
+
+VAR   oldBucket : CARDINAL;
+     lastOfNew : TableEntryPtr;
+     current   : TableEntryPtr;
+     previous  : TableEntryPtr;
+     oldState  : SignedByte;
+
+BEGIN
+  (*-- expand the table size, if possible *)
+  SetHandleSize(theTable, GetHandleSize(theTable) +
+                           VAL(Size, SIZE(TableEntryPtr)));
+  IF (MemError() = noErr) THEN
+    oldState := HGetState(theTable);
+   HLock(theTable);
+   WITH theTable^^ DO
+     oldBucket := p;
+
+     (*-- adjust state variables *)
+     INC(p);
+     IF (p = maxp) THEN
+       maxp := 2 * maxp;
+       p    := 0;
+     END (*--if*);
+     INC(currSize);
+
+     (*-- relocate records to the new bucket (at currSize-1) *)
+     current   := table[oldBucket];
+     previous  := NIL;
+     lastOfNew := NIL;
+     table[currSize-1] := NIL;
+     WHILE (current # NIL) DO
+       IF (Hash(theTable, current^.key) = currSize-1) THEN
+         (*-- attach it to new chain *)
+         IF (lastOfNew = NIL) THEN
+           table[currSize-1] := current;
+         ELSE
+           lastOfNew^.next := current;
+         END (*--if*);
+         IF (previous = NIL) THEN
+           table[oldBucket] := current^.next;
+         ELSE
+           previous^.next := current^.next;
+         END (*--if*);
+         lastOfNew := current;
+         current := current^.next;
+         lastOfNew^.next := NIL;
+       ELSE
+         (*-- leave it on old chain *)
+         previous := current;
+         current := current^.next;
+       END (*--if*);
+     END (*--while*);
+   END (*--with*);
+   HSetState(theTable, oldState);
+  ELSE
+   RaiseErrIn(routine, overflow);
+  END (*--if*);
+END ExpandTable;
+(*-------------------------*)
+
+(*
+Contract the hash table by one bucket.
+*)
+
+PROCEDURE ContractTable (    theTable : HashTable  (*--inout*));
+
+VAR   current   : TableEntryPtr;
+     oldState  : SignedByte;
+
+BEGIN
+  oldState := HGetState(theTable);
+  HLock(theTable);
+  WITH theTable^^ DO
+    (*-- adjust state variables *)
+    IF (p = 0) THEN
+     maxp := maxp DIV 2;
+     p    := maxp - 1;
+   ELSE
+      DEC(p);
+    END (*--if*);
+
+    (*-- relocate records from the last bucket (at currSize-1)
+     -- to the bucket pointed to by p. *)
+   IF (table[p] = NIL) THEN
+     table[p] := table[currSize-1];
+   ELSIF (table[currSize-1] # NIL) THEN
+     current := table[currSize-1];
+     WHILE (current^.next # NIL) DO
+       current := current^.next;
+     END (*--while*);
+     current^.next := table[p];
+     table[p] := table[currSize-1];
+   END (*--if*);
+    DEC(currSize);
+  END (*--with*);
+  HSetState(theTable, oldState);
+  SetHandleSize(theTable, GetHandleSize(theTable) -
+                         VAL(Size, SIZE(TableEntryPtr)));
+END ContractTable;
+(*-------------------------*)
+
+(*
+Search the given hash table for the given key returning the index
+into the hash table where the key was found along with pointers
+to the current and prior nodes in the list.
+*)
+
+PROCEDURE Search   (    theTable   : HashTable     (*--in   *);
+                        theKey     : Key           (*--in   *);
+                    VAR theIndex   : CARDINAL      (*--out  *);
+                    VAR priorNode  : TableEntryPtr (*--out  *);
+                    VAR currNode   : TableEntryPtr (*--out  *))
+                                   : BOOLEAN       (*--out  *);
+
+VAR   compare  : CompareProc;  (*-- key comparison routine *)
+     oldState  : SignedByte;
+
+BEGIN
+  priorNode := NIL;
+  oldState := HGetState(theTable);
+  HLock(theTable);
+  WITH theTable^^ DO
+    compare   := CompareOf(keyID);
+   theIndex  := Hash(theTable, theKey);
+   currNode  := table[theIndex];
+  END (*--with*);
+  HSetState(theTable, oldState);
+  WHILE (currNode # NIL) DO
+   IF (compare(theKey, currNode^.key) = equal) THEN
+     RETURN TRUE;
+   END (*--if*);
+   priorNode:= currNode;
+   currNode := currNode^.next;
+  END (*--while*);
+  RETURN FALSE;
+END Search;
+(*-------------------------*)
+
+PROCEDURE AddTableEntry (    theTable : HashTable  (*--in   *);
+                            theKey   : Key         (*--in   *);
+                            theData  : Data        (*--in   *);
+                            theIndex : CARDINAL    (*--in   *);
+                            theProc  : Operations  (*--in   *));
+
+VAR   newEntry : TableEntryPtr;
+     loadFactor: REAL;         (*-- overall load factor *)
+     oldState  : SignedByte;
+
+BEGIN
+  Allocate(newEntry, SIZE(TableEntry));
+  IF (newEntry = NIL) THEN
+   RaiseErrIn(theProc, overflow);
+  ELSE
+   WITH newEntry^ DO
+     key  := theKey;
+     data := theData;
+     next := theTable^^.table[theIndex];
+   END (*--with*);
+    oldState := HGetState(theTable);
+    HLock(theTable);
+   WITH theTable^^ DO
+     table[theIndex] := newEntry;
+     INC(extent);
+     loadFactor := FLOAT(extent) / FLOAT(currSize);
+     IF (loadFactor > maxLoad) THEN
+       ExpandTable(theTable, theProc);
+     END (*--if*);
+   END (*--with*);
+   HSetState(theTable, oldState);
+  END (*--if*);
+END AddTableEntry;
+(*-------------------------*)
+
+
+PROCEDURE Create   (    keyTypeID  : TypeID        (*--in   *);
+                        dataTypeID : TypeID        (*--in   *);
+                        theSize    : CARDINAL      (*--in   *);
+                        minLoadFact: REAL          (*--in   *);
+                        maxLoadFact: REAL          (*--in   *);
+                        hashFunc   : HashFunction  (*--in   *))
+                                   : HashTable     (*--out  *);
+
+CONST baseSize  = SIZE(UnboundedHashTable) - SIZE(HashingTable);
+CONST entrySize = SIZE(TableEntryPtr);
+
+VAR   newTable : HashTable; (*--temporary for new hash table object *)
+
+BEGIN
+  tableError := noerr;
+  newTable := NewHandle(baseSize + (VAL(INTEGER, theSize) * entrySize));
+  IF (newTable = NullTable) OR (MemError() # noErr) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newTable^^ DO
+     keyID     := keyTypeID;
+     dataID    := dataTypeID;
+     extent    := 0;
+     initSize  := theSize;
+     currSize  := theSize;
+     minLoad   := minLoadFact;
+     maxLoad   := maxLoadFact;
+     p         := 0;
+     maxp      := theSize;
+     hash      := hashFunc;
+   END (*--with*);
+   InitToEmpty(newTable);
+  END (*--if*);
+  RETURN newTable;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy  (VAR theTable   : HashTable     (*--inout*));
+BEGIN
+  Clear(theTable);
+  IF (tableError = noerr) THEN
+    DisposHandle(theTable);
+   theTable := NullTable;
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear        (    theTable   : HashTable     (*--inout*));
+
+VAR   index : CARDINAL;
+     curr  : TableEntryPtr;
+     oldState : SignedByte;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    oldState := HGetState(theTable);
+   HLock(theTable);
+   WITH theTable^^ DO
+     FOR index := 0 TO currSize-1 DO
+       WHILE (table[index] # NIL) DO
+         curr := table[index];
+         table[index] := table[index]^.next;
+         FreeTableEntry(theTable, curr^);
+         Deallocate(curr);
+       END (*--while*);
+     END (*--for*);
+     extent := 0;
+     p      := 0;
+     maxp   := currSize;
+   END (*--with*);
+   HSetState(theTable, oldState);
+   InitToEmpty(theTable);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign   (    theTable   : HashTable     (*--in   *);
+                    VAR toTable    : HashTable     (*--inout*));
+
+  PROCEDURE RecreateTarget () : BOOLEAN (*--out *);
+  BEGIN
+    IF (theTable = NullTable) THEN
+     RaiseErrIn(assign, undefined);
+    ELSIF (toTable = NullTable) THEN
+     WITH theTable^^ DO
+       toTable := Create(keyID, dataID, initSize, minLoad, maxLoad, hash);
+     END (*--with*);
+    ELSIF (toTable = theTable) THEN
+     RETURN FALSE;
+   ELSE
+     Clear(toTable);
+     toTable^^.keyID  := theTable^^.keyID;
+     toTable^^.dataID := theTable^^.dataID;
+     toTable^^.hash   := theTable^^.hash;
+    END (*--if*);
+   RETURN tableError = noerr;
+  END RecreateTarget;
+
+VAR   assignKey  : AssignProc; (*-- key assignment routine *)
+     assignData : AssignProc; (*-- data assignment routine *)
+     index      : CARDINAL;   (*-- loop index over table entries *)
+     current    : TableEntryPtr;
+     oldState   : SignedByte;
+     newKey     : Key;
+     newData    : Data;
+     newIndex   : CARDINAL;
+
+BEGIN
+  tableError := noerr;
+  IF RecreateTarget() THEN
+    oldState := HGetState(theTable);
+    HLock(theTable);
+    WITH theTable^^ DO
+      assignKey  := AssignOf(keyID);
+      assignData := AssignOf(dataID);
+     FOR index := 0 TO currSize-1 DO
+       current := table[index];
+       WHILE (current # NIL) & (tableError = noerr) DO
+         newKey  := assignData(current^.key);
+         newData := assignData(current^.data);
+         newIndex:= Hash(toTable, newKey);
+         AddTableEntry(toTable, newKey, newData, newIndex, assign);
+         current := current^.next;
+       END (*--while*);
+     END (*--for*);
+   END (*--with*);
+   HSetState(theTable, oldState);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Insert   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *));
+
+VAR   index    : CARDINAL;     (*-- bucket where to insert *)
+     prior     : TableEntryPtr;
+     current   : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(insert, undefined);
+  ELSIF Search(theTable, theKey, index, prior, current) THEN
+   RaiseErrIn(insert, duplicatekey);
+  ELSE
+   AddTableEntry(theTable, theKey, theData, index, insert);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+PROCEDURE Remove   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+VAR   index    : CARDINAL;     (*-- bucket where key was found *)
+     prior     : TableEntryPtr;
+     current   : TableEntryPtr;
+     loadFactor: REAL;         (*-- overall load factor *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(remove, undefined);
+  ELSIF Search(theTable, theKey, index, prior, current) THEN
+   IF (prior = NIL) THEN
+     (*-- current is at the head of the list *)
+     theTable^^.table[index] := current^.next;
+   ELSE
+     prior^.next := current^.next;
+   END (*--if*);
+   FreeTableEntry(theTable, current^);
+   Deallocate(current);
+   WITH theTable^^ DO
+     DEC(extent);
+     loadFactor := FLOAT(extent) / FLOAT(currSize);
+   END (*--with*);
+   IF (loadFactor < theTable^^.minLoad) THEN
+     ContractTable(theTable);
+   END (*--if*);
+  ELSE
+   notFound(theKey);
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+PROCEDURE Update   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *);
+                        updateEntry: UpdateProc    (*--in   *));
+
+VAR   index    : CARDINAL;     (*-- bucket where key was found *)
+     prior     : TableEntryPtr;
+     current   : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(remove, undefined);
+  ELSIF Search(theTable, theKey, index, prior, current) THEN
+    updateEntry(current^.key, current^.data, theData);
+  ELSE
+   AddTableEntry(theTable, theKey, theData, index, update);
+  END (*--if*);
+END Update;
+(*-------------------------*)
+
+
+PROCEDURE IsDefined (    theTable  : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+BEGIN
+  RETURN (theTable # NullTable);
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty  (    theTable   : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(isempty, undefined);
+   RETURN TRUE;
+  END (*--if*);
+  RETURN theTable^^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE KeyTypeOf (    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(typeof, undefined);
+   RETURN NullType;
+  END (*--if*);
+  RETURN theTable^^.keyID;
+END KeyTypeOf;
+(*-------------------------*)
+
+PROCEDURE DataTypeOf(    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(typeof, undefined);
+   RETURN NullType;
+  END (*--if*);
+  RETURN theTable^^.dataID;
+END DataTypeOf;
+(*-------------------------*)
+
+PROCEDURE HashOf    (    theTable  : HashTable     (*--in   *))
+                                   : HashFunction  (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(hashof, undefined);
+   RETURN VAL(HashFunction, NIL);
+  END (*--if*);
+  RETURN theTable^^.hash;
+END HashOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(sizeof, undefined);
+   RETURN 0;
+  END (*--if*);
+  RETURN theTable^^.currSize;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE ExtentOf  (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(extentof, undefined);
+   RETURN 0;
+  END (*--if*);
+  RETURN theTable^^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+PROCEDURE IsPresent    (    theTable   : HashTable     (*--in   *);
+                        theKey     : Key           (*--in   *);
+                        found      : FoundProc     (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+VAR   index    : CARDINAL;     (*-- bucket where item was found *)
+     prior     : TableEntryPtr;
+     current   : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(ispresent, undefined);
+  ELSIF Search(theTable, theKey, index, prior, current) THEN
+   found(current^.key, current^.data);
+  ELSE
+   notFound(theKey);
+  END (*--if*);
+END IsPresent;
+(*-------------------------*)
+
+
+PROCEDURE LoopOver (    theTable   : HashTable     (*--in   *);
+                        process    : LoopProc      (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+     curr  : TableEntryPtr;
+     oldState : SignedByte;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    oldState := HGetState(theTable);
+    HLock(theTable);
+   WITH theTable^^ DO
+     FOR index := 0 TO currSize-1 DO
+       curr := table[index];
+       WHILE (curr # NIL) DO
+         WITH curr^ DO
+           IF ~process(key, data) THEN
+             HSetState(theTable, oldState);
+             RETURN;
+           END (*--if*);
+           curr := next;
+         END (*--with*);
+       END (*--while*);
+     END (*--for*);
+   END (*--with*);
+   HSetState(theTable, oldState);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theTable   : HashTable     (*--in   *);
+                        process    : AccessProc    (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+     curr  : TableEntryPtr;
+     oldState : SignedByte;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    oldState := HGetState(theTable);
+    HLock(theTable);
+   WITH theTable^^ DO
+     FOR index := 0 TO currSize-1 DO
+       curr := table[index];
+       WHILE (curr # NIL) DO
+         WITH curr^ DO
+           process(key, data);
+           curr := next;
+         END (*--with*);
+       END (*--while*);
+     END (*--for*);
+   END (*--with*);
+   HSetState(theTable, oldState);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+TYPE  HashTableEntry = POINTER TO TableEntry;
+CONST NullTableEntry = NIL;
+
+VAR   entryState : ARRAY BOOLEAN OF States;
+
+PROCEDURE Iterate  (    theTable   : HashTable     (*--in   *);
+                        process    : IterateProc   (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+     curr  : TableEntryPtr;
+     oldState : SignedByte;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    oldState := HGetState(theTable);
+    HLock(theTable);
+   WITH theTable^^ DO
+     FOR index := 0 TO currSize-1 DO
+       process(index, entryState[table[index] # NIL],
+                      VAL(HashTableEntry, table[index]));
+     END (*--for*);
+   END (*--with*);
+   HSetState(theTable, oldState);
+  END (*--if*);
+END Iterate;
+(*-------------------------*)
+
+PROCEDURE IsNull   (    theEntry   : HashTableEntry    (*--in   *))
+                                   : BOOLEAN           (*--out  *);
+BEGIN
+  RETURN theEntry = NullTableEntry;
+END IsNull;
+(*-------------------------*)
+
+PROCEDURE KeyOf        (    theEntry   : HashTableEntry(*--in   *))
+                                   : Key           (*--out  *);
+BEGIN
+  IF (theEntry = NullTableEntry) THEN
+   RETURN NullItem;
+  ELSE
+   RETURN theEntry^.key;
+  END (*--if*);
+END KeyOf;
+(*-------------------------*)
+
+PROCEDURE DataOf   (    theEntry   : HashTableEntry(*--in   *))
+                                   : Data          (*--out  *);
+BEGIN
+  IF (theEntry = NullTableEntry) THEN
+   RETURN NullItem;
+  ELSE
+   RETURN theEntry^.data;
+  END (*--if*);
+END DataOf;
+(*-------------------------*)
+
+PROCEDURE NextOf   (    theEntry   : HashTableEntry    (*--in   *))
+                                   : HashTableEntry    (*--out  *);
+
+BEGIN
+  IF (theEntry = NullTableEntry) THEN
+   RETURN NullTableEntry;
+  ELSE
+   RETURN VAL(HashTableEntry, theEntry^.next);
+  END (*--if*);
+END NextOf;
+(*-------------------------*)
+
+
+BEGIN
+  FOR tableError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(tableError, NullHandler);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  tableError := noerr;
+  entryState[FALSE] := empty;
+  entryState[TRUE ] := used;
+  NullTable := NIL;
+END LHash.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/lhashbk.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/lhashbk.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/lhashbk.mod
@@ -0,0 +1,831 @@
+IMPLEMENTATION MODULE LinearHashing;
+(*==============================================================
+    Version  : 2.00  18 Sep 1990  C. Lins
+    Compiler : Bob Campbell's MPW Modula-2 Compiler
+    Component: Hash Table - Sequential Unbounded Managed Iterator
+               Linear hashing
+
+    REVISION HISTORY
+    v1.00  23 Apr 1989  C. Lins:
+        Initial Modula-2 implementation
+    v1.01  30 Jun 1989  C. Lins:
+        Removed separation of key and data.
+    v1.02  12 Aug 1989  C. Lins:
+        Change table to VAR parameter in Insert, Remove, Update.
+        Fixed setting of currSize in Clear.
+        Optimized Assign to directly call AddTableEntry.
+    v1.03  13 Aug 1989  C. Lins:
+        Changed active iteration mechanism to match that for
+        Direct Chaining.
+    v1.04  21 Aug 1989  C. Lins:
+        Added HashOf selector.
+        Removed calls to HUnlock since HSetState restores the
+        handle bits correctly.
+    v1.05  29 Aug 1989  C. Lins:
+        Separate key and data.
+    v1.06  03 Sep 1989  C. Lins:
+        Copy hashing function to target hash table in Assign.
+    v1.07  09 Sep 1989  C. Lins:
+        Pass back result from hash table for key from searches
+        instead of key parameter.
+    v1.08  08 Apr 1990  C. Lins:
+        Remove option char operators for compatability with
+        Metrowerks Modula-2.
+    v2.02  18 Sep 1990  C. Lins:
+        The book version.
+
+    c Copyright 1989 Charles A. Lins
+==============================================================*)
+
+FROM SCLStorage IMPORT
+    (*--proc*) Allocate, Deallocate;
+
+FROM Relations IMPORT
+    (*--type*) Relation;
+
+FROM HashTypes IMPORT
+    (*--type*) Exceptions, Operations, States, ComponentID,
+               FoundProc, NotFoundProc, UpdateProc, LoopProc,
+               AccessProc, HashFunction, Key, Data;
+
+FROM Items IMPORT
+    (*--cons*) NullItem,
+    (*--type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM ErrorHandling IMPORT
+    (*--cons*) NullHandler,
+    (*--type*) HandlerProc,
+    (*--proc*) Raise;
+
+FROM TypeManager IMPORT
+    (*--cons*) NullType,
+    (*--type*) TypeID,
+    (*--proc*) AssignOf, CompareOf, DisposeOf;
+
+    (*-------------------------*)
+
+
+TYPE  TableEntryPtr = POINTER TO TableEntry;
+TYPE  TableEntry = RECORD
+        key   : Key;
+        data  : Data;
+        next  : TableEntryPtr;
+      END (*-- TableEntry --*);
+TYPE  HashingTable = ARRAY [0..0] OF TableEntryPtr;
+
+TYPE  UnboundedHashTable = RECORD
+        keyID   : TypeID;
+        dataID  : TypeID;
+        hash    : HashFunction;
+        initSize: CARDINAL;     (*-- initial number of buckets *)
+        currSize: CARDINAL;     (*-- current number of buckets *)
+        minLoad : REAL;         (*-- lower bound on load factor *)
+        maxLoad : REAL;         (*-- upper bound on load factor *)
+        extent  : CARDINAL;     (*-- number of items in table *)
+        p       : CARDINAL;     (*-- next bucket to be split *)
+        maxp    : CARDINAL;     (*-- upper bound on p during this expansion *)
+        table   : HashingTable; (*-- array [1..size] *)
+      END (*-- UnboundedHashTable --*);
+
+TYPE  HashTable  = POINTER TO UnboundedHashTable;
+
+(*-------------------------*)
+
+VAR   tableError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE TableError () : Exceptions                (*--out  *);
+BEGIN
+  RETURN tableError;
+END TableError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions   (*--in   *);
+                          theHandler : HandlerProc  (*--in   *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions   (*--in   *))
+                                     : HandlerProc  (*--out  *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*--in   *);
+                          theError   : Exceptions  (*--in   *));
+BEGIN
+  tableError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+PROCEDURE InitToEmpty (    theTable : HashTable (*--inout*));
+
+VAR   index : CARDINAL;
+
+BEGIN
+  WITH theTable^ DO
+    FOR index := 0 TO currSize-1 DO
+      table[index] := NIL;
+    END (*--for*);
+  END (*--with*);
+END InitToEmpty;
+(*-------------------------*)
+
+PROCEDURE FreeTableEntry (    theTable : HashTable  (*--in   *);
+                              theEntry : TableEntry (*--inout*));
+
+VAR   free : DisposeProc;   (*-- key/data disposal routine *)
+
+BEGIN
+  free := DisposeOf(theTable^.keyID);
+  free(theEntry.key);
+  free := DisposeOf(theTable^.dataID);
+  free(theEntry.data);
+END FreeTableEntry;
+(*-------------------------*)
+
+CONST   baseSize  = SIZE(UnboundedHashTable) - SIZE(HashingTable);
+CONST   entrySize = SIZE(TableEntryPtr);
+
+PROCEDURE CalcTableSize (    numEntries : CARDINAL (*--in   *))
+                                        : CARDINAL (*--out  *);
+BEGIN
+    RETURN baseSize + (entrySize * VAL(INTEGER, numEntries));
+END CalcTableSize;
+(*-------------------------*)
+
+PROCEDURE GetTableSize  (    theTable : HashTable (*--in   *))
+                                      : INTEGER   (*--out  *);
+BEGIN
+    RETURN CalcTableSize(theTable^.currSize);
+END GetTableSize;
+(*-------------------------*)
+
+PROCEDURE SetTableSize  (VAR theTable : HashTable (*--inout*);
+                             theSize  : INTEGER   (*--in   *))
+                                      : BOOLEAN   (*--out  *);
+
+VAR     index    : INTEGER;
+        oldSize  : INTEGER;
+        copySize : INTEGER;
+        newTable : HashTable;
+
+BEGIN
+    (*-- Move to new block of memory *)
+    Allocate(newTable, CalcTableSize(theSize));
+    IF (newTable # NullTable) THEN
+        (*-- determine the smaller of the old and new sizes *)
+        IF (theSize < theTable^.currSize) THEN
+            copySize := theSize;
+        ELSE
+            copySize := theTable^.currSize;
+        END (*--if*);
+        (*-- copy the data into the new table *)
+        newTable^.keyID    := theTable^.keyID;
+        newTable^.dataID   := theTable^.dataID;
+        newTable^.extent   := theTable^.extent;
+        newTable^.currSize := theTable^.currSize;
+        newTable^.initSize := theTable^.initSize;
+        newTable^.hash     := theTable^.hash;
+        newTable^.p        := theTable^.p;
+        newTable^.maxp     := theTable^.maxp;
+        newTable^.minLoad  := theTable^.minLoad;
+        newTable^.maxLoad  := theTable^.maxLoad;
+        FOR index := 0 TO copySize-1 DO
+            newTable^.table[index] := theTable^.table[index];
+        END (*--for*);
+        (*-- free the old table but not its contents *)
+        Deallocate(theTable, CalcTableSize(theTable^.currSize));
+        (*-- store the new table *)
+        theTable := newTable;
+        RETURN TRUE;
+    ELSE
+        RETURN FALSE;
+    END (*--if*);
+END SetTableSize;
+(*-------------------------*)
+
+PROCEDURE Hash (    theTable : HashTable    (*--in   *);
+                    theKey   : Key          (*--in   *))
+                             : CARDINAL     (*--out  *);
+
+CONST prime = 1048583;
+
+VAR   h     : LONGCARD;
+      addr  : CARDINAL;
+
+BEGIN
+  WITH theTable^ DO
+    h := VAL(LONGCARD, hash(theKey)) MOD prime;
+    addr := h MOD VAL(LONGCARD, maxp);
+    IF (addr < p) THEN
+      addr := h MOD VAL(LONGCARD, (2 * maxp));
+    END (*--if*);
+  END (*--with*);
+  RETURN addr;
+END Hash;
+(*-------------------------*)
+
+(*
+Expand the hash table by one bucket. p is the bucket to be split.
+*)
+
+PROCEDURE ExpandTable (    theTable : HashTable     (*--inout*);
+                           routine  : Operations    (*--in   *));
+
+VAR   oldBucket : CARDINAL;
+      lastOfNew : TableEntryPtr;
+      current   : TableEntryPtr;
+      previous  : TableEntryPtr;
+
+BEGIN
+  (*-- expand the table size, if possible *)
+  IF SetTableSize(theTable, theTable^.currSize+1) THEN
+    WITH theTable^ DO
+      oldBucket := p;
+
+      (*-- adjust state variables *)
+      INC(p);
+      IF (p = maxp) THEN
+        maxp := 2 * maxp;
+        p    := 0;
+      END (*--if*);
+      INC(currSize);
+
+      (*-- relocate records to the new bucket (at currSize-1) *)
+      current   := table[oldBucket];
+      previous  := NIL;
+      lastOfNew := NIL;
+      table[currSize-1] := NIL;
+      WHILE (current # NIL) DO
+        IF (Hash(theTable, current^.key) = currSize-1) THEN
+          (*-- attach it to new chain *)
+          IF (lastOfNew = NIL) THEN
+            table[currSize-1] := current;
+          ELSE
+            lastOfNew^.next := current;
+          END (*--if*);
+          IF (previous = NIL) THEN
+            table[oldBucket] := current^.next;
+          ELSE
+            previous^.next := current^.next;
+          END (*--if*);
+          lastOfNew := current;
+          current := current^.next;
+          lastOfNew^.next := NIL;
+        ELSE
+          (*-- leave it on old chain *)
+          previous := current;
+          current := current^.next;
+        END (*--if*);
+      END (*--while*);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(routine, overflow);
+  END (*--if*);
+END ExpandTable;
+(*-------------------------*)
+
+(*
+Contract the hash table by one bucket.
+*)
+
+PROCEDURE ContractTable (    theTable : HashTable   (*--inout*));
+
+VAR   current   : TableEntryPtr;
+
+BEGIN
+  WITH theTable^ DO
+    (*-- adjust state variables *)
+    IF (p = 0) THEN
+      maxp := maxp DIV 2;
+      p    := maxp - 1;
+    ELSE
+      DEC(p);
+    END (*--if*);
+
+    (*-- relocate records from the last bucket (at currSize-1)
+      -- to the bucket pointed to by p. *)
+    IF (table[p] = NIL) THEN
+      table[p] := table[currSize-1];
+    ELSIF (table[currSize-1] # NIL) THEN
+      current := table[currSize-1];
+      WHILE (current^.next # NIL) DO
+        current := current^.next;
+      END (*--while*);
+      current^.next := table[p];
+      table[p] := table[currSize-1];
+    END (*--if*);
+    DEC(currSize);
+  END (*--with*);
+  IF SetTableSize(theTable, theTable^.currSize-1) THEN
+    DEC(theTable^.currSize);
+  ELSE
+    (*-- could not contract table! *)
+  END (*--if*);
+END ContractTable;
+(*-------------------------*)
+
+(*
+Search the given hash table for the given key returning the index
+into the hash table where the key was found along with pointers
+to the current and prior nodes in the list.
+*)
+
+PROCEDURE Search    (    theTable   : HashTable     (*--in   *);
+                         theKey     : Key           (*--in   *);
+                     VAR theIndex   : CARDINAL      (*--out  *);
+                     VAR priorNode  : TableEntryPtr (*--out  *);
+                     VAR currNode   : TableEntryPtr (*--out  *))
+                                    : BOOLEAN       (*--out  *);
+
+VAR   compare   : CompareProc;  (*-- key comparison routine *)
+
+BEGIN
+  priorNode := NIL;
+  WITH theTable^ DO
+    compare   := CompareOf(keyID);
+    theIndex  := Hash(theTable, theKey);
+    currNode  := table[theIndex];
+  END (*--with*);
+  WHILE (currNode # NIL) DO
+    IF (compare(theKey, currNode^.key) = equal) THEN
+      RETURN TRUE;
+    END (*--if*);
+    priorNode:= currNode;
+    currNode := currNode^.next;
+  END (*--while*);
+  RETURN FALSE;
+END Search;
+(*-------------------------*)
+
+PROCEDURE AddTableEntry (    theTable : HashTable   (*--in   *);
+                             theKey   : Key         (*--in   *);
+                             theData  : Data        (*--in   *);
+                             theIndex : CARDINAL    (*--in   *);
+                             theProc  : Operations  (*--in   *));
+
+VAR   newEntry  : TableEntryPtr;
+      loadFactor: REAL;         (*-- overall load factor *)
+
+BEGIN
+  Allocate(newEntry, SIZE(TableEntry));
+  IF (newEntry = NIL) THEN
+    RaiseErrIn(theProc, overflow);
+  ELSE
+    WITH newEntry^ DO
+      key  := theKey;
+      data := theData;
+      next := theTable^.table[theIndex];
+    END (*--with*);
+    WITH theTable^ DO
+      table[theIndex] := newEntry;
+      INC(extent);
+      loadFactor := FLOAT(extent) / FLOAT(currSize);
+      IF (loadFactor > maxLoad) THEN
+        ExpandTable(theTable, theProc);
+      END (*--if*);
+    END (*--with*);
+  END (*--if*);
+END AddTableEntry;
+(*-------------------------*)
+
+
+PROCEDURE Create    (    keyTypeID  : TypeID        (*--in   *);
+                         dataTypeID : TypeID        (*--in   *);
+                         theSize    : CARDINAL      (*--in   *);
+                         minLoadFact: REAL          (*--in   *);
+                         maxLoadFact: REAL          (*--in   *);
+                         hashFunc   : HashFunction  (*--in   *))
+                                    : HashTable     (*--out  *);
+
+VAR   newTable : HashTable; (*--temporary for new hash table object *)
+
+BEGIN
+  tableError := noerr;
+  Allocate(newTable, baseSize + (VAL(INTEGER, theSize) * entrySize));
+  IF (newTable = NullTable) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newTable^ DO
+      keyID     := keyTypeID;
+      dataID    := dataTypeID;
+      extent    := 0;
+      initSize  := theSize;
+      currSize  := theSize;
+      minLoad   := minLoadFact;
+      maxLoad   := maxLoadFact;
+      p         := 0;
+      maxp      := theSize;
+      hash      := hashFunc;
+    END (*--with*);
+    InitToEmpty(newTable);
+  END (*--if*);
+  RETURN newTable;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy   (VAR theTable   : HashTable     (*--inout*));
+BEGIN
+  Clear(theTable);
+  IF (tableError = noerr) THEN
+    Deallocate(theTable, CalcTableSize(theSize));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear     (    theTable   : HashTable     (*--inout*));
+
+VAR   index : CARDINAL;
+      curr  : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO currSize-1 DO
+        WHILE (table[index] # NIL) DO
+          curr := table[index];
+          table[index] := table[index]^.next;
+          FreeTableEntry(theTable, curr^);
+          Deallocate(curr, SIZE(TableEntry));
+        END (*--while*);
+      END (*--for*);
+      extent := 0;
+      p      := 0;
+      maxp   := currSize;
+    END (*--with*);
+    InitToEmpty(theTable);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign    (    theTable   : HashTable     (*--in   *);
+                     VAR toTable    : HashTable     (*--inout*));
+
+  PROCEDURE RecreateTarget () : BOOLEAN (*--out *);
+  BEGIN
+    IF (theTable = NullTable) THEN
+      RaiseErrIn(assign, undefined);
+    ELSIF (toTable = NullTable) THEN
+      WITH theTable^ DO
+        toTable := Create(keyID, dataID, initSize, minLoad, maxLoad, hash);
+      END (*--with*);
+    ELSIF (toTable = theTable) THEN
+      RETURN FALSE;
+    ELSE
+      Clear(toTable);
+      toTable^.keyID  := theTable^.keyID;
+      toTable^.dataID := theTable^.dataID;
+      toTable^.hash   := theTable^.hash;
+    END (*--if*);
+    RETURN tableError = noerr;
+  END RecreateTarget;
+
+VAR   assignKey  : AssignProc; (*-- key assignment routine *)
+      assignData : AssignProc; (*-- data assignment routine *)
+      index      : CARDINAL;   (*-- loop index over table entries *)
+      current    : TableEntryPtr;
+      newKey     : Key;
+      newData    : Data;
+      newIndex   : CARDINAL;
+
+BEGIN
+  tableError := noerr;
+  IF RecreateTarget() THEN
+    WITH theTable^ DO
+      assignKey  := AssignOf(keyID);
+      assignData := AssignOf(dataID);
+      FOR index := 0 TO currSize-1 DO
+        current := table[index];
+        WHILE (current # NIL) & (tableError = noerr) DO
+          newKey  := assignData(current^.key);
+          newData := assignData(current^.data);
+          newIndex:= Hash(toTable, newKey);
+          AddTableEntry(toTable, newKey, newData, newIndex, assign);
+          current := current^.next;
+        END (*--while*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Insert    (    theTable   : HashTable     (*--inout*);
+                         theKey     : Key           (*--in   *);
+                         theData    : Data          (*--in   *));
+
+VAR   index     : CARDINAL;     (*-- bucket where to insert *)
+      prior     : TableEntryPtr;
+      current   : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(insert, undefined);
+  ELSIF Search(theTable, theKey, index, prior, current) THEN
+    RaiseErrIn(insert, duplicatekey);
+  ELSE
+    AddTableEntry(theTable, theKey, theData, index, insert);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+PROCEDURE Remove    (    theTable   : HashTable     (*--inout*);
+                         theKey     : Key           (*--in   *);
+                         notFound   : NotFoundProc  (*--in   *));
+
+VAR   index     : CARDINAL;     (*-- bucket where key was found *)
+      prior     : TableEntryPtr;
+      current   : TableEntryPtr;
+      loadFactor: REAL;         (*-- overall load factor *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(remove, undefined);
+  ELSIF Search(theTable, theKey, index, prior, current) THEN
+    IF (prior = NIL) THEN
+      (*-- current is at the head of the list *)
+      theTable^^.table[index] := current^.next;
+    ELSE
+      prior^.next := current^.next;
+    END (*--if*);
+    FreeTableEntry(theTable, current^);
+    Deallocate(current, SIZE(TableEntry));
+    WITH theTable^^ DO
+      DEC(extent);
+      loadFactor := FLOAT(extent) / FLOAT(currSize);
+    END (*--with*);
+    IF (loadFactor < theTable^^.minLoad) THEN
+      ContractTable(theTable);
+    END (*--if*);
+  ELSE
+    notFound(theKey);
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+PROCEDURE Update    (    theTable   : HashTable     (*--inout*);
+                         theKey     : Key           (*--in   *);
+                         theData    : Data          (*--in   *);
+                         updateEntry: UpdateProc    (*--in   *));
+
+VAR   index     : CARDINAL;     (*-- bucket where key was found *)
+      prior     : TableEntryPtr;
+      current   : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(remove, undefined);
+  ELSIF Search(theTable, theKey, index, prior, current) THEN
+    updateEntry(current^.key, current^.data, theData);
+  ELSE
+    AddTableEntry(theTable, theKey, theData, index, update);
+  END (*--if*);
+END Update;
+(*-------------------------*)
+
+
+PROCEDURE IsDefined (    theTable   : HashTable     (*--in   *))
+                                    : BOOLEAN       (*--out  *);
+BEGIN
+  RETURN (theTable # NullTable);
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theTable   : HashTable     (*--in   *))
+                                    : BOOLEAN       (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(isempty, undefined);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN theTable^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE KeyTypeOf (    theTable   : HashTable     (*--in   *))
+                                    : TypeID        (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(typeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theTable^.keyID;
+END KeyTypeOf;
+(*-------------------------*)
+
+PROCEDURE DataTypeOf(    theTable   : HashTable     (*--in   *))
+                                    : TypeID        (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(typeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theTable^.dataID;
+END DataTypeOf;
+(*-------------------------*)
+
+PROCEDURE HashOf    (    theTable   : HashTable     (*--in   *))
+                                    : HashFunction  (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(hashof, undefined);
+    RETURN VAL(HashFunction, NIL);
+  END (*--if*);
+  RETURN theTable^.hash;
+END HashOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theTable   : HashTable     (*--in   *))
+                                    : CARDINAL      (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(sizeof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theTable^.currSize;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE ExtentOf  (    theTable   : HashTable     (*--in   *))
+                                    : CARDINAL      (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(extentof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theTable^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+PROCEDURE IsPresent (    theTable   : HashTable     (*--in   *);
+                         theKey     : Key           (*--in   *);
+                         found      : FoundProc     (*--in   *);
+                         notFound   : NotFoundProc  (*--in   *));
+
+VAR   index     : CARDINAL;     (*-- bucket where item was found *)
+      prior     : TableEntryPtr;
+      current   : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(ispresent, undefined);
+  ELSIF Search(theTable, theKey, index, prior, current) THEN
+    found(current^.key, current^.data);
+  ELSE
+    notFound(theKey);
+  END (*--if*);
+END IsPresent;
+(*-------------------------*)
+
+
+PROCEDURE LoopOver  (    theTable   : HashTable     (*--in   *);
+                         process    : LoopProc      (*--in   *));
+
+VAR   index : CARDINAL;     (*-- loop index over hashing table *)
+      curr  : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO currSize-1 DO
+        curr := table[index];
+        WHILE (curr # NIL) DO
+          WITH curr^ DO
+            IF ~process(key, data) THEN
+              RETURN;
+            END (*--if*);
+            curr := next;
+          END (*--with*);
+        END (*--while*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse  (    theTable   : HashTable     (*--in   *);
+                         process    : AccessProc    (*--in   *));
+
+VAR   index : CARDINAL;     (*-- loop index over hashing table *)
+      curr  : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO currSize-1 DO
+        curr := table[index];
+        WHILE (curr # NIL) DO
+          WITH curr^ DO
+            process(key, data);
+            curr := next;
+          END (*--with*);
+        END (*--while*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+
+TYPE  HashTableEntry = POINTER TO TableEntry;
+CONST NullTableEntry = NIL;
+
+VAR   entryState : ARRAY BOOLEAN OF States;
+
+PROCEDURE Iterate   (    theTable   : HashTable     (*--in   *);
+                         process    : IterateProc   (*--in   *));
+
+VAR   index : CARDINAL;     (*-- loop index over hashing table *)
+      curr  : TableEntryPtr;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO currSize-1 DO
+        process(index, entryState[table[index] # NIL],
+                       VAL(HashTableEntry, table[index]));
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Iterate;
+(*-------------------------*)
+
+PROCEDURE IsNull    (    theEntry   : HashTableEntry    (*--in   *))
+                                    : BOOLEAN           (*--out  *);
+BEGIN
+  RETURN theEntry = NullTableEntry;
+END IsNull;
+(*-------------------------*)
+
+PROCEDURE KeyOf     (    theEntry   : HashTableEntry(*--in   *))
+                                    : Key           (*--out  *);
+BEGIN
+  IF (theEntry = NullTableEntry) THEN
+    RETURN NullItem;
+  ELSE
+    RETURN theEntry^.key;
+  END (*--if*);
+END KeyOf;
+(*-------------------------*)
+
+PROCEDURE DataOf    (    theEntry   : HashTableEntry(*--in   *))
+                                    : Data          (*--out  *);
+BEGIN
+  IF (theEntry = NullTableEntry) THEN
+    RETURN NullItem;
+  ELSE
+    RETURN theEntry^.data;
+  END (*--if*);
+END DataOf;
+(*-------------------------*)
+
+PROCEDURE NextOf    (    theEntry   : HashTableEntry    (*--in   *))
+                                    : HashTableEntry    (*--out  *);
+
+BEGIN
+  IF (theEntry = NullTableEntry) THEN
+    RETURN NullTableEntry;
+  ELSE
+    RETURN VAL(HashTableEntry, theEntry^.next);
+  END (*--if*);
+END NextOf;
+(*-------------------------*)
+
+
+BEGIN
+  FOR tableError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(tableError, NullHandler);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  tableError := noerr;
+  NullTable := NIL;
+  entryState[FALSE] := empty;
+  entryState[TRUE ] := used;
+END LinearHashing.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/lphash.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/lphash.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/lphash.def
@@ -0,0 +1,134 @@
+DEFINITION MODULE LPHash;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Hash Table - Sequential Bounded Managed Iterator
+              Collision resolution using linear probing
+
+    REVISION HISTORY
+    v1.00  10-11 Apr 1989  C. Lins:
+        Initial Modula-2 implementation
+    v1.01  19 Apr 1989  C. Lins:
+        Created HashTypes module.
+    v1.02  22 Apr 1989  C. Lins:
+       Added Iterate routine for testing purposes.
+    v1.03  11 Jun 1989  C. Lins:
+       Removed notFound procedure parameter from Update. Changed
+       semantics to automatically insert the new entry if not
+       found in the table.
+    v1.04  30 Jun 1989  C. Lins:
+       Removed separation of key and data.
+    v1.05  21 Aug 1989  C. Lins:
+       Added selector HashOf to return hashing function.
+    v1.06  29 Aug 1989  C. Lins:
+       Separate key and data.
+
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+==============================================================*)
+
+FROM HashTypes IMPORT
+   (*--type*) Exceptions, FoundProc, NotFoundProc,
+              UpdateProc, LoopProc, AccessProc, HashFunction,
+              States, Key, Data;
+
+FROM ErrorHandling IMPORT
+   (*--type*) HandlerProc;
+
+FROM TypeManager IMPORT
+   (*--type*) TypeID;
+
+   (*-------------------------*)
+
+
+CONST ModuleID = 1;
+
+PROCEDURE TableError () : Exceptions               (*--out  *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+
+   (*-------------------------*)
+
+
+TYPE  HashTable;
+VAR   NullTable : HashTable;
+
+   (*-------------------------*)
+
+
+PROCEDURE Create   (    keyTypeID  : TypeID        (*--in   *);
+                        dataTypeID : TypeID        (*--in   *);
+                        theSize    : CARDINAL      (*--in   *);
+                        hashFunc   : HashFunction  (*--in   *))
+                                   : HashTable     (*--out  *);
+
+PROCEDURE Destroy  (VAR theTable   : HashTable     (*--inout*));
+
+PROCEDURE Clear    (    theTable   : HashTable     (*--inout*));
+
+PROCEDURE Assign   (    theTable   : HashTable     (*--in   *);
+                    VAR toTable    : HashTable     (*--inout*));
+
+PROCEDURE Insert   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *));
+
+PROCEDURE Remove   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+PROCEDURE Update   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *);
+                        updateEntry: UpdateProc    (*--in   *));
+
+   (*-------------------------*)
+
+
+PROCEDURE IsDefined (    theTable  : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+
+PROCEDURE IsEmpty   (    theTable  : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+
+PROCEDURE KeyTypeOf (    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+
+PROCEDURE DataTypeOf(    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+
+PROCEDURE HashOf    (    theTable  : HashTable     (*--in   *))
+                                   : HashFunction  (*--out  *);
+
+PROCEDURE SizeOf    (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+
+PROCEDURE ExtentOf  (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+
+PROCEDURE IsPresent (    theTable  : HashTable     (*--in   *);
+                         theKey    : Key           (*--in   *);
+                         found     : FoundProc     (*--in   *);
+                         notFound  : NotFoundProc  (*--in   *));
+
+   (*-------------------------*)
+
+
+PROCEDURE LoopOver (    theTable   : HashTable     (*--in   *);
+                        process    : LoopProc      (*--in   *));
+
+PROCEDURE Traverse (    theTable   : HashTable     (*--in   *);
+                        process    : AccessProc    (*--in   *));
+
+
+TYPE  IterateProc = PROCEDURE (CARDINAL, States, Key, Data);
+
+PROCEDURE Iterate  (    theTable   : HashTable     (*--in   *);
+                        process    : IterateProc   (*--in   *));
+
+END LPHash.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/lphash.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/lphash.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/lphash.mod
@@ -0,0 +1,568 @@
+IMPLEMENTATION MODULE LPHash;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Hash Table - Sequential Bounded Managed Iterator
+              Collision resolution using linear probing
+
+    REVISION HISTORY
+    v1.00  10-11 Apr 1989  C. Lins:
+        Initial Modula-2 implementation
+    v1.01  19 Apr 1989  C. Lins:
+        Added GetItem operation. Organizational clean-up after
+       initial testing and implementation of basic operations.
+    v1.02  22 Apr 1989  C. Lins:
+       Added Iterate routine for testing purposes.
+    v1.03  11 Jun 1989  C. Lins:
+       Optimized Insert to test for a full table before searching
+       for the key. Changed Update to automatically insert the
+       entry if it's not found. Corrected Remove to free the key
+       and data values.
+    v1.04  30 Jun 1989  C. Lins:
+       Removed separation of key and data.
+    v1.05  21 Aug 1989  C. Lins:
+       Added HashOf selector.
+    v1.06  29 Aug 1989  C. Lins:
+       Separate key and data.
+    v1.07  03 Sep 1989  C. Lins:
+       Copy hashing function to target hash table in Assign.
+    v1.08  19 Sep 1989  C. Lins:
+       Pass back result from hash table for key from searches
+       instead of key parameter.
+
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+==============================================================*)
+
+FROM SCLStorage IMPORT
+   (*--proc*) Allocate, Deallocate;
+
+FROM Relations IMPORT
+   (*--type*) Relation;
+
+FROM HashTypes IMPORT
+   (*--type*) Exceptions, Operations, ComponentID,
+              FoundProc, NotFoundProc, UpdateProc, LoopProc,
+              AccessProc, HashFunction, States, Key, Data;
+
+FROM Items IMPORT
+   (*--cons*) NullItem,
+   (*--type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM ErrorHandling IMPORT
+   (*--cons*) NullHandler,
+   (*--type*) HandlerProc,
+   (*--proc*) Raise;
+
+FROM TypeManager IMPORT
+   (*--cons*) NullType,
+   (*--type*) TypeID,
+   (*--proc*) AssignOf, CompareOf, DisposeOf;
+
+   (*-------------------------*)
+
+VAR   tableError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE TableError () : Exceptions               (*--out  *);
+BEGIN
+  RETURN tableError;
+END TableError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*--in   *);
+                          theError   : Exceptions  (*--in   *));
+BEGIN
+  tableError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+TYPE  HashTable  = POINTER TO BoundedHashTable;
+TYPE  TableEntry = RECORD
+        state : States;
+        key   : Key;
+        data  : Data;
+      END (*-- TableEntry --*);
+TYPE  HashingTable = ARRAY [0..0] OF TableEntry;
+
+TYPE  BoundedHashTable = RECORD
+        keyID   : TypeID;
+        dataID  : TypeID;
+        h       : HashFunction;
+        size    : CARDINAL;
+        extent  : CARDINAL;
+        table   : HashingTable;
+      END (*-- BoundedHashTable --*);
+
+   (*-------------------------*)
+
+
+(*
+Initialize the table entries to the empty state. O(s)
+*)
+
+PROCEDURE InitToEmpty (    theTable : HashTable (*--inout*));
+
+VAR   index : CARDINAL;
+
+BEGIN
+  WITH theTable^ DO
+    FOR index := 0 TO size-1 DO
+      table[index].state := empty;
+    END (*--for*);
+  END (*--with*);
+END InitToEmpty;
+(*-------------------------*)
+
+(*
+Free a single hash table entry (the key and its associated data). O(1)
+*)
+
+PROCEDURE FreeTableEntry (    theTable : HashTable  (*--in   *);
+                              theEntry : TableEntry (*--inout*));
+
+VAR   free : DisposeProc;  (*-- key/data disposal routine *)
+
+BEGIN
+  free := DisposeOf(theTable^.keyID);
+  free(theEntry.key);
+  free := DisposeOf(theTable^.dataID);
+  free(theEntry.data);
+END FreeTableEntry;
+(*-------------------------*)
+
+(*
+Search the given hash table for the given key returning the index
+into the hash table where the key was found. Finding an empty
+slot in the table causes the index to the last empty or deleted
+slot encountered during the search. O(b/n)
+*)
+
+PROCEDURE Search   (    theTable   : HashTable     (*--in   *);
+                        theKey     : Key           (*--in   *);
+                    VAR theBucket  : CARDINAL      (*--out  *))
+                                   : BOOLEAN       (*--out  *);
+
+VAR  index    : CARDINAL;     (*-- loop index over table entries *)
+     last     : CARDINAL;     (*-- last table entry to examine *)
+     compare  : CompareProc;  (*-- key comparison routine *)
+
+BEGIN
+  theBucket := 0;
+  WITH theTable^ DO
+    compare := CompareOf(keyID);
+    index   := h(theKey) MOD size;
+    last    := (index + size - 1) MOD size;
+    WHILE (index # last) DO
+      WITH table[index] DO
+        CASE state OF
+          empty:
+            IF (theBucket = 0) THEN
+              theBucket := index;
+            END (*--if*);
+            RETURN FALSE;
+        | deleted:
+            IF (theBucket = 0) THEN
+              theBucket := index;
+            END (*--if*);
+        | used:
+            IF (compare(theKey, key) = equal) THEN
+              theBucket := index;
+              RETURN TRUE;
+            END (*--if*);
+        END (*--case*);
+      END (*--with*);
+      index := (index+1) MOD size;
+    END (*--while*);
+  END (*--with*);
+  RETURN FALSE;
+END Search;
+(*-------------------------*)
+
+
+PROCEDURE Create   (    keyTypeID  : TypeID        (*--in   *);
+                        dataTypeID : TypeID        (*--in   *);
+                        theSize    : CARDINAL      (*--in   *);
+                        hashFunc   : HashFunction  (*--in   *))
+                                   : HashTable     (*--out  *);
+
+CONST baseSize  = SIZE(BoundedHashTable) - SIZE(HashingTable);
+CONST entrySize = SIZE(TableEntry);
+
+VAR   newTable : HashTable; (*--temporary for new hash table object *)
+
+BEGIN
+  tableError := noerr;
+  Allocate(newTable, baseSize + theSize * entrySize);
+  IF (newTable = NullTable) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newTable^ DO
+      keyID  := keyTypeID;
+      dataID := dataTypeID;
+      extent := 0;
+      size   := theSize;
+      h      := hashFunc;
+    END (*--with*);
+    InitToEmpty(newTable);
+  END (*--if*);
+  RETURN newTable;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy  (VAR theTable   : HashTable     (*--inout*));
+CONST baseSize  = SIZE(BoundedHashTable) - SIZE(HashingTable);
+CONST entrySize = SIZE(TableEntry);
+BEGIN
+  Clear(theTable);
+  IF (tableError = noerr) THEN
+    Deallocate(theTable, baseSize + theTable^.size * entrySize);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear        (    theTable   : HashTable     (*--inout*));
+
+VAR   index : CARDINAL;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO size-1 DO
+        IF (table[index].state = used) THEN
+          FreeTableEntry(theTable, table[index]);
+        END (*--if*);
+      END (*--for*);
+      extent := 0;
+    END (*--with*);
+    InitToEmpty(theTable);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign   (    theTable   : HashTable     (*--in   *);
+                    VAR toTable    : HashTable     (*--inout*));
+
+  PROCEDURE RecreateTarget () : BOOLEAN (*--out *);
+  BEGIN
+    IF (theTable = NullTable) THEN
+      RaiseErrIn(assign, undefined);
+    ELSIF (toTable = NullTable) THEN
+      WITH theTable^ DO
+        toTable := Create(keyID, dataID, size, h);
+      END (*--with*);
+    ELSIF (toTable = theTable) THEN
+      RETURN FALSE;
+    ELSIF (toTable^.size >= theTable^.extent) THEN
+      Clear(toTable);
+      WITH theTable^ DO
+        toTable^.keyID  := keyID;
+        toTable^.dataID := dataID;
+        toTable^.h      := h;
+      END (*--with*);
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    RETURN tableError = noerr;
+  END RecreateTarget;
+
+VAR  assignKey  : AssignProc; (*-- key assignment routine *)
+     assignData : AssignProc; (*-- data assignment routine *)
+     index      : CARDINAL;   (*-- loop index over table entries *)
+
+BEGIN
+  tableError := noerr;
+  IF RecreateTarget() THEN
+    WITH theTable^ DO
+      assignKey  := AssignOf(keyID);
+      assignData := AssignOf(dataID);
+      FOR index := 0 TO size-1 DO
+        WITH table[index] DO
+          IF (state = used) THEN
+            Insert(toTable, assignKey(key), assignData(data));
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Insert   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *));
+
+VAR   index : CARDINAL;        (*-- bucket where to insert *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(insert, undefined);
+  ELSIF (theTable^.extent = theTable^.size) THEN
+    RaiseErrIn(insert, overflow);
+  ELSIF Search(theTable, theKey, index) THEN
+    RaiseErrIn(insert, duplicatekey);
+  ELSE
+    WITH theTable^ DO
+      WITH table[index] DO
+        state := used;
+        key   := theKey;
+        data  := theData;
+      END (*--with*);
+      INC(extent);
+    END (*--with*);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+PROCEDURE Remove   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+VAR   index : CARDINAL;        (*-- bucket where key was found *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(remove, undefined);
+  ELSIF Search(theTable, theKey, index) THEN
+    WITH theTable^ DO
+      FreeTableEntry(theTable, table[index]);
+      table[index].state := deleted;
+      DEC(extent);
+    END (*--with*);
+  ELSE
+    notFound(theKey);
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+PROCEDURE Update   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *);
+                        updateEntry: UpdateProc    (*--in   *));
+
+VAR   index : CARDINAL;        (*-- bucket where key was found *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(update, undefined);
+  ELSIF Search(theTable, theKey, index) THEN
+    updateEntry(theTable^.table[index].key, theTable^.table[index].data, theData);
+  ELSIF (theTable^.extent = theTable^.size) THEN
+    RaiseErrIn(update, overflow);
+  ELSE
+    WITH theTable^ DO
+      WITH table[index] DO
+        state := used;
+        key   := theKey;
+        data  := theData;
+      END (*--with*);
+      INC(extent);
+    END (*--with*);
+  END (*--if*);
+END Update;
+(*-------------------------*)
+
+
+PROCEDURE IsDefined (    theTable  : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+BEGIN
+  RETURN (theTable # NullTable);
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty  (    theTable   : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(isempty, undefined);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN theTable^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE KeyTypeOf (    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(typeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theTable^.keyID;
+END KeyTypeOf;
+(*-------------------------*)
+
+PROCEDURE DataTypeOf(    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(typeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theTable^.dataID;
+END DataTypeOf;
+(*-------------------------*)
+
+PROCEDURE HashOf    (    theTable  : HashTable     (*--in   *))
+                                   : HashFunction  (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(hashof, undefined);
+    RETURN VAL(HashFunction, NIL);
+  END (*--if*);
+  RETURN theTable^.h;
+END HashOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(sizeof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theTable^.size;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE ExtentOf  (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(extentof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theTable^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+PROCEDURE IsPresent(    theTable   : HashTable     (*--in   *);
+                        theKey     : Key           (*--in   *);
+                        found      : FoundProc     (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+VAR   index    : CARDINAL;     (*-- bucket where item was found *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(ispresent, undefined);
+  ELSIF Search(theTable, theKey, index) THEN
+    found(theTable^.table[index].key, theTable^.table[index].data);
+  ELSE
+    notFound(theKey);
+  END (*--if*);
+END IsPresent;
+(*-------------------------*)
+
+
+PROCEDURE LoopOver (    theTable   : HashTable     (*--in   *);
+                        process    : LoopProc      (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO size-1 DO
+        WITH table[index] DO
+          IF (state = used) & ~process(key, data) THEN
+            RETURN;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theTable   : HashTable     (*--in   *);
+                        process    : AccessProc    (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO size-1 DO
+        WITH table[index] DO
+          IF (state = used) THEN
+            process(key, data);
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+PROCEDURE Iterate  (    theTable   : HashTable     (*--in   *);
+                        process    : IterateProc   (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO size-1 DO
+        WITH table[index] DO
+          CASE state OF
+            used:
+              process(index, state, key, data);
+          | empty, deleted:
+              process(index, state, NullItem, NullItem);
+          END (*--case*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Iterate;
+(*-------------------------*)
+
+
+BEGIN
+  FOR tableError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(tableError, NullHandler);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  tableError := noerr;
+  NullTable := NIL;
+END LPHash.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/ohash.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/ohash.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/ohash.def
@@ -0,0 +1,118 @@
+DEFINITION MODULE OHash;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Hash Table - Sequential Bounded Managed Iterator
+              Collision resolution using double hashing
+
+    REVISION HISTORY
+    v1.00  22 Apr 1989  C. Lins:
+        Initial Modula-2 implementation
+    v1.01  30 Jun 1989  C. Lins:
+        Removed separation of key and data.
+    v1.02  21 Aug 1989  C. Lins:
+       Removed increment function from Create.
+       Added selector HashOf to return hashing function.
+    v1.03  29 Aug 1989  C. Lins:
+       Separate key and data.
+
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+==============================================================*)
+
+FROM HashTypes IMPORT
+   (*--type*) Exceptions, FoundProc, NotFoundProc,
+              UpdateProc, LoopProc, AccessProc, HashFunction,
+              States, Key, Data;
+
+FROM ErrorHandling IMPORT
+   (*--type*) HandlerProc;
+
+FROM TypeManager IMPORT
+   (*--type*) TypeID;
+
+   (*-------------------------*)
+
+
+CONST ModuleID = 5;
+
+PROCEDURE TableError () : Exceptions               (*--out  *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+
+
+TYPE  HashTable;
+VAR   NullTable : HashTable;
+
+
+PROCEDURE Create   (    keyTypeID  : TypeID        (*--in   *);
+                        dataTypeID : TypeID        (*--in   *);
+                        theSize    : CARDINAL      (*--in   *);
+                        hashFunc   : HashFunction  (*--in   *))
+                                   : HashTable     (*--out  *);
+
+PROCEDURE Destroy  (VAR theTable   : HashTable     (*--inout*));
+
+PROCEDURE Clear    (    theTable   : HashTable     (*--inout*));
+
+PROCEDURE Assign   (    theTable   : HashTable     (*--in   *);
+                    VAR toTable    : HashTable     (*--inout*));
+
+PROCEDURE Insert   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *));
+
+PROCEDURE Remove   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+PROCEDURE Update   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *);
+                        updateEntry: UpdateProc    (*--in   *));
+
+
+PROCEDURE IsDefined (    theTable  : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+
+PROCEDURE IsEmpty   (    theTable  : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+
+PROCEDURE KeyTypeOf (    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+
+PROCEDURE DataTypeOf(    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+
+PROCEDURE HashOf    (    theTable  : HashTable     (*--in   *))
+                                   : HashFunction  (*--out  *);
+
+PROCEDURE SizeOf    (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+
+PROCEDURE ExtentOf  (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+
+PROCEDURE IsPresent (    theTable  : HashTable     (*--in   *);
+                         theKey    : Key           (*--in   *);
+                         found     : FoundProc     (*--in   *);
+                         notFound  : NotFoundProc  (*--in   *));
+
+
+PROCEDURE LoopOver (    theTable   : HashTable     (*--in   *);
+                        process    : LoopProc      (*--in   *));
+
+PROCEDURE Traverse (    theTable   : HashTable     (*--in   *);
+                        process    : AccessProc    (*--in   *));
+
+TYPE  IterateProc = PROCEDURE (CARDINAL, States, Key, Data);
+
+PROCEDURE Iterate  (    theTable   : HashTable     (*--in   *);
+                        process    : IterateProc   (*--in   *));
+
+END OHash.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/ohash.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/ohash.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/hashing/ohash.mod
@@ -0,0 +1,593 @@
+IMPLEMENTATION MODULE OHash;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Hash Table - Sequential Bounded Managed Iterator
+              Collision resolution using double hashing
+
+    REVISION HISTORY
+    v1.00  22 Apr 1989  C. Lins:
+        Initial Modula-2 implementation
+    v1.01  30 Jun 1989  C. Lins:
+        Removed separation of key and data.
+    v1.02  21 Aug 1989  C. Lins:
+        Added HashOf selector.
+    v1.03  29 Aug 1989  C. Lins:
+        Added HashOf selector.
+    v1.04  03 Sep 1989  C. Lins:
+        Copy hashing function to target hash table in Assign.
+    v1.05  19 Sep 1989  C. Lins:
+       Pass back result from hash table for key from searches
+       instead of key parameter.
+
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+==============================================================*)
+
+FROM SCLStorage IMPORT
+   (*--proc*) Allocate, Deallocate;
+
+FROM Relations IMPORT
+   (*--type*) Relation;
+
+FROM HashTypes IMPORT
+   (*--type*) Exceptions, Operations, ComponentID,
+              FoundProc, NotFoundProc, UpdateProc, LoopProc,
+              AccessProc, HashFunction, States, Key, Data;
+
+FROM Items IMPORT
+   (*--cons*) NullItem,
+   (*--type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM ErrorHandling IMPORT
+   (*--cons*) NullHandler,
+   (*--type*) HandlerProc,
+   (*--proc*) Raise;
+
+FROM TypeManager IMPORT
+   (*--cons*) NullType,
+   (*--type*) TypeID,
+   (*--proc*) AssignOf, CompareOf, DisposeOf;
+
+   (*-------------------------*)
+
+VAR   tableError : Exceptions;
+VAR   handlers   : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE TableError () : Exceptions               (*--out  *);
+BEGIN
+  RETURN tableError;
+END TableError;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+BEGIN
+  handlers[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+BEGIN
+  RETURN handlers[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations  (*--in   *);
+                          theError   : Exceptions  (*--in   *));
+BEGIN
+  tableError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+TYPE  HashTable  = POINTER TO BoundedHashTable;
+TYPE  TableEntry = RECORD
+        state : States;
+        key   : Key;
+        data  : Data;
+      END (*-- TableEntry --*);
+TYPE  HashingTable = ARRAY [0..0] OF TableEntry;
+
+TYPE  BoundedHashTable = RECORD
+        keyID   : TypeID;
+        dataID  : TypeID;
+        h       : HashFunction;
+        size    : CARDINAL;
+        extent  : CARDINAL;
+        table   : HashingTable;
+      END (*-- BoundedHashTable --*);
+
+
+PROCEDURE InitToEmpty (    theTable : HashTable (*--inout*));
+
+VAR   index : CARDINAL;
+
+BEGIN
+  WITH theTable^ DO
+    FOR index := 0 TO size-1 DO
+      table[index].state := empty;
+    END (*--for*);
+  END (*--with*);
+END InitToEmpty;
+(*-------------------------*)
+
+PROCEDURE FreeTableEntry (    theTable : HashTable  (*--in   *);
+                              theEntry : TableEntry (*--inout*));
+
+VAR   free : DisposeProc;  (*-- key/data disposal routine *)
+
+BEGIN
+  free := DisposeOf(theTable^.keyID);
+  free(theEntry.key);
+  free := DisposeOf(theTable^.dataID);
+  free(theEntry.data);
+END FreeTableEntry;
+(*-------------------------*)
+
+PROCEDURE Hash (    hashAddress: CARDINAL  (*--in   *);
+                    tableSize  : CARDINAL  (*--in   *);
+                VAR theBucket  : CARDINAL  (*--out  *);
+                VAR increment  : CARDINAL  (*--out  *));
+BEGIN
+   theBucket   := hashAddress MOD tableSize;
+   increment   := hashAddress DIV tableSize;
+   IF (increment = 0) THEN
+     increment := 1;
+   END (*--if*);
+END Hash;
+(*-------------------------*)
+
+(*
+Search the given hash table for the given key returning the index
+into the hash table where the key was found. Finding an empty
+slot in the table causes the index to the last empty or deleted
+slot encountered during the search.
+*)
+
+PROCEDURE Search   (    theTable   : HashTable     (*--in   *);
+                        theKey     : Key           (*--in   *);
+                    VAR theBucket  : CARDINAL      (*--out  *))
+                                   : BOOLEAN       (*--out  *);
+
+VAR  index     : CARDINAL;     (*-- loop index over table entries *)
+     incr      : CARDINAL;     (*-- increment *)
+     last      : CARDINAL;     (*-- last table entry to examine *)
+     compare   : CompareProc;  (*-- key comparison routine *)
+     comparison: Relation;     (*-- compare result *)
+
+BEGIN
+  theBucket := 0;
+  WITH theTable^ DO
+    compare := CompareOf(keyID);
+    Hash(h(theKey), size, index, incr);
+    last := (index + (size - 1) * incr) MOD size;
+    WHILE (index # last) DO
+      WITH table[index] DO
+        CASE state OF
+          empty:
+            IF (theBucket = 0) THEN
+              theBucket := index;
+            END (*--if*);
+            RETURN FALSE;
+        | deleted:
+            IF (theBucket = 0) THEN
+              theBucket := index;
+            END (*--if*);
+        | used:
+            comparison := compare(theKey, key);
+            IF (comparison = equal) THEN
+              theBucket := index;
+              RETURN TRUE;
+            ELSIF (comparison = greater) THEN
+              theBucket := index;
+              RETURN FALSE;
+            END (*--if*);
+        END (*--case*);
+      END (*--with*);
+      index := (index + incr) MOD size;
+    END (*--while*);
+  END (*--with*);
+  RETURN FALSE;
+END Search;
+(*-------------------------*)
+
+PROCEDURE AddTableEntry (    theTable : HashTable  (*--inout*);
+                            theKey   : Key         (*--in   *);
+                            theData  : Data        (*--in   *);
+                            theProc  : Operations  (*--in   *));
+
+VAR  index     : CARDINAL;     (*-- bucket where to insert *)
+     incr      : CARDINAL;     (*-- increment value *)
+     compare   : CompareProc;
+     comparison: Relation;
+     tempData  : Item;
+
+BEGIN
+  WITH theTable^ DO
+   compare := CompareOf(keyID);
+   Hash(h(theKey), size, index, incr);
+   LOOP
+     WITH table[index] DO
+       IF (state = used) THEN
+         comparison := compare(key, theKey);
+         IF (comparison = equal) THEN
+           RaiseErrIn(theProc, duplicatekey);
+           EXIT (*--loop*);
+         ELSIF (comparison = greater) THEN
+           tempData := theKey;
+           theKey   := key;
+           key      := tempData;
+           tempData := theData;
+           theData  := data;
+           data     := tempData;
+         END (*--if*);
+       ELSE
+         (*-- empty or deleted --*)
+         state := used;
+         key   := theKey;
+         data  := theData;
+         INC(extent);
+         EXIT (*--loop*);
+       END (*--if*);
+     END (*--with*);
+     index := (index + incr) MOD size;
+   END (*--loop*);
+  END (*--with*);
+END AddTableEntry;
+(*-------------------------*)
+
+
+PROCEDURE Create   (    keyTypeID  : TypeID        (*--in   *);
+                        dataTypeID : TypeID        (*--in   *);
+                        theSize    : CARDINAL      (*--in   *);
+                        hashFunc   : HashFunction  (*--in   *))
+                                   : HashTable     (*--out  *);
+
+CONST baseSize  = SIZE(BoundedHashTable) - SIZE(HashingTable);
+CONST entrySize = SIZE(TableEntry);
+
+VAR   newTable : HashTable; (*--temporary for new hash table object *)
+
+BEGIN
+  tableError := noerr;
+  Allocate(newTable, baseSize + theSize * entrySize);
+  IF (newTable = NullTable) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newTable^ DO
+      keyID  := keyTypeID;
+      dataID := dataTypeID;
+      extent := 0;
+      size   := theSize;
+      h      := hashFunc;
+    END (*--with*);
+    InitToEmpty(newTable);
+  END (*--if*);
+  RETURN newTable;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy  (VAR theTable   : HashTable     (*--inout*));
+CONST baseSize  = SIZE(BoundedHashTable) - SIZE(HashingTable);
+CONST entrySize = SIZE(TableEntry);
+BEGIN
+  Clear(theTable);
+  IF (tableError = noerr) THEN
+    Deallocate(theTable, baseSize + theTable.size * entrySize);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear        (    theTable   : HashTable     (*--inout*));
+
+VAR   index : CARDINAL;
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO size-1 DO
+        IF (table[index].state = used) THEN
+          FreeTableEntry(theTable, table[index]);
+        END (*--if*);
+      END (*--for*);
+      extent := 0;
+    END (*--with*);
+    InitToEmpty(theTable);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign   (    theTable   : HashTable     (*--in   *);
+                    VAR toTable    : HashTable     (*--inout*));
+
+  PROCEDURE RecreateTarget () : BOOLEAN (*--out *);
+  BEGIN
+    IF (theTable = NullTable) THEN
+      RaiseErrIn(assign, undefined);
+    ELSIF (toTable = NullTable) THEN
+      WITH theTable^ DO
+        toTable := Create(keyID, dataID, size, h);
+      END (*--with*);
+    ELSIF (toTable = theTable) THEN
+      RETURN FALSE;
+    ELSIF (toTable^.size >= theTable^.extent) THEN
+      Clear(toTable);
+      WITH theTable^ DO
+        toTable^.keyID  := keyID;
+        toTable^.dataID := dataID;
+        toTable^.h      := h;
+      END (*--with*);
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    RETURN tableError = noerr;
+  END RecreateTarget;
+
+VAR  assignKey  : AssignProc; (*-- key assignment routine *)
+     assignData : AssignProc; (*-- data assignment routine *)
+     index      : CARDINAL;   (*-- loop index over table entries *)
+
+BEGIN
+  tableError := noerr;
+  IF RecreateTarget() THEN
+    WITH theTable^ DO
+      assignKey  := AssignOf(keyID);
+      assignData := AssignOf(dataID);
+      FOR index := 0 TO size-1 DO
+        WITH table[index] DO
+          IF (state = used) THEN
+            Insert(toTable, assignKey(key), assignData(data));
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Insert   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *));
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(insert, undefined);
+  ELSIF (theTable^.extent >= theTable^.size) THEN
+   RaiseErrIn(insert, overflow);
+  ELSE
+    AddTableEntry(theTable, theKey, theData, insert);
+  END (*--if*);
+END Insert;
+(*-------------------------*)
+
+PROCEDURE Remove   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+VAR   index : CARDINAL;        (*-- bucket where key was found *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(remove, undefined);
+  ELSIF Search(theTable, theKey, index) THEN
+    WITH theTable^ DO
+      FreeTableEntry(theTable, table[index]);
+      table[index].state := deleted;
+      DEC(extent);
+    END (*--with*);
+  ELSE
+    notFound(theKey);
+  END (*--if*);
+END Remove;
+(*-------------------------*)
+
+PROCEDURE Update   (    theTable   : HashTable     (*--inout*);
+                        theKey     : Key           (*--in   *);
+                        theData    : Data          (*--in   *);
+                        updateEntry: UpdateProc    (*--in   *));
+
+VAR   index : CARDINAL;        (*-- bucket where key was found *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(remove, undefined);
+  ELSIF Search(theTable, theKey, index) THEN
+    updateEntry(theTable^.table[index].key, theTable^.table[index].data, theData);
+  ELSIF (theTable^.extent >= theTable^.size) THEN
+    RaiseErrIn(update, overflow);
+  ELSE
+    AddTableEntry(theTable, theKey, theData, update);
+  END (*--if*);
+END Update;
+(*-------------------------*)
+
+
+PROCEDURE IsDefined (    theTable  : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+BEGIN
+  RETURN (theTable # NullTable);
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty  (    theTable   : HashTable     (*--in   *))
+                                   : BOOLEAN       (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(isempty, undefined);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN theTable^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE KeyTypeOf (    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(typeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theTable^.keyID;
+END KeyTypeOf;
+(*-------------------------*)
+
+PROCEDURE DataTypeOf(    theTable  : HashTable     (*--in   *))
+                                   : TypeID        (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(typeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theTable^.dataID;
+END DataTypeOf;
+(*-------------------------*)
+
+PROCEDURE HashOf    (    theTable  : HashTable     (*--in   *))
+                                   : HashFunction  (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(hashof, undefined);
+    RETURN VAL(HashFunction, NIL);
+  END (*--if*);
+  RETURN theTable^.h;
+END HashOf;
+(*-------------------------*)
+
+PROCEDURE SizeOf    (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(sizeof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theTable^.size;
+END SizeOf;
+(*-------------------------*)
+
+PROCEDURE ExtentOf  (    theTable  : HashTable     (*--in   *))
+                                   : CARDINAL      (*--out  *);
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(extentof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theTable^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+PROCEDURE IsPresent(    theTable   : HashTable     (*--in   *);
+                        theKey     : Key           (*--in   *);
+                        found      : FoundProc     (*--in   *);
+                        notFound   : NotFoundProc  (*--in   *));
+
+VAR   index : CARDINAL;        (*-- bucket where item was found *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(ispresent, undefined);
+  ELSIF Search(theTable, theKey, index) THEN
+    found(theTable^.table[index].key, theTable^.table[index].data);
+  ELSE
+    notFound(theKey);
+  END (*--if*);
+END IsPresent;
+(*-------------------------*)
+
+
+PROCEDURE LoopOver (    theTable   : HashTable     (*--in   *);
+                        process    : LoopProc      (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO size-1 DO
+        WITH table[index] DO
+          IF (state = used) & ~process(key, data) THEN
+            RETURN;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE Traverse (    theTable   : HashTable     (*--in   *);
+                        process    : AccessProc    (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO size-1 DO
+        WITH table[index] DO
+          IF (state = used) THEN
+            process(key, data);
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+PROCEDURE Iterate  (    theTable   : HashTable     (*--in   *);
+                        process    : IterateProc   (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+
+BEGIN
+  tableError := noerr;
+  IF (theTable = NullTable) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theTable^ DO
+      FOR index := 0 TO size-1 DO
+        WITH table[index] DO
+          CASE state OF
+            used:
+              process(index, state, key, data);
+          | empty, deleted:
+              process(index, state, NullItem, NullItem);
+          END (*--case*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Iterate;
+(*-------------------------*)
+
+
+BEGIN
+  FOR tableError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(tableError, NullHandler);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  tableError := noerr;
+  NullTable := NIL;
+END OHash.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapdsbmi.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapdsbmi.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapdsbmi.def
@@ -0,0 +1,163 @@
+(*
+4.2 Discrete Map Interface
+
+This section provides the definition module for the Map abstraction
+described in the previous chapter. In this variant, the domain and
+range are constrained to discrete values representable using the CHAR
+basic data type. Thus, characters and enumerations can be used as either
+a domain or range or both. Domains may be further restricted to any
+contiguous subrange, for example the capital letters A through Z from
+the ASCII character set. The same is true for ranges.
+*)
+
+DEFINITION MODULE MapDSBMI;
+(*====================================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Discrete Sequential Bounded Managed Iterator
+
+    INTRODUCTION
+    This module provides operations for the discrete map abstract
+   data type.
+
+    REVISION HISTORY
+    v1.01  04 May 1988  C. Lins
+      Initial implementation for TML Modula-2.
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+=====================================================================*)
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+    (*-----------------------*)
+
+(*
+4.2.1  Type Declarations
+*)
+
+TYPE  Item   = [0 .. 255];	(*-- !! WARNING: Changed from BYTE *)
+TYPE  Domain = Item;
+TYPE  Range  = Item;
+
+TYPE  DomainType = RECORD
+        dataType : TypeID; (*-- data type id for Domain *)
+        first    : Domain; (*-- first element of Domain *)
+        last     : Domain; (*-- last element of Domain *)
+      END (*--DomainType*);
+
+TYPE  RangeType = RECORD
+        dataType  : TypeID; (*-- data type id for Range *)
+        first     : Range;  (*-- first element of Range *)
+        last      : Range;  (*-- last element of Range *)
+        undefined : Range;  (*-- undefined element of Range *)
+      END (*--RangeType*);
+
+TYPE  Map;
+VAR   NullMap : Map;
+
+
+(*---------------------------------*)
+(*--          EXCEPTIONS         --*)
+
+CONST ModuleID = 1;
+
+PROCEDURE MapError   ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+
+(*---------------------------------*)
+(*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create  (    theDomain : DomainType (*-- in    *);
+                       theRange  : RangeType  (*-- in    *))
+                                 : Map        (*-- out   *);
+
+PROCEDURE Destroy (VAR theMap    : Map        (*-- inout *));
+
+PROCEDURE Clear   (VAR theMap    : Map        (*-- inout *));
+
+PROCEDURE Assign  (    theMap    : Map        (*-- in    *);
+                   VAR toMap     : Map        (*-- inout *));
+
+PROCEDURE Bind    (VAR theMap    : Map        (*-- inout *);
+                       theItemIn : Domain     (*-- in    *);
+                       toItemIn  : Range      (*-- in    *));
+
+PROCEDURE Unbind  (VAR theMap    : Map        (*-- inout *);
+                       theItemIn : Domain     (*-- in    *));
+
+
+(*---------------------------------*)
+(*--         SELECTORS           --*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+PROCEDURE IsEqual   (    left      : Map        (*-- in    *);
+                         right     : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*-- in    *))
+                                   : CARDINAL   (*-- out   *);
+
+PROCEDURE DomainOf  (    theMap    : Map        (*-- in    *);
+                     VAR theDomain : DomainType (*-- out   *));
+
+PROCEDURE RangeOf   (    theMap    : Map        (*-- in    *);
+                     VAR theRange  : RangeType  (*-- out   *));
+
+PROCEDURE IsBound   (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+PROCEDURE BoundTo   (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *))
+                                   : Range      (*-- out   *);
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *);
+                     VAR toItem    : Range      (*-- out   *))
+                                   : BOOLEAN    (*-- out   *);
+
+
+(*---------------------------------*)
+(*--         ITERATORS           --*)
+
+TYPE  LoopAccessProc = PROCEDURE (Domain, Range) : BOOLEAN;
+TYPE  LoopChangeProc = PROCEDURE (Domain, VAR Range) : BOOLEAN;
+
+PROCEDURE LoopOver   (    theMap    : Map            (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+PROCEDURE LoopChange (    theMap    : Map            (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+
+TYPE  AccessProc = PROCEDURE (Domain, Range);
+TYPE  ChangeProc = PROCEDURE (Domain, VAR Range);
+
+PROCEDURE Traverse   (    theMap    : Map            (*-- in    *);
+                          theProcess: AccessProc     (*-- in    *));
+
+PROCEDURE TravChange (    theMap    : Map            (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+END MapDSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapdsbmi.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapdsbmi.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapdsbmi.mod
@@ -0,0 +1,552 @@
+(*
+4.3 Discrete Map Implementation
+*)
+
+IMPLEMENTATION MODULE MapDSBMI;
+(*====================================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Discrete Sequential Bounded Managed Iterator
+
+    INTRODUCTION
+    This module provides operations for the discrete map abstract
+   data type.
+
+    REVISION HISTORY
+    v1.01a 15 May 1988  C. Lins
+      Initial implementation for TML Modula-2.
+
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+=====================================================================*)
+
+FROM SYSTEM IMPORT
+   (*--Type*) BYTE;
+
+FROM SCLStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions, Operations;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+    (*-----------------------*)
+
+(*
+4.3.1  Type Declarations
+*)
+
+TYPE  Map = POINTER TO DiscreteMap;
+
+TYPE  MapItems = ARRAY Domain OF Range;
+
+TYPE  DiscreteMap = RECORD
+        domain : DomainType;
+        range  : RangeType;
+        size   : INTEGER;
+        extent : INTEGER;
+        items  : MapItems;
+      END (*--DiscreteMap*);
+
+
+(*---------------------------------*)
+(*--          EXCEPTIONS         --*)
+
+VAR   mapError : Exceptions;
+VAR   handler  : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE MapError   ()              : Exceptions  (*-- out   *);
+BEGIN
+  RETURN mapError;
+END MapError;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  mapError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+4.3.2  Local Routines
+*)
+
+PROCEDURE ValidDomain (    theItem   : Domain     (*-- in    *);
+                           theDomain : DomainType (*-- in    *))
+                                     : BOOLEAN    (*-- out   *);
+BEGIN
+  WITH theDomain DO
+    RETURN (first <= theItem) & (theItem <= last);
+  END (*--with*);
+END ValidDomain;
+(*-------------------------*)
+
+PROCEDURE ValidRange  (    theItem   : Domain     (*-- in    *);
+                           theRange  : RangeType  (*-- in    *))
+                                     : BOOLEAN    (*-- out   *);
+BEGIN
+  WITH theRange DO
+    RETURN (first <= theItem) & (theItem <= last);
+  END (*--with*);
+END ValidRange;
+(*-------------------------*)
+
+PROCEDURE AdjustDomain (    theItem   : Domain     (*-- in    *);
+                            theDomain : DomainType (*-- in    *))
+                                      : Item       (*-- out   *);
+BEGIN
+  RETURN theItem - theDomain.first; (*-- force zero-based *)
+END AdjustDomain;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create  (    theDomain : DomainType (*-- in    *);
+                       theRange  : RangeType  (*-- in    *))
+                                 : Map        (*-- out   *);
+
+CONST baseSize = SIZE(DiscreteMap) - SIZE(MapItems);
+CONST byteSize = SIZE(Item);
+
+VAR   newMap  : Map;
+VAR   theSize : INTEGER;
+
+BEGIN
+  mapError := noerr;
+  IF theDomain.first > theDomain.last THEN
+    RaiseErrIn(create, outofdomain);
+    newMap := NullMap;
+  ELSIF theRange.first > theRange.last THEN
+    RaiseErrIn(create, outofrange);
+    newMap := NullMap;
+  ELSE
+    WITH theDomain DO
+      theSize := last - first + 1;
+    END (*--with*);
+    Allocate(newMap, baseSize + byteSize * theSize);
+    IF (newMap = NIL) THEN
+      RaiseErrIn(create, overflow);
+    ELSE
+      WITH newMap^ DO
+        domain := theDomain;
+        range  := theRange;
+        size   := theSize;
+      END (*--with*);
+      Clear(newMap);
+    END (*--if*);
+  END (*--if*);
+  RETURN newMap;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theMap    : Map     (*-- inout *));
+CONST baseSize = SIZE(DiscreteMap) - SIZE(MapItems);
+CONST byteSize = SIZE(Item);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(destroy, undefined);
+  ELSE
+    Deallocate(theMap, baseSize + byteSize * theMap^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theMap    : Map     (*-- inout *));
+
+VAR   index : INTEGER; (*-- loop index over items of Domain *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(Item) TO size-1 DO
+        items[index] := range.undefined;
+      END (*--for*);
+      extent := 0;
+    END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theMap    : Map     (*-- in    *);
+                   VAR toMap     : Map     (*-- inout *));
+
+VAR   index : INTEGER; (*-- loop index over items of Domain *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theMap = toMap) THEN
+    RETURN;
+  ELSIF (toMap = NIL) THEN
+    toMap := Create(theMap^.domain, theMap^.range);
+  ELSE
+    Destroy(toMap);
+    toMap := Create(theMap^.domain, theMap^.range);
+  END (*--if*);
+  
+  IF (mapError = noerr) THEN
+    WITH theMap^ DO
+      FOR index := 0 TO size-1 DO
+       toMap^.items[index] := items[index];
+      END (*--for*);
+      toMap^.extent := extent;
+    END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Bind    (VAR theMap    : Map     (*-- inout *);
+                       theItemIn : Domain  (*-- in    *);
+                       toItemIn  : Range   (*-- in    *));
+
+VAR   adjustedDomain : Item; (*-- numeric equivalent of Domain *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(bind, undefined);
+  ELSIF ~ValidDomain(theItemIn, theMap^.domain) THEN
+    RaiseErrIn(bind, outofdomain);
+  ELSIF ~ValidRange(toItemIn, theMap^.range) THEN
+    RaiseErrIn(bind, outofrange);
+  ELSE
+    WITH theMap^ DO
+     adjustedDomain := AdjustDomain(theItemIn, domain);
+     IF (items[adjustedDomain] = range.undefined) THEN
+       INC(extent);
+     END (*--if*);
+     items[adjustedDomain] := toItemIn;
+   END (*--with*);
+  END (*--if*);
+END Bind;
+(*-------------------------*)
+
+PROCEDURE Unbind  (VAR theMap    : Map     (*-- inout *);
+                       theItemIn : Domain  (*-- in    *));
+
+VAR   adjustedDomain : Item; (*-- numeric equivalent of Domain *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(unbind, undefined);
+  ELSIF ~ValidDomain(theItemIn, theMap^.domain) THEN
+    RaiseErrIn(unbind, outofdomain);
+  ELSE
+    WITH theMap^ DO
+     adjustedDomain := AdjustDomain(theItemIn, domain);
+     IF (items[adjustedDomain] # range.undefined) THEN
+       DEC(extent);
+     END (*--if*);
+     items[adjustedDomain] := range.undefined;
+   END (*--with*);
+  END (*--if*);
+END Unbind;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--         SELECTORS           --*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+BEGIN
+  RETURN theMap # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(isempty, undefined);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN theMap^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left      : Map        (*-- in    *);
+                         right     : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+VAR   index : INTEGER; (*-- loop index over items of Domain *)
+
+BEGIN
+  mapError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.domain.dataType # right^.domain.dataType) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSE
+    WITH left^ DO
+      FOR index := MIN(Item) TO size-1 DO
+        IF (items[index] # right^.items[index]) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*-- in    *))
+                                   : CARDINAL   (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(extentof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+PROCEDURE DomainOf  (    theMap    : Map        (*-- in    *);
+                     VAR theDomain : DomainType (*-- out   *));
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(domainof, undefined);
+  ELSE
+    theDomain := theMap^.domain;
+  END (*--if*);
+END DomainOf;
+(*-------------------------*)
+
+PROCEDURE RangeOf   (    theMap    : Map        (*-- in    *);
+                     VAR theRange  : RangeType  (*-- out   *));
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(rangeof, undefined);
+  ELSE
+    theRange := theMap^.range;
+  END (*--if*);
+END RangeOf;
+(*-------------------------*)
+
+
+PROCEDURE IsBound   (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(isbound, undefined);
+  ELSIF ~ValidDomain(theItem, theMap^.domain) THEN
+    RaiseErrIn(isbound, outofdomain);
+  ELSE
+    WITH theMap^ DO
+      RETURN items[AdjustDomain(theItem, domain)] # range.undefined;
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsBound;
+(*-------------------------*)
+
+PROCEDURE BoundTo   (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *))
+                                   : Range      (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(boundto, undefined);
+  ELSIF ~ValidDomain(theItem, theMap^.domain) THEN
+    RaiseErrIn(boundto, outofdomain);
+  ELSE
+    WITH theMap^ DO
+      RETURN items[AdjustDomain(theItem, domain)];
+    END (*--with*);
+  END (*--if*);
+  RETURN theMap^.range.undefined;
+END BoundTo;
+(*-------------------------*)
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *);
+                     VAR toItem    : Range      (*-- out   *))
+                                   : BOOLEAN    (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(isboundto, undefined);
+  ELSIF ~ValidDomain(theItem, theMap^.domain) THEN
+    RaiseErrIn(isboundto, outofdomain);
+  ELSE
+    WITH theMap^ DO
+      toItem := items[AdjustDomain(theItem, domain)];
+      RETURN toItem # range.undefined;
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsBoundTo;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--         ITERATORS           --*)
+
+PROCEDURE LoopOver   (    theMap    : Map            (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : Item; (*-- loop index over items of Domain *)
+      first : Item; (*-- numeric equivalent of Domain.first *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theMap^ DO
+      first := domain.first;
+      FOR index := MIN(Item) TO VAL(Item, size-1) DO
+        IF (items[index] # range.undefined) THEN
+          IF ~theProcess(VAL(Domain, index + first), items[index]) THEN
+            RETURN;
+          END (*--if*);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE LoopChange (    theMap    : Map            (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+VAR   index : Item; (*-- loop index over items of Domain *)
+      first : Item; (*-- numeric equivalent of Domain.first *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(loopchange, undefined);
+  ELSE
+    WITH theMap^ DO
+      first := domain.first;
+      FOR index := MIN(Item) TO VAL(Item, size-1) DO
+        IF (items[index] # range.undefined) THEN
+          IF ~theProcess(VAL(Domain, index + first), items[index]) THEN
+            RETURN;
+          END (*--if*);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopChange;
+(*-------------------------*)
+
+
+PROCEDURE Traverse   (    theMap    : Map            (*-- in    *);
+                          theProcess: AccessProc     (*-- in    *));
+
+VAR   index : Item; (*-- loop index over items of Domain *)
+      first : Item; (*-- numeric equivalent of Domain.first *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theMap^ DO
+      first := domain.first;
+      FOR index := MIN(Item) TO VAL(Item, size-1) DO
+        IF (items[index] # range.undefined) THEN
+          theProcess(VAL(Domain, index + first), items[index]);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+PROCEDURE TravChange (    theMap    : Map            (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+VAR   index : Item; (*-- loop index over items of Domain *)
+      first : Item; (*-- numeric equivalent of Domain.first *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(travchange, undefined);
+  ELSE
+    WITH theMap^ DO
+      first := domain.first;
+      FOR index := MIN(Item) TO VAL(Item, size-1) DO
+        IF (items[index] # range.undefined) THEN
+          theProcess(VAL(Domain, index + first), items[index]);
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END TravChange;
+(*-------------------------*)
+
+
+(*
+4.3.7 Module Initialization
+
+The module's local variables are initialized to known states.
+mapError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, mapError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR mapError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(mapError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  mapError := noerr;
+  NullMap := NIL;
+END MapDSBMI.
+
+(*
+References
+
+*)
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapdsbmn.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapdsbmn.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapdsbmn.def
@@ -0,0 +1,141 @@
+(*
+4.4 Discrete Map Interface
+
+This section provides the definition module for the Map abstraction
+described in the previous chapter. In this variant, the domain and
+range are constrained to discrete values representable using the CHAR
+basic data type. Thus, characters and enumerations can be used as either
+a domain or range or both. Domains may be further restricted to any
+contiguous subrange, for example the capital letters A through Z from
+the ASCII character set. The same is true for ranges.
+*)
+
+DEFINITION MODULE MapDSBMN;
+(*====================================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Discrete Sequential Bounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module provides operations for the discrete map abstract
+   data type.
+
+    REVISION HISTORY
+    v1.00  04 May 1988  C. Lins
+      Initial implementation for TML Modula-2.
+
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+=====================================================================*)
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+    (*-----------------------*)
+
+(*
+4.2.1  Type Declarations
+*)
+
+TYPE  Item   = [0..255];
+TYPE  Domain = Item;
+TYPE  Range  = Item;
+
+TYPE  DomainType = RECORD
+        dataType : TypeID; (*-- data type id for Domain *)
+        first    : Domain; (*-- first element of Domain *)
+        last     : Domain; (*-- last element of Domain *)
+      END (*--DomainType*);
+
+TYPE  RangeType = RECORD
+        dataType  : TypeID; (*-- data type id for Range *)
+        first     : Range;  (*-- first element of Range *)
+        last      : Range;  (*-- last element of Range *)
+        undefined : Range;  (*-- undefined element of Range *)
+      END (*--RangeType*);
+
+TYPE  Map;
+VAR   NullMap : Map;
+
+
+(*---------------------------------*)
+(*--          EXCEPTIONS         --*)
+
+CONST ModuleID = 2;
+
+PROCEDURE MapError   ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+
+(*---------------------------------*)
+(*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create  (    theDomain : DomainType (*-- in    *);
+                       theRange  : RangeType  (*-- in    *))
+                                 : Map        (*-- out   *);
+
+PROCEDURE Destroy (VAR theMap    : Map        (*-- inout *));
+
+PROCEDURE Clear   (VAR theMap    : Map        (*-- inout *));
+
+PROCEDURE Assign  (    theMap    : Map        (*-- in    *);
+                   VAR toMap     : Map        (*-- inout *));
+
+PROCEDURE Bind    (VAR theMap    : Map        (*-- inout *);
+                       theItemIn : Domain     (*-- in    *);
+                       toItemIn  : Range      (*-- in    *));
+
+PROCEDURE Unbind  (VAR theMap    : Map        (*-- inout *);
+                       theItemIn : Domain     (*-- in    *));
+
+
+(*---------------------------------*)
+(*--         SELECTORS           --*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+PROCEDURE IsEqual   (    left      : Map        (*-- in    *);
+                         right     : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*-- in    *))
+                                   : CARDINAL   (*-- out   *);
+
+PROCEDURE DomainOf  (    theMap    : Map        (*-- in    *);
+                     VAR theDomain : DomainType (*-- out   *));
+
+PROCEDURE RangeOf   (    theMap    : Map        (*-- in    *);
+                     VAR theRange  : RangeType  (*-- out   *));
+
+PROCEDURE IsBound   (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+PROCEDURE BoundTo   (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *))
+                                   : Range      (*-- out   *);
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *);
+                     VAR toItem    : Range      (*-- out   *))
+                                   : BOOLEAN    (*-- out   *);
+
+END MapDSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapdsbmn.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapdsbmn.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapdsbmn.mod
@@ -0,0 +1,443 @@
+(*
+4.5 Discrete Map Implementation
+*)
+
+IMPLEMENTATION MODULE MapDSBMN;
+(*====================================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Discrete Sequential Bounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module provides operations for the discrete map abstract
+   data type.
+
+    REVISION HISTORY
+    v1.00a 15 May 1988  C. Lins
+      Initial implementation for TML Modula-2.
+
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+=====================================================================*)
+
+FROM SCLStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+    (*-----------------------*)
+
+(*
+4.3.1  Type Declarations
+*)
+
+TYPE  Map = POINTER TO DiscreteMap;
+
+TYPE  MapItems = ARRAY Domain OF Range;
+
+TYPE  DiscreteMap = RECORD
+        domain : DomainType;
+        range  : RangeType;
+        size   : INTEGER;
+        extent : INTEGER;
+        items  : MapItems;
+      END (*--DiscreteMap*);
+
+
+(*---------------------------------*)
+(*--          EXCEPTIONS         --*)
+
+VAR   mapError : Exceptions;
+VAR   handler  : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE MapError   ()              : Exceptions  (*-- out   *);
+BEGIN
+  RETURN mapError;
+END MapError;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  mapError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+4.3.2  Local Routines
+*)
+
+PROCEDURE ValidDomain (    theItem   : Domain     (*-- in    *);
+                           theDomain : DomainType (*-- in    *))
+                                     : BOOLEAN    (*-- out   *);
+BEGIN
+  WITH theDomain DO
+    RETURN (first <= theItem) & (theItem <= last);
+  END (*--with*);
+END ValidDomain;
+(*-------------------------*)
+
+PROCEDURE ValidRange  (    theItem   : Domain     (*-- in    *);
+                           theRange  : RangeType  (*-- in    *))
+                                     : BOOLEAN    (*-- out   *);
+BEGIN
+  WITH theRange DO
+    RETURN (first <= theItem) & (theItem <= last);
+  END (*--with*);
+END ValidRange;
+(*-------------------------*)
+
+PROCEDURE AdjustDomain (    theItem   : Domain     (*-- in    *);
+                            theDomain : DomainType (*-- in    *))
+                                      : Byte       (*-- out   *);
+BEGIN
+  RETURN theItem - theDomain.first;
+END AdjustDomain;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create  (    theDomain : DomainType (*-- in    *);
+                       theRange  : RangeType  (*-- in    *))
+                                  : Map        (*-- out   *);
+
+CONST baseSize = SIZE(DiscreteMap) - SIZE(MapItems);
+CONST byteSize = SIZE(Item);
+
+VAR   newMap  : Map;
+VAR   theSize : INTEGER;
+
+BEGIN
+  mapError := noerr;
+  IF theDomain.first > theDomain.last THEN
+    RaiseErrIn(create, outofdomain);
+    newMap := NullMap;
+  ELSIF theRange.first > theRange.last THEN
+    RaiseErrIn(create, outofrange);
+    newMap := NullMap;
+  ELSE
+    WITH theDomain DO
+      theSize := last - first + 1;
+    END (*--with*);
+    Allocate(newMap, baseSize + byteSize * theSize);
+    IF (newMap = NIL) THEN
+      RaiseErrIn(create, overflow);
+    ELSE
+      WITH newMap^ DO
+        domain := theDomain;
+        range  := theRange;
+        size   := theSize;
+      END (*--with*);
+      Clear(newMap);
+    END (*--if*);
+  END (*--if*);
+  RETURN newMap;
+END Create;
+(*-------------------------*)
+
+PROCEDURE Destroy (VAR theMap    : Map     (*-- inout *));
+CONST baseSize = SIZE(DiscreteMap) - SIZE(MapItems);
+CONST byteSize = SIZE(Item);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(destroy, undefined);
+  ELSE
+    Deallocate(theMap, baseSize + byteSize * theMap^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+PROCEDURE Clear   (VAR theMap    : Map     (*-- inout *));
+
+VAR   index : Item; (*-- loop index over items of Domain *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(Item) TO VAL(Item, size-1) DO
+        items[index] := range.undefined;
+     END (*--for*);
+     extent := 0;
+   END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+PROCEDURE Assign  (    theMap    : Map     (*-- in    *);
+                   VAR toMap     : Map     (*-- inout *));
+
+VAR   index : INTEGER; (*-- loop index over items of Domain *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theMap = toMap) THEN
+    RETURN;
+  ELSIF (toMap = NIL) THEN
+    toMap := Create(theMap^.domain, theMap^.range);
+  ELSE
+    Destroy(toMap);
+    toMap := Create(theMap^.domain, theMap^.range);
+  END (*--if*);
+  
+  IF (mapError = noerr) THEN
+    WITH theMap^ DO
+      FOR index := 0 TO size-1 DO
+        toMap^.items[index] := items[index];
+      END (*--for*);
+      toMap^.extent := extent;
+    END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+PROCEDURE Bind    (VAR theMap    : Map     (*-- inout *);
+                       theItemIn : Domain  (*-- in    *);
+                       toItemIn  : Range   (*-- in    *));
+
+VAR   adjustedDomain : Item; (*-- numeric equivalent of Domain *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(bind, undefined);
+  ELSIF ~ValidDomain(theItemIn, theMap^.domain) THEN
+    RaiseErrIn(bind, outofdomain);
+  ELSIF ~ValidRange(toItemIn, theMap^.range) THEN
+    RaiseErrIn(bind, outofrange);
+  ELSE
+    WITH theMap^ DO
+     adjustedDomain := AdjustDomain(theItemIn, domain);
+     IF (items[adjustedDomain] = range.undefined) THEN
+       INC(extent);
+     END (*--if*);
+     items[adjustedDomain] := toItemIn;
+   END (*--with*);
+  END (*--if*);
+END Bind;
+(*-------------------------*)
+
+PROCEDURE Unbind  (VAR theMap    : Map     (*-- inout *);
+                       theItemIn : Domain  (*-- in    *));
+
+VAR   adjustedDomain : Item; (*-- numeric equivalent of Domain *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(unbind, undefined);
+  ELSIF ~ValidDomain(theItemIn, theMap^.domain) THEN
+    RaiseErrIn(unbind, outofdomain);
+  ELSE
+    WITH theMap^ DO
+      adjustedDomain := AdjustDomain(theItemIn, domain);
+      IF (items[adjustedDomain] # range.undefined) THEN
+        DEC(extent);
+      END (*--if*);
+      items[adjustedDomain] := range.undefined;
+    END (*--with*);
+  END (*--if*);
+END Unbind;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--         SELECTORS           --*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+BEGIN
+  RETURN theMap # NIL;
+END IsDefined;
+(*-------------------------*)
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(isempty, undefined);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN theMap^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+PROCEDURE IsEqual   (    left      : Map        (*-- in    *);
+                         right     : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+VAR   index : Item; (*-- loop index over items of Domain *)
+
+BEGIN
+  mapError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.domain.dataType # right^.domain.dataType) THEN
+    RaiseErrIn(isequal, typeerror);
+  ELSIF (left^.extent = right^.extent) THEN
+    WITH left^ DO
+      FOR index := MIN(Item) TO VAL(Item, size-1) DO
+        IF (items[index] # right^.items[index]) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*-- in    *))
+                                   : CARDINAL   (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(extentof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+PROCEDURE DomainOf  (    theMap    : Map        (*-- in    *);
+                     VAR theDomain : DomainType (*-- out   *));
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(domainof, undefined);
+  ELSE
+    theDomain := theMap^.domain;
+  END (*--if*);
+END DomainOf;
+(*-------------------------*)
+
+PROCEDURE RangeOf   (    theMap    : Map        (*-- in    *);
+                     VAR theRange  : RangeType  (*-- out   *));
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(rangeof, undefined);
+  ELSE
+    theRange := theMap^.range;
+  END (*--if*);
+END RangeOf;
+(*-------------------------*)
+
+
+PROCEDURE IsBound   (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(isbound, undefined);
+  ELSIF ~ValidDomain(theItem, theMap^.domain) THEN
+    RaiseErrIn(isbound, outofdomain);
+  ELSE
+    WITH theMap^ DO
+      RETURN items[AdjustDomain(theItem, domain)] # range.undefined;
+   END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsBound;
+(*-------------------------*)
+
+PROCEDURE BoundTo   (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *))
+                                   : Range      (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(boundto, undefined);
+  ELSIF ~ValidDomain(theItem, theMap^.domain) THEN
+    RaiseErrIn(boundto, outofdomain);
+  ELSE
+    WITH theMap^ DO
+      RETURN items[AdjustDomain(theItem, domain)];
+    END (*--with*);
+  END (*--if*);
+  RETURN theMap^.range.undefined;
+END BoundTo;
+(*-------------------------*)
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *);
+                     VAR toItem    : Range      (*-- out   *))
+                                   : BOOLEAN    (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(isboundto, undefined);
+  ELSIF ~ValidDomain(theItem, theMap^.domain) THEN
+    RaiseErrIn(isboundto, outofdomain);
+  ELSE
+    WITH theMap^ DO
+      toItem := items[AdjustDomain(theItem, domain)];
+      RETURN toItem # range.undefined;
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsBoundTo;
+(*-------------------------*)
+
+
+(*
+4.5.6 Module Initialization
+
+The module's local variables are initialized to known states.
+mapError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, mapError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR mapError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(mapError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  mapError := noerr;
+  NullMap := NIL;
+END MapDSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmi.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmi.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmi.def
@@ -0,0 +1,155 @@
+(*
+11.1 Bounded Map Interface
+*)
+
+DEFINITION MODULE MapSBMI;
+(*====================================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Sequential Bounded Managed Iterator
+
+    INTRODUCTION
+    This module provides operations for the bounded map abstract
+   data type.
+
+    REVISION HISTORY
+    v1.01  04 May 1988  C. Lins
+      Initial implementation.
+       8/26/89     CL      Add SizeOf selector
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+=====================================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+    (*-----------------------*)
+
+(*
+11.1.1 Type Declarations
+*)
+
+TYPE  Domain = Item;
+TYPE  Range  = Item;
+
+TYPE  Map;
+CONST NullMap = VAL(Map, NIL);
+
+TYPE  MapSize = [1..4094];
+
+
+(*
+11.1.2 Exceptions
+*)
+
+CONST ModuleID = 3;
+
+PROCEDURE MapError   ()              : Exceptions  (*--out  *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+
+
+(*
+11.1.3 Constructors
+*)
+
+PROCEDURE Create  (    theDomain : TypeID  (*--in   *);
+                       theRange  : TypeID  (*--in   *);
+                       theSize   : MapSize (*--in   *))
+                                 : Map     (*--out  *);
+
+PROCEDURE Destroy (VAR theMap    : Map     (*--inout*));
+
+PROCEDURE Clear   (    theMap    : Map     (*--inout*));
+
+PROCEDURE Assign  (    theMap    : Map     (*--in   *);
+                   VAR toMap     : Map     (*--inout *));
+
+PROCEDURE Bind    (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *);
+                       toItemIn  : Range   (*--in   *));
+
+PROCEDURE Unbind  (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *));
+
+
+(*
+11.1.4 Selectors
+*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE IsEqual   (    left      : Map        (*--in   *);
+                         right     : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE SizeOf    (    theMap    : Map        (*--in   *))
+                                   : CARDINAL   (*--out  *);
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*--in   *))
+                                   : CARDINAL   (*--out  *);
+
+PROCEDURE DomainOf  (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+
+PROCEDURE RangeOf   (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+
+PROCEDURE IsBound   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE BoundTo   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : Range      (*--out  *);
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *);
+                     VAR toItem    : Range      (*--out  *))
+                                   : BOOLEAN    (*--out  *);
+
+
+(*
+11.1.5 Iterators
+*)
+
+TYPE  LoopAccessProc = PROCEDURE (Domain, Range) : BOOLEAN;
+TYPE  LoopChangeProc = PROCEDURE (Domain, VAR Range) : BOOLEAN;
+
+PROCEDURE LoopOver   (    theMap    : Map            (*--in   *);
+                          theProcess: LoopAccessProc (*--in   *));
+
+PROCEDURE LoopChange (    theMap    : Map            (*--in   *);
+                          theProcess: LoopChangeProc (*--in   *));
+
+
+TYPE  AccessProc = PROCEDURE (Domain, Range);
+TYPE  ChangeProc = PROCEDURE (Domain, VAR Range);
+
+PROCEDURE Traverse   (    theMap    : Map            (*--in   *);
+                          theProcess: AccessProc     (*--in   *));
+
+PROCEDURE TravChange (    theMap    : Map            (*--in   *);
+                          theProcess: ChangeProc     (*--in   *));
+
+END MapSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmi.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmi.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmi.mod
@@ -0,0 +1,715 @@
+(*
+11.2 Bounded Map Implementation
+*)
+
+IMPLEMENTATION MODULE MapSBMI;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Sequential Bounded Managed Iterator
+
+    INTRODUCTION
+    This module provides operations for the bounded map abstract
+   data type. This implementation uses an unordered array as
+   the underlying representation.
+
+    REVISION HISTORY
+    v1.01 16 May 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.02 18 Apr 1989  C. Lins
+      Added use of component id constant.
+       8/27/89     CL      Added local Search utility operation. Freed range when updated in Bind.
+       8/26/89     CL      Add SizeOf selector.
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+===============================================================*)
+
+FROM SCLStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+   (*--Cons*) NullItem,
+   (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM Relations IMPORT
+   (*--type*) Relation;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, CompareOf, DisposeOf;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+
+    (*-----------------------*)
+
+(*
+5.2.1  Type Declarations
+*)
+
+TYPE  Pair = RECORD
+        d : Domain;     (*-- value of the domain *)
+        r : Range;      (*-- mapped to value of the range *)
+      END (*--Pair*);
+
+TYPE  MapItems = ARRAY MapSize OF Pair;
+
+TYPE  BoundedMap = RECORD
+        domain : TypeID;   (*-- data type id for the domain *)
+        range  : TypeID;   (*-- data type id for the range *)
+        size   : CARDINAL; (*-- maximum # of items in map *)
+        extent : CARDINAL; (*-- current # of items in map *)
+        items  : MapItems; (*-- array [1..size] *)
+      END (*--BoundedMap*);
+
+TYPE  Map = POINTER TO BoundedMap;
+
+
+(*
+5.2.2  Exceptions
+*)
+
+VAR   mapError : Exceptions;
+VAR   handler  : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE MapError   ()              : Exceptions  (*--out  *);
+BEGIN
+  RETURN mapError;
+END MapError;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*--in   *);
+                          theError   : Exceptions (*--in   *));
+BEGIN
+  mapError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+(*
+11.3.3 Local Routines
+
+Search implements a linear search on the items array of a map. The
+routine is used by the map operations Unbind and IsBound to
+determine if a given item of the domain is present in the unordered
+array and return its array index, if any. Complexity O(n).
+*)
+
+PROCEDURE Search   (    theMap     : Map       (*--in   *);
+                        theDomain  : Domain    (*--in   *);
+                    VAR theIndex   : CARDINAL  (*--out  *))
+                                   : BOOLEAN   (*--out  *);
+
+VAR      compare : CompareProc; (*-- domain value comparison routine *)
+
+BEGIN
+  WITH theMap^ DO
+    compare := CompareOf(domain);
+    theIndex:= MIN(MapSize);
+    WHILE (theIndex <= extent) DO
+      IF compare(theDomain, items[theIndex].d) = equal THEN
+        RETURN TRUE;
+      END (*--if*);
+      INC(theIndex);
+    END (*--while*);
+  END (*--with*);
+  RETURN FALSE;
+END Search;
+(*-------------------------*)
+
+
+(*
+11.2.4 Constructors
+*)
+
+(*
+Create attempts to form a new, empty map object. The routine uses
+the standard strategy employed throughout all of the bounded
+components presented in the series of allocating an object containing
+an array of varying size. If the allocation is successful, the data
+types of the domain and range are saved along with the map's maximum
+size, while the extent (the number of items present in the map) is
+initialized to zero. Note that Allocate set the pointer to NIL if
+unable to get the specified number of bytes from the system allocation
+routine. Complexity O(1).
+*)
+
+PROCEDURE Create  (    theDomain : TypeID  (*--in   *);
+                       theRange  : TypeID  (*--in   *);
+                       theSize   : MapSize (*--in   *))
+                                 : Map     (*--out  *);
+
+CONST baseSize = VAL(CARDINAL, SIZE(BoundedMap) - SIZE(MapItems));
+CONST pairSize = VAL(CARDINAL, SIZE(Pair));
+
+VAR   newMap : Map;
+
+BEGIN
+  mapError := noerr;
+  Allocate(newMap, baseSize + pairSize * theSize);
+  IF (newMap = NullMap) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newMap^ DO
+      domain := theDomain;
+      range  := theRange;
+      size   := theSize;
+      extent := 0;
+    END (*--with*);
+  END (*--if*);
+  RETURN newMap;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy is the inverse of Create, making a Map ╘undefined╒. To
+simplify matters we use Clear to test for an undefined map and
+to remove all existing domain/range pairs from the map, if any.
+If an error does not occur then we may dispose of the map object
+itself. Note that the version of Deallocate given here, automatically
+disposes of the proper amount of space (i.e., that which was
+originally allocated to the object. Complexity O(n).
+*)
+
+PROCEDURE Destroy (VAR theMap    : Map     (*--inout*));
+CONST baseSize = SIZE(BoundedMap) - SIZE(MapItems);
+CONST pairSize = SIZE(Pair);
+BEGIN
+  Clear(theMap);
+  IF (mapError = noerr) THEN
+    Deallocate(theMap, baseSize + pairSize * theMap^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear removes all domain/range pairs from the map, if any. The data
+types of the domain and range are used to retrieve the dynamic memory
+deallocation routines, if any, associated with the domain and range.
+This allows us to store arbitrarily complex structures within the map.
+Complexity O(n).
+*)
+
+PROCEDURE Clear   (    theMap    : Map     (*--inout*));
+
+VAR   index      : CARDINAL;    (*--loop index over item pairs*)
+      freeDomain : DisposeProc; (*--disposal routine for items of Domain*)
+      freeRange  : DisposeProc; (*--disposal routine for items of Range*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theMap^ DO
+      freeDomain := DisposeOf(domain);
+      freeRange  := DisposeOf(range);
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          freeDomain(d);
+          freeRange(r);
+        END (*--with*);
+      END (*--for*);
+      extent := 0;
+    END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates a map object, including the domain/range pairs and
+the relationship between them. If the target map, toMap, is undefined
+on entry to the routine it is automatically created with the same
+domain and range data types, and the same maximum size as the source
+map. If the source map is not empty, it is cleared of its contents
+and its domain/range data types are altered to match those of the source
+map. This step is called recreating the target map. Once completed without
+error, the assignment takes place using a simple loop over the number of
+items in the source map. Complexity O(m+n).
+*)
+
+PROCEDURE Assign  (    theMap    : Map     (*--in   *);
+                   VAR toMap     : Map     (*--inout*));
+
+VAR   index        : CARDINAL;   (*--loop index over items of Domain*)
+     assignDomain : AssignProc; (*--domain items assignment routine*)
+     assignRange  : AssignProc; (*--range items assignment routine*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theMap = toMap) THEN
+    RETURN;
+  ELSIF (toMap = NullMap) THEN
+    WITH theMap^ DO
+      toMap := Create(domain, range, size);
+   END (*--with*);
+  ELSIF (theMap^.extent <= toMap^.size) THEN
+    Clear(toMap);
+    WITH theMap^ DO
+      toMap^.domain := domain;
+      toMap^.range  := range;
+   END (*--with*);
+  ELSE
+    RaiseErrIn(assign, overflow);
+  END (*--if*);
+
+  IF (mapError = noerr) THEN
+    WITH theMap^ DO
+      assignDomain := AssignOf(domain);
+      assignRange  := AssignOf(range);
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          toMap^.items[index].d := assignDomain(d);
+          toMap^.items[index].r := assignRange(r);
+        END (*--with*);
+      END (*--for*);
+      toMap^.extent := extent;
+    END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Bind attempts to add (or update) the domain/range pair of items to
+the given map. If the item of the domain already exists in the map
+the item of the range is updated to that given. The algorithm must
+therefore be able to detect the insertion of duplicate domain items.
+Because the array is unordered, the only approach is to use a sequential
+search to find the desired item, if it is present. This is similar to
+the second approach discussed for the ordered array representation. The
+complexity is O(n).
+*)
+
+PROCEDURE Bind    (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *);
+                       toItemIn  : Range   (*--in   *));
+
+VAR  index : CARDINAL; (*--where domain value was found*)
+     free  : DisposeProc;
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(bind, undefined);
+  ELSIF (theMap^.extent = theMap^.size) THEN
+    RaiseErrIn(bind, overflow);
+  ELSIF Search(theMap, theItemIn, index) THEN
+    free := DisposeOf(theMap^.range);
+    free(theMap^.items[index].r);
+    theMap^.items[index].r := toItemIn;
+  ELSE
+    WITH theMap^ DO
+      INC(extent);
+      WITH items[extent] DO
+        d := theItemIn;
+        r := toItemIn;
+      END (*--with*);
+    END (*--with*);
+  END (*--if*);
+END Bind;
+(*-------------------------*)
+
+(*
+Unbind searches for and then removes the domain/range pair of items
+associated with the given domain item. If the item is not in the map
+then the map is left unchanged. Because the array of items is unordered
+a sequential search must be used to determine if the item is indeed present
+in the array. If the item is found it is overwritten with the last item
+in the array (recovering dynamically allocated space, if any), the count
+of items is decremented, and the routine is exited immediately. Thus, if
+the end of the FOR loop is reached, the given domain item is not bound to
+any value of the range.
+Complexity O(n).
+*)
+
+PROCEDURE Unbind  (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *));
+
+VAR  index : CARDINAL;    (*--where domain value was found*)
+     free  : DisposeProc; (*--disposal routine for items*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(unbind, undefined);
+  ELSIF (theMap^.extent = 0) OR ~Search(theMap, theItemIn, index) THEN
+    RaiseErrIn(unbind, notbound);
+  ELSE
+    WITH theMap^ DO
+      WITH items[index] DO
+        free := DisposeOf(domain);
+        free(d);
+        free := DisposeOf(range);
+        free(r);
+      END (*--with*);
+      items[index] := items[extent];
+      DEC(extent);
+    END (*--with*);
+  END (*--if*);
+END Unbind;
+(*-------------------------*)
+
+
+(*
+5.2.4  Selectors
+*)
+
+(*
+IsDefined simply treats a NIL map as the representation for a map
+that has not been created. Complexity O(1).
+*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+BEGIN
+  RETURN (theMap # NullMap);
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns true if the map contains no domain/range pairs, and
+false otherwise. Because we have maintained a count of pairs during
+insertions and deletions this state can be determined quickly. Thus
+we have complexity on the order of O(1).
+*)
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isempty, undefined);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN theMap^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual determines if the left and right mappings contain the same
+domain/range bindings. Initially, we avoid undefined maps [section
+10.4.n of our specification] and mismatched domain data types, in both
+cases signaling an exception and returning false. Next the trivial
+case where the maps have different numbers of elements is handled
+by avoiding the comparison loop.
+
+As the arrays are unordered the whole of the right map must be searched
+for each item of the left map. Thus, this version of IsEqual has a
+complexity on the order of O(n**2). Of course, if this operation is
+not used, or used only infrequently, by the client, this may be immaterial.
+*)
+
+PROCEDURE IsEqual   (    left      : Map        (*--in   *);
+                         right     : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR  index : CARDINAL; (*--loop index over left map items of Domain*)
+     jndex : CARDINAL; (*--loop index over right map items of Domain*)
+     compareDomain : CompareProc; (*--domain comparison routine*)
+     compareRange  : CompareProc; (*--range comparison routine*)
+
+BEGIN
+  mapError := noerr;
+  IF (left = NullMap) OR (right = NullMap) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.domain # right^.domain) OR
+        (left^.range # right^.range) THEN
+    RaiseErrIn(isequal, typeerror);
+
+  ELSIF (left^.extent = right^.extent) THEN
+    WITH left^ DO
+      compareDomain := CompareOf(domain);
+      compareRange  := CompareOf(range);
+      FOR index := MIN(MapSize) TO extent DO
+        jndex := MIN(MapSize);
+        LOOP
+          IF (jndex > extent) THEN
+            RETURN FALSE;
+          ELSIF compareDomain(items[index].d, right^.items[jndex].d) = equal THEN
+            IF compareRange(items[index].r, right^.items[jndex].r) = equal THEN
+              EXIT (*--loop*);
+            ELSE
+              RETURN FALSE;
+            END (*--if*);
+          ELSE
+            INC(jndex);
+          END (*--if*);
+        END (*--loop*);
+      END (*--for*);
+    END (*--with*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+SizeOf returns the maximum number of domain/range pairs allowed in the
+map object. Undefined maps raise an exception and return zero.
+Complexity O(1)
+*)
+
+PROCEDURE SizeOf   (    theMap    : Map        (*--in   *))
+                                  : CARDINAL   (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(sizeof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.size;
+END SizeOf;
+(*-------------------------*)
+
+(*
+ExtentOf returns the number of domain/range pairs present in the
+map object. Undefined maps raise an exception and return zero.
+Complexity O(1)
+*)
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*--in   *))
+                                   : CARDINAL   (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(extentof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+(*
+DomainOf and RangeOf simply return the data type IDs for the domain
+and range, respectively. Undefined maps cause the NullType to be
+returned. Complexity O(1)
+*)
+
+PROCEDURE DomainOf  (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(domainof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.domain;
+END DomainOf;
+(*-------------------------*)
+
+PROCEDURE RangeOf   (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(rangeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.range;
+END RangeOf;
+(*-------------------------*)
+
+(*
+IsBound, BoundTo, and IsBoundTo all use a sequential search to determine
+the presence of the given item of the domain. This must be done as an
+unordered array is used for the internal map representation. Each routine
+returns the appropriate value(s) depending on its function result.
+Complexity O(n).
+*)
+
+PROCEDURE IsBound   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR   index : CARDINAL;    (*-- index of item if found *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isbound, undefined);
+    RETURN FALSE;
+  END (*--if*);
+  RETURN Search(theMap, theItem, index);
+END IsBound;
+(*-------------------------*)
+
+PROCEDURE BoundTo   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : Range      (*--out  *);
+
+VAR   index : CARDINAL;    (*-- index of item if found *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(boundto, undefined);
+  ELSIF Search(theMap, theItem, index) THEN
+    RETURN theMap^.items[index].r;
+  END (*--if*);
+  RETURN NullItem;
+END BoundTo;
+(*-------------------------*)
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *);
+                     VAR toItem    : Range      (*--out  *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR   index : CARDINAL;    (*-- index of item if found *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isboundto, undefined);
+  ELSIF Search(theMap, theItem, index) THEN
+    toItem := theMap^.items[index].r;
+    RETURN TRUE;
+  END (*--if*);
+  toItem := NullItem;
+  RETURN FALSE;
+END IsBoundTo;
+(*-------------------------*)
+
+
+(*
+11.2.5 Iterators
+*)
+
+PROCEDURE LoopOver   (    theMap    : Map            (*--in   *);
+                          theProcess: LoopAccessProc (*--in   *));
+
+VAR   index : CARDINAL; (*--loop index over items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          IF ~theProcess(d, r) THEN
+            RETURN;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE LoopChange (    theMap    : Map            (*--in   *);
+                          theProcess: LoopChangeProc (*--in   *));
+
+VAR   index : CARDINAL; (*--loop index over items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(loopchange, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          IF ~theProcess(d, r) THEN
+            RETURN;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopChange;
+(*-------------------------*)
+
+
+PROCEDURE Traverse   (    theMap    : Map            (*--in   *);
+                          theProcess: AccessProc     (*--in   *));
+
+VAR   index : CARDINAL; (*--loop index over items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          theProcess(d, r);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+PROCEDURE TravChange (    theMap    : Map            (*--in   *);
+                          theProcess: ChangeProc     (*--in   *));
+
+VAR   index : CARDINAL; (*--loop index over items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(travchange, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          theProcess(d, r);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END TravChange;
+(*-------------------------*)
+
+
+(*
+5.2.6 Module Initialization
+
+The module's local variables are initialized to known states.
+mapError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, mapError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR mapError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(mapError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  mapError := noerr;
+  NullMap := NIL;
+END MapSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmih.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmih.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmih.def
@@ -0,0 +1,158 @@
+(*
+11.1 Bounded Map Interface
+*)
+
+DEFINITION MODULE MapSBMIH;
+(*====================================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Sequential Bounded Managed Iterator
+
+    INTRODUCTION
+    This module provides operations for the bounded map abstract
+   data type.
+
+    REVISION HISTORY
+    v1.00  21 Aug 1989  C. Lins
+      Initial implementation using hash tables.
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+=====================================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions;
+
+FROM HashTypes IMPORT
+    (*--Type*) HashFunction;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+    (*-----------------------*)
+
+(*
+11.1.1 Type Declarations
+*)
+
+TYPE  Domain = Item;
+TYPE  Range  = Item;
+
+TYPE  Map;
+VAR   NullMap : Map;
+
+TYPE  MapSize = [1..4094];
+
+
+(*
+11.1.2 Exceptions
+*)
+
+CONST ModuleID = 7;
+
+PROCEDURE MapError   ()              : Exceptions  (*--out  *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+
+
+(*
+11.1.3 Constructors
+*)
+
+PROCEDURE Create  (    theDomain : TypeID       (*--in   *);
+                       theRange  : TypeID       (*--in   *);
+                       theSize   : MapSize      (*--in   *);
+                       theHashOf : HashFunction (*--in   *))
+                                 : Map          (*--out  *);
+
+PROCEDURE Destroy (VAR theMap    : Map         (*--inout*));
+
+PROCEDURE Clear   (    theMap    : Map         (*--inout*));
+
+PROCEDURE Assign  (    theMap    : Map         (*--in   *);
+                   VAR toMap     : Map         (*--inout *));
+
+PROCEDURE Bind    (    theMap    : Map         (*--inout*);
+                       theItemIn : Domain      (*--in   *);
+                       toItemIn  : Range       (*--in   *));
+
+PROCEDURE Unbind  (    theMap    : Map         (*--inout*);
+                       theItemIn : Domain      (*--in   *));
+
+
+(*
+11.1.4 Selectors
+*)
+
+PROCEDURE IsDefined (    theMap    : Map       (*--in   *))
+                                   : BOOLEAN   (*--out  *);
+
+PROCEDURE IsEmpty   (    theMap    : Map       (*--in   *))
+                                   : BOOLEAN   (*--out  *);
+
+PROCEDURE IsEqual   (    left      : Map       (*--in   *);
+                         right     : Map       (*--in   *))
+                                   : BOOLEAN   (*--out  *);
+
+PROCEDURE SizeOf    (    theMap    : Map        (*--in   *))
+                                   : CARDINAL   (*--out  *);
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*--in   *))
+                                   : CARDINAL   (*--out  *);
+
+PROCEDURE DomainOf  (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+
+PROCEDURE RangeOf   (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+
+PROCEDURE IsBound   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE BoundTo   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : Range      (*--out  *);
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *);
+                     VAR toItem    : Range      (*--out  *))
+                                   : BOOLEAN    (*--out  *);
+
+
+(*
+11.1.5 Iterators
+*)
+
+TYPE  LoopAccessProc = PROCEDURE (Domain, Range) : BOOLEAN;
+TYPE  LoopChangeProc = PROCEDURE (Domain, VAR Range) : BOOLEAN;
+
+PROCEDURE LoopOver   (    theMap    : Map            (*--in   *);
+                          theProcess: LoopAccessProc (*--in   *));
+
+PROCEDURE LoopChange (    theMap    : Map            (*--in   *);
+                          theProcess: LoopChangeProc (*--in   *));
+
+
+TYPE  AccessProc = PROCEDURE (Domain, Range);
+TYPE  ChangeProc = PROCEDURE (Domain, VAR Range);
+
+PROCEDURE Traverse   (    theMap    : Map            (*--in   *);
+                          theProcess: AccessProc     (*--in   *));
+
+PROCEDURE TravChange (    theMap    : Map            (*--in   *);
+                          theProcess: ChangeProc     (*--in   *));
+
+END MapSBMIH.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmih.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmih.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmih.mod
@@ -0,0 +1,774 @@
+(*
+11.2 Bounded Map Implementation
+*)
+
+IMPLEMENTATION MODULE MapSBMIHash;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Sequential Bounded Managed Iterator
+              Uses Double Hashing
+
+    INTRODUCTION
+    This module provides operations for the bounded map abstract
+   data type. This implementation uses a hash table as the
+   underlying representation with double hashing collision resolution.
+
+    REVISION HISTORY
+    v1.00 21 Aug 1989  C. Lins
+      Initial implementation using hash tables.
+    v1.01 26 Aug 1989  C. Lins
+      Free range value in Bind before replacing value.
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+===============================================================*)
+
+FROM SCLStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+   (*--Cons*) NullItem,
+   (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM Relations IMPORT
+   (*--type*) Relation;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, CompareOf, DisposeOf;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM HashTypes IMPORT
+    (*--Type*) States, HashFunction;
+
+    (*-----------------------*)
+
+(*
+11.2.1 Type Declarations
+*)
+
+TYPE  Pair = RECORD
+        s : States;     (*-- state of the bucket *)
+        d : Domain;     (*-- value of the domain *)
+        r : Range;      (*-- mapped to value of the range *)
+      END (*--Pair*);
+
+TYPE  MapItems = ARRAY [0..0] OF Pair;
+TYPE  BoundedMap = RECORD
+        domain  : TypeID;   (*-- data type id for the domain *)
+        range   : TypeID;   (*-- data type id for the range *)
+        h       : HashFunction;
+        size    : CARDINAL;
+        extent  : CARDINAL;
+        table   : MapItems;
+      END (*--BoundedMap*);
+
+TYPE  Map = POINTER TO BoundedMap;
+
+(*
+5.2.2  Exceptions
+*)
+
+VAR   mapError : Exceptions;
+VAR   handler  : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE MapError   ()              : Exceptions  (*--out  *);
+BEGIN
+  RETURN mapError;
+END MapError;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*--in   *);
+                          theError   : Exceptions (*--in   *));
+BEGIN
+  mapError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+PROCEDURE InitToEmpty (    theMap : Map (*--inout*));
+
+VAR   index : CARDINAL;
+
+BEGIN
+  WITH theMap^ DO
+    FOR index := 0 TO size-1 DO
+      table[index].s := empty;
+    END (*--for*);
+  END (*--with*);
+END InitToEmpty;
+(*-------------------------*)
+
+PROCEDURE FreeBinding (    theMap   : Map      (*--in   *);
+                       VAR thePair  : Pair     (*--inout*));
+
+VAR   free : DisposeProc;  (*-- domain/range disposal routine *)
+
+BEGIN
+  free := DisposeOf(theMap^.domain);
+  free(thePair.d);
+  free := DisposeOf(theMap^.range);
+  free(thePair.r);
+END FreeBinding;
+(*-------------------------*)
+
+PROCEDURE AddBinding (    theMap   : Map        (*--inout*);
+                          theIndex : CARDINAL   (*--in   *);
+                          theDomain: Domain     (*--in   *);
+                          theRange : Range      (*--in   *));
+BEGIN
+  WITH theMap^ DO
+    WITH table[theIndex] DO
+      s := used;
+      d := theDomain;
+      r := theRange;
+    END (*--with*);
+    INC(extent);
+  END (*--with*);
+END AddBinding;
+(*-------------------------*)
+
+PROCEDURE Search   (    theMap     : Map           (*--in   *);
+                        theKey     : Domain        (*--in   *);
+                    VAR theBucket  : CARDINAL      (*--out  *))
+                                   : BOOLEAN       (*--out  *);
+
+VAR  index     : CARDINAL;     (*-- loop index over table entries *)
+     inc       : CARDINAL;     (*-- increment *)
+     last      : CARDINAL;     (*-- last table entry to examine *)
+     hashAddr  : CARDINAL;     (*-- hash address *)
+     compare   : CompareProc;  (*-- key comparison routine *)
+
+BEGIN
+  theBucket := 0;
+  WITH theMap^ DO
+    compare := CompareOf(domain);
+    hashAddr:= h(theKey);
+    index   := hashAddr MOD size;
+    inc     := hashAddr DIV size;
+    IF (inc = 0) THEN
+     inc := 1;
+    END (*--if*);
+    last := (index + (size - 1) * inc) MOD size;
+    WHILE (index # last) DO
+      WITH table[index] DO
+        CASE s OF
+          empty:
+            IF (theBucket = 0) THEN
+              theBucket := index;
+            END (*--if*);
+            RETURN FALSE;
+        | deleted:
+            IF (theBucket = 0) THEN
+              theBucket := index;
+            END (*--if*);
+        | used:
+            IF (compare(theKey, d) = equal) THEN
+              theBucket := index;
+              RETURN TRUE;
+            END (*--if*);
+        END (*--case*);
+      END (*--with*);
+      index := (index+inc) MOD size;
+    END (*--while*);
+  END (*--with*);
+  RETURN FALSE;
+END Search;
+(*-------------------------*)
+
+
+(*
+11.2.3 Constructors
+*)
+
+(*
+Create attempts to form a new, empty map object. The routine uses
+the standard strategy employed throughout all of the bounded
+components presented in the series of allocating an object containing
+an array of varying size. If the allocation is successful, the data
+types of the domain and range are saved along with the map's maximum
+size, while the extent (the number of items present in the map) is
+initialized to zero. Note that Allocate set the pointer to NIL if
+unable to get the specified number of bytes from the system allocation
+routine. Complexity O(1).
+*)
+
+PROCEDURE Create  (    theDomain : TypeID       (*--in   *);
+                       theRange  : TypeID       (*--in   *);
+                       theSize   : MapSize      (*--in   *);
+                       theHashOf : HashFunction (*--in   *))
+                                 : Map          (*--out  *);
+
+CONST baseSize = SIZE(BoundedMap) - SIZE(MapItems);
+CONST pairSize = SIZE(Pair);
+
+VAR   newMap : Map;
+
+BEGIN
+  mapError := noerr;
+  Allocate(newMap, baseSize + pairSize * theSize);
+  IF (newMap = NullMap) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newMap^ DO
+      domain := theDomain;
+      range  := theRange;
+      extent := 0;
+      size   := theSize;
+      h      := theHashOf;
+    END (*--with*);
+    InitToEmpty(newMap);
+  END (*--if*);
+  RETURN newMap;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy is the inverse of Create, making a Map ╘undefined╒. To
+simplify matters we use Clear to test for an undefined map and
+to remove all existing domain/range pairs from the map, if any.
+If an error does not occur then we may dispose of the map object
+itself. Note that the version of Deallocate given here, automatically
+disposes of the proper amount of space (i.e., that which was
+originally allocated to the object. Complexity O(n).
+*)
+
+PROCEDURE Destroy (VAR theMap    : Map         (*--inout*));
+CONST baseSize = SIZE(BoundedMap) - SIZE(MapItems);
+CONST pairSize = SIZE(Pair);
+BEGIN
+  Clear(theMap);
+  IF (mapError = noerr) THEN
+    Deallocate(theMap, baseSize + pairSize * theMap^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear removes all domain/range pairs from the map, if any. The data
+types of the domain and range are used to retrieve the dynamic memory
+deallocation routines, if any, associated with the domain and range.
+This allows us to store arbitrarily complex structures within the map.
+Complexity O(n).
+*)
+
+PROCEDURE Clear   (    theMap    : Map             (*--inout*));
+
+VAR   index : CARDINAL;
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := 0 TO size-1 DO
+        IF (table[index].s = used) THEN
+          FreeBinding(theMap, table[index]);
+        END (*--if*);
+      END (*--for*);
+      extent := 0;
+    END (*--with*);
+    InitToEmpty(theMap);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates a map object, including the domain/range pairs and
+the relationship between them. If the target map, toMap, is undefined
+on entry to the routine it is automatically created with the same
+domain and range data types, and the same maximum size as the source
+map. If the source map is not empty, it is cleared of its contents
+and its domain/range data types are altered to match those of the source
+map. This step is called recreating the target map. Once completed without
+error, the assignment takes place using a simple loop over the number of
+items in the source map. Complexity O(m+n).
+*)
+
+PROCEDURE Assign  (    theMap    : Map          (*--in   *);
+                   VAR toMap     : Map         (*--inout*));
+
+  PROCEDURE RecreateTarget () : BOOLEAN (*--out *);
+  BEGIN
+    IF (theMap = NullMap) THEN
+      RaiseErrIn(assign, undefined);
+    ELSIF (theMap = toMap) THEN
+      RETURN FALSE;
+    ELSIF (toMap = NullMap) THEN
+      WITH theMap^ DO
+        toMap := Create(domain, range, size, h);
+      END (*--with*);
+    ELSIF (theMap^.extent <= toMap^.size) THEN
+      Clear(toMap);
+      WITH theMap^ DO
+        toMap^.domain := domain;
+        toMap^.range  := range;
+      END (*--with*);
+    ELSE
+      RaiseErrIn(assign, overflow);
+    END (*--if*);
+    RETURN mapError = noerr;
+  END RecreateTarget;
+
+VAR  assignDomain : AssignProc; (*-- domain item assignment routine *)
+     assignRange  : AssignProc; (*-- range item assignment routine *)
+     index        : CARDINAL;   (*-- loop index over table entries *)
+
+BEGIN
+  mapError := noerr;
+  IF RecreateTarget() THEN
+    WITH theMap^ DO
+      assignDomain := AssignOf(domain);
+      assignRange  := AssignOf(range);
+      FOR index := 0 TO size-1 DO
+        WITH table[index] DO
+          IF (s = used) THEN
+            Bind(toMap, assignDomain(d), assignRange(r));
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Bind attempts to add (or update) the domain/range pair of items to
+the given map. If the item of the domain already exists in the map
+the item of the range is updated to that given. The algorithm must
+therefore be able to detect the insertion of duplicate domain items.
+Because the array is unordered, the only approach is to use a sequential
+search to find the desired item, if it is present. This is similar to
+the second approach discussed for the ordered array representation. The
+complexity is O(n).
+*)
+
+PROCEDURE Bind    (    theMap    : Map         (*--inout*);
+                       theItemIn : Domain      (*--in   *);
+                       toItemIn  : Range       (*--in   *));
+
+VAR  index : CARDINAL;     (*-- bucket where to insert *)
+     free  : DisposeProc;  (*-- range value disposal routine *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(bind, undefined);
+  ELSIF (theMap^.extent = theMap^.size) THEN
+    RaiseErrIn(bind, overflow);
+  ELSIF Search(theMap, theItemIn, index) THEN
+    free := DisposeOf(theMap^.range);
+    free(theMap^.table[index].r);
+    theMap^.table[index].r := toItemIn;
+  ELSE
+    AddBinding(theMap, index, theItemIn, toItemIn);
+  END (*--if*);
+END Bind;
+(*-------------------------*)
+
+(*
+Unbind searches for and then removes the domain/range pair of items
+associated with the given domain item. If the item is not in the map
+then the map is left unchanged. Because the array of items is unordered
+a sequential search must be used to determine if the item is indeed present
+in the array. If the item is found it is overwritten with the last item
+in the array (recovering dynamically allocated space, if any), the count
+of items is decremented, and the routine is exited immediately. Thus, if
+the end of the FOR loop is reached, the given domain item is not bound to
+any value of the range.
+Complexity O(n).
+*)
+
+PROCEDURE Unbind  (    theMap    : Map         (*--inout*);
+                       theItemIn : Domain      (*--in   *));
+
+VAR   index : CARDINAL;    (*--loop index over item pairs*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(unbind, undefined);
+  ELSIF (theMap^.extent = 0) THEN
+    RaiseErrIn(unbind, notbound);
+  ELSIF Search(theMap, theItemIn, index) THEN
+    WITH theMap^ DO
+      FreeBinding(theMap, table[index]);
+      table[index].s := deleted;
+      DEC(extent);
+    END (*--with*);
+  ELSE
+    RaiseErrIn(unbind, notbound);
+  END (*--if*);
+END Unbind;
+(*-------------------------*)
+
+
+(*
+11.2.4 Selectors
+*)
+
+(*
+IsDefined simply treats a NIL map as the representation for a map
+that has not been created. Complexity O(1).
+*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+BEGIN
+  RETURN (theMap # NullMap);
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns true if the map contains no domain/range pairs, and
+false otherwise. Because we have maintained a count of pairs during
+insertions and deletions this state can be determined quickly. Thus
+we have complexity on the order of O(1).
+*)
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isempty, undefined);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN theMap^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual determines if the left and right mappings contain the same
+domain/range bindings. Initially, we avoid undefined maps [section
+10.4.n of our specification] and mismatched domain data types, in both
+cases signaling an exception and returning false. Next the trivial
+case where the maps have different numbers of elements is handled
+by avoiding the comparison loop.
+
+As the arrays are unordered the whole of the right map must be searched
+for each item of the left map. Thus, this version of IsEqual has a
+complexity on the order of O(n**2). Of course, if this operation is
+not used, or used only infrequently, by the client, this may be immaterial.
+*)
+
+PROCEDURE IsEqual   (    left      : Map        (*--in   *);
+                         right     : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR  index : CARDINAL; (*--loop index over left map items of Domain*)
+     jndex : CARDINAL; (*--loop index over right map items of Domain*)
+     compareDomain : CompareProc; (*--domain comparison routine*)
+     compareRange  : CompareProc; (*--range comparison routine*)
+
+BEGIN
+  mapError := noerr;
+  IF (left = NullMap) OR (right = NullMap) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.domain # right^.domain) OR
+        (left^.range # right^.range) THEN
+    RaiseErrIn(isequal, typeerror);
+
+  ELSIF (left^.extent = right^.extent) THEN
+    WITH left^ DO
+      compareDomain := CompareOf(domain);
+      compareRange  := CompareOf(range);
+      FOR index := MIN(MapSize) TO extent DO
+        jndex := MIN(MapSize);
+        LOOP
+          IF (jndex > extent) THEN
+            RETURN FALSE;
+          ELSIF compareDomain(table[index].d, right^.table[jndex].d) = equal THEN
+            IF compareRange(table[index].r, right^.table[jndex].r) = equal THEN
+              EXIT (*--loop*);
+            ELSE
+              RETURN FALSE;
+            END (*--if*);
+          ELSE
+            INC(jndex);
+          END (*--if*);
+        END (*--loop*);
+      END (*--for*);
+    END (*--with*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+ExtentOf returns the number of domain/range pairs present in the
+map object. Undefined maps raise an exception and return zero.
+Complexity O(1)
+*)
+
+PROCEDURE SizeOf    (    theMap    : Map        (*--in   *))
+                                   : CARDINAL   (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(sizeof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.size;
+END SizeOf;
+(*-------------------------*)
+
+(*
+ExtentOf returns the number of domain/range pairs present in the
+map object. Undefined maps raise an exception and return zero.
+Complexity O(1)
+*)
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*--in   *))
+                                   : CARDINAL   (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(extentof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+(*
+DomainOf and RangeOf simply return the data type IDs for the domain
+and range, respectively. Undefined maps cause the NullType to be
+returned. Complexity O(1)
+*)
+
+PROCEDURE DomainOf  (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(domainof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.domain;
+END DomainOf;
+(*-------------------------*)
+
+PROCEDURE RangeOf   (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(rangeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.range;
+END RangeOf;
+(*-------------------------*)
+
+(*
+IsBound, BoundTo, and IsBoundTo all use a sequential search to determine
+the presence of the given item of the domain. This must be done as an
+unordered array is used for the internal map representation. Each routine
+returns the appropriate value(s) depending on its function result.
+Complexity O(n).
+*)
+
+PROCEDURE IsBound   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR   index : CARDINAL; (*--loop index over items*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isbound, undefined);
+    RETURN FALSE;
+  END (*--if*);
+  RETURN Search(theMap, theItem, index);
+END IsBound;
+(*-------------------------*)
+
+PROCEDURE BoundTo   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : Range      (*--out  *);
+
+VAR   index : CARDINAL; (*--loop index over items*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(boundto, undefined);
+  ELSIF Search(theMap, theItem, index) THEN
+    RETURN theMap^.table[index].r;
+  ELSE
+    RaiseErrIn(boundto, notbound);
+  END (*--if*);
+  RETURN NullItem;
+END BoundTo;
+(*-------------------------*)
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *);
+                     VAR toItem    : Range      (*--out  *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR   index : CARDINAL; (*--loop index over items*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isboundto, undefined);
+  ELSIF Search(theMap, theItem, index) THEN
+    toItem := theMap^.table[index].r;
+    RETURN TRUE;
+  END (*--if*);
+  toItem := NullItem;
+  RETURN FALSE;
+END IsBoundTo;
+(*-------------------------*)
+
+
+(*
+11.2.5 Iterators
+*)
+
+PROCEDURE LoopOver   (    theMap    : Map            (*--in   *);
+                          theProcess: LoopAccessProc (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := 0 TO size-1 DO
+        WITH table[index] DO
+          IF (s = used) & ~theProcess(d, r) THEN
+            RETURN;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE LoopChange (    theMap    : Map            (*--in   *);
+                          theProcess: LoopChangeProc (*--in   *));
+
+VAR   index : CARDINAL;        (*-- loop index over hashing table *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(loopchange, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := 0 TO size-1 DO
+        WITH table[index] DO
+          IF (s = used) & ~theProcess(d, r) THEN
+            RETURN;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopChange;
+(*-------------------------*)
+
+
+PROCEDURE Traverse   (    theMap    : Map            (*--in   *);
+                          theProcess: AccessProc     (*--in   *));
+
+VAR   index : CARDINAL; (*--loop index over items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := 0 TO size-1 DO
+        WITH table[index] DO
+          IF (s = used) THEN
+            theProcess(d, r);
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+PROCEDURE TravChange (    theMap    : Map            (*--in   *);
+                          theProcess: ChangeProc     (*--in   *));
+
+VAR   index : CARDINAL; (*--loop index over items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(travchange, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := 0 TO size-1 DO
+        WITH table[index] DO
+          IF (s = used) THEN
+            theProcess(d, r);
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END TravChange;
+(*-------------------------*)
+
+
+(*
+11.2.6 Module Initialization
+
+The module's local variables are initialized to known states.
+mapError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, mapError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR mapError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(mapError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  mapError := noerr;
+  NullMap := NIL;
+END MapSBMIHash.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmio.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmio.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmio.mod
@@ -0,0 +1,761 @@
+(*
+5.3 Bounded Map Implementation
+*)
+
+IMPLEMENTATION MODULE MapSBMI;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Sequential Bounded Managed Iterator
+
+    INTRODUCTION
+    This module provides operations for the bounded map abstract
+   data type. This implementation uses an ordered array as
+   the underlying representation.
+
+    REVISION HISTORY
+    v1.01 16 May 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.02 18 Apr 1989  C. Lins
+      Initial implementation for TML Modula-2.
+       8/27/89     CL      Free range value in Bind.
+       8/26/89     CL      Correct Search's final comparison to use compare proc.
+       8/26/89     CL      Add SizeOf selector.
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+===============================================================*)
+
+FROM Relations IMPORT
+   (*--Type*) Relation;
+
+FROM Items IMPORT
+   (*--Cons*) NullItem,
+   (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM SCLStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+   (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM TypeManager IMPORT
+   (*--Cons*) NullType,
+    (*--Type*) TypeID,
+   (*--Proc*) AssignOf, CompareOf, DisposeOf;
+
+
+    (*-----------------------*)
+
+(*
+5.3.1 Type Declarations
+
+The physical structures used to represent the Map are the same here as
+for the unordered array implementation presented in the previous section
+(5.2). The difference is in how the Pair records are ordered within the
+MapItems array. Here, the pairs are ordered in acsending order based on
+domain values. This organization facilitates searching for a given item
+of the domain (binary search can be used), with the consequence that
+insertions are slower as the proper ordering must be maintained.
+*)
+
+TYPE  Pair = RECORD
+        d : Domain;
+        r : Range;
+      END (*--Pair*);
+
+TYPE  MapItems = ARRAY MapSize OF Pair;
+
+TYPE  BoundedMap = RECORD
+        domain : TypeID;   (*-- data type id for the domain *)
+        range  : TypeID;   (*-- data type id for the range *)
+        size   : CARDINAL; (*-- maximum # of items in map *)
+        extent : CARDINAL; (*-- current # of items in map *)
+        items  : MapItems; (*-- array [1..theSize] *)
+      END (*--BoundedMap*);
+
+TYPE  Map = POINTER TO BoundedMap;
+
+
+(*---------------------------------*)
+(*--          EXCEPTIONS         --*)
+
+VAR   mapError : Exceptions;
+VAR   handler  : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE MapError   ()              : Exceptions  (*-- out   *);
+BEGIN
+  RETURN mapError;
+END MapError;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  mapError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+5.3.3 Local Routines
+
+Search implements a binary search on the items array of a map. The
+routine is used by the map operations Unbind and IsBound to quickly
+determine if a given item of the domain is present in the ordered
+array and return its array index, if any. Note that when the items
+array is empty (i.e., extent = zero), the value of high upon
+termination of the binary search is also zero. Complexity O(log2 n).
+*)
+
+PROCEDURE Search   (    theMap  : Map      (*-- in    *);
+                        theItem : Domain   (*-- in    *);
+                    VAR atIndex : CARDINAL (*-- out   *))
+                                : BOOLEAN  (*-- out   *);
+
+VAR  middle  : CARDINAL;    (*-- indexes for binary search *)
+     low     : CARDINAL;
+     high    : CARDINAL;
+     compare : CompareProc; (*-- domain item comparison routine *)
+
+BEGIN
+  WITH theMap^ DO
+    compare := CompareOf(domain);
+    low     := MIN(MapSize);
+    high    := extent;
+
+    WHILE low < high DO
+      middle := (low + high) DIV 2;
+      IF compare(items[middle].d, theItem) = less THEN
+        low := middle + 1;
+      ELSE
+        high := middle;
+      END (*--if*);
+    END (*--while*);
+
+    atIndex := high;
+    RETURN (high >= MIN(MapSize)) &
+           (compare(items[high].d, theItem) = equal);
+  END (*--with*);
+END Search;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--        CONSTRUCTORS         --*)
+
+(*
+Create attempts to form a new, empty map object. The routine uses
+the standard strategy employed throughout all of the bounded
+components presented in the series of allocating an object containing
+an array of varying size. If the allocation is successful, the data
+types of the domain and range are saved along with the map's maximum
+size, while the extent (the number of items present in the map) is
+initialized to zero. Note that Allocate set the pointer to NIL if
+unable to get the specified number of bytes from the system allocation
+routine. Complexity O(1).
+*)
+
+PROCEDURE Create  (    theDomain : TypeID  (*-- in    *);
+                       theRange  : TypeID  (*-- in    *);
+                       theSize   : MapSize (*-- in    *))
+                                 : Map     (*-- out   *);
+
+CONST baseSize = SIZE(BoundedMap) - SIZE(MapItems);
+CONST pairSize = SIZE(Pair);
+
+VAR   newMap : Map;
+
+BEGIN
+  mapError := noerr;
+  Allocate(newMap, baseSize + pairSize * theSize);
+  IF (newMap = NIL) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newMap^ DO
+      domain := theDomain;
+      range  := theRange;
+      size   := theSize;
+      extent := 0;
+    END (*--with*);
+  END (*--if*);
+  RETURN newMap;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy is the inverse of Create, making a Map ╘undefined╒. To
+simplify matters we use Clear to test for an undefined map and
+to remove all existing domain/range pairs from the map, if any.
+If an error does not occur then we may dispose of the map object
+itself. Note that the version of Deallocate given here, automatically
+disposes of the proper amount of space (i.e., that which was
+originally allocated to the object. Complexity O(n).
+*)
+
+PROCEDURE Destroy (VAR theMap    : Map     (*-- inout *));
+CONST baseSize = SIZE(BoundedMap) - SIZE(MapItems);
+CONST pairSize = SIZE(Pair);
+BEGIN
+  Clear(theMap);
+  IF (mapError = noerr) THEN
+    Deallocate(theMap, baseSize + pairSize * theMap^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear removes any domain/range pairs from the map, if any. The data
+types of the domain and range are used to retrieve the dynamic memory
+deallocation routines, if any, associated with the domain and range.
+This allows us to store arbitrarily complex structures within the map.
+Complexity O(n).
+*)
+
+PROCEDURE Clear   (    theMap    : Map     (*-- inout *));
+
+VAR   index      : CARDINAL;    (*-- loop index over item pairs *)
+      freeDomain : DisposeProc; (*-- disposal routine for items of Domain *)
+      freeRange  : DisposeProc; (*-- disposal routine for items of Range *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theMap^ DO
+      freeDomain := DisposeOf(domain);
+      freeRange  := DisposeOf(range);
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          freeDomain(d);
+          freeRange(r);
+        END (*--with*);
+      END (*--for*);
+      extent := 0;
+    END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates a map object, including the domain/range pairs and
+the relationship between them. If the target map, toMap, is undefined
+on entry to the routine it is automatically created with the same
+domain and range data types, and the same maximum size as the source
+map. If the source map is not empty then it is cleared of its contents
+and its domain/range data types are altered to match those of the source
+map. This step is called recreating the target map. Once completed without
+error, the assignment takes place using a simple loop over the number of
+items in the source map. Complexity O(m+n).
+*)
+
+PROCEDURE Assign  (    theMap    : Map     (*-- in    *);
+                   VAR toMap     : Map     (*-- inout *));
+
+VAR  index        : CARDINAL;   (*-- loop index over items of Domain *)
+     assignDomain : AssignProc; (*-- domain items assignment routine *)
+     assignRange  : AssignProc; (*-- range items assignment routine *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theMap = toMap) THEN
+    RETURN;
+  ELSIF (toMap = NIL) THEN
+    WITH theMap^ DO
+      toMap := Create(domain, range, size);
+    END (*--with*);
+  ELSIF (theMap^.extent <= toMap^.size) THEN
+    Clear(toMap);
+    WITH theMap^ DO
+      toMap^.domain := domain;
+      toMap^.range  := range;
+   END (*--with*);
+  ELSE
+    RaiseErrIn(assign, overflow);
+  END (*--if*);
+
+  IF (mapError = noerr) THEN
+    WITH theMap^ DO
+      assignDomain := AssignOf(domain);
+      assignRange  := AssignOf(range);
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          toMap^.items[index].d := assignDomain(d);
+          toMap^.items[index].r := assignRange(r);
+       END (*--with*);
+     END (*--for*);
+     toMap^.extent := extent;
+   END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Bind attempts to add (or update) the domain/range pair of items to
+the given map. If the item of the domain already exists in the map
+the item of the range is updated to that given. The algorithm must
+therefore be able to detect the insertion of duplicate domain items.
+We must also leave the array in an ordered state for future binary
+searches to work correctly. There are two approaches that may be used:
+
+1)  use a binary search to determine the presence or absence of the
+   given domain item. If the item already exists in the array this
+   will be done in O(log n) steps and this is much more efficient
+   than a linear sequential search which uses O(n) steps. Only if the
+   item is not present in the array do we use Gonnet's insertion into
+   an ordered array algorithm [GONN, pg. 31].
+
+2) simply use an ordered sequential search on the array. If the item
+   is found, the range is updated with the new value and the search
+   terminated. Otherwise, as soon as a domain item is found in the
+   array that is greater than the domain item being added, the array
+   is expanded by shifting items to make room for the new element.
+   The complexity of this approach is on the order of O(n) for both
+   insertion and update operations.
+
+The choice between these two methods depends on the number of updates
+relative to the number of insertions. If there are many more updates to
+the map than insertions, the first approach is clearly better in the long
+run. If the map is never updated (only insertions occur) the extra
+binary search of the first approach is extraneous work; though the
+difference between the two may be insignificant the for small map sizes
+supported by this module.
+
+We shall employ the former tactic on the assumption that efficient
+updating of the map is desired.
+
+The insertion algorithm below combines shifting items into higher array
+indexes while it searches from the end of the array for the proper
+location to insert the new domain/range pair. Once the loop terminates
+by either (1) finding an element less than the new domain item, or (2)
+reaching the front of the array; the new pair can be inserted at the
+index'th + 1 location in the array.
+
+Overall complexity O(n log2 n); for update operations O(log2 n).
+*)
+
+PROCEDURE Bind    (    theMap    : Map     (*-- inout *);
+                       theItemIn : Domain  (*-- in    *);
+                       toItemIn  : Range   (*-- in    *));
+
+VAR  index   : CARDINAL;    (*-- insertion loop index *)
+     compare : CompareProc; (*-- domain item comparison routine *)
+     free  : DisposeProc;
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(bind, undefined);
+  ELSIF (theMap^.extent = theMap^.size) THEN
+    RaiseErrIn(bind, overflow);
+  ELSIF Search(theMap, theItemIn, index) THEN
+    free := DisposeOf(theMap^.range);
+    free(theMap^.items[index].r);
+    theMap^.items[index].r := toItemIn;
+  ELSE
+    WITH theMap^ DO
+      compare := CompareOf(domain);
+      index   := extent;
+      INC(extent);
+      WHILE (index >= MIN(MapSize)) &
+            (compare(items[index].d, theItemIn) = greater) DO
+        items[index+1] := items[index];
+        DEC(index);
+      END (*--while*);
+      WITH items[index+1] DO
+        d := theItemIn;
+        r := toItemIn;
+      END (*--with*);
+    END (*--with*);
+  END (*--if*);
+END Bind;
+(*-------------------------*)
+
+(*
+Unbind searches for and then removes the domain/range pair of items
+associated with the given domain item. If the item is not in the map
+then the map is left unchanged (though the notbound exception is raised).
+Because the array of items is ordered a binary search can be used to
+determine if the item is indeed present in the array. If it is, then all
+items above the index where the item is found must be shifted down one
+position within the array.
+Complexity O(n log2 n).
+*)
+
+PROCEDURE Unbind  (    theMap    : Map     (*-- inout *);
+                       theItemIn : Domain  (*-- in    *));
+
+VAR  index : CARDINAL;    (*-- index of found item, if any *)
+     free  : DisposeProc; (*-- disposal routine for items *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(unbind, undefined);
+  ELSIF (theMap^.extent = 0) OR ~Search(theMap, theItemIn, index) THEN
+    RaiseErrIn(unbind, notbound);
+  ELSE
+    WITH theMap^ DO
+      WITH items[index] DO
+        free := DisposeOf(domain);
+        free(d);
+        free := DisposeOf(range);
+        free(r);
+      END (*--with*);
+      FOR index := index+1 TO extent DO
+        items[index-1] := items[index];
+      END (*--for*);
+      DEC(extent);
+    END (*--with*);
+  END (*--if*);
+END Unbind;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--         SELECTORS           --*)
+
+(*
+IsDefined simply treats a NIL map as the representation for a map
+that has not been created. Complexity O(1).
+*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+BEGIN
+  RETURN theMap # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns true if the map contains no domain/range pairs, and
+false otherwise. Because we have maintained a count of pairs during
+insertions and deletions this state can be determined quickly. Thus
+we have complexity on the order of O(1).
+*)
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(isempty, undefined);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN theMap^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual determines if the left and right mappings contain the same
+domain/range bindings. Initially, we avoid undefined maps [section
+3.4.n of our specification] and mismatched domain data types, in both
+cases signaling an exception and returning false. Next the trivial
+case where the maps have different numbers of elements is handled
+by avoiding the comparison loop. Only if the two maps have the same
+number of elements do we iterate over the domain/range pairs in each.
+As soon as an inequality is encountered we can return false. Otherwise,
+if the iteration covers all of the elements then the maps must be equal.
+Complexity: O(Min(m,n))
+*)
+
+PROCEDURE IsEqual   (    left      : Map        (*-- in    *);
+                         right     : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+VAR  index : CARDINAL; (*-- loop index over map item pairs *)
+     compareDomain : CompareProc;
+     compareRange  : CompareProc;
+
+BEGIN
+  mapError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.domain # right^.domain) OR
+        (left^.range  # right^.range) THEN
+    RaiseErrIn(isequal, typeerror);
+
+  ELSIF (left^.extent = right^.extent) THEN
+    WITH left^ DO
+      compareDomain := CompareOf(domain);
+      compareRange  := CompareOf(range);
+      FOR index := MIN(MapSize) TO extent DO
+        IF (compareDomain(items[index].d, right^.items[index].d) # equal) OR
+           (compareRange(items[index].r, right^.items[index].r) # equal) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+SizeOf returns the maximum number of domain/range pairs allowed in the
+map object. Undefined maps raise an exception and return zero.
+Complexity O(1)
+*)
+
+PROCEDURE SizeOf    (    theMap    : Map        (*-- in    *))
+                                   : CARDINAL   (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(sizeof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.size;
+END SizeOf;
+(*-------------------------*)
+
+(*
+ExtentOf returns the number of domain/range pairs present in the
+map object. Undefined maps raise an exception and return zero.
+Complexity O(1)
+*)
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*-- in    *))
+                                   : CARDINAL   (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(extentof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+(*
+DomainOf and RangeOf simply return the data type IDs for the domain
+and range, respectively. Undefined maps cause the NullType to be
+returned. Complexity O(1)
+*)
+
+PROCEDURE DomainOf  (    theMap    : Map        (*-- in    *))
+                                   : TypeID     (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(domainof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.domain;
+END DomainOf;
+(*-------------------------*)
+
+PROCEDURE RangeOf   (    theMap    : Map        (*-- in    *))
+                                   : TypeID     (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(rangeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.range;
+END RangeOf;
+(*-------------------------*)
+
+(*
+IsBound uses the binary search, provided by the routine Search, to
+determine the presence of the given item. BoundTo is similar, except
+that the bound item of the range is returned. IsBoundTo combines the
+facilities provided by both routines. Complexity O(log2 n).
+*)
+
+PROCEDURE IsBound   (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+VAR   index : CARDINAL;    (*-- index of item if found *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(isbound, undefined);
+    RETURN FALSE;
+  END (*--if*);
+  RETURN Search(theMap, theItem, index);
+END IsBound;
+(*-------------------------*)
+
+PROCEDURE BoundTo   (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *))
+                                   : Range      (*-- out   *);
+
+VAR   index : CARDINAL;    (*-- index of item if found *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(boundto, undefined);
+  ELSIF Search(theMap, theItem, index) THEN
+    RETURN theMap^.items[index].r;
+  END (*--if*);
+  RETURN NullItem;
+END BoundTo;
+(*-------------------------*)
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *);
+                     VAR toItem    : Range      (*-- out   *))
+                                   : BOOLEAN    (*-- out   *);
+
+VAR   index   : CARDINAL;    (*-- index of item if found *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(isboundto, undefined);
+  ELSIF Search(theMap, theItem, index) THEN
+    toItem := theMap^.items[index].r;
+    RETURN TRUE;
+  END (*--if*);
+  toItem := NullItem;
+  RETURN FALSE;
+END IsBoundTo;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--         ITERATORS           --*)
+
+PROCEDURE LoopOver   (    theMap    : Map            (*-- in    *);
+                          theProcess: LoopAccessProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items of Domain *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          IF ~theProcess(d, r) THEN
+            RETURN;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE LoopChange (    theMap    : Map            (*-- in    *);
+                          theProcess: LoopChangeProc (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items of Domain *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(loopchange, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          IF ~theProcess(d, r) THEN
+            RETURN;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopChange;
+(*-------------------------*)
+
+
+PROCEDURE Traverse   (    theMap    : Map            (*-- in    *);
+                          theProcess: AccessProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items of Domain *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          theProcess(d, r);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+PROCEDURE TravChange (    theMap    : Map            (*-- in    *);
+                          theProcess: ChangeProc     (*-- in    *));
+
+VAR   index : CARDINAL; (*-- loop index over items of Domain *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(travchange, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          theProcess(d, r);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END TravChange;
+(*-------------------------*)
+
+
+(*
+5.3.7 Module Initialization
+
+The module's local variables are initialized to known states.
+mapError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, mapError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR mapError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(mapError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  mapError := noerr;
+  NullMap := NIL;
+END MapSBMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmn.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmn.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmn.def
@@ -0,0 +1,128 @@
+(*
+5.3 Bounded Map Interface
+*)
+
+DEFINITION MODULE MapSBMN;
+(*====================================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Sequential Bounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module provides operations for the bounded map abstract
+   data type.
+
+    REVISION HISTORY
+    v1.00  04 May 1988  C. Lins
+      Initial implementation for TML Modula-2.
+       8/26/89     CL      Add SizeOf selector.
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+=====================================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+    (*-----------------------*)
+
+(*
+5.3.1  Type Declarations
+*)
+
+TYPE  Domain = Item;
+TYPE  Range  = Item;
+
+TYPE  Map;
+VAR   NullMap : Map;
+
+TYPE  MapSize = [1..4094];
+
+
+(*---------------------------------*)
+(*--          EXCEPTIONS         --*)
+
+CONST ModuleID = 4;
+
+PROCEDURE MapError   ()              : Exceptions  (*-- out   *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+
+
+(*---------------------------------*)
+(*--        CONSTRUCTORS         --*)
+
+PROCEDURE Create  (    theDomain : TypeID  (*-- in    *);
+                       theRange  : TypeID  (*-- in    *);
+                       theSize   : MapSize (*-- in    *))
+                                 : Map     (*-- out   *);
+
+PROCEDURE Destroy (VAR theMap    : Map     (*-- inout *));
+
+PROCEDURE Clear   (    theMap    : Map     (*-- inout *));
+
+PROCEDURE Assign  (    theMap    : Map     (*-- in    *);
+                   VAR toMap     : Map     (*-- inout *));
+
+PROCEDURE Bind    (    theMap    : Map     (*-- inout *);
+                       theItemIn : Domain  (*-- in    *);
+                       toItemIn  : Range   (*-- in    *));
+
+PROCEDURE Unbind  (    theMap    : Map     (*-- inout *);
+                       theItemIn : Domain  (*-- in    *));
+
+
+(*---------------------------------*)
+(*--         SELECTORS           --*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+PROCEDURE IsEqual   (    left      : Map        (*-- in    *);
+                         right     : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+PROCEDURE SizeOf    (    theMap    : Map        (*-- in    *))
+                                   : CARDINAL   (*-- out   *);
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*-- in    *))
+                                   : CARDINAL   (*-- out   *);
+
+PROCEDURE DomainOf  (    theMap    : Map        (*-- in    *))
+                                   : TypeID     (*-- out   *);
+
+PROCEDURE RangeOf   (    theMap    : Map        (*-- in    *))
+                                   : TypeID     (*-- out   *);
+
+PROCEDURE IsBound   (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+PROCEDURE BoundTo   (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *))
+                                   : Range      (*-- out   *);
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *);
+                     VAR toItem    : Range      (*-- out   *))
+                                   : BOOLEAN    (*-- out   *);
+
+END MapSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmn.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmn.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmn.mod
@@ -0,0 +1,621 @@
+(*
+11.2 Bounded Map Implementation
+*)
+
+IMPLEMENTATION MODULE MapSBMN;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Sequential Bounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module provides operations for the bounded map abstract
+   data type. This implementation uses an unordered array as
+   the underlying representation.
+
+    REVISION HISTORY
+    v1.01 16 May 1988  C. Lins
+      Initial implementation for TML Modula-2.
+    v1.02 18 Apr 1989  C. Lins
+      Added use of component id constant.
+       8/27/89     CL      Free range value in Bind.
+       8/26/89     CL      Add SizeOf selector.
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+===============================================================*)
+
+FROM SCLStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+   (*--Cons*) NullItem,
+   (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM Relations IMPORT
+   (*--type*) Relation;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, CompareOf, DisposeOf;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+
+    (*-----------------------*)
+
+(*
+5.2.1  Type Declarations
+*)
+
+TYPE  Pair = RECORD
+        d : Domain;     (*-- value of the domain *)
+        r : Range;      (*-- mapped to value of the range *)
+      END (*--Pair*);
+
+TYPE  MapItems = ARRAY MapSize OF Pair;
+
+TYPE  BoundedMap = RECORD
+        domain : TypeID;   (*-- data type id for the domain *)
+        range  : TypeID;   (*-- data type id for the range *)
+        size   : CARDINAL; (*-- maximum # of items in map *)
+        extent : CARDINAL; (*-- current # of items in map *)
+        items  : MapItems; (*-- array [1..size] *)
+      END (*--BoundedMap*);
+
+TYPE  Map = POINTER TO BoundedMap;
+
+
+(*
+5.2.2  Exceptions
+*)
+
+VAR   mapError : Exceptions;
+VAR   handler  : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE MapError   ()              : Exceptions  (*--out  *);
+BEGIN
+  RETURN mapError;
+END MapError;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*--in   *);
+                          theError   : Exceptions (*--in   *));
+BEGIN
+  mapError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+(*
+11.3.3 Local Routines
+
+Search implements a linear search on the items array of a map. The
+routine is used by the map operations Unbind and IsBound to
+determine if a given item of the domain is present in the unordered
+array and return its array index, if any. Complexity O(n).
+*)
+
+PROCEDURE Search   (    theMap     : Map       (*--in   *);
+                        theDomain  : Domain    (*--in   *);
+                    VAR theIndex   : CARDINAL  (*--out  *))
+                                   : BOOLEAN   (*--out  *);
+
+VAR      compare : CompareProc; (*-- domain value comparison routine *)
+
+BEGIN
+  WITH theMap^ DO
+    compare := CompareOf(domain);
+    theIndex:= MIN(MapSize);
+    WHILE (theIndex <= extent) DO
+      IF compare(theDomain, items[theIndex].d) = equal THEN
+        RETURN TRUE;
+      END (*--if*);
+      INC(theIndex);
+    END (*--while*);
+  END (*--with*);
+  RETURN FALSE;
+END Search;
+(*-------------------------*)
+
+
+(*
+5.2.3  Constructors
+*)
+
+(*
+Create attempts to form a new, empty map object. The routine uses
+the standard strategy employed throughout all of the bounded
+components presented in the series of allocating an object containing
+an array of varying size. If the allocation is successful, the data
+types of the domain and range are saved along with the map's maximum
+size, while the extent (the number of items present in the map) is
+initialized to zero. Note that Allocate set the pointer to NIL if
+unable to get the specified number of bytes from the system allocation
+routine. Complexity O(1).
+*)
+
+PROCEDURE Create  (    theDomain : TypeID  (*--in   *);
+                       theRange  : TypeID  (*--in   *);
+                       theSize   : MapSize (*--in   *))
+                                 : Map     (*--out  *);
+
+CONST baseSize = SIZE(BoundedMap) - SIZE(MapItems);
+CONST pairSize = SIZE(Pair);
+
+VAR   newMap : Map;
+
+BEGIN
+  mapError := noerr;
+  Allocate(newMap, baseSize + pairSize * theSize);
+  IF (newMap = NullMap) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newMap^ DO
+      domain := theDomain;
+      range  := theRange;
+      size   := theSize;
+      extent := 0;
+    END (*--with*);
+  END (*--if*);
+  RETURN newMap;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy is the inverse of Create, making a Map ╘undefined╒. To
+simplify matters we use Clear to test for an undefined map and
+to remove all existing domain/range pairs from the map, if any.
+If an error does not occur then we may dispose of the map object
+itself. Note that the version of Deallocate given here, automatically
+disposes of the proper amount of space (i.e., that which was
+originally allocated to the object. Complexity O(n).
+*)
+
+PROCEDURE Destroy (VAR theMap    : Map     (*--inout*));
+CONST baseSize = SIZE(BoundedMap) - SIZE(MapItems);
+CONST pairSize = SIZE(Pair);
+BEGIN
+  Clear(theMap);
+  IF (mapError = noerr) THEN
+    Deallocate(theMap, baseSize + pairSize * theMap^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear removes all domain/range pairs from the map, if any. The data
+types of the domain and range are used to retrieve the dynamic memory
+deallocation routines, if any, associated with the domain and range.
+This allows us to store arbitrarily complex structures within the map.
+Complexity O(n).
+*)
+
+PROCEDURE Clear   (    theMap    : Map     (*--inout*));
+
+VAR   index      : CARDINAL;    (*--loop index over item pairs*)
+      freeDomain : DisposeProc; (*--disposal routine for items of Domain*)
+      freeRange  : DisposeProc; (*--disposal routine for items of Range*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theMap^ DO
+      freeDomain := DisposeOf(domain);
+      freeRange  := DisposeOf(range);
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          freeDomain(d);
+          freeRange(r);
+        END (*--with*);
+      END (*--for*);
+      extent := 0;
+    END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates a map object, including the domain/range pairs and
+the relationship between them. If the target map, toMap, is undefined
+on entry to the routine it is automatically created with the same
+domain and range data types, and the same maximum size as the source
+map. If the source map is not empty, it is cleared of its contents
+and its domain/range data types are altered to match those of the source
+map. This step is called recreating the target map. Once completed without
+error, the assignment takes place using a simple loop over the number of
+items in the source map. Complexity O(m+n).
+*)
+
+PROCEDURE Assign  (    theMap    : Map     (*--in   *);
+                   VAR toMap     : Map     (*--inout*));
+
+VAR  index        : CARDINAL;   (*--loop index over items of Domain*)
+     assignDomain : AssignProc; (*--domain items assignment routine*)
+     assignRange  : AssignProc; (*--range items assignment routine*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theMap = toMap) THEN
+    RETURN;
+  ELSIF (toMap = NullMap) THEN
+    WITH theMap^ DO
+      toMap := Create(domain, range, size);
+    END (*--with*);
+  ELSIF (theMap^.extent <= toMap^.size) THEN
+    Clear(toMap);
+    WITH theMap^ DO
+      toMap^.domain := domain;
+      toMap^.range  := range;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(assign, overflow);
+  END (*--if*);
+
+  IF (mapError = noerr) THEN
+    WITH theMap^ DO
+      assignDomain := AssignOf(domain);
+      assignRange  := AssignOf(range);
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          toMap^.items[index].d := assignDomain(d);
+          toMap^.items[index].r := assignRange(r);
+        END (*--with*);
+      END (*--for*);
+      toMap^.extent := extent;
+    END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Bind attempts to add (or update) the domain/range pair of items to
+the given map. If the item of the domain already exists in the map
+the item of the range is updated to that given. The algorithm must
+therefore be able to detect the insertion of duplicate domain items.
+Because the array is unordered, the only approach is to use a sequential
+search to find the desired item, if it is present. This is similar to
+the second approach discussed for the ordered array representation. The
+complexity is O(n).
+*)
+
+PROCEDURE Bind    (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *);
+                       toItemIn  : Range   (*--in   *));
+
+VAR  index : CARDINAL; (*--where domain value was found*)
+     free  : DisposeProc;
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(bind, undefined);
+  ELSIF (theMap^.extent = theMap^.size) THEN
+    RaiseErrIn(bind, overflow);
+  ELSIF Search(theMap, theItemIn, index) THEN
+    free := DisposeOf(theMap^.range);
+    free(theMap^.items[index].r);
+    theMap^.items[index].r := toItemIn;
+  ELSE
+    WITH theMap^ DO
+      INC(extent);
+      WITH items[extent] DO
+        d := theItemIn;
+        r := toItemIn;
+      END (*--with*);
+    END (*--with*);
+  END (*--if*);
+END Bind;
+(*-------------------------*)
+
+(*
+Unbind searches for and then removes the domain/range pair of items
+associated with the given domain item. If the item is not in the map
+then the map is left unchanged. Because the array of items is unordered
+a sequential search must be used to determine if the item is indeed present
+in the array. If the item is found it is overwritten with the last item
+in the array (recovering dynamically allocated space, if any), the count
+of items is decremented, and the routine is exited immediately. Thus, if
+the end of the FOR loop is reached, the given domain item is not bound to
+any value of the range.
+Complexity O(n).
+*)
+
+PROCEDURE Unbind  (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *));
+
+VAR  index : CARDINAL;    (*--where domain value was found*)
+     free  : DisposeProc; (*--disposal routine for items*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(unbind, undefined);
+  ELSIF (theMap^.extent = 0) OR ~Search(theMap, theItemIn, index) THEN
+    RaiseErrIn(unbind, notbound);
+  ELSE
+    WITH theMap^ DO
+      WITH items[index] DO
+        free := DisposeOf(domain);
+        free(d);
+        free := DisposeOf(range);
+        free(r);
+      END (*--with*);
+      items[index] := items[extent];
+      DEC(extent);
+    END (*--with*);
+  END (*--if*);
+END Unbind;
+(*-------------------------*)
+
+
+(*
+5.2.4  Selectors
+*)
+
+(*
+IsDefined simply treats a NIL map as the representation for a map
+that has not been created. Complexity O(1).
+*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+BEGIN
+  RETURN (theMap # NullMap);
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns true if the map contains no domain/range pairs, and
+false otherwise. Because we have maintained a count of pairs during
+insertions and deletions this state can be determined quickly. Thus
+we have complexity on the order of O(1).
+*)
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isempty, undefined);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN theMap^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual determines if the left and right mappings contain the same
+domain/range bindings. Initially, we avoid undefined maps [section
+10.4.n of our specification] and mismatched domain data types, in both
+cases signaling an exception and returning false. Next the trivial
+case where the maps have different numbers of elements is handled
+by avoiding the comparison loop.
+
+As the arrays are unordered the whole of the right map must be searched
+for each item of the left map. Thus, this version of IsEqual has a
+complexity on the order of O(n**2). Of course, if this operation is
+not used, or used only infrequently, by the client, this may be immaterial.
+*)
+
+PROCEDURE IsEqual   (    left      : Map        (*--in   *);
+                         right     : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR  index : CARDINAL; (*--loop index over left map items of Domain*)
+     jndex : CARDINAL; (*--loop index over right map items of Domain*)
+     compareDomain : CompareProc; (*--domain comparison routine*)
+     compareRange  : CompareProc; (*--range comparison routine*)
+
+BEGIN
+  mapError := noerr;
+  IF (left = NullMap) OR (right = NullMap) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.domain # right^.domain) OR
+        (left^.range # right^.range) THEN
+    RaiseErrIn(isequal, typeerror);
+
+  ELSIF (left^.extent = right^.extent) THEN
+    WITH left^ DO
+      compareDomain := CompareOf(domain);
+      compareRange  := CompareOf(range);
+      FOR index := MIN(MapSize) TO extent DO
+        jndex := MIN(MapSize);
+        LOOP
+          IF (jndex > extent) THEN
+            RETURN FALSE;
+          ELSIF compareDomain(items[index].d, right^.items[jndex].d) = equal THEN
+            IF compareRange(items[index].r, right^.items[jndex].r) = equal THEN
+              EXIT (*--loop*);
+            ELSE
+              RETURN FALSE;
+            END (*--if*);
+          ELSE
+            INC(jndex);
+          END (*--if*);
+        END (*--loop*);
+      END (*--for*);
+    END (*--with*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+SizeOf returns the maximum number of domain/range pairs allowed in the
+map object. Undefined maps raise an exception and return zero.
+Complexity O(1)
+*)
+
+PROCEDURE SizeOf    (    theMap    : Map        (*-- in    *))
+                                   : CARDINAL   (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(sizeof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.size;
+END SizeOf;
+(*-------------------------*)
+
+(*
+ExtentOf returns the number of domain/range pairs present in the
+map object. Undefined maps raise an exception and return zero.
+Complexity O(1)
+*)
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*--in   *))
+                                   : CARDINAL   (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(extentof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+(*
+DomainOf and RangeOf simply return the data type IDs for the domain
+and range, respectively. Undefined maps cause the NullType to be
+returned. Complexity O(1)
+*)
+
+PROCEDURE DomainOf  (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(domainof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.domain;
+END DomainOf;
+(*-------------------------*)
+
+PROCEDURE RangeOf   (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(rangeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.range;
+END RangeOf;
+(*-------------------------*)
+
+(*
+IsBound, BoundTo, and IsBoundTo all use a sequential search to determine
+the presence of the given item of the domain. This must be done as an
+unordered array is used for the internal map representation. Each routine
+returns the appropriate value(s) depending on its function result.
+Complexity O(n).
+*)
+
+PROCEDURE IsBound   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR   index : CARDINAL;    (*-- index of item if found *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isbound, undefined);
+    RETURN FALSE;
+  END (*--if*);
+  RETURN Search(theMap, theItem, index);
+END IsBound;
+(*-------------------------*)
+
+PROCEDURE BoundTo   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : Range      (*--out  *);
+
+VAR   index : CARDINAL;    (*-- index of item if found *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(boundto, undefined);
+  ELSIF Search(theMap, theItem, index) THEN
+    RETURN theMap^.items[index].r;
+  END (*--if*);
+  RETURN NullItem;
+END BoundTo;
+(*-------------------------*)
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *);
+                     VAR toItem    : Range      (*--out  *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR   index : CARDINAL;    (*-- index of item if found *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isboundto, undefined);
+  ELSIF Search(theMap, theItem, index) THEN
+    toItem := theMap^.items[index].r;
+    RETURN TRUE;
+  END (*--if*);
+  toItem := NullItem;
+  RETURN FALSE;
+END IsBoundTo;
+(*-------------------------*)
+
+
+(*
+5.2.7 Module Initialization
+
+The module's local variables are initialized to known states.
+mapError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, mapError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR mapError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(mapError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  mapError := noerr;
+  NullMap := NIL;
+END MapSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmno.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmno.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbmno.mod
@@ -0,0 +1,659 @@
+(*
+5.4 Bounded Map Implementation
+*)
+
+IMPLEMENTATION MODULE MapSBMN;
+(*====================================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Sequential Bounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module provides operations for the bounded map abstract
+   data type. This implementation uses an ordered array as
+   the underlying representation.
+
+    REVISION HISTORY
+    v1.00a 16 May 1988  C. Lins
+      Initial implementation for TML Modula-2.
+       8/27/89     CL      Free range value in Bind.
+       8/26/89     CL      Add SizeOf selector.
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+=====================================================================*)
+
+FROM Relations IMPORT
+   (*--Type*) Relation;
+
+FROM Items IMPORT
+   (*--Cons*) NullItem,
+   (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM SCLStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, CompareOf, DisposeOf;
+
+
+    (*-----------------------*)
+
+(*
+5.4.1 Type Declarations
+
+The physical structures used to represent the Map are the same here as
+for the unordered array implementation presented in the previous section
+(5.2). The difference is in how the Pair records are ordered within the
+MapItems array. Here, the pairs are ordered in acsending order based on
+domain values. This organization facilitates searching for a given item
+of the domain (binary search can be used), with the consequence that
+insertions are slower as the proper ordering must be maintained.
+*)
+
+TYPE  Pair = RECORD
+        d : Domain;
+        r : Range;
+      END (*--Pair*);
+
+TYPE  MapItems = ARRAY MapSize OF Pair;
+
+TYPE  BoundedMap = RECORD
+        domain : TypeID;   (*-- data type id for the domain *)
+        range  : TypeID;   (*-- data type id for the range *)
+        size   : CARDINAL; (*-- maximum # of items in map *)
+        extent : CARDINAL; (*-- current # of items in map *)
+        items  : MapItems; (*-- array [1..theSize] *)
+      END (*--BoundedMap*);
+
+TYPE  Map = POINTER TO BoundedMap;
+
+
+(*---------------------------------*)
+(*--          EXCEPTIONS         --*)
+
+VAR   mapError : Exceptions;
+VAR   handler  : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE MapError   ()              : Exceptions  (*-- out   *);
+BEGIN
+  RETURN mapError;
+END MapError;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*-- in    *))
+                                     : HandlerProc (*-- out   *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*-- in    *);
+                          theHandler : HandlerProc (*-- in    *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*-- in    *);
+                          theError   : Exceptions (*-- in    *));
+BEGIN
+  mapError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+5.4.3 Local Routines
+
+Search implements a binary search on the items array of a map. The
+routine is used by the map operations Unbind and IsBound to quickly
+determine if a given item of the domain is present in the ordered
+array and return its array index, if any. Note that when the items
+array is empty (i.e., extent = zero), the value of high upon
+termination of the binary search is also zero. Complexity O(log2 n).
+*)
+
+PROCEDURE Search   (    theMap  : Map      (*-- in    *);
+                        theItem : Domain   (*-- in    *);
+                    VAR atIndex : CARDINAL (*-- out   *))
+                                : BOOLEAN  (*-- out   *);
+
+VAR  middle  : CARDINAL;    (*-- indexes for binary search *)
+     low     : CARDINAL;
+     high    : CARDINAL;
+     compare : CompareProc; (*-- domain item comparison routine *)
+
+BEGIN
+  WITH theMap^ DO
+    compare := CompareOf(domain);
+    low     := MIN(MapSize);
+    high    := extent;
+
+    WHILE low < high DO
+      middle := (low + high) DIV 2;
+      IF compare(items[middle].d, theItem) = less THEN
+        low := middle + 1;
+      ELSE
+        high := middle;
+      END (*--if*);
+     END (*--while*);
+
+    atIndex := high;
+    RETURN (high >= MIN(MapSize)) & (items[high].d = theItem);
+  END (*--with*);
+END Search;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--        CONSTRUCTORS         --*)
+
+(*
+Create attempts to form a new, empty map object. The routine uses
+the standard strategy employed throughout all of the bounded
+components presented in the series of allocating an object containing
+an array of varying size. If the allocation is successful, the data
+types of the domain and range are saved along with the map's maximum
+size, while the extent (the number of items present in the map) is
+initialized to zero. Note that Allocate set the pointer to NIL if
+unable to get the specified number of bytes from the system allocation
+routine. Complexity O(1).
+*)
+
+PROCEDURE Create  (    theDomain : TypeID  (*-- in    *);
+                       theRange  : TypeID  (*-- in    *);
+                       theSize   : MapSize (*-- in    *))
+                                 : Map     (*-- out   *);
+
+CONST baseSize = SIZE(BoundedMap) - SIZE(MapItems);
+CONST pairSize = SIZE(Pair);
+
+VAR   newMap : Map;
+
+BEGIN
+  mapError := noerr;
+  Allocate(newMap, baseSize + pairSize * theSize);
+  IF (newMap = NIL) THEN
+   RaiseErrIn(create, overflow);
+  ELSE
+    WITH newMap^ DO
+      domain := theDomain;
+      range  := theRange;
+      size   := theSize;
+      extent := 0;
+    END (*--with*);
+  END (*--if*);
+  RETURN newMap;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy is the inverse of Create, making a Map ╘undefined╒. To
+simplify matters we use Clear to test for an undefined map and
+to remove all existing domain/range pairs from the map, if any.
+If an error does not occur then we may dispose of the map object
+itself. Note that the version of Deallocate given here, automatically
+disposes of the proper amount of space (i.e., that which was
+originally allocated to the object. Complexity O(n).
+*)
+
+PROCEDURE Destroy (VAR theMap    : Map     (*-- inout *));
+CONST baseSize = SIZE(BoundedMap) - SIZE(MapItems);
+CONST pairSize = SIZE(Pair);
+BEGIN
+  Clear(theMap);
+  IF (mapError = noerr) THEN
+    Deallocate(theMap, baseSize + pairSize * theMap^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear removes any domain/range pairs from the map, if any. The data
+types of the domain and range are used to retrieve the dynamic memory
+deallocation routines, if any, associated with the domain and range.
+This allows us to store arbitrarily complex structures within the map.
+Complexity O(n).
+*)
+
+PROCEDURE Clear   (    theMap    : Map     (*-- inout *));
+
+VAR   index      : CARDINAL;    (*-- loop index over item pairs *)
+      freeDomain : DisposeProc; (*-- disposal routine for items of Domain *)
+      freeRange  : DisposeProc; (*-- disposal routine for items of Range *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theMap^ DO
+      freeDomain := DisposeOf(domain);
+      freeRange  := DisposeOf(range);
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          freeDomain(d);
+          freeRange(r);
+        END (*--with*);
+      END (*--for*);
+      extent := 0;
+    END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates a map object, including the domain/range pairs and
+the relationship between them. If the target map, toMap, is undefined
+on entry to the routine it is automatically created with the same
+domain and range data types, and the same maximum size as the source
+map. If the source map is not empty then it is cleared of its contents
+and its domain/range data types are altered to match those of the source
+map. This step is called recreating the target map. Once completed without
+error, the assignment takes place using a simple loop over the number of
+items in the source map. Complexity O(m+n).
+*)
+
+PROCEDURE Assign  (    theMap    : Map     (*-- in    *);
+                   VAR toMap     : Map     (*-- inout *));
+
+VAR  index        : CARDINAL;   (*-- loop index over items of Domain *)
+     assignDomain : AssignProc; (*-- domain items assignment routine *)
+     assignRange  : AssignProc; (*-- range items assignment routine *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theMap = toMap) THEN
+    RETURN;
+  ELSIF (toMap = NIL) THEN
+    WITH theMap^ DO
+      toMap := Create(domain, range, size);
+    END (*--with*);
+  ELSIF (theMap^.extent <= toMap^.size) THEN
+    Clear(toMap);
+    WITH theMap^ DO
+      toMap^.domain := domain;
+      toMap^.range  := range;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(assign, overflow);
+  END (*--if*);
+
+  IF (mapError = noerr) THEN
+    WITH theMap^ DO
+      assignDomain := AssignOf(domain);
+      assignRange  := AssignOf(range);
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          toMap^.items[index].d := assignDomain(d);
+          toMap^.items[index].r := assignRange(r);
+        END (*--with*);
+      END (*--for*);
+      toMap^.extent := extent;
+    END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Bind attempts to add (or update) the domain/range pair of items to
+the given map. If the item of the domain already exists in the map
+the item of the range is updated to that given. The algorithm must
+therefore be able to detect the insertion of duplicate domain items.
+We must also leave the array in an ordered state for future binary
+searches to work correctly. There are two approaches that may be used:
+
+1)  use a binary search to determine the presence or absence of the
+   given domain item. If the item already exists in the array this
+   will be done in O(log n) steps and this is much more efficient
+   than a linear sequential search which uses O(n) steps. Only if the
+   item is not present in the array do we use Gonnet's insertion into
+   an ordered array algorithm [GONN, pg. 31].
+
+2) simply use an ordered sequential search on the array. If the item
+   is found, the range is updated with the new value and the search
+   terminated. Otherwise, as soon as a domain item is found in the
+   array that is greater than the domain item being added, the array
+   is expanded by shifting items to make room for the new element.
+   The complexity of this approach is on the order of O(n) for both
+   insertion and update operations.
+
+The choice between these two methods depends on the number of updates
+relative to the number of insertions. If there are many more updates to
+the map than insertions, the first approach is clearly better in the long
+run. If the map is never updated (only insertions occur) the extra
+binary search of the first approach is extraneous work; though the
+difference between the two may be insignificant the for small map sizes
+supported by this module.
+
+We shall employ the former tactic on the assumption that efficient
+updating of the map is desired.
+
+The insertion algorithm below combines shifting items into higher array
+indexes while it searches from the end of the array for the proper
+location to insert the new domain/range pair. Once the loop terminates
+by either (1) finding an element less than the new domain item, or (2)
+reaching the front of the array; the new pair can be inserted at the
+index'th + 1 location in the array.
+
+Overall complexity O(n log2 n); for update operations O(log2 n).
+*)
+
+PROCEDURE Bind    (    theMap    : Map     (*-- inout *);
+                       theItemIn : Domain  (*-- in    *);
+                       toItemIn  : Range   (*-- in    *));
+
+VAR  index   : CARDINAL;    (*-- insertion loop index *)
+     compare : CompareProc; (*-- domain item comparison routine *)
+     free    : DisposeProc;
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(bind, undefined);
+  ELSIF (theMap^.extent = theMap^.size) THEN
+    RaiseErrIn(bind, overflow);
+  ELSIF Search(theMap, theItemIn, index) THEN
+    free := DisposeOf(theMap^.range);
+    free(theMap^.items[index].r);
+    theMap^.items[index].r := toItemIn;
+  ELSE
+    WITH theMap^ DO
+      compare := CompareOf(domain);
+      index   := extent;
+      INC(extent);
+      WHILE (index >= MIN(MapSize)) &
+            (compare(items[index].d, theItemIn) = greater) DO
+        items[index+1] := items[index];
+        DEC(index);
+      END (*--while*);
+      WITH items[index+1] DO
+        d := theItemIn;
+        r := toItemIn;
+      END (*--with*);
+    END (*--with*);
+  END (*--if*);
+END Bind;
+(*-------------------------*)
+
+(*
+Unbind searches for and then removes the domain/range pair of items
+associated with the given domain item. If the item is not in the map
+then the map is left unchanged (though the notbound exception is raised).
+Because the array of items is ordered a binary search can be used to
+determine if the item is indeed present in the array. If it is, then all
+items above the index where the item is found must be shifted down one
+position within the array.
+Complexity O(n log2 n).
+*)
+
+PROCEDURE Unbind  (    theMap    : Map     (*-- inout *);
+                       theItemIn : Domain  (*-- in    *));
+
+VAR  index : CARDINAL;    (*-- index of found item, if any *)
+     free  : DisposeProc; (*-- disposal routine for items *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(unbind, undefined);
+  ELSIF (theMap^.extent = 0) OR ~Search(theMap, theItemIn, index) THEN
+    RaiseErrIn(unbind, notbound);
+  ELSE
+    WITH theMap^ DO
+      WITH items[index] DO
+        free := DisposeOf(domain);
+        free(d);
+        free := DisposeOf(range);
+        free(r);
+      END (*--with*);
+      FOR index := index+1 TO extent DO
+        items[index-1] := items[index];
+      END (*--for*);
+      DEC(extent);
+    END (*--with*);
+  END (*--if*);
+END Unbind;
+(*-------------------------*)
+
+
+(*---------------------------------*)
+(*--         SELECTORS           --*)
+
+(*
+IsDefined simply treats a NIL map as the representation for a map
+that has not been created. Complexity O(1).
+*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+BEGIN
+  RETURN theMap # NIL;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns true if the map contains no domain/range pairs, and
+false otherwise. Because we have maintained a count of pairs during
+insertions and deletions this state can be determined quickly. Thus
+we have complexity on the order of O(1).
+*)
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(isempty, undefined);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN theMap^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual determines if the left and right mappings contain the same
+domain/range bindings. Initially, we avoid undefined maps [section
+3.4.n of our specification] and mismatched domain data types, in both
+cases signaling an exception and returning false. Next the trivial
+case where the maps have different numbers of elements is handled
+by avoiding the comparison loop. Only if the two maps have the same
+number of elements do we iterate over the domain/range pairs in each.
+As soon as an inequality is encountered we can return false. Otherwise,
+if the iteration covers all of the elements then the maps must be equal.
+Complexity: O(Min(m,n))
+*)
+
+PROCEDURE IsEqual   (    left      : Map        (*-- in    *);
+                         right     : Map        (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+VAR   index : CARDINAL; (*-- loop index over map item pairs *)
+
+BEGIN
+  mapError := noerr;
+  IF (left = NIL) OR (right = NIL) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.domain # right^.domain) THEN
+    RaiseErrIn(isequal, typeerror);
+
+  ELSIF (left^.extent = right^.extent) THEN
+    WITH left^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        IF (items[index].d # right^.items[index].d) OR
+           (items[index].r # right^.items[index].r) THEN
+          RETURN FALSE;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+SizeOf returns the maximum number of domain/range pairs allowed in the
+map object. Undefined maps raise an exception and return zero.
+Complexity O(1)
+*)
+
+PROCEDURE SizeOf    (    theMap    : Map        (*-- in    *))
+                                   : CARDINAL   (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(sizeof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.size;
+END SizeOf;
+(*-------------------------*)
+
+(*
+ExtentOf returns the number of domain/range pairs present in the
+map object. Undefined maps raise an exception and return zero.
+Complexity O(1)
+*)
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*-- in    *))
+                                   : CARDINAL   (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(extentof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+(*
+DomainOf and RangeOf simply return the data type IDs for the domain
+and range, respectively. Undefined maps cause the NullType to be
+returned. Complexity O(1)
+*)
+
+PROCEDURE DomainOf  (    theMap    : Map        (*-- in    *))
+                                   : TypeID     (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(domainof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.domain;
+END DomainOf;
+(*-------------------------*)
+
+PROCEDURE RangeOf   (    theMap    : Map        (*-- in    *))
+                                   : TypeID     (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(rangeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.range;
+END RangeOf;
+(*-------------------------*)
+
+(*
+IsBound uses the binary search, provided by the routine Search, to
+determine the presence of the given item. BoundTo is similar, except
+that the bound item of the range is returned. IsBoundTo combines the
+facilities provided by both routines. Complexity O(log2 n).
+*)
+
+PROCEDURE IsBound   (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *))
+                                   : BOOLEAN    (*-- out   *);
+
+VAR   index : CARDINAL;    (*-- index of item if found *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(isbound, undefined);
+    RETURN FALSE;
+  END (*--if*);
+  RETURN Search(theMap, theItem, index);
+END IsBound;
+(*-------------------------*)
+
+PROCEDURE BoundTo   (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *))
+                                   : Range      (*-- out   *);
+
+VAR   index : CARDINAL;    (*-- index of item if found *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(boundto, undefined);
+  ELSIF Search(theMap, theItem, index) THEN
+    RETURN theMap^.items[index].r;
+  END (*--if*);
+  RETURN NullItem;
+END BoundTo;
+(*-------------------------*)
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*-- in    *);
+                         theItem   : Domain     (*-- in    *);
+                     VAR toItem    : Range      (*-- out   *))
+                                   : BOOLEAN    (*-- out   *);
+
+VAR   index   : CARDINAL;    (*-- index of item if found *)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(isboundto, undefined);
+  ELSIF Search(theMap, theItem, index) THEN
+    toItem := theMap^.items[index].r;
+    RETURN TRUE;
+  END (*--if*);
+  toItem := NullItem;
+  RETURN FALSE;
+END IsBoundTo;
+(*-------------------------*)
+
+
+(*
+5.4.7 Module Initialization
+
+The module's local variables are initialized to known states.
+mapError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, mapError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR mapError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(mapError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  mapError := noerr;
+  NullMap := NIL;
+END MapSBMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbui.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbui.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbui.def
@@ -0,0 +1,155 @@
+(*
+11.3 Bounded Map Interface
+*)
+
+DEFINITION MODULE MapSBUI;
+(*====================================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Sequential Bounded Unmanaged Iterator
+
+    INTRODUCTION
+    This module provides operations for the bounded map abstract
+   data type.
+
+    REVISION HISTORY
+    v1.00  21 Aug 1989  C. Lins
+      Initial implementation.
+       8/26/89     CL      Add SizeOf selector.
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+=====================================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+    (*-----------------------*)
+
+(*
+11.3.1 Type Declarations
+*)
+
+TYPE  Domain = Item;
+TYPE  Range  = Item;
+
+TYPE  Map;
+VAR   NullMap : Map;
+
+TYPE  MapSize = [1..4094];
+
+
+(*
+11.3.2 Exceptions
+*)
+
+CONST ModuleID = 9;
+
+PROCEDURE MapError   ()              : Exceptions  (*--out  *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+
+
+(*
+11.3.3 Constructors
+*)
+
+PROCEDURE Create  (    theDomain : TypeID  (*--in   *);
+                       theRange  : TypeID  (*--in   *);
+                       theSize   : MapSize (*--in   *))
+                                 : Map     (*--out  *);
+
+PROCEDURE Destroy (VAR theMap    : Map     (*--inout*));
+
+PROCEDURE Clear   (    theMap    : Map     (*--inout*));
+
+PROCEDURE Assign  (    theMap    : Map     (*--in   *);
+                   VAR toMap     : Map     (*--inout *));
+
+PROCEDURE Bind    (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *);
+                       toItemIn  : Range   (*--in   *));
+
+PROCEDURE Unbind  (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *));
+
+
+(*
+11.3.4 Selectors
+*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE IsEqual   (    left      : Map        (*--in   *);
+                         right     : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE SizeOf    (    theMap    : Map        (*-- in    *))
+                                   : CARDINAL   (*-- out   *);
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*--in   *))
+                                   : CARDINAL   (*--out  *);
+
+PROCEDURE DomainOf  (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+
+PROCEDURE RangeOf   (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+
+PROCEDURE IsBound   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE BoundTo   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : Range      (*--out  *);
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *);
+                     VAR toItem    : Range      (*--out  *))
+                                   : BOOLEAN    (*--out  *);
+
+
+(*
+11.3.5 Iterators
+*)
+
+TYPE  LoopAccessProc = PROCEDURE (Domain, Range) : BOOLEAN;
+TYPE  LoopChangeProc = PROCEDURE (Domain, VAR Range) : BOOLEAN;
+
+PROCEDURE LoopOver   (    theMap    : Map            (*--in   *);
+                          theProcess: LoopAccessProc (*--in   *));
+
+PROCEDURE LoopChange (    theMap    : Map            (*--in   *);
+                          theProcess: LoopChangeProc (*--in   *));
+
+
+TYPE  AccessProc = PROCEDURE (Domain, Range);
+TYPE  ChangeProc = PROCEDURE (Domain, VAR Range);
+
+PROCEDURE Traverse   (    theMap    : Map            (*--in   *);
+                          theProcess: AccessProc     (*--in   *));
+
+PROCEDURE TravChange (    theMap    : Map            (*--in   *);
+                          theProcess: ChangeProc     (*--in   *));
+
+END MapSBUI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbui.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbui.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbui.mod
@@ -0,0 +1,686 @@
+(*
+11.4 Bounded Map Implementation
+*)
+
+IMPLEMENTATION MODULE MapSBUI;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Sequential Bounded Unmanaged Iterator
+
+    INTRODUCTION
+    This module provides operations for the bounded map abstract
+   data type. This implementation uses an unordered array as
+   the underlying representation.
+
+    REVISION HISTORY
+       v1.00 21 Aug 1989  C. Lins
+         Initial implementation.
+       8/26/89     CL      Add SizeOf selector.
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+===============================================================*)
+
+FROM SCLStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+   (*--Cons*) NullItem,
+   (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+
+    (*-----------------------*)
+
+(*
+11.4.1 Type Declarations
+*)
+
+TYPE  Pair = RECORD
+        d : Domain;     (*-- value of the domain *)
+        r : Range;      (*-- mapped to value of the range *)
+      END (*--Pair*);
+
+TYPE  MapItems = ARRAY MapSize OF Pair;
+
+TYPE  BoundedMap = RECORD
+        domain : TypeID;   (*-- data type id for the domain *)
+        range  : TypeID;   (*-- data type id for the range *)
+        size   : CARDINAL; (*-- maximum # of items in map *)
+        extent : CARDINAL; (*-- current # of items in map *)
+        items  : MapItems; (*-- array [1..size] *)
+      END (*--BoundedMap*);
+
+TYPE  Map = POINTER TO BoundedMap;
+
+
+(*
+11.4.2 Exceptions
+*)
+
+VAR   mapError : Exceptions;
+VAR   handler  : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE MapError   ()              : Exceptions  (*--out  *);
+BEGIN
+  RETURN mapError;
+END MapError;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*--in   *);
+                          theError   : Exceptions (*--in   *));
+BEGIN
+  mapError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+11.4.3 Constructors
+*)
+
+(*
+Create attempts to form a new, empty map object. The routine uses
+the standard strategy employed throughout all of the bounded
+components presented in the series of allocating an object containing
+an array of varying size. If the allocation is successful, the data
+types of the domain and range are saved along with the map's maximum
+size, while the extent (the number of items present in the map) is
+initialized to zero. Note that Allocate set the pointer to NIL if
+unable to get the specified number of bytes from the system allocation
+routine. Complexity O(1).
+*)
+
+PROCEDURE Create  (    theDomain : TypeID  (*--in   *);
+                       theRange  : TypeID  (*--in   *);
+                       theSize   : MapSize (*--in   *))
+                                 : Map     (*--out  *);
+
+CONST baseSize = SIZE(BoundedMap) - SIZE(MapItems);
+CONST pairSize = SIZE(Pair);
+
+VAR   newMap : Map;
+
+BEGIN
+  mapError := noerr;
+  Allocate(newMap, baseSize + pairSize * theSize);
+  IF (newMap = NullMap) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newMap^ DO
+      domain := theDomain;
+      range  := theRange;
+      size   := theSize;
+      extent := 0;
+    END (*--with*);
+  END (*--if*);
+  RETURN newMap;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy is the inverse of Create, making a Map ╘undefined╒. To
+simplify matters we use Clear to test for an undefined map and
+to remove all existing domain/range pairs from the map, if any.
+If an error does not occur then we may dispose of the map object
+itself. Note that the version of Deallocate given here, automatically
+disposes of the proper amount of space (i.e., that which was
+originally allocated to the object. Complexity O(1).
+*)
+
+PROCEDURE Destroy (VAR theMap    : Map     (*--inout*));
+CONST baseSize = SIZE(BoundedMap) - SIZE(MapItems);
+CONST pairSize = SIZE(Pair);
+BEGIN
+  Clear(theMap);
+  IF (mapError = noerr) THEN
+    Deallocate(theMap, baseSize + pairSize * theMap^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear removes all domain/range pairs from the map, if any. For unmanaged
+components there is no need to deallocate the elements of the domain or
+range. Thus, it is sufficient to reset the extent to zero to clear the
+map. Complexity O(1).
+*)
+
+PROCEDURE Clear   (    theMap    : Map     (*--inout*));
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theMap^ DO
+      extent := 0;
+    END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates a map object, including the domain/range pairs and
+the relationship between them. If the target map, toMap, is undefined
+on entry to the routine it is automatically created with the same
+domain and range data types, and the same maximum size as the source
+map. If the source map is not empty, it is cleared of its contents
+and its domain/range data types are altered to match those of the source
+map. This step is called recreating the target map. Once completed without
+error, the assignment takes place using a simple loop over the number of
+items in the source map. Since the values from the domain and range are
+discrete, simple assignment as provide by Modula-2 accomplishes the
+duplication of domain and range values. Complexity O(n).
+*)
+
+PROCEDURE Assign  (    theMap    : Map     (*--in   *);
+                   VAR toMap     : Map     (*--inout*));
+
+VAR   index : CARDINAL;   (*--loop index over items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theMap = toMap) THEN
+    RETURN;
+  ELSIF (toMap = NullMap) THEN
+    WITH theMap^ DO
+      toMap := Create(domain, range, size);
+    END (*--with*);
+  ELSIF (theMap^.extent <= toMap^.size) THEN
+    Clear(toMap);
+    WITH theMap^ DO
+      toMap^.domain := domain;
+      toMap^.range  := range;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(assign, overflow);
+  END (*--if*);
+  
+  IF (mapError = noerr) THEN
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          toMap^.items[index].d := d;
+          toMap^.items[index].r := r;
+        END (*--with*);
+      END (*--for*);
+      toMap^.extent := extent;
+    END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Bind attempts to add (or update) the domain/range pair of items to
+the given map. If the item of the domain already exists in the map
+the item of the range is updated to that given. The algorithm must
+therefore be able to detect the insertion of duplicate domain items.
+Because the array is unordered, the only approach is to use a sequential
+search to find the desired item, if it is present. This is similar to
+the second approach discussed for the ordered array representation. The
+complexity is O(n).
+*)
+
+PROCEDURE Bind    (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *);
+                       toItemIn  : Range   (*--in   *));
+
+VAR   index : CARDINAL; (*--loop index over item pairs*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(bind, undefined);
+  ELSIF (theMap^.extent = theMap^.size) THEN
+    RaiseErrIn(bind, overflow);
+  ELSE
+    WITH theMap^ DO
+      index := MIN(MapSize);
+      LOOP
+        IF (index > extent) THEN
+          EXIT (*--loop*);
+        ELSIF (items[index].d = theItemIn) THEN
+          items[index].r := toItemIn;
+          RETURN;
+        END (*--if*);
+        INC(index);
+      END (*--loop*);
+
+      INC(extent);
+      WITH items[extent] DO
+        d := theItemIn;
+        r := toItemIn;
+      END (*--with*);
+    END (*--with*);
+  END (*--if*);
+END Bind;
+(*-------------------------*)
+
+(*
+Unbind searches for and then removes the domain/range pair of items
+associated with the given domain item. If the item is not in the map
+then the map is left unchanged. Because the array of items is unordered
+a sequential search must be used to determine if the item is indeed present
+in the array. If the item is found it is overwritten with the last item
+in the array (recovering dynamically allocated space, if any), the count
+of items is decremented, and the routine is exited immediately. Thus, if
+the end of the FOR loop is reached, the given domain item is not bound to
+any value of the range.
+Complexity O(n).
+*)
+
+PROCEDURE Unbind  (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *));
+
+VAR   index : CARDINAL;    (*--loop index over item pairs*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(unbind, undefined);
+  ELSIF (theMap^.extent = 0) THEN
+    RaiseErrIn(unbind, notbound);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        IF (theItemIn = items[index].d) THEN
+          items[index] := items[extent];
+          DEC(extent);
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+    RaiseErrIn(unbind, notbound);
+  END (*--if*);
+END Unbind;
+(*-------------------------*)
+
+
+(*
+5.2.4  Selectors
+*)
+
+(*
+IsDefined simply treats a NIL map as the representation for a map
+that has not been created. Complexity O(1).
+*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+BEGIN
+  RETURN theMap # NullMap;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns true if the map contains no domain/range pairs, and
+false otherwise. Because we have maintained a count of pairs during
+insertions and deletions this state can be determined quickly. Thus
+we have complexity on the order of O(1).
+*)
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isempty, undefined);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN theMap^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual determines if the left and right mappings contain the same
+domain/range bindings. Initially, we avoid undefined maps [section
+10.4.n of our specification] and mismatched domain data types, in both
+cases signaling an exception and returning false. Next the trivial
+case where the maps have different numbers of elements is handled
+by avoiding the comparison loop.
+
+As the arrays are unordered the whole of the right map must be searched
+for each item of the left map. Thus, this version of IsEqual has a
+complexity on the order of O(n**2). Of course, if this operation is
+not used, or used only infrequently, by the client, this may be immaterial.
+*)
+
+PROCEDURE IsEqual   (    left      : Map        (*--in   *);
+                         right     : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR  index : CARDINAL; (*--loop index over left map items of Domain*)
+     jndex : CARDINAL; (*--loop index over right map items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (left = NullMap) OR (right = NullMap) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.domain # right^.domain) THEN
+    RaiseErrIn(isequal, typeerror);
+
+  ELSIF (left^.extent = right^.extent) THEN
+    WITH left^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        jndex := MIN(MapSize);
+        LOOP
+          IF (jndex > extent) THEN
+            RETURN FALSE;
+          ELSIF (items[index].d = right^.items[jndex].d) THEN
+            IF (items[index].r = right^.items[jndex].r) THEN
+              EXIT (*--loop*);
+            ELSE
+              RETURN FALSE;
+            END (*--if*);
+          ELSE
+            INC(jndex);
+          END (*--if*);
+        END (*--loop*);
+      END (*--for*);
+    END (*--with*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+SizeOf returns the maximum number of domain/range pairs allowed in the
+map object. Undefined maps raise an exception and return zero.
+Complexity O(1)
+*)
+
+PROCEDURE SizeOf    (    theMap    : Map        (*-- in    *))
+                                   : CARDINAL   (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(sizeof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.size;
+END SizeOf;
+(*-------------------------*)
+
+(*
+ExtentOf returns the number of domain/range pairs present in the
+map object. Undefined maps raise an exception and return zero.
+Complexity O(1)
+*)
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*--in   *))
+                                   : CARDINAL   (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(extentof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+(*
+DomainOf and RangeOf simply return the data type IDs for the domain
+and range, respectively. Undefined maps cause the NullType to be
+returned. Complexity O(1)
+*)
+
+PROCEDURE DomainOf  (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(domainof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.domain;
+END DomainOf;
+(*-------------------------*)
+
+PROCEDURE RangeOf   (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(rangeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.range;
+END RangeOf;
+(*-------------------------*)
+
+(*
+IsBound, BoundTo, and IsBoundTo all use a sequential search to determine
+the presence of the given item of the domain. This must be done as an
+unordered array is used for the internal map representation. Each routine
+returns the appropriate value(s) depending on its function result.
+Complexity O(n).
+*)
+
+PROCEDURE IsBound   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR   index : CARDINAL; (*--loop index over items*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isbound, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          IF (theItem = d) THEN
+            RETURN TRUE;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsBound;
+(*-------------------------*)
+
+PROCEDURE BoundTo   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : Range      (*--out  *);
+
+VAR   index : CARDINAL; (*--loop index over items*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(boundto, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          IF (theItem = d) THEN
+            RETURN r;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END BoundTo;
+(*-------------------------*)
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *);
+                     VAR toItem    : Range      (*--out  *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR   index : CARDINAL; (*--loop index over items*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isboundto, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          IF (theItem = d) THEN
+            toItem := r;
+            RETURN TRUE;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+  toItem := NullItem;
+  RETURN FALSE;
+END IsBoundTo;
+(*-------------------------*)
+
+
+(*
+11.4.5 Iterators
+*)
+
+PROCEDURE LoopOver   (    theMap    : Map            (*--in   *);
+                          theProcess: LoopAccessProc (*--in   *));
+
+VAR   index : CARDINAL; (*--loop index over items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          IF ~theProcess(d, r) THEN
+            RETURN;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE LoopChange (    theMap    : Map            (*--in   *);
+                          theProcess: LoopChangeProc (*--in   *));
+
+VAR   index : CARDINAL; (*--loop index over items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(loopchange, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          IF ~theProcess(d, r) THEN
+            RETURN;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END LoopChange;
+(*-------------------------*)
+
+
+PROCEDURE Traverse   (    theMap    : Map            (*--in   *);
+                          theProcess: AccessProc     (*--in   *));
+
+VAR   index : CARDINAL; (*--loop index over items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          theProcess(d, r);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+PROCEDURE TravChange (    theMap    : Map            (*--in   *);
+                          theProcess: ChangeProc     (*--in   *));
+
+VAR   index : CARDINAL; (*--loop index over items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(travchange, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          theProcess(d, r);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+END TravChange;
+(*-------------------------*)
+
+
+(*
+11.4.6 Module Initialization
+
+The module's local variables are initialized to known states.
+mapError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, mapError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR mapError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(mapError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  mapError := noerr;
+  NullMap := NIL;
+END MapSBUI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbun.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbun.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbun.def
@@ -0,0 +1,131 @@
+(*
+11.3 Bounded Map Interface
+*)
+
+DEFINITION MODULE MapSBUN;
+(*====================================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Sequential Bounded Unmanaged Non-Iterator
+
+    INTRODUCTION
+    This module provides operations for the bounded map abstract
+   data type.
+
+    REVISION HISTORY
+       v1.00  21 Aug 1989  C. Lins
+         Initial implementation.
+       8/26/89     CL      Add SizeOf selector.
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+=====================================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+    (*-----------------------*)
+
+(*
+11.3.1 Type Declarations
+*)
+
+TYPE  Domain = Item;
+TYPE  Range  = Item;
+
+TYPE  Map;
+VAR   NullMap : Map;
+
+TYPE  MapSize = [1..4094];
+
+
+(*
+11.3.2 Exceptions
+*)
+
+CONST ModuleID = 10;
+
+PROCEDURE MapError   ()              : Exceptions  (*--out  *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+
+
+(*
+11.3.3 Constructors
+*)
+
+PROCEDURE Create  (    theDomain : TypeID  (*--in   *);
+                       theRange  : TypeID  (*--in   *);
+                       theSize   : MapSize (*--in   *))
+                                 : Map     (*--out  *);
+
+PROCEDURE Destroy (VAR theMap    : Map     (*--inout*));
+
+PROCEDURE Clear   (    theMap    : Map     (*--inout*));
+
+PROCEDURE Assign  (    theMap    : Map     (*--in   *);
+                   VAR toMap     : Map     (*--inout *));
+
+PROCEDURE Bind    (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *);
+                       toItemIn  : Range   (*--in   *));
+
+PROCEDURE Unbind  (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *));
+
+
+(*
+11.3.4 Selectors
+*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE IsEqual   (    left      : Map        (*--in   *);
+                         right     : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE SizeOf    (    theMap    : Map        (*--in   *))
+                                   : CARDINAL   (*--out  *);
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*--in   *))
+                                   : CARDINAL   (*--out  *);
+
+PROCEDURE DomainOf  (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+
+PROCEDURE RangeOf   (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+
+PROCEDURE IsBound   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE BoundTo   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : Range      (*--out  *);
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *);
+                     VAR toItem    : Range      (*--out  *))
+                                   : BOOLEAN    (*--out  *);
+
+END MapSBUN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbun.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbun.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsbun.mod
@@ -0,0 +1,592 @@
+(*
+11.4 Bounded Map Implementation
+*)
+
+IMPLEMENTATION MODULE MapSBUN;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Sequential Bounded Unmanaged Non-Iterator
+
+    INTRODUCTION
+    This module provides operations for the bounded map abstract
+   data type. This implementation uses an unordered array as
+   the underlying representation.
+
+    REVISION HISTORY
+       v1.00 21 Aug 1989  C. Lins
+         Initial implementation.
+       8/26/89     CL      Add SizeOf selector.
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+===============================================================*)
+
+FROM SCLStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+   (*--Cons*) NullItem,
+   (*--Type*) Item;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+
+    (*-----------------------*)
+
+(*
+11.4.1 Type Declarations
+*)
+
+TYPE  Pair = RECORD
+        d : Domain;     (*-- value of the domain *)
+        r : Range;      (*-- mapped to value of the range *)
+      END (*--Pair*);
+
+TYPE  MapItems = ARRAY MapSize OF Pair;
+
+TYPE  BoundedMap = RECORD
+        domain : TypeID;   (*-- data type id for the domain *)
+        range  : TypeID;   (*-- data type id for the range *)
+        size   : CARDINAL; (*-- maximum # of items in map *)
+        extent : CARDINAL; (*-- current # of items in map *)
+        items  : MapItems; (*-- array [1..size] *)
+      END (*--BoundedMap*);
+
+TYPE  Map = POINTER TO BoundedMap;
+
+
+(*
+11.4.2 Exceptions
+*)
+
+VAR   mapError : Exceptions;
+VAR   handler  : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE MapError   ()              : Exceptions  (*--out  *);
+BEGIN
+  RETURN mapError;
+END MapError;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*--in   *);
+                          theError   : Exceptions (*--in   *));
+BEGIN
+  mapError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+
+(*
+11.4.3 Constructors
+*)
+
+(*
+Create attempts to form a new, empty map object. The routine uses
+the standard strategy employed throughout all of the bounded
+components presented in the series of allocating an object containing
+an array of varying size. If the allocation is successful, the data
+types of the domain and range are saved along with the map's maximum
+size, while the extent (the number of items present in the map) is
+initialized to zero. Note that Allocate set the pointer to NIL if
+unable to get the specified number of bytes from the system allocation
+routine. Complexity O(1).
+*)
+
+PROCEDURE Create  (    theDomain : TypeID  (*--in   *);
+                       theRange  : TypeID  (*--in   *);
+                       theSize   : MapSize (*--in   *))
+                                 : Map     (*--out  *);
+
+CONST baseSize = SIZE(BoundedMap) - SIZE(MapItems);
+CONST pairSize = SIZE(Pair);
+
+VAR   newMap : Map;
+
+BEGIN
+  mapError := noerr;
+  Allocate(newMap, baseSize + pairSize * theSize);
+  IF (newMap = NullMap) THEN
+   RaiseErrIn(create, overflow);
+  ELSE
+    WITH newMap^ DO
+      domain := theDomain;
+      range  := theRange;
+      size   := theSize;
+      extent := 0;
+    END (*--with*);
+  END (*--if*);
+  RETURN newMap;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy is the inverse of Create, making a Map ╘undefined╒. To
+simplify matters we use Clear to test for an undefined map and
+to remove all existing domain/range pairs from the map, if any.
+If an error does not occur then we may dispose of the map object
+itself. Note that the version of Deallocate given here, automatically
+disposes of the proper amount of space (i.e., that which was
+originally allocated to the object. Complexity O(1).
+*)
+
+PROCEDURE Destroy (VAR theMap    : Map     (*--inout*));
+CONST baseSize = SIZE(BoundedMap) - SIZE(MapItems);
+CONST pairSize = SIZE(Pair);
+BEGIN
+  Clear(theMap);
+  IF (mapError = noerr) THEN
+    Deallocate(theMap, baseSize + pairSize * theMap^.size);
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear removes all domain/range pairs from the map, if any. For unmanaged
+components there is no need to deallocate the elements of the domain or
+range. Thus, it is sufficient to reset the extent to zero to clear the
+map. Complexity O(1).
+*)
+
+PROCEDURE Clear   (    theMap    : Map     (*--inout*));
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theMap^ DO
+      extent := 0;
+    END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates a map object, including the domain/range pairs and
+the relationship between them. If the target map, toMap, is undefined
+on entry to the routine it is automatically created with the same
+domain and range data types, and the same maximum size as the source
+map. If the source map is not empty, it is cleared of its contents
+and its domain/range data types are altered to match those of the source
+map. This step is called recreating the target map. Once completed without
+error, the assignment takes place using a simple loop over the number of
+items in the source map. Since the values from the domain and range are
+discrete, simple assignment as provide by Modula-2 accomplishes the
+duplication of domain and range values. Complexity O(n).
+*)
+
+PROCEDURE Assign  (    theMap    : Map     (*--in   *);
+                   VAR toMap     : Map     (*--inout*));
+
+VAR   index : CARDINAL;   (*--loop index over items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theMap = toMap) THEN
+    RETURN;
+  ELSIF (toMap = NullMap) THEN
+    WITH theMap^ DO
+      toMap := Create(domain, range, size);
+    END (*--with*);
+  ELSIF (theMap^.extent <= toMap^.size) THEN
+    Clear(toMap);
+    WITH theMap^ DO
+      toMap^.domain := domain;
+      toMap^.range  := range;
+    END (*--with*);
+  ELSE
+    RaiseErrIn(assign, overflow);
+  END (*--if*);
+  
+  IF (mapError = noerr) THEN
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          toMap^.items[index].d := d;
+          toMap^.items[index].r := r;
+        END (*--with*);
+      END (*--for*);
+      toMap^.extent := extent;
+    END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Bind attempts to add (or update) the domain/range pair of items to
+the given map. If the item of the domain already exists in the map
+the item of the range is updated to that given. The algorithm must
+therefore be able to detect the insertion of duplicate domain items.
+Because the array is unordered, the only approach is to use a sequential
+search to find the desired item, if it is present. This is similar to
+the second approach discussed for the ordered array representation. The
+complexity is O(n).
+*)
+
+PROCEDURE Bind    (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *);
+                       toItemIn  : Range   (*--in   *));
+
+VAR   index : CARDINAL; (*--loop index over item pairs*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(bind, undefined);
+  ELSIF (theMap^.extent = theMap^.size) THEN
+    RaiseErrIn(bind, overflow);
+  ELSE
+    WITH theMap^ DO
+      index := MIN(MapSize);
+      LOOP
+        IF (index > extent) THEN
+          EXIT (*--loop*);
+        ELSIF (items[index].d = theItemIn) THEN
+          items[index].r := toItemIn;
+          RETURN;
+        END (*--if*);
+        INC(index);
+      END (*--loop*);
+
+      INC(extent);
+      WITH items[extent] DO
+        d := theItemIn;
+        r := toItemIn;
+      END (*--with*);
+    END (*--with*);
+  END (*--if*);
+END Bind;
+(*-------------------------*)
+
+(*
+Unbind searches for and then removes the domain/range pair of items
+associated with the given domain item. If the item is not in the map
+then the map is left unchanged. Because the array of items is unordered
+a sequential search must be used to determine if the item is indeed present
+in the array. If the item is found it is overwritten with the last item
+in the array (recovering dynamically allocated space, if any), the count
+of items is decremented, and the routine is exited immediately. Thus, if
+the end of the FOR loop is reached, the given domain item is not bound to
+any value of the range.
+Complexity O(n).
+*)
+
+PROCEDURE Unbind  (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *));
+
+VAR   index : CARDINAL;    (*--loop index over item pairs*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(unbind, undefined);
+  ELSIF (theMap^.extent = 0) THEN
+    RaiseErrIn(unbind, notbound);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        IF (theItemIn = items[index].d) THEN
+          items[index] := items[extent];
+          DEC(extent);
+          RETURN;
+        END (*--if*);
+      END (*--for*);
+    END (*--with*);
+    RaiseErrIn(unbind, notbound);
+  END (*--if*);
+END Unbind;
+(*-------------------------*)
+
+
+(*
+5.2.4  Selectors
+*)
+
+(*
+IsDefined simply treats a NIL map as the representation for a map
+that has not been created. Complexity O(1).
+*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+BEGIN
+  RETURN theMap # NullMap;
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns true if the map contains no domain/range pairs, and
+false otherwise. Because we have maintained a count of pairs during
+insertions and deletions this state can be determined quickly. Thus
+we have complexity on the order of O(1).
+*)
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isempty, undefined);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN theMap^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual determines if the left and right mappings contain the same
+domain/range bindings. Initially, we avoid undefined maps [section
+10.4.n of our specification] and mismatched domain data types, in both
+cases signaling an exception and returning false. Next the trivial
+case where the maps have different numbers of elements is handled
+by avoiding the comparison loop.
+
+As the arrays are unordered the whole of the right map must be searched
+for each item of the left map. Thus, this version of IsEqual has a
+complexity on the order of O(n**2). Of course, if this operation is
+not used, or used only infrequently, by the client, this may be immaterial.
+*)
+
+PROCEDURE IsEqual   (    left      : Map        (*--in   *);
+                         right     : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR   index : CARDINAL; (*--loop index over left map items of Domain*)
+     jndex : CARDINAL; (*--loop index over right map items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (left = NullMap) OR (right = NullMap) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.domain # right^.domain) THEN
+    RaiseErrIn(isequal, typeerror);
+
+  ELSIF (left^.extent = right^.extent) THEN
+    WITH left^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        jndex := MIN(MapSize);
+        LOOP
+          IF (jndex > extent) THEN
+            RETURN FALSE;
+          ELSIF (items[index].d = right^.items[jndex].d) THEN
+            IF (items[index].r = right^.items[jndex].r) THEN
+              EXIT (*--loop*);
+            ELSE
+              RETURN FALSE;
+            END (*--if*);
+          ELSE
+            INC(jndex);
+          END (*--if*);
+        END (*--loop*);
+      END (*--for*);
+    END (*--with*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+SizeOf returns the maximum number of domain/range pairs allowed in the
+map object. Undefined maps raise an exception and return zero.
+Complexity O(1)
+*)
+
+PROCEDURE SizeOf    (    theMap    : Map        (*-- in    *))
+                                   : CARDINAL   (*-- out   *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NIL) THEN
+    RaiseErrIn(sizeof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.size;
+END SizeOf;
+(*-------------------------*)
+
+(*
+ExtentOf returns the number of domain/range pairs present in the
+map object. Undefined maps raise an exception and return zero.
+Complexity O(1)
+*)
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*--in   *))
+                                   : CARDINAL   (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(extentof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+(*
+DomainOf and RangeOf simply return the data type IDs for the domain
+and range, respectively. Undefined maps cause the NullType to be
+returned. Complexity O(1)
+*)
+
+PROCEDURE DomainOf  (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(domainof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.domain;
+END DomainOf;
+(*-------------------------*)
+
+PROCEDURE RangeOf   (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(rangeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.range;
+END RangeOf;
+(*-------------------------*)
+
+(*
+IsBound, BoundTo, and IsBoundTo all use a sequential search to determine
+the presence of the given item of the domain. This must be done as an
+unordered array is used for the internal map representation. Each routine
+returns the appropriate value(s) depending on its function result.
+Complexity O(n).
+*)
+
+PROCEDURE IsBound   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR   index : CARDINAL; (*--loop index over items*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isbound, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          IF (theItem = d) THEN
+            RETURN TRUE;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+  RETURN FALSE;
+END IsBound;
+(*-------------------------*)
+
+PROCEDURE BoundTo   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : Range      (*--out  *);
+
+VAR   index : CARDINAL; (*--loop index over items*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(boundto, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          IF (theItem = d) THEN
+            RETURN r;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+  RETURN NullItem;
+END BoundTo;
+(*-------------------------*)
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *);
+                     VAR toItem    : Range      (*--out  *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR   index : CARDINAL; (*--loop index over items*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isboundto, undefined);
+  ELSE
+    WITH theMap^ DO
+      FOR index := MIN(MapSize) TO extent DO
+        WITH items[index] DO
+          IF (theItem = d) THEN
+            toItem := r;
+            RETURN TRUE;
+          END (*--if*);
+        END (*--with*);
+      END (*--for*);
+    END (*--with*);
+  END (*--if*);
+  toItem := NullItem;
+  RETURN FALSE;
+END IsBoundTo;
+(*-------------------------*)
+
+
+(*
+11.4.6 Module Initialization
+
+The module's local variables are initialized to known states.
+mapError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, mapError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR mapError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(mapError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  mapError := noerr;
+  NullMap := NIL;
+END MapSBUN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsumi.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsumi.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsumi.def
@@ -0,0 +1,147 @@
+(*
+12.1 Unbounded Map Interface
+*)
+
+DEFINITION MODULE MapSUMI;
+(*====================================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Sequential Unbounded Managed Iterator
+
+    INTRODUCTION
+    This module provides operations for the unbounded map abstract
+   data type.
+
+    REVISION HISTORY
+       8/26/89     CL      Initial version
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+=====================================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+    (*-----------------------*)
+
+(*
+12.1.1 Type Declarations
+*)
+
+TYPE  Domain = Item;
+TYPE  Range  = Item;
+
+TYPE  Map;
+VAR   NullMap : Map;
+
+
+(*
+12.1.2 Exceptions
+*)
+
+CONST ModuleID = 15;
+
+PROCEDURE MapError   ()              : Exceptions  (*--out  *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+
+
+(*
+12.1.3 Constructors
+*)
+
+PROCEDURE Create  (    theDomain : TypeID  (*--in   *);
+                       theRange  : TypeID  (*--in   *))
+                                 : Map     (*--out  *);
+
+PROCEDURE Destroy (VAR theMap    : Map     (*--inout*));
+
+PROCEDURE Clear   (    theMap    : Map     (*--inout*));
+
+PROCEDURE Assign  (    theMap    : Map     (*--in   *);
+                   VAR toMap     : Map     (*--inout *));
+
+PROCEDURE Bind    (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *);
+                       toItemIn  : Range   (*--in   *));
+
+PROCEDURE Unbind  (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *));
+
+
+(*
+12.1.4 Selectors
+*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE IsEqual   (    left      : Map        (*--in   *);
+                         right     : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*--in   *))
+                                   : CARDINAL   (*--out  *);
+
+PROCEDURE DomainOf  (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+
+PROCEDURE RangeOf   (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+
+PROCEDURE IsBound   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE BoundTo   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : Range      (*--out  *);
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *);
+                     VAR toItem    : Range      (*--out  *))
+                                   : BOOLEAN    (*--out  *);
+
+
+(*
+12.1.5 Iterators
+*)
+
+TYPE  LoopAccessProc = PROCEDURE (Domain, Range) : BOOLEAN;
+TYPE  LoopChangeProc = PROCEDURE (Domain, VAR Range) : BOOLEAN;
+
+PROCEDURE LoopOver   (    theMap    : Map            (*--in   *);
+                          theProcess: LoopAccessProc (*--in   *));
+
+PROCEDURE LoopChange (    theMap    : Map            (*--in   *);
+                          theProcess: LoopChangeProc (*--in   *));
+
+
+TYPE  AccessProc = PROCEDURE (Domain, Range);
+TYPE  ChangeProc = PROCEDURE (Domain, VAR Range);
+
+PROCEDURE Traverse   (    theMap    : Map            (*--in   *);
+                          theProcess: AccessProc     (*--in   *));
+
+PROCEDURE TravChange (    theMap    : Map            (*--in   *);
+                          theProcess: ChangeProc     (*--in   *));
+
+END MapSUMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsumi.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsumi.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsumi.mod
@@ -0,0 +1,709 @@
+(*
+12.2 Unbounded Map Implementation
+*)
+
+IMPLEMENTATION MODULE MapSUMI;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Sequential Unbounded Managed Iterator
+
+    INTRODUCTION
+    This module provides operations for the bounded map abstract
+   data type. This implementation uses an unordered list as
+   the underlying representation.
+
+    REVISION HISTORY
+       8/26/89     CL      Initial version.
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+===============================================================*)
+
+FROM SCLStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+   (*--Cons*) NullItem,
+   (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM Relations IMPORT
+   (*--type*) Relation;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+   (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM TypeManager IMPORT
+   (*--Cons*) NullType,
+    (*--Type*) TypeID,
+   (*--Proc*) AssignOf, CompareOf, DisposeOf;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+
+    (*-----------------------*)
+
+(*
+12.2.1 Type Declarations
+*)
+
+TYPE  MapItem = POINTER TO Pair;
+
+TYPE  Pair = RECORD
+        d   : Domain;       (*-- value of the domain *)
+        r   : Range;        (*-- mapped to value of the range *)
+        next: MapItem;
+      END (*--Pair*);
+
+TYPE  UnboundedMap = RECORD
+        domain : TypeID;    (*-- data type id for the domain *)
+        range  : TypeID;    (*-- data type id for the range *)
+        extent : CARDINAL;  (*-- current # of items in map *)
+        items  : MapItem;   (*-- head of list of pairs *)
+      END (*--UnboundedMap*);
+
+TYPE  Map = POINTER TO UnboundedMap;
+
+
+(*
+12.2.2 Exceptions
+*)
+
+VAR   mapError : Exceptions;
+VAR   handler  : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE MapError   ()              : Exceptions  (*--out  *);
+BEGIN
+  RETURN mapError;
+END MapError;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*--in   *);
+                          theError   : Exceptions (*--in   *));
+BEGIN
+  mapError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+PROCEDURE Search    (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *);
+                     VAR theIndex  : MapItem    (*--out  *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR   compareDomain : CompareProc; (*-- domain value comparison routine *)
+
+BEGIN
+  WITH theMap^ DO
+    compareDomain := CompareOf(domain);
+    theIndex := items;
+  END (*--with*);
+  WHILE (theIndex # NIL) DO
+    IF compareDomain(theItem, theIndex^.d) = equal THEN
+      RETURN TRUE;
+    END (*--if*);
+    theIndex := theIndex^.next;
+  END (*--while*);
+  RETURN FALSE;
+END Search;
+(*-------------------------*)
+
+(*
+12.2.3 Constructors
+*)
+
+(*
+Create attempts to form a new, empty map object. If the allocation is
+successful, the data
+types of the domain and range are saved, while the extent (the number
+of items present in the map) is
+initialized to zero. Note that Allocate set the pointer to NIL if
+unable to get the specified number of bytes from the system allocation
+routine. Complexity O(1).
+*)
+
+PROCEDURE Create  (    theDomain : TypeID  (*--in   *);
+                       theRange  : TypeID  (*--in   *))
+                                 : Map     (*--out  *);
+
+VAR   newMap : Map;
+
+BEGIN
+  mapError := noerr;
+  Allocate(newMap, SIZE(UnboundedMap));
+  IF (newMap = NullMap) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newMap^ DO
+      domain := theDomain;
+      range  := theRange;
+      extent := 0;
+      items  := NIL;
+    END (*--with*);
+  END (*--if*);
+  RETURN newMap;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy is the inverse of Create, making a Map ╘undefined╒. To
+simplify matters we use Clear to test for an undefined map and
+to remove all existing domain/range pairs from the map, if any.
+If an error does not occur then we may dispose of the map object
+itself. Note that the version of Deallocate given here, automatically
+disposes of the proper amount of space (i.e., that which was
+originally allocated to the object. Complexity O(n).
+*)
+
+PROCEDURE Destroy (VAR theMap    : Map     (*--inout*));
+BEGIN
+  Clear(theMap);
+  IF (mapError = noerr) THEN
+    Deallocate(theMap, SIZE(UnboundedMap));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear removes all domain/range pairs from the map, if any. The data
+types of the domain and range are used to retrieve the dynamic memory
+deallocation routines, if any, associated with the domain and range.
+This allows us to store arbitrarily complex structures within the map.
+Complexity O(n).
+*)
+
+PROCEDURE Clear   (    theMap    : Map     (*--inout*));
+
+VAR   freeDomain : DisposeProc; (*--disposal routine for items of Domain*)
+      freeRange  : DisposeProc; (*--disposal routine for items of Range*)
+      oldItem    : MapItem;
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theMap^ DO
+      freeDomain := DisposeOf(domain);
+      freeRange  := DisposeOf(range);
+      WHILE (items # NIL) DO
+        WITH items^ DO
+          freeDomain(d);
+          freeRange(r);
+        END (*--with*);
+        oldItem := items;
+        items := items^.next;
+        Deallocate(oldItem, SIZE(Pair));
+      END (*--for*);
+      extent := 0;
+    END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates a map object, including the domain/range pairs and
+the relationship between them. If the target map, toMap, is undefined
+on entry to the routine it is automatically created with the same
+domain and range data types, and the same maximum size as the source
+map. If the source map is not empty, it is cleared of its contents
+and its domain/range data types are altered to match those of the source
+map. This step is called recreating the target map. Once completed without
+error, the assignment takes place using a simple loop over the number of
+items in the source map. Complexity O(m+n).
+*)
+
+PROCEDURE Assign  (    theMap    : Map     (*--in   *);
+                   VAR toMap     : Map     (*--inout*));
+
+VAR  index        : MapItem;   (*--loop index over items of Domain*)
+     assignDomain : AssignProc; (*--domain items assignment routine*)
+     assignRange  : AssignProc; (*--range items assignment routine*)
+     newPair      : MapItem;
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theMap = toMap) THEN
+    RETURN;
+  ELSIF (toMap = NullMap) THEN
+    WITH theMap^ DO
+      toMap := Create(domain, range);
+    END (*--with*);
+  ELSE
+    Clear(toMap);
+    WITH theMap^ DO
+      toMap^.domain := domain;
+      toMap^.range  := range;
+    END (*--with*);
+  END (*--if*);
+
+  IF (mapError = noerr) THEN
+    WITH theMap^ DO
+      assignDomain := AssignOf(domain);
+      assignRange  := AssignOf(range);
+      index := items;
+      WHILE (index # NIL) DO
+        Allocate(newPair, SIZE(Pair));
+        IF (newPair # NIL) THEN
+          newPair^.d := assignDomain(index^.d);
+          newPair^.r := assignRange(index^.r);
+          newPair^.next := toMap^.items;
+          toMap^.items := newPair;
+        ELSE
+          RaiseErrIn(assign, overflow);
+          RETURN;
+        END (*--if*);
+        index := index^.next;
+      END (*--for*);
+      toMap^.extent := extent;
+    END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Bind attempts to add (or update) the domain/range pair of items to
+the given map. If the item of the domain already exists in the map
+the item of the range is updated to that given. The algorithm must
+therefore be able to detect the insertion of duplicate domain items.
+Because the array is unordered, the only approach is to use a sequential
+search to find the desired item, if it is present. This is similar to
+the second approach discussed for the ordered array representation. The
+complexity is O(n).
+*)
+
+PROCEDURE Bind    (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *);
+                       toItemIn  : Range   (*--in   *));
+
+VAR   index : MapItem; (*--loop index over item pairs*)
+      free  : DisposeProc;
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(bind, undefined);
+  ELSIF Search(theMap, theItemIn, index) THEN
+    free := DisposeOf(theMap^.range);
+    free(index^.r);
+    index^.r := toItemIn;
+  ELSE
+    Allocate(index, SIZE(Pair));
+    IF (index = NIL) THEN
+      RaiseErrIn(bind, overflow);
+    ELSE
+      WITH index^ DO
+        d := theItemIn;
+        r := toItemIn;
+        next := theMap^.items;
+      END (*--with*);
+      WITH theMap^ DO
+        INC(extent);
+        items := index;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Bind;
+(*-------------------------*)
+
+(*
+Unbind searches for and then removes the domain/range pair of items
+associated with the given domain item. If the item is not in the map
+then the map is left unchanged. Because the array of items is unordered
+a sequential search must be used to determine if the item is indeed present
+in the array. If the item is found it is overwritten with the last item
+in the array (recovering dynamically allocated space, if any), the count
+of items is decremented, and the routine is exited immediately. Thus, if
+the end of the FOR loop is reached, the given domain item is not bound to
+any value of the range.
+Complexity O(n).
+*)
+
+PROCEDURE Unbind  (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *));
+
+VAR  index : MapItem;    (*--loop index over item pairs*)
+     prior : MapItem;
+     free  : DisposeProc; (*--disposal routine for items*)
+     compareDomain : CompareProc;
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(unbind, undefined);
+  ELSIF (theMap^.extent = 0) THEN
+   RaiseErrIn(unbind, notbound);
+  ELSE
+    WITH theMap^ DO
+      compareDomain := CompareOf(domain);
+      index := items;
+      prior := NIL;
+      WHILE (index # NIL) DO
+        WITH index^ DO
+          IF compareDomain(theItemIn, d) = equal THEN
+            free := DisposeOf(domain);
+            free(d);
+            free := DisposeOf(range);
+            free(r);
+            IF (prior = NIL) THEN
+              items := index^.next;
+            ELSE
+              prior^.next := index^.next;
+            END (*--if*);
+            Deallocate(index, SIZE(Pair));
+            DEC(extent);
+            RETURN;
+          END (*--if*);
+        END (*--with*);
+        prior := index;
+        index := index^.next;
+      END (*--while*);
+    END (*--with*);
+    RaiseErrIn(unbind, notbound);
+  END (*--if*);
+END Unbind;
+(*-------------------------*)
+
+
+(*
+12.2.4 Selectors
+*)
+
+(*
+IsDefined simply treats a NIL map as the representation for a map
+that has not been created. Complexity O(1).
+*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+BEGIN
+  RETURN (theMap # NullMap);
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns true if the map contains no domain/range pairs, and
+false otherwise. Because we have maintained a count of pairs during
+insertions and deletions this state can be determined quickly. Thus
+we have complexity on the order of O(1).
+*)
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isempty, undefined);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN theMap^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual determines if the left and right mappings contain the same
+domain/range bindings. Initially, we avoid undefined maps [section
+10.4.n of our specification] and mismatched domain data types, in both
+cases signaling an exception and returning false. Next the trivial
+case where the maps have different numbers of elements is handled
+by avoiding the comparison loop.
+
+As the arrays are unordered the whole of the right map must be searched
+for each item of the left map. Thus, this version of IsEqual has a
+complexity on the order of O(n**2). Of course, if this operation is
+not used, or used only infrequently, by the client, this may be immaterial.
+*)
+
+PROCEDURE IsEqual   (    left      : Map        (*--in   *);
+                         right     : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR  index : MapItem; (*--loop index over left map items of Domain*)
+     jndex : MapItem; (*--loop index over right map items of Domain*)
+     compareDomain : CompareProc; (*--domain comparison routine*)
+     compareRange  : CompareProc; (*--range comparison routine*)
+
+BEGIN
+  mapError := noerr;
+  IF (left = NullMap) OR (right = NullMap) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.domain # right^.domain) OR
+        (left^.range # right^.range) THEN
+    RaiseErrIn(isequal, typeerror);
+
+  ELSIF (left^.extent = right^.extent) THEN
+    WITH left^ DO
+      compareDomain := CompareOf(domain);
+      compareRange  := CompareOf(range);
+      index := items;
+      WHILE (index # NIL) DO
+        jndex := right^.items;
+        LOOP
+          IF (jndex = NIL) THEN
+            RETURN FALSE;
+          ELSIF compareDomain(index^.d, jndex^.d) = equal THEN
+            IF compareRange(index^.r, jndex^.r) = equal THEN
+              EXIT (*--loop*);
+            ELSE
+              RETURN FALSE;
+            END (*--if*);
+          ELSE
+            jndex := jndex^.next;
+          END (*--if*);
+        END (*--loop*);
+        index := index^.next;
+      END (*--while*);
+    END (*--with*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+ExtentOf returns the number of domain/range pairs present in the
+map object. Undefined maps raise an exception and return zero.
+Complexity O(1)
+*)
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*--in   *))
+                                   : CARDINAL   (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(extentof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+(*
+DomainOf and RangeOf simply return the data type IDs for the domain
+and range, respectively. Undefined maps cause the NullType to be
+returned. Complexity O(1)
+*)
+
+PROCEDURE DomainOf  (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(domainof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.domain;
+END DomainOf;
+(*-------------------------*)
+
+PROCEDURE RangeOf   (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(rangeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.range;
+END RangeOf;
+(*-------------------------*)
+
+(*
+IsBound, BoundTo, and IsBoundTo all use a sequential search to determine
+the presence of the given item of the domain. This must be done as an
+unordered array is used for the internal map representation. Each routine
+returns the appropriate value(s) depending on its function result.
+Complexity O(n).
+*)
+
+PROCEDURE IsBound   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR   index : MapItem; (*--where domain item was found*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isbound, undefined);
+    RETURN FALSE;
+  END (*--if*);
+  RETURN Search(theMap, theItem, index);
+END IsBound;
+(*-------------------------*)
+
+PROCEDURE BoundTo   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : Range      (*--out  *);
+
+VAR   index : MapItem; (*--where domain item was found*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(boundto, undefined);
+  ELSIF Search(theMap, theItem, index) THEN
+    RETURN index^.r;
+  END (*--if*);
+  RETURN NullItem;
+END BoundTo;
+(*-------------------------*)
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *);
+                     VAR toItem    : Range      (*--out  *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR   index : MapItem; (*--where domain item was found*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isboundto, undefined);
+  ELSIF Search(theMap, theItem, index) THEN
+    toItem := index^.r;
+    RETURN TRUE;
+  END (*--if*);
+  toItem := NullItem;
+  RETURN FALSE;
+END IsBoundTo;
+(*-------------------------*)
+
+
+(*
+12.2.5 Iterators
+*)
+
+PROCEDURE LoopOver   (    theMap    : Map            (*--in   *);
+                          theProcess: LoopAccessProc (*--in   *));
+
+VAR   index : MapItem; (*--loop index over items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(loopover, undefined);
+  ELSE
+    index := theMap^.items;
+    WHILE (index # NIL) DO
+      WITH index^ DO
+        IF ~theProcess(d, r) THEN
+          RETURN;
+        END (*--if*);
+      END (*--with*);
+      index := index^.next;
+    END (*--while*);
+  END (*--if*);
+END LoopOver;
+(*-------------------------*)
+
+PROCEDURE LoopChange (    theMap    : Map            (*--in   *);
+                          theProcess: LoopChangeProc (*--in   *));
+
+VAR   index : MapItem; (*--loop index over items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(loopchange, undefined);
+  ELSE
+    index := theMap^.items;
+    WHILE (index # NIL) DO
+      WITH index^ DO
+        IF ~theProcess(d, r) THEN
+          RETURN;
+        END (*--if*);
+      END (*--with*);
+      index := index^.next;
+    END (*--while*);
+  END (*--if*);
+END LoopChange;
+(*-------------------------*)
+
+
+PROCEDURE Traverse   (    theMap    : Map            (*--in   *);
+                          theProcess: AccessProc     (*--in   *));
+
+VAR   index : MapItem; (*--loop index over items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(traverse, undefined);
+  ELSE
+    index := theMap^.items;
+    WHILE (index # NIL) DO
+      WITH index^ DO
+        theProcess(d, r);
+      END (*--with*);
+      index := index^.next;
+    END (*--while*);
+  END (*--if*);
+END Traverse;
+(*-------------------------*)
+
+PROCEDURE TravChange (    theMap    : Map            (*--in   *);
+                          theProcess: ChangeProc     (*--in   *));
+
+VAR   index : MapItem; (*--loop index over items of Domain*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(travchange, undefined);
+  ELSE
+    index := theMap^.items;
+    WHILE (index # NIL) DO
+      WITH index^ DO
+        theProcess(d, r);
+      END (*--with*);
+      index := index^.next;
+    END (*--while*);
+  END (*--if*);
+END TravChange;
+(*-------------------------*)
+
+
+(*
+12.2.6 Module Initialization
+
+The module's local variables are initialized to known states.
+mapError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, mapError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR mapError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(mapError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  mapError := noerr;
+  NullMap := NIL;
+END MapSUMI.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsumn.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsumn.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsumn.def
@@ -0,0 +1,123 @@
+(*
+12.1 Unbounded Map Interface
+*)
+
+DEFINITION MODULE MapSUMN;
+(*====================================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Sequential Unbounded Managed Iterator
+
+    INTRODUCTION
+    This module provides operations for the unbounded map abstract
+   data type.
+
+    REVISION HISTORY
+       8/26/89     CL      Initial version
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+=====================================================================*)
+
+FROM Items IMPORT
+    (*--Type*) Item;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc;
+
+FROM TypeManager IMPORT
+    (*--Type*) TypeID;
+
+
+    (*-----------------------*)
+
+(*
+12.1.1 Type Declarations
+*)
+
+TYPE  Domain = Item;
+TYPE  Range  = Item;
+
+TYPE  Map;
+VAR   NullMap : Map;
+
+
+(*
+12.1.2 Exceptions
+*)
+
+CONST ModuleID = 16;
+
+PROCEDURE MapError   ()              : Exceptions  (*--out  *);
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+
+
+(*
+12.1.3 Constructors
+*)
+
+PROCEDURE Create  (    theDomain : TypeID  (*--in   *);
+                       theRange  : TypeID  (*--in   *))
+                                 : Map     (*--out  *);
+
+PROCEDURE Destroy (VAR theMap    : Map     (*--inout*));
+
+PROCEDURE Clear   (    theMap    : Map     (*--inout*));
+
+PROCEDURE Assign  (    theMap    : Map     (*--in   *);
+                   VAR toMap     : Map     (*--inout *));
+
+PROCEDURE Bind    (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *);
+                       toItemIn  : Range   (*--in   *));
+
+PROCEDURE Unbind  (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *));
+
+
+(*
+12.1.4 Selectors
+*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE IsEqual   (    left      : Map        (*--in   *);
+                         right     : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*--in   *))
+                                   : CARDINAL   (*--out  *);
+
+PROCEDURE DomainOf  (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+
+PROCEDURE RangeOf   (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+
+PROCEDURE IsBound   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+PROCEDURE BoundTo   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : Range      (*--out  *);
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *);
+                     VAR toItem    : Range      (*--out  *))
+                                   : BOOLEAN    (*--out  *);
+
+END MapSUMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsumn.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsumn.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/mapsumn.mod
@@ -0,0 +1,615 @@
+(*
+12.2 Unbounded Map Implementation
+*)
+
+IMPLEMENTATION MODULE MapSUMN;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Monolithic Structures - Map (Opaque version)
+               Sequential Unbounded Managed Non-Iterator
+
+    INTRODUCTION
+    This module provides operations for the bounded map abstract
+   data type. This implementation uses an unordered list as
+   the underlying representation.
+
+    REVISION HISTORY
+       8/26/89     CL      Initial version.
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+===============================================================*)
+
+FROM SCLStorage IMPORT
+    (*--Proc*) Allocate, Deallocate;
+
+FROM Items IMPORT
+   (*--Cons*) NullItem,
+   (*--Type*) Item, AssignProc, CompareProc, DisposeProc;
+
+FROM Relations IMPORT
+   (*--type*) Relation;
+
+FROM ErrorHandling IMPORT
+    (*--Type*) HandlerProc,
+    (*--Proc*) Raise, NullHandler, ExitOnError;
+
+FROM TypeManager IMPORT
+    (*--Cons*) NullType,
+    (*--Type*) TypeID,
+    (*--Proc*) AssignOf, CompareOf, DisposeOf;
+
+FROM MapTypes IMPORT
+    (*--Type*) Exceptions, Operations, ComponentID;
+
+
+    (*-----------------------*)
+
+(*
+12.2.1 Type Declarations
+*)
+
+TYPE  MapItem = POINTER TO Pair;
+
+TYPE  Pair = RECORD
+        d   : Domain;       (*-- value of the domain *)
+        r   : Range;        (*-- mapped to value of the range *)
+        next: MapItem;
+      END (*--Pair*);
+
+TYPE  UnboundedMap = RECORD
+        domain : TypeID;    (*-- data type id for the domain *)
+        range  : TypeID;    (*-- data type id for the range *)
+        extent : CARDINAL;  (*-- current # of items in map *)
+        items  : MapItem;   (*-- head of list of pairs *)
+      END (*--UnboundedMap*);
+
+TYPE  Map = POINTER TO UnboundedMap;
+
+
+(*
+12.2.2 Exceptions
+*)
+
+VAR   mapError : Exceptions;
+VAR   handler  : ARRAY Exceptions OF HandlerProc;
+
+PROCEDURE MapError   ()              : Exceptions  (*--out  *);
+BEGIN
+  RETURN mapError;
+END MapError;
+(*-------------------------*)
+
+PROCEDURE GetHandler (    theError   : Exceptions  (*--in   *))
+                                     : HandlerProc (*--out  *);
+BEGIN
+  RETURN handler[theError];
+END GetHandler;
+(*-------------------------*)
+
+PROCEDURE SetHandler (    theError   : Exceptions  (*--in   *);
+                          theHandler : HandlerProc (*--in   *));
+BEGIN
+  handler[theError] := theHandler;
+END SetHandler;
+(*-------------------------*)
+
+PROCEDURE RaiseErrIn (    theRoutine : Operations (*--in   *);
+                          theError   : Exceptions (*--in   *));
+BEGIN
+  mapError := theError;
+  Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
+END RaiseErrIn;
+(*-------------------------*)
+
+PROCEDURE Search    (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *);
+                     VAR theIndex  : MapItem    (*--out  *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR   compareDomain : CompareProc; (*-- domain value comparison routine *)
+
+BEGIN
+  WITH theMap^ DO
+    compareDomain := CompareOf(domain);
+    theIndex := items;
+  END (*--with*);
+  WHILE (theIndex # NIL) DO
+    IF compareDomain(theItem, theIndex^.d) = equal THEN
+      RETURN TRUE;
+    END (*--if*);
+    theIndex := theIndex^.next;
+  END (*--while*);
+  RETURN FALSE;
+END Search;
+(*-------------------------*)
+
+(*
+12.2.3 Constructors
+*)
+
+(*
+Create attempts to form a new, empty map object. If the allocation is
+successful, the data
+types of the domain and range are saved, while the extent (the number
+of items present in the map) is
+initialized to zero. Note that Allocate set the pointer to NIL if
+unable to get the specified number of bytes from the system allocation
+routine. Complexity O(1).
+*)
+
+PROCEDURE Create  (    theDomain : TypeID  (*--in   *);
+                       theRange  : TypeID  (*--in   *))
+                                 : Map     (*--out  *);
+
+VAR   newMap : Map;
+
+BEGIN
+  mapError := noerr;
+  Allocate(newMap, SIZE(UnboundedMap));
+  IF (newMap = NullMap) THEN
+    RaiseErrIn(create, overflow);
+  ELSE
+    WITH newMap^ DO
+      domain := theDomain;
+      range  := theRange;
+      extent := 0;
+      items  := NIL;
+    END (*--with*);
+  END (*--if*);
+  RETURN newMap;
+END Create;
+(*-------------------------*)
+
+(*
+Destroy is the inverse of Create, making a Map ╘undefined╒. To
+simplify matters we use Clear to test for an undefined map and
+to remove all existing domain/range pairs from the map, if any.
+If an error does not occur then we may dispose of the map object
+itself. Note that the version of Deallocate given here, automatically
+disposes of the proper amount of space (i.e., that which was
+originally allocated to the object. Complexity O(n).
+*)
+
+PROCEDURE Destroy (VAR theMap    : Map     (*--inout*));
+BEGIN
+  Clear(theMap);
+  IF (mapError = noerr) THEN
+    Deallocate(theMap, SIZE(UnboundedMap));
+  END (*--if*);
+END Destroy;
+(*-------------------------*)
+
+(*
+Clear removes all domain/range pairs from the map, if any. The data
+types of the domain and range are used to retrieve the dynamic memory
+deallocation routines, if any, associated with the domain and range.
+This allows us to store arbitrarily complex structures within the map.
+Complexity O(n).
+*)
+
+PROCEDURE Clear   (    theMap    : Map     (*--inout*));
+
+VAR   freeDomain : DisposeProc; (*--disposal routine for items of Domain*)
+      freeRange  : DisposeProc; (*--disposal routine for items of Range*)
+      oldItem    : MapItem;
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(clear, undefined);
+  ELSE
+    WITH theMap^ DO
+      freeDomain := DisposeOf(domain);
+      freeRange  := DisposeOf(range);
+      WHILE (items # NIL) DO
+        WITH items^ DO
+          freeDomain(d);
+          freeRange(r);
+        END (*--with*);
+        oldItem := items;
+        items := items^.next;
+        Deallocate(oldItem, SIZE(Pair));
+      END (*--for*);
+      extent := 0;
+    END (*--with*);
+  END (*--if*);
+END Clear;
+(*-------------------------*)
+
+(*
+Assign duplicates a map object, including the domain/range pairs and
+the relationship between them. If the target map, toMap, is undefined
+on entry to the routine it is automatically created with the same
+domain and range data types, and the same maximum size as the source
+map. If the source map is not empty, it is cleared of its contents
+and its domain/range data types are altered to match those of the source
+map. This step is called recreating the target map. Once completed without
+error, the assignment takes place using a simple loop over the number of
+items in the source map. Complexity O(m+n).
+*)
+
+PROCEDURE Assign  (    theMap    : Map     (*--in   *);
+                   VAR toMap     : Map     (*--inout*));
+
+VAR  index        : MapItem;   (*--loop index over items of Domain*)
+     assignDomain : AssignProc; (*--domain items assignment routine*)
+     assignRange  : AssignProc; (*--range items assignment routine*)
+     newPair      : MapItem;
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(assign, undefined);
+  ELSIF (theMap = toMap) THEN
+    RETURN;
+  ELSIF (toMap = NullMap) THEN
+    WITH theMap^ DO
+      toMap := Create(domain, range);
+    END (*--with*);
+  ELSE
+    Clear(toMap);
+    WITH theMap^ DO
+      toMap^.domain := domain;
+      toMap^.range  := range;
+   END (*--with*);
+  END (*--if*);
+
+  IF (mapError = noerr) THEN
+    WITH theMap^ DO
+      assignDomain := AssignOf(domain);
+      assignRange  := AssignOf(range);
+      index := items;
+      WHILE (index # NIL) DO
+        Allocate(newPair, SIZE(Pair));
+        IF (newPair # NIL) THEN
+          newPair^.d := assignDomain(index^.d);
+          newPair^.r := assignRange(index^.r);
+          newPair^.next := toMap^.items;
+          toMap^.items := newPair;
+        ELSE
+          RaiseErrIn(assign, overflow);
+          RETURN;
+        END (*--if*);
+        index := index^.next;
+      END (*--for*);
+      toMap^.extent := extent;
+    END (*--with*);
+  END (*--if*);
+END Assign;
+(*-------------------------*)
+
+(*
+Bind attempts to add (or update) the domain/range pair of items to
+the given map. If the item of the domain already exists in the map
+the item of the range is updated to that given. The algorithm must
+therefore be able to detect the insertion of duplicate domain items.
+Because the array is unordered, the only approach is to use a sequential
+search to find the desired item, if it is present. This is similar to
+the second approach discussed for the ordered array representation. The
+complexity is O(n).
+*)
+
+PROCEDURE Bind    (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *);
+                       toItemIn  : Range   (*--in   *));
+
+VAR   index : MapItem; (*--loop index over item pairs*)
+      free  : DisposeProc;
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(bind, undefined);
+  ELSIF Search(theMap, theItemIn, index) THEN
+    free := DisposeOf(theMap^.range);
+    free(index^.r);
+    index^.r := toItemIn;
+  ELSE
+    Allocate(index, SIZE(Pair));
+    IF (index = NIL) THEN
+      RaiseErrIn(bind, overflow);
+    ELSE
+      WITH index^ DO
+        d := theItemIn;
+        r := toItemIn;
+        next := theMap^.items;
+      END (*--with*);
+      WITH theMap^ DO
+        INC(extent);
+        items := index;
+      END (*--with*);
+    END (*--if*);
+  END (*--if*);
+END Bind;
+(*-------------------------*)
+
+(*
+Unbind searches for and then removes the domain/range pair of items
+associated with the given domain item. If the item is not in the map
+then the map is left unchanged. Because the array of items is unordered
+a sequential search must be used to determine if the item is indeed present
+in the array. If the item is found it is overwritten with the last item
+in the array (recovering dynamically allocated space, if any), the count
+of items is decremented, and the routine is exited immediately. Thus, if
+the end of the FOR loop is reached, the given domain item is not bound to
+any value of the range.
+Complexity O(n).
+*)
+
+PROCEDURE Unbind  (    theMap    : Map     (*--inout*);
+                       theItemIn : Domain  (*--in   *));
+
+VAR  index : MapItem;    (*--loop index over item pairs*)
+     prior : MapItem;
+     free  : DisposeProc; (*--disposal routine for items*)
+     compareDomain : CompareProc;
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(unbind, undefined);
+  ELSIF (theMap^.extent = 0) THEN
+    RaiseErrIn(unbind, notbound);
+  ELSE
+    WITH theMap^ DO
+      compareDomain := CompareOf(domain);
+      index := items;
+      prior := NIL;
+      WHILE (index # NIL) DO
+        WITH index^ DO
+          IF compareDomain(theItemIn, d) = equal THEN
+            free := DisposeOf(domain);
+            free(d);
+            free := DisposeOf(range);
+            free(r);
+            IF (prior = NIL) THEN
+              items := index^.next;
+            ELSE
+              prior^.next := index^.next;
+            END (*--if*);
+            Deallocate(index, SIZE(Pair));
+            DEC(extent);
+            RETURN;
+          END (*--if*);
+        END (*--with*);
+        prior := index;
+        index := index^.next;
+      END (*--while*);
+    END (*--with*);
+    RaiseErrIn(unbind, notbound);
+  END (*--if*);
+END Unbind;
+(*-------------------------*)
+
+
+(*
+12.2.4 Selectors
+*)
+
+(*
+IsDefined simply treats a NIL map as the representation for a map
+that has not been created. Complexity O(1).
+*)
+
+PROCEDURE IsDefined (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+BEGIN
+  RETURN (theMap # NullMap);
+END IsDefined;
+(*-------------------------*)
+
+(*
+IsEmpty returns true if the map contains no domain/range pairs, and
+false otherwise. Because we have maintained a count of pairs during
+insertions and deletions this state can be determined quickly. Thus
+we have complexity on the order of O(1).
+*)
+
+PROCEDURE IsEmpty   (    theMap    : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isempty, undefined);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN theMap^.extent = 0;
+END IsEmpty;
+(*-------------------------*)
+
+(*
+IsEqual determines if the left and right mappings contain the same
+domain/range bindings. Initially, we avoid undefined maps [section
+10.4.n of our specification] and mismatched domain data types, in both
+cases signaling an exception and returning false. Next the trivial
+case where the maps have different numbers of elements is handled
+by avoiding the comparison loop.
+
+As the arrays are unordered the whole of the right map must be searched
+for each item of the left map. Thus, this version of IsEqual has a
+complexity on the order of O(n**2). Of course, if this operation is
+not used, or used only infrequently, by the client, this may be immaterial.
+*)
+
+PROCEDURE IsEqual   (    left      : Map        (*--in   *);
+                         right     : Map        (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR  index : MapItem; (*--loop index over left map items of Domain*)
+     jndex : MapItem; (*--loop index over right map items of Domain*)
+     compareDomain : CompareProc; (*--domain comparison routine*)
+     compareRange  : CompareProc; (*--range comparison routine*)
+
+BEGIN
+  mapError := noerr;
+  IF (left = NullMap) OR (right = NullMap) THEN
+    RaiseErrIn(isequal, undefined);
+  ELSIF (left^.domain # right^.domain) OR
+        (left^.range # right^.range) THEN
+    RaiseErrIn(isequal, typeerror);
+
+  ELSIF (left^.extent = right^.extent) THEN
+    WITH left^ DO
+      compareDomain := CompareOf(domain);
+      compareRange  := CompareOf(range);
+      index := items;
+      WHILE (index # NIL) DO
+        jndex := right^.items;
+        LOOP
+          IF (jndex = NIL) THEN
+            RETURN FALSE;
+          ELSIF compareDomain(index^.d, jndex^.d) = equal THEN
+            IF compareRange(index^.r, jndex^.r) = equal THEN
+              EXIT (*--loop*);
+            ELSE
+              RETURN FALSE;
+            END (*--if*);
+          ELSE
+            jndex := jndex^.next;
+          END (*--if*);
+        END (*--loop*);
+        index := index^.next;
+      END (*--while*);
+    END (*--with*);
+    RETURN TRUE;
+  END (*--if*);
+  RETURN FALSE;
+END IsEqual;
+(*-------------------------*)
+
+(*
+ExtentOf returns the number of domain/range pairs present in the
+map object. Undefined maps raise an exception and return zero.
+Complexity O(1)
+*)
+
+PROCEDURE ExtentOf  (    theMap    : Map        (*--in   *))
+                                   : CARDINAL   (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(extentof, undefined);
+    RETURN 0;
+  END (*--if*);
+  RETURN theMap^.extent;
+END ExtentOf;
+(*-------------------------*)
+
+(*
+DomainOf and RangeOf simply return the data type IDs for the domain
+and range, respectively. Undefined maps cause the NullType to be
+returned. Complexity O(1)
+*)
+
+PROCEDURE DomainOf  (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(domainof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.domain;
+END DomainOf;
+(*-------------------------*)
+
+PROCEDURE RangeOf   (    theMap    : Map        (*--in   *))
+                                   : TypeID     (*--out  *);
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(rangeof, undefined);
+    RETURN NullType;
+  END (*--if*);
+  RETURN theMap^.range;
+END RangeOf;
+(*-------------------------*)
+
+(*
+IsBound, BoundTo, and IsBoundTo all use a sequential search to determine
+the presence of the given item of the domain. This must be done as an
+unordered array is used for the internal map representation. Each routine
+returns the appropriate value(s) depending on its function result.
+Complexity O(n).
+*)
+
+PROCEDURE IsBound   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR   index : MapItem; (*--where domain item was found*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isbound, undefined);
+    RETURN FALSE;
+  END (*--if*);
+  RETURN Search(theMap, theItem, index);
+END IsBound;
+(*-------------------------*)
+
+PROCEDURE BoundTo   (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *))
+                                   : Range      (*--out  *);
+
+VAR   index : MapItem; (*--where domain item was found*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(boundto, undefined);
+  ELSIF Search(theMap, theItem, index) THEN
+    RETURN index^.r;
+  END (*--if*);
+  RETURN NullItem;
+END BoundTo;
+(*-------------------------*)
+
+PROCEDURE IsBoundTo (    theMap    : Map        (*--in   *);
+                         theItem   : Domain     (*--in   *);
+                     VAR toItem    : Range      (*--out  *))
+                                   : BOOLEAN    (*--out  *);
+
+VAR   index : MapItem; (*--where domain item was found*)
+
+BEGIN
+  mapError := noerr;
+  IF (theMap = NullMap) THEN
+    RaiseErrIn(isboundto, undefined);
+  ELSIF Search(theMap, theItem, index) THEN
+    toItem := index^.r;
+    RETURN TRUE;
+  END (*--if*);
+  toItem := NullItem;
+  RETURN FALSE;
+END IsBoundTo;
+(*-------------------------*)
+
+
+(*
+12.2.6 Module Initialization
+
+The module's local variables are initialized to known states.
+mapError is used to fill the handlers array with a routine
+that will exit the program when an exception is raised (saving the
+declaration of a special loop control variable for this purpose).
+The condition noerr is given the NullHandler which is presumed to
+do nothing.  Applying MIN and MAX to cover all exceptions followed
+by resetting the handler for noerr ensures that this initialization
+will be unaffected by any future changes to the number of Exceptions
+or their order of declaration within the enumeration.  Since a FOR loop
+control variable is undefined following the loop, mapError must be
+set to indicate that an error has not yet occurred.
+*)
+
+BEGIN
+  FOR mapError := MIN(Exceptions) TO MAX(Exceptions) DO
+    SetHandler(mapError, ExitOnError);
+  END (*--for*);
+  SetHandler(noerr, NullHandler);
+  mapError := noerr;
+  NullMap := NIL;
+END MapSUMN.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/maptypes.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/maptypes.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/maptypes.def
@@ -0,0 +1,71 @@
+DEFINITION MODULE MapTypes; 
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Map Structure Utility - Standard Types
+
+    THE ABSTRACTION
+    This module provides centralized definitions of the operations
+    and exceptions for all map modules.
+
+    REVISION HISTORY
+    v1.01  04 May 1988  C. Lins:
+        Initial TML Modula-2 implementation
+    v1.02  18 Apr 1989  C. Lins:
+        Added component id constant.
+   v1.03   8/26/89     CL      Add duplicate binding exception.
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+==============================================================*)
+
+CONST ComponentID = 256 * 8;   (*-- must be a multiple of 256 *)
+
+    (*---------------------------------*)
+    (*--        MAP OPERATIONS       --*)
+
+TYPE  Operations = (
+                    (*-- Module Initialization *)
+                    modinit,
+
+                    (*-- Constructors *)
+                    create, destroy, clear, assign,
+                    bind, unbind,
+
+                    (*-- Selectors *)
+                    isdefined, isempty, isequal, sizeof,
+                    extentof, domainof, rangeof,
+                    isbound, boundto, isboundto,
+
+                    (*-- Iterators *)
+                    loopover, loopchange, traverse, travchange,
+
+                    (*-- Guarded Concurrent Operations *)
+                    seize, release
+                   );
+
+TYPE  Constructors = Operations [ create    .. unbind     ];
+TYPE  Selectors    = Operations [ isdefined .. isboundto  ];
+TYPE  Iterators    = Operations [ loopover  .. travchange ];
+TYPE  GuardedOps   = Operations [ seize     .. release    ];
+
+
+    (*---------------------------------*)
+    (*--        MAP EXCEPTIONS       --*)
+
+TYPE  Exceptions = (noerr,       (*-- Nothing went wrong, all's well. *)
+                    initfailed,  (*-- Module initialization failure. *)
+                    duplicate,   (*-- Duplicate binding *)
+                    notbound,    (*-- Domain value not bound to range *)
+                    outofdomain, (*-- Value not legal in domain *)
+                    outofrange,  (*-- Value not legal in range *)
+                    overflow,    (*-- Map cannot grow big enough for
+                                   -- the requested operation. *)
+                    typeerror,   (*-- Type mismatch between maps *)
+                    undefined    (*-- Map has not been Created, or
+                                   -- the map has been Destroyed. *)
+                   );
+
+TYPE  ExceptionSet = SET OF Exceptions;
+
+END MapTypes.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/maptypes.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/maptypes.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/maps/maptypes.mod
@@ -0,0 +1,2 @@
+IMPLEMENTATION MODULE MapTypes; 
+END MapTypes.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/sorting/sort.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/sorting/sort.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/sorting/sort.def
@@ -0,0 +1,128 @@
+DEFINITION MODULE Sort;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Tools - Sorting Utilities
+
+       Unless stated otherwise, each of the sort algorithms assume
+       the array being sorted has an index in the range of 0..N-1.
+       Furthermore, the array itself extends from 0 through N, inclusive.
+       a[N] is used by many of the below algorithms as a temporary.
+       
+       Refer to The Modula-2 Software Component Library, Volume 4,
+       Chapter 3 for comprehensive analytic results on the performance
+       of these algorithms.
+
+    REVISION HISTORY
+    v1.00  13-21 May 1989  C. Lins:
+        Initial implementation
+
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+==============================================================*)
+
+FROM Relations IMPORT
+   (*--type*)  Relation;
+
+(*--------------------*)
+
+(*
+The following procedure types declare operations on the components of an
+array given indices into the array. The client module must provide actual
+procedures necessary to implement these operations. The following semantics
+are assumed by the various sort algorithms:
+
+CompareProc    compares the values of the elements at the given indices
+               returning the ordering relation between them. Specifically,
+               CompareProc returns the following result:
+                   less        when A[i] < A[j]
+                   greater when A[i] > A[j]
+                   equal       when A[i] = A[j]
+               where A is the array, i indicates the first parameter, and j
+               indicates the second parameter.
+AssignProc assigns the value of the element at the second index to the value
+           of the element at the first index. This is equivalent to the
+           Modula-2 language statement A[i] := A[j].
+SwapProc   swaps the elements at the given indices. Thus, the result is:
+               A[i]' = A[j] and
+               A[j]' = A[i]
+*)
+
+TYPE   CompareProc = PROCEDURE (CARDINAL, CARDINAL) : Relation;
+TYPE   AssignProc  = PROCEDURE (CARDINAL, CARDINAL);
+TYPE   SwapProc    = PROCEDURE (CARDINAL, CARDINAL);
+
+(*--------------------*)
+
+PROCEDURE InsertionSort  (    numItems : CARDINAL    (*--in   *);
+                              compare  : CompareProc (*--in   *);
+                              swap     : SwapProc    (*--in   *));
+
+PROCEDURE BinaryInsertionSort (    numItems : CARDINAL    (*--in   *);
+                                   compare  : CompareProc (*--in   *);
+                                   assign   : AssignProc  (*--in   *));
+
+PROCEDURE SelectionSort  (    numItems : CARDINAL    (*--in   *);
+                              compare  : CompareProc (*--in   *);
+                              swap     : SwapProc    (*--in   *));
+
+PROCEDURE ShellSort      (    numItems : CARDINAL    (*--in   *);
+                              compare  : CompareProc (*--in   *);
+                              assign   : AssignProc  (*--in   *));
+
+PROCEDURE HeapSort       (    numItems : CARDINAL    (*--in   *);
+                              compare  : CompareProc (*--in   *);
+                              swap     : SwapProc    (*--in   *));
+
+PROCEDURE QuickSort         (    numItems : CARDINAL    (*--in   *);
+                                 compare  : CompareProc (*--in   *);
+                                 assign   : AssignProc  (*--in   *);
+                                 swap     : SwapProc    (*--in   *);
+                                 cutoff   : INTEGER       (*--in   *));
+
+PROCEDURE BSort          (    numItems : CARDINAL    (*--in   *);
+                              compare  : CompareProc (*--in   *);
+                              assign   : AssignProc  (*--in   *);
+                              swap     : SwapProc    (*--in   *));
+
+
+(*
+MeanSort is only suitable for sorting arrays whose keys are numeric
+quantities. This is because is uses the mean value of a sample of the
+array to perform the ordering of keys. In this particular version, we
+assume that the keys are INTEGERs. Thus, in addition to the usual
+comparison and swap procedure parameters, operations are necessary for
+extracting the numeric key and storing the computed mean at a specific
+array index. These operations are provided by the procedure types
+"ValueProc" and "AssignItemProc", respectively.
+*)
+
+TYPE   ValueProc = PROCEDURE (CARDINAL) : INTEGER;
+TYPE   AssignItemProc = PROCEDURE (CARDINAL, INTEGER);
+
+PROCEDURE MeanSort       (    numItems : CARDINAL       (*--in   *);
+                              compare  : CompareProc    (*--in   *);
+                              swap     : SwapProc       (*--in   *);
+                              value    : ValueProc      (*--in   *);
+                              assign   : AssignItemProc (*--in   *));
+
+(*
+StraightMerge sort assumes array indices in the range of 1..N instead of
+0..N-1. The index positions N+1 to 2*N are used as temporaries for holding
+the intermediate result.
+*)
+
+PROCEDURE StraightMerge  (    numItems : CARDINAL    (*--in   *);
+                              compare  : CompareProc (*--in   *);
+                              assign   : AssignProc  (*--in   *));
+
+PROCEDURE BubbleSort     (    numItems : CARDINAL    (*--in   *);
+                              compare  : CompareProc (*--in   *);
+                              swap     : SwapProc    (*--in   *));
+
+PROCEDURE ShakerSort     (    numItems : CARDINAL    (*--in   *);
+                              compare  : CompareProc (*--in   *);
+                              swap     : SwapProc    (*--in   *));
+
+END Sort.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/sorting/sort.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/sorting/sort.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/sorting/sort.mod
@@ -0,0 +1,705 @@
+IMPLEMENTATION MODULE Sort;
+(*==============================================================
+    Version  : 2.0 16 Sep 1990 C. Lins
+    Compiler : Generic pc Modula-2
+    Component: Tools - Sorting Utilities
+
+    REVISION HISTORY
+    v1.00  13-21 May 1989  C. Lins:
+        Initial implementation
+
+   v2.00  16 Sep 1990  C. Lins
+     Created generic pc version
+   (C) Copyright 1990 Charles A. Lins
+==============================================================*)
+
+FROM Relations IMPORT
+   (*--type*)  Relation;
+
+(*
+This version of Insertion Sort is from Jon Bentley, "Writing
+Efficient Programs", pg 64. The use of assignment to break the
+swap operation into its components may not be applicable here
+as our assignments involve the overhead of procedure calls.
+*)
+
+PROCEDURE InsertionSort  (    numItems : CARDINAL    (*--in   *);
+                              compare  : CompareProc (*--in   *);
+                              swap     : SwapProc    (*--in   *));
+
+VAR        index : CARDINAL;
+           jndex : CARDINAL;
+
+BEGIN
+   FOR index := 1 TO numItems-1 DO
+       jndex := index;
+       WHILE (jndex > 0) & (compare(jndex, jndex-1) = less) DO
+           swap(jndex, jndex-1);
+           DEC(jndex);
+       END (*--while*);
+   END (*--for*);
+END InsertionSort;
+(*--------------------*)
+
+(*
+A variation on Insertion Sort using a binary (instead of linear)
+search of the array. This particular implementation is based on the one
+given in Wirth []. While the algorithmic complexity is no better than
+linear insertion sort, the actual execution time tends to be less due to
+a reduction in the number of comparisons. This improvement does not hold
+when the array is already initially sorted or when the array contains
+a large number of identical values.
+*)
+
+PROCEDURE BinaryInsertionSort (    numItems : CARDINAL    (*--in   *);
+                                   compare  : CompareProc (*--in   *);
+                                   assign   : AssignProc  (*--in   *));
+
+VAR        index  : CARDINAL;      (*--loop index over items of the array *)
+           jndex  : CARDINAL;
+           middle : CARDINAL;      (*--middle of the subarray *)
+           left   : CARDINAL;      (*--left of of the subarray *)
+           right  : CARDINAL;      (*--right of of the subarray *)
+
+BEGIN
+   FOR index := 1 TO numItems-1 DO
+       assign(numItems, index);
+       left := 0;
+       right:= index;
+       WHILE (left < right) DO
+           middle := (left+right) DIV 2;
+           IF (compare(middle, numItems) # greater) THEN
+               left := middle + 1;
+           ELSE
+               right := middle;
+           END (*--if*);
+       END (*--while*);
+       FOR jndex := index TO right+1 BY -1 DO
+           assign(jndex, jndex-1);
+       END (*--for*);
+       assign(right, numItems);
+   END (*--for*);
+END BinaryInsertionSort;
+(*--------------------*)
+
+(*
+The following is a delayed selection sort algorithm derived from Sedgewick
+[pg. 95]. This implementation, while its performance is on the order of
+O(n**2), in practice performs better than straight selection sort by
+reducing the number of exchanges. The actual running time of the algorithm
+varies little regardless of the input.
+*)
+
+PROCEDURE SelectionSort  (    numItems : CARDINAL    (*--in   *);
+                              compare  : CompareProc (*--in   *);
+                              swap     : SwapProc    (*--in   *));
+
+VAR        index   : CARDINAL;     (*--loop index over items of the array *)
+           jndex   : CARDINAL;     (*--inner loop index *)
+           min     : CARDINAL;     (*--smallest item so far *)
+
+BEGIN
+   FOR index := 0 TO numItems-1 DO
+       min := index;
+       FOR jndex := index+1 TO numItems-1 DO
+           IF (compare(jndex, min) = less) THEN
+               min := jndex;
+           END (*--if*);
+       END (*--for*);
+       swap(min, index);
+   END (*--for*);
+END SelectionSort;
+(*--------------------*)
+
+(*
+ShellSort is a sort algorithm with a long history going back to 1959.
+Sedgewick's version which dynamically calculates the offset based
+on the equation: h(k-1) = 3*h(k)+1, giving the sequence 1, 4, 13, 40, 121,
+364, 1093, 3280, 9841, .... This version has a minor enhancement avoiding
+assignment of the temporary back into the same array location from which
+it was extracted. Such an optimization may be acceptable here as the
+assignment is accomplished using a procedure call ╤ a relatively expensive
+operation. For an excellent discussion of this particular implementation
+the reader is referred to [, pp. 97-99].
+*)
+
+PROCEDURE ShellSort      (    numItems : CARDINAL    (*--in   *);
+                              compare  : CompareProc (*--in   *);
+                              assign   : AssignProc  (*--in   *));
+
+VAR   index : CARDINAL;
+      jndex : INTEGER;
+      h     : INTEGER;
+
+BEGIN
+   h := 1;
+   REPEAT
+       h := 3 * h + 1;
+   UNTIL VAL(CARDINAL, h) > numItems;
+   REPEAT
+       h := h DIV 3;
+       FOR index := h TO numItems-1 DO
+           assign(numItems, index);
+           jndex := index;
+           LOOP
+               IF (compare(jndex-h, numItems) = greater) THEN
+                   assign(jndex, jndex-h);
+                   DEC(jndex, h);
+                   IF (jndex < h) THEN
+                       EXIT (*--loop*);
+                   END (*--if*);
+               ELSE
+                   EXIT (*--loop*);
+               END (*--if*);
+           END (*--loop*);
+           IF (jndex # VAL(INTEGER, index)) THEN
+               assign(jndex, numItems);
+           END (*--if*);
+       END (*--for*);
+   UNTIL (h = 1);
+END ShellSort;
+(*--------------------*)
+
+(*
+HeapSort is an unusual sort algorithm. It initially constructs a priority
+queue followed by repeated extraction of the maximum element from the
+queue until the queue is empty. The heap data structure is used for the
+priority queue and this shares the space with the array being sorted.
+HeapSort has been proven to guarantee sorting N elements in time
+proportional to N log N, regardless of the input. This is significant in
+that there is no worst case, and therefore, no input sequence causing
+HeapSort to run slower.
+
+Both Bentley [] and Sedgewick [] devote considerable attention to the
+priority queue data structure and heapsort.
+*)
+
+PROCEDURE HeapSort       (    numItems : CARDINAL    (*--in   *);
+                              compare  : CompareProc (*--in   *);
+                              swap     : SwapProc    (*--in   *));
+
+VAR        index  : CARDINAL;
+
+   PROCEDURE SiftUp (    index : CARDINAL (*--in   *);
+                         upper : CARDINAL (*--in   *));
+
+   VAR     jndex  : CARDINAL;
+
+   BEGIN
+       WHILE (2 * index) <= upper DO
+           jndex := 2 * index;
+           IF (jndex < upper) THEN
+               IF (compare(jndex, jndex+1) = less) THEN
+                   INC(jndex);
+               END (*--if*);
+           END (*--if*);
+           IF (compare(index, jndex) = less) THEN
+               swap(index, jndex);
+               index := jndex;
+           ELSE
+               index := upper+1;
+           END (*--if*);
+       END (*--while*);
+   END SiftUp;
+
+BEGIN
+  IF (numItems > 1) THEN
+       (*-- construct heap --*)
+       FOR index := numItems DIV 2 TO 1 BY -1 DO
+           SiftUp(index, numItems);
+       END (*--for*);
+
+       (*-- repeatedly extract minimum from priority queue heap --*)
+       FOR index := numItems-1 TO 1 BY -1 DO
+           SiftUp(0, index);
+           swap(0, index);
+       END (*--for*);
+   END (*--if*);
+END HeapSort;
+(*--------------------*)
+
+(*
+Quicksort ╤ the preeminent sort algorithm. Since its introduction in
+1961 by C.A.R. Hoare [, ] this algorithm has been subjected to rigorous
+mathematical analysis and empirical experiment []. Numerous suggestions
+to Hoare's original implementation have been made over the years towards
+improving Quicksort especially with regard to the worst case scenarios.
+These are discussed in greater detail below and in the references.
+
+This particular implementation has all the optimizations thrown in
+(other than using an non-recursive implementation):
+   Ñ use an outer while loop to switch to a faster algorithm for
+       nearly sorted small arrays (in this case, Insertion sort). Cutoff
+       can be any value between 5 and 30, though on our system a value
+       of 9 or 10 gives the best results. This is confirmed by empirical
+       studies [].
+   Ñ call the simplier sort only once (this is slightly more efficient
+       when the elements have repeated keys or with large random arrays).
+   Ñ reduce the growth of the stack by processing the smaller of the
+       two subarrays first ("tail-recursion removal"). This ensures that
+       the stack grows to at most about lg N entries.
+   Ñ reduce the time in the inner loops by using two indices moving
+       towards one another.
+   Ñ code the 'split' algorithm in-line instead of using a procedure
+       call.
+   Ñ instead of selecting a partitioning element at random (or simply
+       choosing the first element in a subarray as the partitioning
+       element) this variant uses the median-of-three optimization.
+       Here we take the median of a small section of the subarray (three
+       elements). These are chosen from the first element, the last element,
+       and the middle element of the subarray. This should improve the
+       running time in the worst-case scenarios.
+
+The only data set on which this algorithm does very poorly is when all
+the values in the array are the same (a very unlikely occurance).
+*)
+
+PROCEDURE QuickSort      (    numItems : CARDINAL    (*--in   *);
+                              compare  : CompareProc (*--in   *);
+                              assign   : AssignProc  (*--in   *);
+                              swap     : SwapProc    (*--in   *);
+                              cutoff   : INTEGER     (*--in   *));
+
+   PROCEDURE InsertionSort (    lower : INTEGER (*--in   *);
+                                upper : INTEGER (*--in   *));
+
+   VAR     index : INTEGER;
+           jndex : INTEGER;
+
+   BEGIN
+       FOR index := lower+1 TO upper DO
+           jndex := index;
+           WHILE (jndex > lower) & (compare(jndex, jndex-1) = less) DO
+               swap(jndex, jndex-1);
+               DEC(jndex);
+           END (*--while*);
+       END (*--for*);
+   END InsertionSort;
+
+   PROCEDURE quicksort (    lower : INTEGER (*--in   *);
+                            upper : INTEGER (*--in   *));
+
+   VAR     index : INTEGER;
+           jndex : INTEGER;
+           middle: INTEGER;
+
+   BEGIN
+       WHILE (upper - lower > cutoff ) DO
+       
+           (*--
+               Choose a partitioning element by taking the median of the
+             lower, middle, and upper elements of the subarray.
+           --*)
+           middle := (lower+upper) DIV 2;
+           IF (compare(middle, upper) = greater) THEN
+               swap(middle, upper);
+           END (*--if*);
+           IF (compare(middle, lower) = greater) THEN
+               swap(middle, lower);
+           END (*--if*);
+           IF (compare(lower, upper) = greater) THEN
+               swap(lower, upper);
+           END (*--if*);
+           index := lower;
+           jndex := upper;
+           assign(numItems, lower);
+           
+           (*-- split array in two --*)
+           WHILE (index < jndex) DO
+               WHILE (compare(jndex, numItems) = greater) DO
+                   DEC(jndex);
+               END (*--while*);
+               assign(index, jndex);
+               WHILE (index < jndex) & (compare(index, numItems) # greater) DO
+                   INC(index);
+               END (*--while*);
+               assign(jndex, index);
+           END (*--while*);
+           assign(index, numItems);
+
+           (*-- sort recursively, the smallest first --*)
+           IF (index-lower < upper-index) THEN
+               quicksort(lower, index-1);
+               lower := index + 1;
+           ELSE
+               quicksort(index+1, upper);
+               upper := index - 1;
+           END (*--if*);
+       END (*--while*);
+   END quicksort;
+
+BEGIN
+  IF (numItems > 1) THEN
+    quicksort(0, numItems-1);
+       InsertionSort(0, numItems-1);
+  END (*--if*);
+END QuickSort;
+(*--------------------*)
+
+(*
+BSort from CACM April 1985, pp 400-402 by Roger L. Wainwright. Far
+superior to standard QuickSort on arrays that are already sorted or
+nearly so. The idea is a combination of Bubble Sort (of all things!)
+and Quicksort taking advantage of partially sorted subarrays. The
+implementation below is a direct translation into Modula-2 from 
+the Pascal version as given in the aforementioned article. 
+
+The reader is referred to Wainwright's original article for a complete
+discussion of the operation of this algorithm with a few caveats.
+First, the performance results for Quicksort are unfair in that a
+non-optimized implementation was obviously used (based on the number
+of comparisons). Second, there was no comparative measurement to other
+traditional sort algorithms such as Shellsort and Heapsort. The experimental
+results shown earlier demonstrate that there are many cases where these
+algorithms outperform BSort considerably. The only area where we found
+BSort to be an improvement over an optimized implementation of Quicksort
+(or other sort algorithms) was on small (<= 200 elements) arrays with a
+sortedness ratio <= 2%.
+*)
+
+PROCEDURE BSort          (    numItems : CARDINAL    (*--in   *);
+                              compare  : CompareProc (*--in   *);
+                              assign   : AssignProc  (*--in   *);
+                              swap     : SwapProc    (*--in   *));
+
+   PROCEDURE bsort (    m : INTEGER      (*--in   *);
+                        n : INTEGER      (*--in   *);
+                        midKey : INTEGER (*--in   *));
+
+   VAR     continue : BOOLEAN; (*-- false when partitioning process are completed *)
+           leftFlag : BOOLEAN; (*-- true whenever left subfile is not in sorted order *)
+           rightFlag: BOOLEAN; (*-- true whenever right subfile is not in sorted order *)
+           index    : INTEGER; (*-- used to partition the subfiles so that at any time *)
+           jndex    : INTEGER; (*-- k[index] < k[midKey] and k[jndex] >= k[midKey] *)
+           size     : INTEGER; (*-- number of items in a subfile *)
+
+   BEGIN
+       IF (m < n) THEN
+           assign(numItems, midKey);
+           leftFlag    := FALSE;
+           rightFlag   := FALSE;
+           index       := m;
+           jndex       := n;
+           continue    := TRUE;
+           WHILE continue DO
+               WHILE (index # jndex) & (compare(index, numItems) = less) DO
+                   (*--
+                       build the left subfile ensuring that the
+                       rightmost key is always the largest of the subfile
+                   --*)
+                   IF (index # m) & (compare(index-1, index) = greater) THEN
+                       swap(index-1, index);
+                       leftFlag := TRUE;
+                   END (*--if*);
+                   INC(index);
+               END (*--while*);
+           
+               WHILE (index # jndex) & (compare(jndex, numItems) # less) DO
+                   (*-- 
+                       build the right subfile ensuring that the
+                       leftmost key is always the smallest of the subfile
+                   --*)
+                   IF (jndex # n) & (compare(jndex, jndex+1) = greater) THEN
+                       swap(jndex+1, jndex);
+                       rightFlag := TRUE;
+                   END (*--if*);
+                   DEC(jndex);
+               END (*--while*);
+               
+               IF (index # jndex) THEN
+                   (*--
+                       interchange k[index] from the left subfile with
+                       k[jndex] from the right subfile
+                    --*)
+                   swap(jndex, index);
+               ELSE
+                   (*-- partitioning into left and right subfiles has been completed --*)
+                   IF (compare(jndex, numItems) # less) THEN
+                       (*-- check the right subfile to ensure that the first element, k[jndex] is the smallest --*)
+                       IF (compare(jndex, jndex+1) = greater) THEN
+                           swap(jndex+1, jndex);
+                           rightFlag := TRUE;
+                       END (*--if*);
+                   ELSE
+                       (*-- check the left subfile to ensure that the last element, k[index-1] is the largest --*)
+                       IF (compare(index-1, index) = greater) THEN
+                           swap(index-1, index);
+                           leftFlag := TRUE;
+                       END (*--if*);
+                       IF (compare(index-2, index-1) = greater) THEN
+                           swap(index-1, index-2);
+                       END (*--if*);
+                   END (*--if*);
+                   continue := FALSE;
+               END (*--if*);
+           END (*--while*);
+           
+           (*-- process the left subfile --*)
+           size := index - m;
+           IF (size > 2) & leftFlag THEN (*-- subfile must have at least 3 elements and not be already sorted *)
+               IF (size = 3) THEN                  (*-- special case of 3 elements --*)
+                   (*-- place k[m] and k[m+1] in sorted order --*)
+                   IF (compare(m, m+1) = greater) THEN
+                       swap(m, m+1);
+                   END (*--if*);
+               ELSE
+                   bsort(m, index-2, (m+index-2) DIV 2);
+               END (*--if*);
+           END (*--if*);
+           
+           (*-- process the left subfile --*)
+           size := n - jndex + 1;
+           IF (size > 2) & rightFlag THEN (*-- subfile must have at least 3 elements and not be already sorted *)
+               IF (size = 3) THEN                   (*-- special case of 3 elements --*)
+                   (*-- place k[j+1] and k[j+2] in sorted order --*)
+                   IF (compare(jndex+1, jndex+2) = greater) THEN
+                       swap(jndex+1, jndex+2);
+                   END (*--if*);
+               ELSE
+                   bsort(jndex+1, n, (jndex+1+n) DIV 2);
+               END (*--if*);
+           END (*--if*);
+       END (*--if*);
+   END bsort;
+
+BEGIN
+  IF (numItems > 1) THEN
+    bsort(0, numItems-1, numItems DIV 2);
+  END (*--if*);
+END BSort;
+(*--------------------*)
+
+(*
+MeanSort derived from algorithm by Dalia Motzkin, MeanSort, Communications of the ACM 26 (4),
+April 1983, 250-251. The author believes this algorithm is better than QuickSort, but
+Wainwright contends that this isn't so. Obviously, this algorithm is only works for arrays
+containing keys whose values have arithmetic operators applicable on them. In this version,
+we assume that the array is of INTEGERs and that the sum of any given subarray does not
+exceed MAX(LONGINT). We found that on large (2000 elements) random arrays with a sortedness
+ratio >= 8% the running time for MeanSort outperformed BSort. In all other cases, BSort was
+superior.
+*)
+
+PROCEDURE MeanSort       (    numItems : CARDINAL       (*--in   *);
+                              compare  : CompareProc    (*--in   *);
+                              swap     : SwapProc       (*--in   *);
+                              value    : ValueProc      (*--in   *);
+                              assign   : AssignItemProc (*--in   *));
+
+   PROCEDURE meansort (    lower : INTEGER (*--in   *);
+                           upper : INTEGER (*--in   *);
+                           mean  : INTEGER (*--in   *));
+
+   VAR     index    : INTEGER;
+           jndex    : INTEGER;
+           leftSum  : LONGINT;
+           rightSum : LONGINT;
+
+   BEGIN
+       IF (lower < upper) THEN
+           leftSum := 0;
+           rightSum:= 0;
+           index   := lower;
+           jndex   := upper;
+           assign(numItems, mean);
+           LOOP
+               WHILE (index # jndex) & (compare(index, numItems) = less) DO
+                   INC(leftSum, value(index));
+                   INC(index);
+               END (*--while*);
+               WHILE (index # jndex) & (compare(jndex, numItems) # less) DO
+                   INC(rightSum, value(jndex));
+                   DEC(jndex);
+               END (*--while*);
+               IF (index # jndex) THEN
+                   swap(index, jndex);
+               ELSE
+                   EXIT (*--loop*);
+               END (*--if*);
+           END (*--loop*);
+           IF (index = lower) THEN
+               RETURN;
+           END (*--if*);
+           INC(rightSum, value(jndex));
+           meansort(lower, index-1, VAL(INTEGER, leftSum DIV VAL(LONGINT, index - lower)));
+           meansort(jndex, upper, VAL(INTEGER, rightSum DIV VAL(LONGINT, upper - jndex + 1)));
+       END (*--if*);
+   END meansort;
+
+VAR        sum   : LONGINT;      (*-- sum of array values *)
+           index : CARDINAL;       (*-- loop index over the array for computing initial mean *)
+
+BEGIN
+  IF (numItems > 1) THEN
+       sum := 0;
+       FOR index := 0 TO numItems-1 DO
+           INC(sum, value(index));
+       END (*--for*);
+    meansort(0, numItems-1, VAL(INTEGER, sum DIV VAL(LONGINT, numItems)));
+  END (*--if*);
+END MeanSort;
+(*--------------------*)
+
+(*
+From Wirth, Algorithms & Data Structures pg 104.
+*)
+
+PROCEDURE StraightMerge  (    numItems : CARDINAL    (*--in   *);
+                              compare  : CompareProc (*--in   *);
+                              assign   : AssignProc  (*--in   *));
+
+VAR      index : CARDINAL;
+         jndex : CARDINAL;
+         kndex : CARDINAL;
+         limit : CARDINAL;
+         t     : CARDINAL;
+         h, m, p, q, r : INTEGER;
+         up : BOOLEAN;
+
+BEGIN
+  up := TRUE;
+  p  := 1;
+  REPEAT
+   h := 1;
+       m := numItems;
+       IF up THEN
+           index := 1;
+           jndex := numItems;
+           kndex := numItems + 1;
+           limit := 2 * numItems;
+       ELSE
+           kndex := 1;
+           limit := numItems;
+           index := numItems + 1;
+           jndex := 2 * numItems;
+       END (*--if*);
+       REPEAT
+           (*-- merge a run from i- and j- sources into k-destination *)
+           IF (m >= p) THEN
+               q := p;
+           ELSE
+               q := m;
+           END (*--if*);
+           DEC(m, q);
+           IF (m >= p) THEN
+               r := p;
+           ELSE
+               r := m;
+           END (*--if*);
+           DEC(m, r);
+           WHILE (q > 0) & (r > 0) DO
+               IF (compare(index, jndex) = less) THEN
+                   assign(kndex, index);
+                   kndex := VAL(INTEGER, kndex) + h;
+                   INC(index);
+                   DEC(q);
+               ELSE
+                   assign(kndex, jndex);
+                   kndex := VAL(INTEGER, kndex) + h;
+                   DEC(jndex);
+                   DEC(r);
+               END (*--if*);
+           END (*--while*);
+   
+           WHILE (r > 0) DO
+               assign(kndex, jndex);
+               kndex := VAL(INTEGER, kndex) + h;
+               DEC(jndex);
+               DEC(r);
+           END (*--while*);
+   
+           WHILE (q > 0) DO
+               assign(kndex, index);
+               kndex := VAL(INTEGER, kndex) + h;
+               INC(index);
+               DEC(q);
+           END (*--while*);
+           h := -h;
+           t := kndex;
+           kndex := limit;
+           limit := t;
+       UNTIL m = 0;
+       up := ~up;
+       p  := 2 * p;
+   UNTIL VAL(CARDINAL, p) >= numItems;
+   IF ~up THEN
+       FOR index := 1 TO numItems DO
+           assign(index, index + numItems);
+       END (*--for*);
+   END (*--if*);
+END StraightMerge;
+(*--------------------*)
+
+(*
+Gonnet's version of Bubble Sort. More efficient than the usual version
+when the array is in random order or ordered in reverse. When the
+array is ordered, or contains the same value in every position of the
+array, it uses more time than other implementations. The author does not
+recommend this algorithm for any purpose.
+*)
+
+PROCEDURE BubbleSort     (    numItems : CARDINAL    (*--in   *);
+                              compare  : CompareProc (*--in   *);
+                              swap     : SwapProc    (*--in   *));
+
+VAR        index   : CARDINAL;     (*--loop index over items of the array *)
+           jndex   : CARDINAL;     (*--lower bound at start of each FOR loop *)
+           lower   : CARDINAL;     (*--lower bound of the array to sort *)
+           upper   : CARDINAL;     (*--upper bound of the array to sort *)
+
+BEGIN
+   lower := 0;
+   upper := numItems-1;
+   WHILE (upper > lower) DO
+       jndex := lower;
+       FOR index := lower TO upper-1 DO
+           IF (compare(index, index+1) = greater) THEN
+               swap(index, index+1);
+           END (*--if*);
+           jndex := index;
+       END (*--for*);
+       upper := jndex;
+   END (*--while*);
+END BubbleSort;
+(*--------------------*)
+
+(*
+Gonnet's version of Shaker Sort (double-direction bubble sort). This algorithm
+performs reasonably well in comparison with the standard Bubblesort. For small,
+nearly ordered arrays (<= 200 elements with a sortedness ratio <= 2%) the performance
+was better than Quicksort but not as good as Insertion sort.
+*)
+
+PROCEDURE ShakerSort     (    numItems : CARDINAL    (*--in   *);
+                              compare  : CompareProc (*--in   *);
+                              swap     : SwapProc    (*--in   *));
+
+VAR        index   : CARDINAL;     (*--loop index over items of the array *)
+           jndex   : CARDINAL;     (*--lower bound at start of each FOR loop *)
+           lower   : CARDINAL;     (*--lower bound of the array to sort *)
+           upper   : CARDINAL;     (*--upper bound of the array to sort *)
+
+BEGIN
+   lower := 0;
+   upper := numItems-1;
+   WHILE (upper > lower) DO
+       jndex := lower;
+       FOR index := lower TO upper-1 DO
+           IF (compare(index, index+1) = greater) THEN
+               swap(index, index+1);
+               jndex := index;
+           END (*--if*);
+       END (*--for*);
+       upper := jndex;
+       FOR index := upper TO lower+1 BY -1 DO
+           IF (compare(index, index-1) = less) THEN
+               swap(index, index-1);
+               jndex := index;
+           END (*--if*);
+       END (*--for*);
+       lower := jndex;
+   END (*--while*);
+END ShakerSort;
+(*--------------------*)
+
+END Sort.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/sorting/sortdata.def b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/sorting/sortdata.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/sorting/sortdata.def
@@ -0,0 +1,7 @@
+DEFINITION MODULE SortData;
+
+CONST  kMaxArraySize = 10000;
+TYPE   DataArray     = ARRAY [0..kMaxArraySize] OF INTEGER;
+VAR    theRandomData : POINTER TO DataArray;
+
+END SortData.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/sorting/sortdata.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/sorting/sortdata.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/sorting/sortdata.mod
@@ -0,0 +1,2 @@
+IMPLEMENTATION MODULE SortData;
+END SortData.
diff --git a/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/sorting/timesort.mod b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/sorting/timesort.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol4/sorting/timesort.mod
@@ -0,0 +1,752 @@
+MODULE TimeSort;
+
+FROM SCLStorage IMPORT
+   (*--proc*) Allocate, Deallocate;
+
+FROM EventManager IMPORT
+   (*--proc*) TickCount;
+
+FROM Utilities IMPORT
+   (*--proc*) GetDateTime;
+
+FROM IUPackage IMPORT
+   (*--type*) DateForm,
+   (*--proc*) IUDateString;
+
+FROM QuickDraw IMPORT
+   (*--var *) randSeed,
+   (*--proc*) Random;
+
+FROM InOut IMPORT
+   (*--proc*) WriteString, WriteLn, WriteReal, WriteInt, WriteLongCard,
+              WriteCard;
+
+FROM InOutUtils IMPORT
+   (*--proc*) WriteBlanks, WriteLnString, WriteLblCardinal, WriteLblBoolean;
+
+FROM Arguments IMPORT
+   (*--proc*) ArgumentCount, Argument;
+
+FROM IntEnv IMPORT
+   (*--proc*) Exit;
+
+FROM BDPackage IMPORT
+   (*--proc*) StringToNum;
+
+FROM StringUtils IMPORT
+   (*--proc*) IsEqual;
+
+FROM SortData IMPORT
+   (*--cons*) kMaxArraySize,
+   (*--type*) DataArray,
+   (*--var *) theRandomData;
+
+IMPORT Relations;
+IMPORT Sort;
+(*
+IMPORT QuickSorts;
+IMPORT InsertionSorts;
+*)
+IMPORT MergeSorts;
+IMPORT Diagnostic;
+(*--------------------*)
+
+CONST kDefaultArraySize = 3000;
+VAR   arraySize : CARDINAL;
+
+CONST kDefaultNumRuns = 1;
+VAR   numRuns : CARDINAL;
+
+CONST kDefaultSeed = 1D;
+VAR   theSeed : LONGINT;
+
+TYPE   SortAlgorithms = (insertion,
+                         selection,
+                         bubble,
+                         shaker,        (*-- Gonnet *)
+                         heap,          (*-- Gonnet *)
+                         shell,         (*-- Segdewick *)
+                         quick,
+                         bsort,         (*-- Wainwright *)
+                         mean,          (*-- Motzkin *)
+                         merge          (*-- various merge sorts *)
+                        );
+
+TYPE  SortSet = SET OF SortAlgorithms;
+CONST kDefaultSorts = SortSet{};
+VAR   theSorts : SortSet;
+VAR   theValue : INTEGER;
+
+CONST  kDefaultCutoff = 10;
+VAR    cutoff   : INTEGER;
+
+TYPE   Orderings = (unordered,         (*-- random data set *)
+                    ascending,         (*-- ordered list *)
+                    descending,        (*-- ordered list in reverse order *)
+                    same               (*-- ordered list of the same value *)
+                   );
+CONST  kDefaultOrder = unordered;
+VAR    theOrder : Orderings;
+VAR    orderName: ARRAY Orderings, [0..10] OF CHAR;
+
+CONST kDefaultRatio = 0;
+VAR   theRatio : INTEGER;
+
+CONST  kDefaultVerify = FALSE;
+VAR    verifyOrder : BOOLEAN;
+
+CONST  kDefaultDataSet = 0;
+VAR    dataSet : [0..8];
+
+(*--------------------*)
+
+
+VAR        comparisons : LONGCARD;
+VAR        interchanges: LONGCARD;
+VAR        assignments : LONGCARD;
+VAR        statistics  : BOOLEAN;
+
+VAR        doCompare2  : Sort.CompareProc;
+VAR        doAssign2   : Sort.AssignProc;
+VAR        doSwap      : Sort.SwapProc;
+VAR        doValue     : Sort.ValueProc;
+VAR        doAssignMean: Sort.AssignItemProc;
+
+TYPE   pInteger = POINTER TO INTEGER;
+VAR    theIntegerArray : ARRAY [0..kMaxArraySize] OF INTEGER;
+(*--------------------*)
+
+
+PROCEDURE GetArguments;
+
+CONST  caseInsensitive = FALSE;
+
+VAR    index : CARDINAL;
+       argc  : CARDINAL;
+       theArg: ARRAY [0..31] OF CHAR;
+       theLongArg : LONGINT;
+
+   PROCEDURE NextArgument;
+   BEGIN
+       Argument(index, theArg);
+       INC(index);
+   END NextArgument;
+
+BEGIN
+   arraySize   := kDefaultArraySize;
+   numRuns     := kDefaultNumRuns;
+   theSeed     := kDefaultSeed;
+   theSorts    := kDefaultSorts;
+   theOrder    := kDefaultOrder;
+   theValue    := 1;
+   statistics  := FALSE;
+   verifyOrder := kDefaultVerify;
+   theRatio    := kDefaultRatio;
+   cutoff      := kDefaultCutoff;
+   dataSet     := kDefaultDataSet;
+
+   argc := ArgumentCount()-1;
+   index := 1;
+   WHILE (index <= argc) DO
+       NextArgument;
+
+       IF IsEqual(theArg, '-s', caseInsensitive) THEN
+           NextArgument;
+           StringToNum(theArg, theLongArg);
+           IF (theLongArg < 1D) THEN
+               theLongArg := 1;
+           ELSIF (theLongArg > VAL(LONGINT, kMaxArraySize)) THEN
+               theLongArg := kMaxArraySize;
+           END (*--if*);
+           arraySize := theLongArg;
+
+       ELSIF IsEqual(theArg, '-n', caseInsensitive) THEN
+           NextArgument;
+           StringToNum(theArg, theLongArg);
+           IF (theLongArg < 1D) THEN
+               theLongArg := 1;
+           END (*--if*);
+           numRuns := theLongArg;
+
+       ELSIF IsEqual(theArg, '-ds', caseInsensitive) THEN
+           NextArgument;
+           StringToNum(theArg, theLongArg);
+           IF (theLongArg < 0) OR (theLongArg > 8) THEN
+               theLongArg := 0;
+           END (*--if*);
+           dataSet := theLongArg;
+
+       ELSIF IsEqual(theArg, '-seed', caseInsensitive) THEN
+           NextArgument;
+           StringToNum(theArg, theLongArg);
+           IF (theLongArg < 1D) THEN
+               theLongArg := 1;
+           END (*--if*);
+           theSeed := theLongArg;
+
+       ELSIF IsEqual(theArg, '-ratio', caseInsensitive) THEN
+           NextArgument;
+           StringToNum(theArg, theLongArg);
+           IF (theLongArg < 0D) OR (theLongArg > 100) THEN
+               theLongArg := 0D;
+           END (*--if*);
+           theRatio := theLongArg;
+
+       ELSIF IsEqual(theArg, '-cutoff', caseInsensitive) THEN
+           NextArgument;
+           StringToNum(theArg, theLongArg);
+           IF (theLongArg < 0D) OR (theLongArg > 100) THEN
+               theLongArg := kDefaultCutoff;
+           END (*--if*);
+           cutoff := theLongArg;
+
+       ELSIF IsEqual(theArg, '-insertion', caseInsensitive) THEN
+           INCL(theSorts, insertion);
+       ELSIF IsEqual(theArg, '-selection', caseInsensitive) THEN
+           INCL(theSorts, selection);
+       ELSIF IsEqual(theArg, '-bubble', caseInsensitive) THEN
+           INCL(theSorts, bubble);
+       ELSIF IsEqual(theArg, '-shaker', caseInsensitive) THEN
+           INCL(theSorts, shaker);
+       ELSIF IsEqual(theArg, '-heap', caseInsensitive) THEN
+           INCL(theSorts, heap);
+       ELSIF IsEqual(theArg, '-shell', caseInsensitive) THEN
+           INCL(theSorts, shell);
+       ELSIF IsEqual(theArg, '-quick', caseInsensitive) THEN
+           INCL(theSorts, quick);
+       ELSIF IsEqual(theArg, '-bsort', caseInsensitive) THEN
+           INCL(theSorts, bsort);
+       ELSIF IsEqual(theArg, '-mean', caseInsensitive) THEN
+           INCL(theSorts, mean);
+       ELSIF IsEqual(theArg, '-merge', caseInsensitive) THEN
+           INCL(theSorts, merge);
+
+       ELSIF IsEqual(theArg, '-all', caseInsensitive) THEN
+           INCL(theSorts, insertion);
+           INCL(theSorts, selection);
+           INCL(theSorts, heap);
+           INCL(theSorts, bubble);
+           INCL(theSorts, shaker);
+           INCL(theSorts, shell);
+           INCL(theSorts, quick);
+           INCL(theSorts, bsort);
+           INCL(theSorts, mean);
+           INCL(theSorts, merge);
+
+       ELSIF IsEqual(theArg, '-random', caseInsensitive) THEN
+           theOrder := unordered;
+       ELSIF IsEqual(theArg, '-ordered', caseInsensitive) THEN
+           theOrder := ascending;
+       ELSIF IsEqual(theArg, '-reverse', caseInsensitive) THEN
+           theOrder := descending;
+       ELSIF IsEqual(theArg, '-same', caseInsensitive) THEN
+           theOrder := same;
+           NextArgument;
+           StringToNum(theArg, theLongArg);
+           theValue := theLongArg;
+
+       ELSIF IsEqual(theArg, '-verify', caseInsensitive) THEN
+           verifyOrder := TRUE;
+
+       ELSIF IsEqual(theArg, '-stats', caseInsensitive) THEN
+           statistics := TRUE;
+
+       ELSE
+           Diagnostic.WriteString('### Unidentified option: ');
+           Diagnostic.WriteString(theArg);
+           Diagnostic.WriteLn;
+           Diagnostic.WriteString('### Usage: TimeSort [options╔]');
+           Diagnostic.WriteLn;
+           Diagnostic.WriteString('-s nnn      array size where nnn is a positive integer <= 8192');
+           Diagnostic.WriteLn;
+           Diagnostic.WriteString('-n nnn      number of runs');
+           Diagnostic.WriteLn;
+           Diagnostic.WriteString('-seed nnn   random number seed');
+           Diagnostic.WriteLn;
+           Diagnostic.WriteString('-ratio nn   sortedness ratio where 0 < nn < 100. Valid with -ordered or -reverse');
+           Diagnostic.WriteLn;
+           Diagnostic.WriteString('-cutoff nn  cutoff value for some quicksort algorithms');
+           Diagnostic.WriteLn;
+           Diagnostic.WriteString('-random     randomize array (duplicates allowed)');
+           Diagnostic.WriteLn;
+           Diagnostic.WriteString('-ordered    identity permutation');
+           Diagnostic.WriteLn;
+           Diagnostic.WriteString('-reverse    reverse identity permutation');
+           Diagnostic.WriteLn;
+           Diagnostic.WriteString('-same nnn   same value in all positions in the array');
+           Diagnostic.WriteLn;
+           Diagnostic.WriteString('-verify     verify sorted result');
+           Diagnostic.WriteLn;
+           Diagnostic.WriteString('-stats      statistics on number of comparisons, etc');
+           Diagnostic.WriteLn;
+           Diagnostic.WriteString('-all        run all sorting algorithms');
+           Diagnostic.WriteLn;
+           Diagnostic.WriteString('-insertion  insertion sorts');
+           Diagnostic.WriteLn;
+           Exit(1D);
+       END (*--if*);
+   END (*--while*);
+END GetArguments;
+(*--------------------*)
+
+PROCEDURE Title ();
+
+VAR   dateTime   : LONGINT;
+VAR   dateString : ARRAY [0..99] OF CHAR;
+
+BEGIN
+   orderName[unordered]    := "Random";
+   orderName[ascending]    := "Ascending";
+   orderName[descending]   := "Descending";
+   orderName[same]         := "Same Value";
+
+   WriteLnString("Sorting Performance tests in Bob Campbell's Modula-2 v1.4d11");
+   GetDateTime(dateTime);
+   IUDateString(dateTime, shortDate, dateString);
+   WriteString("Run on ");
+   WriteLnString(dateString);
+   WriteLblCardinal("# of runs: ", numRuns, 1);
+   WriteLblCardinal(".  Array Size: ", arraySize, 1);
+   WriteLblBoolean(".  Statistics: ", statistics);
+   WriteLblBoolean(".  Verification: ", verifyOrder);
+   WriteLn;
+   WriteString("Data Set #");
+   WriteCard(dataSet, 1);
+   WriteString("  Ordering: ");
+   WriteString(orderName[theOrder]);
+   WriteString(".  ");
+   CASE theOrder OF
+     unordered:
+           WriteLblCardinal("Seed: ", theSeed, 1);
+   | ascending,
+     descending:
+           WriteLblCardinal("Sortedness Ratio: ", theRatio, 1);
+           WriteLblCardinal("% with ", TRUNC((FLOAT(theRatio) / 100.) * FLOAT(arraySize)), 1);
+           WriteString(" elements out-of-order.");
+   | same:
+           WriteLblCardinal("Value: ", theValue, 1);
+   END (*--case*);
+   WriteLn;
+   IF (quick IN theSorts) THEN
+       WriteLblCardinal("Cutoff: ", cutoff, 1);
+       WriteLn;
+   END (*--if*);
+   WriteLn;
+   WriteBlanks(22);
+   WriteString("Ticks");
+   WriteBlanks(2);
+   WriteString("Seconds");
+   IF statistics THEN
+       WriteBlanks(2);
+       WriteString("Interchanges");
+       WriteBlanks(2);
+       WriteString("Comparisons");
+       WriteBlanks(2);
+       WriteString("Assignments");
+   END (*--if*);
+   WriteLn;
+END Title;
+(*--------------------*)
+
+PROCEDURE CompareIntegersAt (left, right : CARDINAL) : Relations.Relation;
+BEGIN
+   IF (theIntegerArray[left] < theIntegerArray[right]) THEN
+       RETURN Relations.less;
+   ELSIF (theIntegerArray[left] > theIntegerArray[right]) THEN
+       RETURN Relations.greater;
+   ELSE
+       RETURN Relations.equal;
+   END (*--if*);
+END CompareIntegersAt;
+(*--------------------*)
+
+PROCEDURE CompareIntegersAtStats (left, right : CARDINAL) : Relations.Relation;
+BEGIN
+   INC(comparisons);
+   IF (theIntegerArray[left] < theIntegerArray[right]) THEN
+       RETURN Relations.less;
+   ELSIF (theIntegerArray[left] > theIntegerArray[right]) THEN
+       RETURN Relations.greater;
+   ELSE
+       RETURN Relations.equal;
+   END (*--if*);
+END CompareIntegersAtStats;
+(*--------------------*)
+
+PROCEDURE AssignIntegersAt (left, right : CARDINAL);
+BEGIN
+   theIntegerArray[left] := theIntegerArray[right];
+END AssignIntegersAt;
+(*--------------------*)
+
+PROCEDURE AssignIntegersAtStats (left, right : CARDINAL);
+BEGIN
+   INC(assignments);
+   theIntegerArray[left] := theIntegerArray[right];
+END AssignIntegersAtStats;
+(*--------------------*)
+
+PROCEDURE SwapIntegersAt (left, right : CARDINAL);
+
+VAR temp : INTEGER;
+
+BEGIN
+   temp := theIntegerArray[left];
+   theIntegerArray[left] := theIntegerArray[right];
+   theIntegerArray[right] := temp;
+END SwapIntegersAt;
+(*--------------------*)
+
+PROCEDURE SwapIntegersAtStats (left, right : CARDINAL);
+
+VAR temp : INTEGER;
+
+BEGIN
+   INC(interchanges);
+   temp := theIntegerArray[left];
+   theIntegerArray[left] := theIntegerArray[right];
+   theIntegerArray[right] := temp;
+END SwapIntegersAtStats;
+(*--------------------*)
+
+(*-- The next three routines are especially for MeanSort. *)
+
+PROCEDURE ValueAt (index : CARDINAL) : INTEGER;
+BEGIN
+   RETURN theIntegerArray[index];
+END ValueAt;
+(*--------------------*)
+
+PROCEDURE AssignMean (index : CARDINAL; mean : INTEGER);
+BEGIN
+   theIntegerArray[index] := mean;
+END AssignMean;
+(*--------------------*)
+
+PROCEDURE AssignMeanStats (index : CARDINAL; mean : INTEGER);
+BEGIN
+   INC(assignments);
+   theIntegerArray[index] := mean;
+END AssignMeanStats;
+(*--------------------*)
+
+PROCEDURE GetRandomData;
+
+VAR        i : CARDINAL;
+
+   (*
+   PermuteArray alters the strict ordering of the array based on the sortedness
+   ratio as given in the command line. The sortedness ratio of a list of N
+   records is defined as k/N, where k is the minimum number of elements that
+   must be removed so that the remaining portion of the list is sorted. For a
+   sorted list, this ratio is zero, and for a completely out-of-order list, the
+   ratio approaches one. Each list of size N with a sortedness ratio k/N is
+   created from the identify permutation:
+       First, k randomly chosen elements are removed from the permutation and
+       randomly inserted into another list of size N.
+       Then the remaining N-k elements of the permutation are inserted in order
+       in the vacant list slots. If, in so doing, one of the random k elements
+       lies between, and has a value between, two of the inserted elements, then
+       the random element and one of the inserted elements are exchanged. Thus,
+       the k elements of the permutation are the smallest subset whose removal
+       leaves the list sorted; hence, the sortedness ratio of the list is k/n.
+   See further references [Cook, Wainwright].
+   
+   In our case, we initialize the permuted array to zeroes to indicate vacant
+   slots.
+   *)
+
+   PROCEDURE PermuteArray;
+
+   VAR     k : CARDINAL;       (*-- minimum number of elements that are out-of-order *)
+   VAR     i : CARDINAL;       (*-- loop index over permutedArray *)
+   VAR     j : CARDINAL;       (*-- number of randomly permuted elements so far *)
+   VAR     h : CARDINAL;       (*-- index into permuted array for random element *)
+   VAR     permutedArray : POINTER TO DataArray;
+
+   BEGIN
+       k := TRUNC((FLOAT(theRatio) / 100.) * FLOAT(arraySize));
+       IF (k > 0) THEN
+           Allocate(permutedArray, SIZE(DataArray));
+           IF (permutedArray) = NIL THEN
+               Diagnostic.WriteString('Could not allocate permuted array');
+               Diagnostic.WriteLn;
+               Exit(3);
+           END (*--if*);
+           
+           (*-- Initialize the permuted array --*)
+           FOR i := 0 TO arraySize-1 DO
+               permutedArray^[i] := 0;
+           END (*--for*);
+           
+           (*-- Select k elements at random to insert into permuted array --*)
+           j := k;
+           WHILE (j # 0) DO
+               i := VAL(CARDINAL, ABS(Random())) MOD arraySize;        (*-- get a random slot in data array *)
+               h := VAL(CARDINAL, ABS(Random())) MOD arraySize;        (*-- get a random slot in permuted array *)
+               (*-- make sure we haven't used either slot before *)
+               IF (theRandomData^[i] # 0) & (permutedArray^[h] = 0) THEN
+                   permutedArray^[h] := theRandomData^[i];
+                   theRandomData^[i] := 0;
+                   DEC(j);
+               END (*--if*);
+           END (*--while*);
+           
+           (*-- Insert the elements of the identity permutation into the permuted array --*)
+           h := 0;
+           i := 0;
+           WHILE (i <= arraySize-1) DO
+               IF (theRandomData^[i] # 0) THEN
+                   IF (permutedArray^[h] = 0) THEN
+                       permutedArray^[h] := theRandomData^[i];
+
+                       (*-- advance both indices --*)
+                       INC(h);
+                       INC(i);
+                   ELSE
+
+                       (*-- ensure we haven't put permuted elements in order --*)
+                       IF (theOrder = ascending) & (h > 0) & (permutedArray^[h] = permutedArray^[h-1]+1) THEN
+                           j := permutedArray^[h];
+                           permutedArray^[h] := permutedArray^[h-1];
+                           permutedArray^[h-1] := j;
+                       ELSIF (theOrder = descending) & (permutedArray^[h] = permutedArray^[h-1]-1) THEN
+                           j := permutedArray^[h];
+                           permutedArray^[h] := permutedArray^[h-1];
+                           permutedArray^[h-1] := j;
+                       END (*--if*);
+                       INC(h);
+                   END (*--if*);
+               ELSE
+                   INC(i);
+               END (*--if*);
+           END (*--while*);
+           
+           (*-- Copy permuted data back into original array for sort tests --*)
+           FOR i := 0 TO arraySize-1 DO
+               theRandomData^[i] := permutedArray^[i];
+           END (*--for*);
+           
+           Deallocate(permutedArray, SIZE(DataArray));
+       END (*--if*);
+   END PermuteArray;
+
+BEGIN
+   Allocate(theRandomData, SIZE(DataArray));
+   IF theRandomData = NIL THEN
+       Diagnostic.WriteString('Could not allocate the data array');
+       Diagnostic.WriteLn;
+       Exit(2);
+   END (*--if*);
+
+   randSeed := theSeed;
+   CASE theOrder OF
+       unordered : FOR i := 0 TO arraySize-1 DO
+                     theRandomData^[i] := Random();
+                   END (*--for*);
+   |   ascending : FOR i := 0 TO arraySize-1 DO
+                     theRandomData^[i] := i+1;
+                   END (*--for*);
+                   PermuteArray;
+   |   descending: FOR i := 0 TO arraySize-1 DO
+                     theRandomData^[i] := arraySize-i;
+                   END (*--for*);
+                   PermuteArray;
+   |   same      : FOR i := 0 TO arraySize-1 DO
+                     theRandomData^[i] := theValue;
+                   END (*--for*);
+   END (*--case*);
+END GetRandomData;
+(*--------------------*)
+
+PROCEDURE FillIntegerArray;
+
+VAR        i : CARDINAL;
+
+BEGIN
+   comparisons := 0D;
+   interchanges:= 0D;
+   assignments := 0D;
+   FOR i := 0 TO arraySize-1 DO
+       theIntegerArray[i] := theRandomData^[i];
+   END (*--for*);
+END FillIntegerArray;
+(*--------------------*)
+
+VAR startTicks : LONGINT;
+    stopTicks  : LONGINT;
+
+PROCEDURE PrintResults (    theMsg : ARRAY OF CHAR (*--in   *));
+
+VAR elapsedTicks : LONGINT;
+    elapsedSeconds : REAL;
+    width : INTEGER;
+    index : CARDINAL;
+
+BEGIN
+   elapsedTicks := stopTicks - startTicks;
+   WriteString(theMsg);
+   width := 20 - HIGH(theMsg);
+   IF (width > 0) THEN
+       WriteBlanks(width);
+   END (*--if*);
+   WriteInt(elapsedTicks, 6);
+   elapsedSeconds := FLOAT(elapsedTicks) / 60.;
+   WriteReal(elapsedSeconds, 9, 2, TRUE);
+
+   IF statistics THEN
+       WriteLongCard(interchanges, 14);
+       WriteLongCard(comparisons, 13);
+       WriteLongCard(assignments, 13);
+   END (*--if*);
+
+   IF verifyOrder THEN
+       index := 0;
+       LOOP
+           IF (theIntegerArray[index] > theIntegerArray[index+1]) THEN
+               WriteBlanks(2);
+               WriteString("### Assertion failed! Out of order at [");
+               WriteCard(index, 1);
+               WriteString("]. ");
+               WriteInt(theIntegerArray[index], 1);
+               WriteString(" > ");
+               WriteInt(theIntegerArray[index+1], 1);
+               EXIT (*--loop*);
+           END (*--if*);
+           INC(index);
+           IF (index >= arraySize-1) THEN
+               EXIT (*--loop*);
+           END (*--if*);
+       END (*--loop*);
+   END (*--if*);
+   WriteLn;
+END PrintResults;
+(*--------------------*)
+
+VAR  index : CARDINAL;
+
+BEGIN
+   GetArguments();
+   Title();
+   GetRandomData();
+   IF statistics THEN
+       doCompare2 := CompareIntegersAtStats;
+       doAssign2  := AssignIntegersAtStats;
+       doSwap       := SwapIntegersAtStats;
+       doValue      := ValueAt;
+       doAssignMean := AssignMeanStats;
+   ELSE
+       doCompare2 := CompareIntegersAt;
+       doAssign2  := AssignIntegersAt;
+       doSwap       := SwapIntegersAt;
+       doValue      := ValueAt;
+       doAssignMean := AssignMean;
+   END (*--if*);
+   
+   FOR index := 1 TO numRuns DO
+
+       IF insertion IN theSorts THEN
+           FillIntegerArray;
+           startTicks:=TickCount();
+           Sort.InsertionSort(arraySize, doCompare2, doSwap);
+           stopTicks:=TickCount();
+           PrintResults("Insertion Sort");
+
+           FillIntegerArray;
+           startTicks:=TickCount();
+           Sort.BinaryInsertionSort(arraySize, doCompare2, doAssign2);
+           stopTicks:=TickCount();
+           PrintResults("Binary Insertion");
+       END (*--if*);
+
+       IF selection IN theSorts THEN
+           FillIntegerArray;
+           startTicks:=TickCount();
+           Sort.SelectionSort (arraySize,      (*-- # of items in the array *)
+                               doCompare2,     (*-- item comparison routine *)
+                               doSwap);        (*-- item swap routine *)
+           stopTicks:=TickCount();
+           PrintResults("Selection Sort");
+       END (*--if*);
+   
+       IF bubble IN theSorts THEN
+           FillIntegerArray;
+           startTicks:=TickCount();
+           Sort.BubbleSort(arraySize,      (*-- # of items in the array *)
+                           doCompare2,     (*-- item comparison routine *)
+                           doSwap);        (*-- item swap routine *)
+           stopTicks:=TickCount();
+           PrintResults("Bubble Sort");
+       END (*--if*);
+       IF shaker IN theSorts THEN
+           FillIntegerArray;
+           startTicks:=TickCount();
+           Sort.ShakerSort(arraySize,      (*-- # of items in the array *)
+                           doCompare2,     (*-- item comparison routine *)
+                           doSwap);        (*-- item swap routine *)
+           stopTicks:=TickCount();
+           PrintResults("Shaker Sort");
+       END (*--if*);
+       IF shell IN theSorts THEN
+           FillIntegerArray;
+           startTicks:=TickCount();
+           Sort.ShellSort (arraySize,  (*-- # of items in the array *)
+                           doCompare2, (*-- item comparison routine *)
+                           doAssign2); (*-- item swap routine *)
+           stopTicks:=TickCount();
+           PrintResults("Shell Sort");
+       END (*--if*);
+   
+       IF heap IN theSorts THEN
+           FillIntegerArray;
+           startTicks:=TickCount();
+           Sort.HeapSort (arraySize,     (*-- # of items in the array *)
+                          doCompare2,    (*-- item comparison routine *)
+                          doSwap);       (*-- item swap routine *)
+           stopTicks:=TickCount();
+           PrintResults("Heap Sort");
+       END (*--if*);
+   
+       IF quick IN theSorts THEN
+           FillIntegerArray;
+           startTicks:=TickCount();
+           Sort.QuickSort(arraySize, doCompare2, doAssign2, doSwap, cutoff);
+           stopTicks:=TickCount();
+           PrintResults("Quick Sort");
+       END (*--if*);
+   
+       IF bsort IN theSorts THEN
+           FillIntegerArray;
+           startTicks:=TickCount();
+           Sort.BSort(arraySize,         (*-- # of items in the array *)
+                      doCompare2,        (*-- item comparison routine *)
+                      doAssign2,         (*-- item assignment routine *)
+                      doSwap);           (*-- item swap routine *)
+           stopTicks:=TickCount();
+           PrintResults("BSort");
+       END (*--if*);
+
+       IF mean IN theSorts THEN
+           FillIntegerArray;
+           startTicks:=TickCount();
+           Sort.MeanSort(arraySize,     (*-- # of items in the array *)
+                         doCompare2,    (*-- item comparison routine *)
+                         doSwap,        (*-- item swap routine *)
+                         doValue,       (*-- item retrieval routine *)
+                         doAssignMean); (*-- assign mean to array[numItems] *)
+           stopTicks:=TickCount();
+           PrintResults("Mean Sort ");
+       END (*--if*);
+
+       IF merge IN theSorts THEN
+           FillIntegerArray;
+           startTicks:=TickCount();
+           MergeSorts.StraightMerge(arraySize-1, doCompare2, doAssign2);
+           stopTicks:=TickCount();
+           PrintResults("Straight Merge Sort ");
+       END (*--if*);
+   END (*--for*);
+   WriteLn;
+   Deallocate(theRandomData, SIZE(DataArray));
+END TimeSort.
+
diff --git a/examples/Modula-2_Libraries/OLSON/olsen/porting/HackNameLists.def b/examples/Modula-2_Libraries/OLSON/olsen/porting/HackNameLists.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/OLSON/olsen/porting/HackNameLists.def
@@ -0,0 +1,61 @@
+(*$Copyright 1988 by Olsen & Associates (O&A), Zurich, Switzerland.
+
+                       All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies, and
+that both that copyright notice and this permission notice appear in
+supporting documentation, and that all modifications of this software
+or its documentation not made by O&A or its agents are accompanied
+by a prominent notice stating who made the modifications and the date
+of the modifications.
+
+O&A DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE AND ITS
+DOCUMENTATION, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS.  IN NO EVENT SHALL O&A BE LIABLE FOR ANY SPECIAL, INDIRECT OR
+CONSEQUENTIAL DAMAGES, ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
+USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
+OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
+PERFORMANCE OF THIS SOFTWARE OR ITS DOCUMENTATION.
+******************)
+
+DEFINITION MODULE HackNameLists;
+(*
+ * THIS MODULE CONTAINS AS MUCH IMPLEMENTATION AS NECESSARY TO SUPPORT
+ * THE PROGRAM hackm2pp.   IT SHOULD NOT BE USED FOR ANYTHING ELSE.
+ *)
+IMPORT
+    SysTypes;
+EXPORT QUALIFIED
+    Object, 	    Orderings,      FindCases,         Create,
+    DONTCARE,	    Insert, 	    Find;
+
+TYPE
+    Object;
+TYPE
+    Orderings = ( forwardSorted, reverseSorted, queue, stack );
+    FindCases = ( caseSensitive, caseInsensitive, allLowerCase, allUpperCase );
+
+PROCEDURE Create(
+    VAR list          : Object;
+        howToTraverse : Orderings;
+        howToFind     : FindCases
+    );
+
+VAR
+    DONTCARE : SysTypes.ANYPTR;
+
+PROCEDURE Insert(
+    list           : Object;
+    name           : ARRAY OF CHAR;
+    importerObject : SysTypes.ANYPTR
+    );
+
+PROCEDURE Find(
+        list           : Object;       
+        name           : ARRAY OF CHAR;
+    VAR importerObject : SysTypes.ANYPTR
+    )                  : BOOLEAN;     
+
+END HackNameLists.
diff --git a/examples/Modula-2_Libraries/OLSON/olsen/porting/HackNameLists.mod b/examples/Modula-2_Libraries/OLSON/olsen/porting/HackNameLists.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/OLSON/olsen/porting/HackNameLists.mod
@@ -0,0 +1,139 @@
+(*$Copyright 1988 by Olsen & Associates (O&A), Zurich, Switzerland.
+
+                       All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies, and
+that both that copyright notice and this permission notice appear in
+supporting documentation, and that all modifications of this software
+or its documentation not made by O&A or its agents are accompanied
+by a prominent notice stating who made the modifications and the date
+of the modifications.
+
+O&A DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE AND ITS
+DOCUMENTATION, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS.  IN NO EVENT SHALL O&A BE LIABLE FOR ANY SPECIAL, INDIRECT OR
+CONSEQUENTIAL DAMAGES, ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
+USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
+OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
+PERFORMANCE OF THIS SOFTWARE OR ITS DOCUMENTATION.
+******************)
+
+IMPLEMENTATION MODULE HackNameLists;
+(*
+ * THIS MODULE CONTAINS AS MUCH IMPLEMENTATION AS NECESSARY TO SUPPORT
+ * THE PROGRAM hackm2pp.   IT SHOULD NOT BE USED FOR ANYTHING ELSE.
+ *)
+IMPORT
+    GenConsts,
+    SafeStorage,
+    Strings,
+    SYSTEM,
+    SysTypes;
+
+TYPE
+    Element = POINTER TO ElementRec;
+    Object = POINTER TO ObjectRec;
+    ObjectRec = RECORD
+	head : Element;
+    END;
+
+    ElementRec = RECORD
+	key    : GenConsts.Identifier;
+	impObj : SysTypes.ANYPTR;
+	next   : Element;
+    END;
+
+PROCEDURE Create(
+    VAR list          : Object;
+        howToTraverse : Orderings;
+        howToFind     : FindCases
+    );
+    BEGIN (* Create *)
+	IF ( howToTraverse # forwardSorted ) OR
+	   ( howToFind # caseSensitive ) THEN
+	    HALT;
+	END;
+	SafeStorage.ALLOCATE( list, SYSTEM.TSIZE( ObjectRec ) );
+	WITH list^ DO
+	    head := NIL;
+	END;
+    END Create;
+
+
+PROCEDURE Insert(
+    list           : Object;
+    name           : ARRAY OF CHAR;
+    importerObject : SysTypes.ANYPTR
+    );
+    VAR
+	element : Element;
+    BEGIN (* Insert *)
+	SafeStorage.ALLOCATE( element, SYSTEM.TSIZE( ElementRec ) );
+	WITH element^ DO
+	    Strings.Assign( name, key );
+	    impObj := importerObject;
+	    next := list^.head;
+	    list^.head := element;
+	END;
+    END Insert;
+
+PROCEDURE Equal(
+    left  : ARRAY OF CHAR;
+    right : ARRAY OF CHAR
+    )     : BOOLEAN;
+    VAR
+	i    : SysTypes.Card;
+	high : SysTypes.Card;
+    BEGIN (* Equal *)
+	IF HIGH( left ) > HIGH( right ) THEN
+	    high := HIGH( right );
+	ELSE
+	    high := HIGH( left );
+	END;
+
+	FOR i := 0 TO high DO
+	    IF left[ i ] # right[ i ] THEN
+		RETURN FALSE;
+	    END;
+	    IF left[ i ] = 0C THEN	(* Same and both null! *)
+		RETURN TRUE;
+	    END;
+	END;
+
+	IF HIGH( left ) = HIGH( right ) THEN
+	    (* All values equal and high's equal *)
+	    RETURN TRUE;
+	ELSIF HIGH( left ) > HIGH( right ) THEN
+	    (* Left is statically larger.  If 0C at just past right's high.. *)
+	    RETURN left[ HIGH( right ) + 1 ] = 0C;
+	END;
+	(* Right is statically larger.  If 0C at just past left's high.. *)
+	RETURN right[ HIGH( left ) + 1 ] = 0C;
+    END Equal;
+
+PROCEDURE Find(
+        list           : Object;       
+        name           : ARRAY OF CHAR;
+    VAR importerObject : SysTypes.ANYPTR
+    )                  : BOOLEAN;     
+    VAR
+	element : Element;
+    BEGIN (* Find *)
+	element := list^.head;
+	WHILE element # NIL DO
+	    WITH element^ DO
+		IF Equal( name, key ) THEN
+		    importerObject := impObj;
+		    RETURN TRUE;
+		END;
+		element := next; 
+		(* WITH INVALID *)
+	    END;
+	END;
+	importerObject := NIL; (* Cause an error in case there are bugs *)
+	RETURN FALSE;
+    END Find;
+
+END HackNameLists.
diff --git a/examples/Modula-2_Libraries/OLSON/olsen/porting/HackTextIO.def b/examples/Modula-2_Libraries/OLSON/olsen/porting/HackTextIO.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/OLSON/olsen/porting/HackTextIO.def
@@ -0,0 +1,85 @@
+(*$Copyright 1988 by Olsen & Associates (O&A), Zurich, Switzerland.
+
+                       All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies, and
+that both that copyright notice and this permission notice appear in
+supporting documentation, and that all modifications of this software
+or its documentation not made by O&A or its agents are accompanied
+by a prominent notice stating who made the modifications and the date
+of the modifications.
+
+O&A DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE AND ITS
+DOCUMENTATION, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS.  IN NO EVENT SHALL O&A BE LIABLE FOR ANY SPECIAL, INDIRECT OR
+CONSEQUENTIAL DAMAGES, ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
+USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
+OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
+PERFORMANCE OF THIS SOFTWARE OR ITS DOCUMENTATION.
+******************)
+
+DEFINITION MODULE HackTextIO;
+(*
+ * THIS MODULE CONTAINS AS MUCH IMPLEMENTATION AS NECESSARY TO SUPPORT
+ * THE PROGRAM hackm2pp.  THE ONLY PROCEDURES WHICH REALLY COUNT ARE
+ * ReadChars, WriteChars, and WriteLn.  THE SEMANTICS OF THESE PROCEDURES
+ * MUST BE LIKE TextIO TO AS GREAT AN EXTENT AS REQUIRED.
+ *)
+IMPORT 
+    IOConsts,
+    SYSTEM,
+    SysTypes;
+EXPORT QUALIFIED
+    Object,		States,		DONTCARE,
+    ReadChars,		WriteChars, 	WriteLn,
+    PrintErrorMessage,	GetOpenPath,
+    GetInput,		GetOutput;
+
+TYPE
+    Object;
+
+    States = ( 
+        ok,         (* previous IO operation was successful *)
+        endOfFile,  (* end-of-file was read in last IO operation *)
+        endOfLine,  (* end-of-line was read in last IO operation *)
+        error       (* the last IO operation failed *)
+    );
+VAR
+    DONTCARE : States;
+
+PROCEDURE ReadChars(
+        file      : Object;          (* in "ok" state and readable *)
+        buf       : SYSTEM.ADDRESS;  (* location where read data is put *)
+        bufSize   : SysTypes.Card;   (* maximum number of chars to read *)
+    VAR charsRead : SysTypes.Card    (* actual number of chars read *)
+    )             : States;          (* see States *)
+
+PROCEDURE WriteChars(
+        file    : Object;          (* not in "error" state and writable *)
+        buf     : SYSTEM.ADDRESS;  (* contains data to be written *)
+        bufSize : SysTypes.Card    (* number of bytes to be written *)
+    )           : States;          (* success => "ok" *)
+
+PROCEDURE WriteLn(
+    file : Object   (*  in "ok" state and writable *)
+    )    : States;  (* success => "ok" *)
+
+PROCEDURE PrintErrorMessage(
+    file : Object;
+    msg  : ARRAY OF CHAR
+    );
+
+PROCEDURE GetOpenPath(
+        file : Object;        (* must be valid *)
+    VAR path : IOConsts.Path  (* path of external file, or empty *)
+    );
+
+PROCEDURE GetInput(
+    ) : Object;  (* is "readOnly" *)
+
+PROCEDURE GetOutput(
+    ) : Object;  (* is "appendOnly" *)
+
+END HackTextIO.
diff --git a/examples/Modula-2_Libraries/OLSON/olsen/porting/HackTextIO.mod b/examples/Modula-2_Libraries/OLSON/olsen/porting/HackTextIO.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/OLSON/olsen/porting/HackTextIO.mod
@@ -0,0 +1,168 @@
+(*$Copyright 1988 by Olsen & Associates (O&A), Zurich, Switzerland.
+
+                       All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies, and
+that both that copyright notice and this permission notice appear in
+supporting documentation, and that all modifications of this software
+or its documentation not made by O&A or its agents are accompanied
+by a prominent notice stating who made the modifications and the date
+of the modifications.
+
+O&A DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE AND ITS
+DOCUMENTATION, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS.  IN NO EVENT SHALL O&A BE LIABLE FOR ANY SPECIAL, INDIRECT OR
+CONSEQUENTIAL DAMAGES, ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
+USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
+OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
+PERFORMANCE OF THIS SOFTWARE OR ITS DOCUMENTATION.
+******************)
+
+IMPLEMENTATION MODULE HackTextIO;
+(*
+ * Sample module for aiding in porting the preprocessor.  This should
+ * run on most byte stream file oriented systems with few modifications.
+ * This version has been tested on a Sun-3 running Sun 3.2 and with
+ * Sun's M2 compiler.
+ * 
+ * We do buffered IO for efficiency, but it really isn't necessary.
+ *)
+IMPORT 
+    ASCII,
+    IOConsts,
+    ProgErrOutput,
+    SYSTEM,
+    UnixError,
+    UnixCsys_file;
+
+TYPE
+    Object = CARDINAL;
+
+VAR
+    inputBuffer : ARRAY [ 0 .. 511 ] OF CHAR;
+    inputIndex  : INTEGER;	(* Must be int to deal with unix *)
+    inputLength : INTEGER;	(* ditto *)
+
+PROCEDURE ReadChars(
+        file      : Object;          (* in "ok" state and readable *)
+        buf       : SYSTEM.ADDRESS;  (* location where read data is put *)
+        bufSize   : CARDINAL;        (* maximum number of chars to read *)
+    VAR charsRead : CARDINAL         (* actual number of chars read *)
+    )             : States;          (* see States *)
+    VAR
+	cp : POINTER TO ARRAY [ 0 .. 1001 ] OF CHAR;
+	ch : CHAR;
+    BEGIN (* ReadChars *)
+	cp := buf;
+	charsRead := 0;
+	LOOP
+	    IF inputIndex >= inputLength THEN
+		inputLength := UnixCsys_file.read( file, 
+		    SYSTEM.ADR( inputBuffer ), HIGH( inputBuffer ) + 1 );
+		IF inputLength <= 0 THEN
+		    IF inputLength = 0 THEN
+			RETURN endOfFile;
+		    END;
+		    RETURN error;
+		END;
+		inputIndex := 0;
+	    END;
+
+	    ch := inputBuffer[ inputIndex ];
+	    INC( inputIndex );
+	    IF ch = ASCII.lf THEN
+		(* Throws away the lf *)
+		RETURN endOfLine;
+	    END;
+	    cp^[ charsRead ] := ch;
+	    INC( charsRead );
+	    IF charsRead >= bufSize THEN
+		RETURN ok;
+	    END;
+        END; (* LOOP *)
+
+    END ReadChars;
+
+
+PROCEDURE WriteChars(
+        file    : Object;          (* not in "error" state and writable *)
+        buf     : SYSTEM.ADDRESS;  (* contains data to be written *)
+        bufSize : CARDINAL         (* number of chars to be written *)
+    )           : States;          (* success => "ok" *)
+    VAR
+	count : INTEGER;
+    BEGIN (* WriteChars *)
+
+	REPEAT
+	    count := UnixCsys_file.write( file, buf, bufSize );
+	    IF count <= 0 THEN
+		RETURN error;
+	    END;
+	    DEC( bufSize, CARDINAL( count ) );
+	    INC( buf, CARDINAL( count ) );
+	UNTIL bufSize = 0;
+
+	RETURN ok;
+
+    END WriteChars;
+
+VAR
+    newLine : ARRAY [ 0 .. 0 ] OF CHAR;
+PROCEDURE WriteLn(
+    file : Object   (*  in "ok" state and writable *)
+    )    : States;  (* success => "ok" *)
+    BEGIN (* WriteLn *)
+	RETURN WriteChars( file, SYSTEM.ADR( newLine ), HIGH( newLine ) + 1 );
+    END WriteLn;
+
+
+PROCEDURE PrintErrorMessage(
+    file : Object;
+    msg  : ARRAY OF CHAR
+    );
+    VAR
+	path : IOConsts.Path;
+    BEGIN (* PrintErrorMessage *)
+	GetOpenPath( file, path );
+	UnixError.PrintMessage( UnixError.Get(), path );
+    END PrintErrorMessage;
+
+
+PROCEDURE GetOpenPath(
+        file : Object;        (* must be valid *)
+    VAR path : IOConsts.Path  (* path of external file, or empty *)
+    );
+    BEGIN (* GetOpenPath *)
+	IF file = GetInput() THEN
+	    path := "standard input";
+	ELSE
+	    path := "standard output";
+	END;
+    END GetOpenPath;
+
+
+PROCEDURE GetInput(
+    ) : Object;  (* is "readOnly" *)
+    BEGIN (* GetInput *)
+	RETURN UnixCsys_file.stdInputHandle;
+    END GetInput;
+
+
+PROCEDURE GetOutput(
+    ) : Object;  (* is "appendOnly" *)
+    BEGIN (* GetOutput *)
+	RETURN UnixCsys_file.stdOutputHandle;
+    END GetOutput;
+
+
+BEGIN (* HackText *)
+
+    (* Set up the read buffer *)
+    inputIndex := 0;
+    inputLength := 0;
+
+    newLine[ 0 ] := ASCII.lf;
+
+END HackTextIO.
diff --git a/examples/Modula-2_Libraries/OLSON/olsen/porting/hackm2pp.mod b/examples/Modula-2_Libraries/OLSON/olsen/porting/hackm2pp.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/OLSON/olsen/porting/hackm2pp.mod
@@ -0,0 +1,78 @@
+(*$Copyright 1988 by Olsen & Associates (O&A), Zurich, Switzerland.
+
+                       All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies, and
+that both that copyright notice and this permission notice appear in
+supporting documentation, and that all modifications of this software
+or its documentation not made by O&A or its agents are accompanied
+by a prominent notice stating who made the modifications and the date
+of the modifications.
+
+O&A DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE AND ITS
+DOCUMENTATION, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS.  IN NO EVENT SHALL O&A BE LIABLE FOR ANY SPECIAL, INDIRECT OR
+CONSEQUENTIAL DAMAGES, ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
+USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
+OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
+PERFORMANCE OF THIS SOFTWARE OR ITS DOCUMENTATION.
+******************)
+
+MODULE hackm2pp;
+(*
+ * Hack front end of M2PParser and M2PScanner for porting purposes.
+ *
+ * True variables are hard-coded so you don't need ProgArgs or
+ * ProgEnviron.  The input and output are defined by the module
+ * HackTextIO which is a hacked up version of the normal TextIO.
+ *)
+IMPORT
+    M2PParser,
+    M2PScanner,
+    HackNameLists,
+    HackTextIO;
+
+PROCEDURE Process( 
+    input      : HackTextIO.Object;
+    output     : HackTextIO.Object;
+    variables  : HackNameLists.Object 
+    )          : BOOLEAN;
+
+    VAR
+	result    : BOOLEAN;
+	processedObject: M2PScanner.Object;
+
+    BEGIN (* Process *)
+
+        M2PScanner.Open( processedObject, input, output, 
+			 M2PScanner.stripOff );
+
+	result := M2PParser.Parse( processedObject, variables );
+ 
+	result := M2PScanner.Close( processedObject ) AND result;
+
+	RETURN result;
+
+    END Process;
+
+VAR
+    variables : HackNameLists.Object;
+BEGIN (* hackm2pp *)
+
+    HackNameLists.Create( variables, HackNameLists.forwardSorted,
+		      HackNameLists.caseSensitive );
+    HackNameLists.Insert( variables, "Assert", HackNameLists.DONTCARE );
+    HackNameLists.Insert( variables, "Debug", HackNameLists.DONTCARE );
+    HackNameLists.Insert( variables, "SysTypesCheck", HackNameLists.DONTCARE );
+    HackNameLists.Insert( variables, "SunOS", HackNameLists.DONTCARE );
+    HackNameLists.Insert( variables, "SunM2", HackNameLists.DONTCARE );
+    HackNameLists.Insert( variables, "SunArch", HackNameLists.DONTCARE );
+    HackNameLists.Insert( variables, "BigEndian", HackNameLists.DONTCARE );
+
+    IF NOT Process( HackTextIO.GetInput(), HackTextIO.GetOutput(), variables ) 
+      THEN HALT;
+    END;
+
+END hackm2pp.
diff --git a/examples/Modula-2_Libraries/PMOS/asmtest/innerker.def b/examples/Modula-2_Libraries/PMOS/asmtest/innerker.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/asmtest/innerker.def
@@ -0,0 +1,136 @@
+DEFINITION MODULE InnerKernel;
+
+
+	(****************************************************************)
+	(*								*)
+	(*	THIS IS A SPECIAL VERSION OF INNERKER.DEF, WHICH	*)
+	(*	FORCES PARAMETERS TO BE PASSED ON THE STACK.		*)
+	(*								*)
+	(****************************************************************)
+
+(*# module(implementation=>off,init_code=>off) *)
+(*# call(reg_param=>()) *)
+
+	(****************************************************************)
+	(*								*)
+	(*	This is the nonportable part of the PMOS kernel.	*)
+	(*	It contains procedures whose implementation depends	*)
+	(*	not only on the processor, but also on compiler		*)
+	(*	conventions (which registers are saved, etc.).		*)
+	(*								*)
+	(*	This file is the definition module for the "portable"	*)
+	(*	version based on Wirth-style coroutine operations.	*)
+	(*	The only real difference between this file and the	*)
+	(*	standard PMOS version of InnerKer.DEF is that the	*)
+	(*	compiler pragmas are stripped out of this version.	*)
+	(*								*)
+	(*	Programmer:	P. Moylan				*)
+	(*	Last edited:	16 March 1995				*)
+	(*	Status:		Working					*)
+	(*								*)
+	(****************************************************************)
+
+FROM Types IMPORT
+    (* type *)	FarPointer;
+
+TYPE
+    TaskSelector = FarPointer;
+    FloatSaveSelector = CARDINAL;
+
+(************************************************************************)
+
+PROCEDURE EnterKernel (): CARDINAL;
+
+    (* Saves the processor flags word, including the current "interrupt	*)
+    (* enable" status, and returns with interrupts disabled.		*)
+    (* NOTE: this procedure and the following one should be used as a	*)
+    (* matched pair.							*)
+
+PROCEDURE LeaveKernel (PSW: CARDINAL);
+
+    (* Restores the processor flags word, including the "interrupt	*)
+    (* enable" status.  NOTE: this procedure and the one above should	*)
+    (* be used as a matched pair.					*)
+
+PROCEDURE TaskInit (StackBase: ADDRESS;  StackSize: CARDINAL;
+			EnableInterrupts: BOOLEAN;
+			TaskExit, StartAddress: PROC): TaskSelector;
+
+    (* Initialises the stack for a new task.  Parameter StackBase	*)
+    (* points to a block of memory which can be used to hold the stack	*)
+    (* (note that this is a pointer to the start of the memory block,	*)
+    (* not to the bottom of the stack); and StackSize is the size of	*)
+    (* this block.  The next parameter specifies whether processor	*)
+    (* interrupts should be enabled when the task is started.		*)
+    (* StartAddress and TaskExit are the start address of the task code	*)
+    (* and the start address of the code to execute when the task	*)
+    (* terminates.  The value returned is a selector for the new task.	*)
+
+PROCEDURE InitMainTask (): TaskSelector;
+
+    (* Like TaskInit, but for the special case of the original task	*)
+    (* which is running at program startup.  The function of this	*)
+    (* procedure is simply to ensure that the main stack layout is	*)
+    (* consistent with what we do for all other tasks.			*)
+
+PROCEDURE Transfer (VAR (*OUT*) source: TaskSelector;
+					destination: TaskSelector);
+
+    (* Performs a task switch to the destination task, at the same time	*)
+    (* saving a selector for the outgoing task in variable "source".	*)
+    (* This allows a subsequent call to Transfer to resume the		*)
+    (* original task.  By the time this procedure has returned to the	*)
+    (* caller, then, we are again executing the calling task.		*)
+
+    (* Special case: if this procedure is called by an interrupt task,	*)
+    (* the call is interpreted as a requiring a task switch from the	*)
+    (* interrupted task - i.e. the source parameter must specify the	*)
+    (* interrupted task - to the destination task.  In this case the	*)
+    (* actual switch to the destination task does not happen until the	*)
+    (* interrupt task makes its next call to IOTransfer.  The reason	*)
+    (* for this interpretation is that task switching to and from	*)
+    (* interrupt tasks is managed internally by this module; the	*)
+    (* occurrence of an interrupt is not something that can be		*)
+    (* controlled by the caller.					*)
+
+PROCEDURE IOTransfer;
+
+    (* May be called only from an interrupt task.  Performs a task	*)
+    (* switch from the current interrupt task to the task which it	*)
+    (* interrupted.  Unlike Transfer, no parameters are required	*)
+    (* because (a) the selector for the destination task is already	*)
+    (* known to this module, having been saved at the time of the	*)
+    (* interrupt; and (b) selectors for interrupt tasks are maintained	*)
+    (* directly by this module rather than by the caller.		*)
+
+PROCEDURE StartInterruptTask (TS: TaskSelector; InterruptNumber: CARDINAL);
+
+    (* Starts an interrupt task by running its initialisation section	*)
+    (* - i.e. everything up to the first IOTransfer - and arranging	*)
+    (* that from then on it will be activated by the given interrupt.	*)
+
+PROCEDURE DisconnectFromInterrupt (TS: TaskSelector);
+
+    (* Restores the interrupt vector to which TS was connected to its	*)
+    (* state before TS was established as an interrupt task.  (N.B. The	*)
+    (* result could be chaotic if there was no previous call to		*)
+    (* StartInterruptTask.)						*)
+
+PROCEDURE MakeFloatSaveSelector (selector: TaskSelector): FloatSaveSelector;
+
+    (* Creates the special form of selector which must subsequently be	*)
+    (* used in calls to save and restore the floating point state.	*)
+    (* The parameter supplied must be the value of the task selector	*)
+    (* as created by TaskInit.						*)
+
+PROCEDURE NPXsave (selector: FloatSaveSelector);
+
+    (* Saves the state of the Numeric Processor Extension coprocessor.	*)
+
+PROCEDURE NPXrestore (selector: FloatSaveSelector);
+
+    (* The operation complementary to NewNPXsave.  Restores the		*)
+    (* previously saved state of the floating point coprocessor.	*)
+
+END InnerKernel.
+
diff --git a/examples/Modula-2_Libraries/PMOS/asmtest/playbuff.def b/examples/Modula-2_Libraries/PMOS/asmtest/playbuff.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/asmtest/playbuff.def
@@ -0,0 +1,105 @@
+DEFINITION MODULE PlayBuff;
+
+	(****************************************************************)
+	(*								*)
+	(*	THIS IS A SPECIAL VERSION OF PLAYBUFF.DEF, WHICH	*)
+	(*	FORCES PARAMETERS TO BE PASSED ON THE STACK.		*)
+	(*								*)
+	(****************************************************************)
+
+(*# module(implementation=>off,init_code=>off) *)
+(*# call(reg_param=>()) *)
+
+	(********************************************************)
+	(*							*)
+	(*		Playing buffered sounds			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	28 February 1995		*)
+	(*  Status:		OK				*)
+	(*							*)
+	(*	This module consists mainly of a timer		*)
+	(*	interrupt routine which continuously sends	*)
+	(*	data from a memory buffer to the speaker.	*)
+	(*	Higher-level modules can produce sound by	*)
+	(*	computing the desired waveform and stuffing	*)
+	(*	it into the buffer (using synchronisation	*)
+	(*	calls to ensure that they don't overwrite	*)
+	(*	data that haven't yet been sent to the		*)
+	(*	speaker).					*)
+	(*							*)
+	(*	Note that synchronisation will be lost,		*)
+	(*	resulting in a distorted sound, if the caller	*)
+	(*	is unable to supply data fast enough.		*)
+	(*	Programs using this module are not necessarily	*)
+	(*	portable to slower processors.			*)
+	(*							*)
+	(********************************************************)
+
+(*# module (init_code => off) *)
+
+FROM Types IMPORT
+    (* proc *)	FarPointer;
+
+(************************************************************************)
+(*			THE FORMAT OF THE USER DATA			*)
+(************************************************************************)
+(*									*)
+(* The waveform to be played is specified as an array of bytes, each of	*)
+(* which specifies a desired output level at one sample time.  We're	*)
+(* operating under some very tight time constraints, so to gain speed	*)
+(* the caller writes directly into the memory buffer from which the	*)
+(* timer interrupt routine in this module is taking the values.  It's	*)
+(* a single circular buffer internally, but the caller is expected to	*)
+(* treat it as two half-buffers, each of size OutputBufferSize.  As the	*)
+(* interrupt routine is working on one half, the caller is expected to	*)
+(* fill the other.  The interrupt routine never waits for the caller to	*)
+(* supply data, so it's up to the caller to supply new data as quickly	*)
+(* as possible, using procedures Synch0 and Synch1 to avoid overtaking	*)
+(* the interrupt routine.						*)
+(*									*)
+(************************************************************************)
+
+CONST OutputBufferSize = 128;
+
+    (* OutputBufferSize is the size of a half-buffer.  Do not alter	*)
+    (* this constant unless you are prepared to make consequential	*)
+    (* changes in the implementation module.				*)
+
+PROCEDURE BufferAddress (): FarPointer;
+
+    (* Returns the address of the first half-buffer. *)
+
+PROCEDURE SetCycleCount (count: BYTE);
+
+    (* Sets the cycle count which determines the sampling frequency.	*)
+    (* The default value is 64, giving an 18.643 kHz sampling rate.	*)
+
+PROCEDURE StartPlaying;
+
+    (* Call this just after the first half-buffer has been filled. *)
+
+(*# save, call(near_call=>off, seg_name=>PlayBuff) *)
+
+PROCEDURE Synch0;
+
+    (* Call this when you've just finished filling the second half of	*)
+    (* the buffer and want to move back to the first half.  On return	*)
+    (* from this procedure, the caller is permitted to start filling	*)
+    (* the first half.							*)
+
+PROCEDURE Synch1;
+
+    (* Call this when you've just finished filling the first half of	*)
+    (* the buffer and want to move on to the second half.  On return	*)
+    (* from this procedure, the caller is permitted to start filling	*)
+    (* the second half.							*)
+
+(*# restore *)
+
+PROCEDURE StopPlaying;
+
+    (* Stops the music and cleans up. *)
+
+END PlayBuff.
+
diff --git a/examples/Modula-2_Libraries/PMOS/control/sources/controld.mod b/examples/Modula-2_Libraries/PMOS/control/sources/controld.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/control/sources/controld.mod
@@ -0,0 +1,673 @@
+MODULE ControlDemo;
+
+	(********************************************************)
+	(*							*)
+	(*	   Implementation of a PI controller.		*)
+	(*							*)
+	(*  Programmers:	P.Moylan, R.Middleton, T.Wylie	*)
+	(*  							*)
+	(*	This is PJM's version, rewritten to work        *)
+	(*      with the TopSpeed compiler.                     *)
+	(*							*)
+	(*  Last Edited:	9 March 1995			*)
+	(*  Status:						*)
+	(*	Working, except					*)
+	(*		- the DMA bug still remains a mystery.	*)
+	(*	Seems to have an excessive number of global	*)
+	(*	 variables, may need cleaning up in terms of	*)
+	(*	 data structure design.				*)
+	(*							*)
+	(********************************************************)
+
+FROM Trace IMPORT
+    (* proc*)	NYI, TraceOn;
+
+FROM TransferFunctions IMPORT
+    (* type *)	TransferFunction,
+    (* proc *)	CreateTransferFunction, DestroyTransferFunction,
+		UpdateSamplingInterval, Filter, EditTransferFunction;
+
+FROM TextLines IMPORT
+    (* type *)	LineType,
+    (* proc *)	Box, HLine;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, WriteString, WriteLn, SetCursor,
+		WriteChar, EditAborted;
+
+FROM RealIO IMPORT
+    (* proc *)	WriteReal, EditReal;
+
+FROM ScreenEditor IMPORT
+    (* type *)	Structure,
+    (* proc *)	RealField, Combine, ScreenEdit, DeleteStructure;
+
+FROM Menus IMPORT
+    (* type *)	Menu, ItemText,
+    (* proc *)	CreateMenu, PositionMenu, SelectFromMenu, DestroyMenu;
+
+FROM TaskControl IMPORT
+    (* type *)	Lock,
+    (* proc *)	CreateTask, CreateLock, Obtain, Release;
+
+FROM AnalogueIO IMPORT
+    (* proc *)	StartPeriodicSampling, WaitForNextSample, AnalogueOut,
+		StopPeriodicSampling,AnalogueInput;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM Timer IMPORT
+    (* proc *)	Sleep;
+
+FROM Calculator IMPORT
+    (* proc *)	RunCalculator;
+
+FROM Piano IMPORT
+    (* proc *)	PlayPiano;
+
+FROM Logger IMPORT
+    (* proc *)	StartLogging, Log, StopLogging;
+
+FROM Mouse IMPORT
+    (* proc *)	MouseAvailable;
+
+FROM UserInterface IMPORT
+    (* type *)	UIWindow, Capability, CapabilitySet,
+    (* proc *)	AllowMouseControl;
+
+(************************************************************************)
+
+    (* Set the following constant to FALSE if testing the software	*)
+    (* on a machine lacking the A/D hardware.				*)
+
+CONST RTIpresent = FALSE;
+
+(************************************************************************)
+(*				SHARED DATA				*)
+(************************************************************************)
+
+    (* Because the data used by the control task can be altered by	*)
+    (* user options, a lot of it has to be global to the module.	*)
+    (* Locks are used for critical section protection of all		*)
+    (* global variables except for the Boolean flags and the transfer	*)
+    (* functions.  For the transfer functions, we assume that module	*)
+    (* TransferFunctions looks after its own critical section		*)
+    (* protection.  The Boolean flags are not protected since there	*)
+    (* don't seem to be any dangerous race conditions associated with	*)
+    (* them - although it would be worth having another look to see	*)
+    (* whether this assumption is justified.				*)
+
+VAR
+    (* ShutdownDesired is used to tell the control task to stop, and	*)
+    (* semaphore ShutdownCompleted is used to signal that the shutdown	*)
+    (* operation has been performed.  RestartDesired tells the		*)
+    (* controller to re-initialise itself, with a new sampling interval	*)
+    (* but not a new state.						*)
+
+    ShutdownDesired, RestartDesired: BOOLEAN;
+    ShutdownCompleted: Semaphore;
+
+    FF, FB, C : TransferFunction;
+
+    IOSignals:  RECORD
+		    access: Lock;
+		    Input, Output, SetPoint, Error: REAL;
+    		END (*RECORD*);
+
+    (* We are implementing the controller transfer function (K1 + K2/s)	*)
+    (* with Anti-Integral Windup. IntegralGain and ProportionalGain	*)
+    (* are the continuous time gains we wish to use. KpDiscrete		*)
+    (* and IwDiscrete are the delta operator form discrete proportional	*)
+    (* gain, and integral rate ( rad/sec ) obtained using a bilinear	*)
+    (* approximation of the continuous controller.			*)
+    (*	KpDiscrete = ProportionalGain + IntegralGain * delta * 0.5	*)
+    (*	IwDiscrete = IntegralGain / KpDiscrete				*)
+    (*	KtDiscrete = TachoGain						*)
+    (* where delta is the sampling interval.				*)
+
+    ControllerParameters:
+		    RECORD
+			access: Lock;
+			delta: REAL;	(* seconds *)
+			IntegralGain, ProportionalGain, TachoGain: REAL;
+			KpDiscrete, IwDiscrete, KtDiscrete: REAL;
+		    END;
+
+    (* When LoggingInProgress is TRUE, the raw data from the A/D	*)
+    (* converter are saved in a disk file.				*)
+
+    LoggingInProgress: BOOLEAN;
+
+(************************************************************************)
+(*			    UTILITY ROUTINES				*)
+(************************************************************************)
+
+PROCEDURE VoltToInteger (v: REAL): INTEGER;
+
+    (* This function converts a real number, v, into an integer		*)
+    (* suitable for output to a 12 bit two's complement D/A converter.	*)
+    (* This function is only valid for the factory setting of Bipolar	*)
+    (* (i.e. +/- 10V) output, and 2's complement output data.		*)
+
+    CONST MaxVolts = 9.99;
+
+    VAR negative: BOOLEAN;  absvalue: CARDINAL;
+
+    BEGIN
+	negative := v < 0.0;
+	IF negative THEN v := -v END(*IF*);
+	IF v >= MaxVolts THEN v := MaxVolts; END(*IF*);
+	absvalue := TRUNC (204.8*v + 0.5);
+	IF negative THEN RETURN -INTEGER(absvalue)
+	ELSE RETURN absvalue
+	END (*IF*);
+    END VoltToInteger;
+
+(***********************************************************************)
+
+PROCEDURE IntegerToVolt (c: INTEGER): REAL;
+
+    (* This function converts an integer into a real number		*)
+    (* representing the voltage. This function works correctly only if	*)
+    (* the RTI-815 board is set at the factory settings, i.e., +/-10V	*)
+    (* operation, 2's complement digital output.  Note that, even	*)
+    (* though the A/D converter is a 12-bit converter, it sign-extends	*)
+    (* correctly to give a 16-bit 2's complement number.		*)
+
+    CONST scale = 1.0/204.8;
+
+    BEGIN
+	IF c >= 0 THEN RETURN scale*FLOAT(c);
+	ELSE RETURN -scale*FLOAT(-c);
+	END (* IF *);
+    END IntegerToVolt;
+
+(************************************************************************)
+
+PROCEDURE CalcDiscrete;
+
+    (* Procedure to recompute the discrete time controller gains: 	*)
+    (*		KpDiscrete, IwDiscrete, KtDiscrete			*)
+    (* in the global ( to this module ) record : ControllerParameters.	*)
+    (* This procedure should be called every time the parameters, or	*)
+    (* the sampling rate is changed.  Assumption: execution of this	*)
+    (* procedure has been made indivisible by critical section		*)
+    (* protection applied by the caller.				*)
+
+    BEGIN
+	WITH ControllerParameters DO
+	    KpDiscrete := ProportionalGain + delta * 0.5 * IntegralGain ;
+	    IwDiscrete := IntegralGain / ProportionalGain ;
+	    KtDiscrete := TachoGain;
+	END (* WITH *)
+    END CalcDiscrete ;
+ 
+(************************************************************************)
+(*			   THE MONITORING TASK				*)
+(************************************************************************)
+
+PROCEDURE MonitorTask;
+
+    (* This task displays the plant input and output on the screen.	*)
+    (* We run it at a low priority, so that it will not interfere with	*)
+    (* the controller.							*)
+
+    VAR w: Window;  error, input, output, setpoint: REAL;
+	flipflop,Count: CARDINAL;  dummy: UIWindow;
+
+    BEGIN
+	flipflop := 0;
+	OpenWindow (w, yellow, cyan, 0, 5, 4, 43, simpleframe, nodivider);
+	IF MouseAvailable() THEN
+	    dummy := AllowMouseControl (w, "Monitor plant",
+				CapabilitySet {wshow, wmove, whide});
+	END (*IF*);
+	WriteString (w, "Plant input :");  WriteLn (w);
+	WriteString (w, "Plant output:"); WriteLn (w);
+	WriteString (w, "Set point   :"); WriteLn (w);
+	WriteString (w, "Error       :");
+	REPEAT
+	    WITH IOSignals DO
+		Obtain (access);
+		output := Output;  input := Input;
+		setpoint := SetPoint; error := Error;
+		Release (access);
+	    END (*WITH*);
+	    SetCursor (w, 1, 15);  WriteReal (w, input, 8);
+	    SetCursor (w, 2, 15);  WriteReal (w, output, 8);
+	    SetCursor (w, 3, 15);  WriteReal (w, setpoint, 8);
+	    SetCursor (w, 4, 15);  WriteReal (w, error, 8);
+	    SetCursor (w, 2, 28);
+	    INC ( flipflop );
+	    CASE flipflop OF
+		1 : WriteString ( w, '-  -');
+			|
+		2 : WriteString ( w, '\  /');
+			|
+		3 : WriteString ( w, '|  |');
+			|
+		4 : WriteString ( w, '/  \');
+			flipflop := 0;
+		ELSE WriteString ( w, '***');
+	    END (* CASE flipflop *);
+	    Sleep (100);
+	UNTIL ShutdownDesired;
+	CloseWindow (w);
+	Signal (ShutdownCompleted);
+    END MonitorTask;
+
+(************************************************************************)
+(*			   THE CONTROLLER TASK				*)
+(************************************************************************)
+
+PROCEDURE ControlTask;
+
+    (* This procedure runs as a separate task, and it implements the	*)
+    (* control algorithm.						*)
+
+    CONST MaxInput = 10.0;  MinInput = -10.0;
+
+	(* The above constants define the maximum and minimum input	*)
+	(* used in the anti-integral-windup scheme.			*)
+
+    VAR	PIstate: REAL;  SamplePeriod: LONGCARD;
+	controlvalue: INTEGER;
+ 	Measurement : ARRAY [0..3] OF INTEGER;
+		(* Raw A/D Converter Data goes into Measurement[0..2]	*)
+		(* D/A value copied into Measurement[3], for logging.	*)
+	PlantInput, TachoFB, gain: REAL;
+
+    BEGIN
+	PIstate := 0.0;
+	REPEAT
+	    WITH ControllerParameters DO
+		Obtain (access);
+		CalcDiscrete;
+		SamplePeriod := VAL(LONGCARD,1.0E06*delta);
+		Release (access);
+	    END;
+
+	    (* Insertion for testing *)
+
+	    IF NOT RTIpresent THEN
+		Measurement[0] := 7876;
+		Measurement[1] := -36;
+		Measurement[2] := 30605;
+	    END (*IF*);
+   	    StartPeriodicSampling (0,2,SamplePeriod,0,Measurement);
+	    REPEAT
+
+		(* The following test allows the software to be tested	*)
+		(* in the absence of the RTI A/D hardware.		*)
+
+		IF RTIpresent THEN
+		    WaitForNextSample;
+		ELSE
+		    Sleep (CARDINAL(SamplePeriod DIV 1000));
+		END (*IF*);
+
+		WITH IOSignals DO
+		    Obtain (access);
+		    Output := IntegerToVolt( Measurement[0] );
+		    SetPoint := IntegerToVolt( Measurement[1] );
+		    TachoFB := IntegerToVolt( Measurement[2] );
+
+		    (* Form error signal		    		*)
+		    (*		==> Input to Control Compensator.	*)
+
+		    Error := Filter(FF, SetPoint) - Filter(FB, Output);
+
+		    (* Pass error signal through control	*)
+		    (* compensator and PI controller.		*)
+
+		    WITH ControllerParameters DO
+			Obtain (access);
+			gain := KpDiscrete;
+			Release (access);
+		    END (*WITH*);
+
+		    Input := gain * Filter(C, Error) + PIstate;
+
+		    IF Input > MaxInput THEN Input := MaxInput;
+		    ELSIF Input < MinInput THEN Input := MinInput;
+		    END (* IF *);
+
+		    WITH ControllerParameters DO
+			Obtain (access);
+			PIstate := PIstate + delta*IwDiscrete*(Input-PIstate);
+			PlantInput := Input - KtDiscrete*TachoFB;
+			Release (access);
+		    END (*WITH*);
+
+		    Release (access);
+		END (*WITH*);
+
+		controlvalue := VoltToInteger (PlantInput);
+
+		AnalogueOut (0, controlvalue);
+		Measurement[3] := controlvalue;
+
+		IF LoggingInProgress THEN
+		    Log (Measurement);
+		END (*IF*);
+
+	    UNTIL RestartDesired OR ShutdownDesired;
+
+	    StopPeriodicSampling;
+	    RestartDesired := FALSE;
+
+	UNTIL ShutdownDesired;
+
+	AnalogueOut(0,0);	(* to stop servo *)
+	Signal (ShutdownCompleted);
+
+    END ControlTask;
+
+(************************************************************************)
+(*			    THE USER INTERFACE				*)
+(************************************************************************)
+
+PROCEDURE ChangeSamplingInterval;
+
+    (* Allows the keyboard user to change the analogue sampling interval. *)
+
+    CONST Return = CHR(13);
+
+    VAR w: Window;  dummy: UIWindow;
+	millisecs, newdelta: REAL;
+
+    BEGIN
+	WITH ControllerParameters DO
+	    Obtain (access);
+	    millisecs := 1000.0*delta;
+	    Release (access);
+	END (*WITH*);
+
+	OpenWindow (w, white, magenta, 13, 15, 20, 61, simpleframe, nodivider);
+	IF MouseAvailable() THEN
+	    dummy := AllowMouseControl (w, "Set sampling interval",
+				CapabilitySet {wshow, wmove, wescape});
+	END (*IF*);
+	WriteString (w, "Sampling interval:          milliseconds");
+	SetCursor (w, 1, 20);
+	EditReal (w, millisecs, 8);
+	IF NOT EditAborted() THEN
+	    newdelta := 0.001*millisecs;
+
+	    WITH ControllerParameters DO
+		Obtain (access);
+		delta := newdelta;
+		Release (access);
+	    END (*WITH*);
+
+	    UpdateSamplingInterval (FF, newdelta);
+	    UpdateSamplingInterval (FB, newdelta);
+	    UpdateSamplingInterval (C, newdelta);
+
+	    RestartDesired := TRUE;
+	END (*IF*);
+	CloseWindow (w);
+
+    END ChangeSamplingInterval;
+
+(************************************************************************)
+
+PROCEDURE ChangeControllerGains;
+
+    (* Allows the keyboard user to change the controller gains.		*)
+
+    VAR w: Window;  dummy: UIWindow;  S: Structure;
+	Gain1, Gain2, Gain3: REAL;  abort: BOOLEAN;
+
+    BEGIN
+
+	(* Initial screen display. *)
+
+	OpenWindow (w, white, magenta, 12, 16, 45, 75, simpleframe, nodivider);
+	IF MouseAvailable() THEN
+	    dummy := AllowMouseControl (w, "Set gains",
+				CapabilitySet {wshow, wmove, wescape});
+	END (*IF*);
+	WriteString (w, "Proportional gain :");  WriteLn (w);
+	WriteString (w, "    Integral gain :");  WriteLn (w);
+	WriteString (w, "       Tacho gain :");
+
+	(* Take a copy of the current continuous-time gains.	*)
+
+	WITH ControllerParameters DO
+	    Obtain (access);
+	    Gain1 := ProportionalGain;
+	    Gain2 := IntegralGain;
+	    Gain3 := TachoGain;
+	    Release (access);
+	END (*WITH*);
+
+	(* Create the editing structure used by ScreenEditor.	*)
+
+	WITH ControllerParameters DO
+	    S := RealField (Gain1, 1, 21, 8);
+	    Combine (S, RealField (Gain2, 2, 21, 8));
+	    Combine (S, RealField (Gain3, 3, 21, 8));
+	END (*WITH*);
+
+	(* The actual editing: *)
+
+	ScreenEdit (w, S, abort);
+
+	(* End of user interaction.	*)
+
+	DeleteStructure (S);
+	CloseWindow (w);
+
+	(* Convert the new values to discrete-time form.	*)
+
+	IF NOT abort THEN
+	    WITH ControllerParameters DO
+		Obtain (access);
+		ProportionalGain := Gain1;
+		IntegralGain := Gain2;
+		TachoGain := Gain3;
+		CalcDiscrete;
+		Release (access);
+	    END (*WITH*);
+	END (*IF*);
+
+    END ChangeControllerGains;
+
+(************************************************************************)
+
+PROCEDURE HandleOptions;
+
+    TYPE OptionRange = [0..10];
+
+    VAR M: Menu;  Messages: ARRAY OptionRange OF ItemText;
+	finished: BOOLEAN;
+
+    BEGIN
+	Messages[0] := "     Options";
+	Messages[1] := "Sampling interval";
+	Messages[2] := "PI controller gains";
+	Messages[3] := "Feedforward Compensator";
+	Messages[4] := "Feedback Compensator";
+	Messages[5] := "Control Compensator";
+	Messages[6] := "Calculator";
+	Messages[7] := "Piano";
+	Messages[8] := "Start logging";
+	Messages[9] := "Stop logging";
+	Messages[10] := "Exit";
+	CreateMenu (M, 1, Messages, MAX(OptionRange));
+	PositionMenu (M, 0, 3+MAX(OptionRange), 50, 75);
+	finished := FALSE;
+	REPEAT
+	    CASE SelectFromMenu (M)  OF
+		    0:	finished := TRUE;
+		|
+		    1:	ChangeSamplingInterval;
+		|
+		    2:	ChangeControllerGains;
+		|
+		    3:  EditTransferFunction (FF, "Feedforward Compensator");
+		|
+		    4:  EditTransferFunction (FB, "Feedback Compensator");
+		|
+		    5:  EditTransferFunction (C, "Control Compensator");
+		|
+		    6:	RunCalculator;
+		|
+		    7:	PlayPiano;
+		|
+		    8:	LoggingInProgress := StartLogging();
+		|
+		    9:	LoggingInProgress := FALSE;
+			StopLogging;
+		|
+		   10:	finished := TRUE;
+		|
+		  ELSE
+			NYI ("that option");
+	    END (*CASE*);
+	UNTIL finished;
+	ShutdownDesired := TRUE;
+	DestroyMenu (M);
+    END HandleOptions;
+
+(************************************************************************)
+(*				INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE BlockDiagram (w: Window);
+
+    (* Draws a picture in window w showing the controller configuration. *)
+
+    BEGIN
+	Box (w, 1, 6, 8, 3, single);
+	SetCursor (w, 2, 2);  WriteString(w,"Out");
+	HLine (w, 3, 2, 6, single);
+	SetCursor (w, 2, 8);  WriteString(w,"Feed");
+	SetCursor (w, 3, 8);  WriteString(w,"Back");
+
+	Box (w, 6, 6, 8, 3, single);
+	HLine (w, 7, 2, 6, single);
+	SetCursor (w, 8, 2);  WriteString(w,"Ref");
+	SetCursor (w, 7, 8);  WriteString(w,"Feed");
+	SetCursor (w, 8, 7);  WriteString(w,"Forward");
+
+	Box (w, 1, 19, 8, 8, single);
+	HLine (w, 3, 14, 19, single);
+	HLine (w, 7, 14, 19, single);
+	SetCursor (w, 3, 21);  WriteChar (w, "-");
+	SetCursor (w, 5, 23);  WriteChar (w, "Σ");
+	SetCursor (w, 7, 21);  WriteChar (w, "+");
+
+	Box (w, 3, 32, 8, 3, single);
+	SetCursor (w, 4, 33);  WriteString(w,"Control");
+	SetCursor (w, 5, 34);  WriteString(w,"Comp");
+
+	HLine (w, 4, 27, 32, single);
+
+	Box (w, 3, 45, 7, 3, single);
+	SetCursor (w, 4, 46);  WriteString(w,"  PI  ");
+
+	HLine (w, 4, 40, 45, single);
+	HLine (w, 4, 52, 57, single);
+
+	SetCursor (w, 5, 56);  WriteString(w,"In");
+	SetCursor (w, 9, 30);  WriteString(w,"General Controller Structure");
+
+    END BlockDiagram;
+
+(***********************************************************************)
+
+PROCEDURE RunTheController;
+
+    CONST DefaultDelta = 0.100;	(* seconds *)
+
+    VAR titlewindow, diagram: Window;  dummy: UIWindow;
+
+    BEGIN
+
+	(* Create some initial messages. *)
+
+	OpenWindow (titlewindow, black, white, 7, 12, 0, 46,
+					doubleframe, nodivider);
+	IF MouseAvailable() THEN
+	    dummy := AllowMouseControl (titlewindow, "Title window",
+				CapabilitySet {wshow, wmove, whide});
+	END (*IF*);
+	SetCursor (titlewindow, 1, 14);
+	WriteString (titlewindow, "Control Laboratory");
+	SetCursor (titlewindow, 2, 4);
+	WriteString (titlewindow, "_______________________________________");
+
+	SetCursor (titlewindow, 4, 4);
+	WriteString (titlewindow, "PJM's test version of the PI controller");
+
+	OpenWindow (diagram,white,red,14,24,10,69,doubleframe,nodivider);
+	IF MouseAvailable() THEN
+	    dummy := AllowMouseControl (diagram, "Block diagram",
+				CapabilitySet {wshow, wmove, whide});
+	END (*IF*);
+	BlockDiagram (diagram);
+
+	(* Initialization of global variables. *)
+
+	LoggingInProgress := FALSE;
+	ShutdownDesired := FALSE;  RestartDesired := FALSE;
+	CreateSemaphore (ShutdownCompleted, 0);
+
+	WITH ControllerParameters DO
+	    CreateLock (access);
+	    Obtain (access);
+	    delta := DefaultDelta;
+	    IntegralGain := 0.0;  ProportionalGain := 1.0;
+	    TachoGain := 0.0;
+	    Release (access);
+	END (*WITH*);
+
+	WITH IOSignals DO
+	    CreateLock (access);
+	    Obtain (access);
+	    Output := 0.0;  Input := 0.0;  SetPoint := 0.0;
+	    Release (access);
+	END (*WITH*);
+
+	CreateTransferFunction (FF, DefaultDelta);
+	CreateTransferFunction (FB, DefaultDelta);
+	CreateTransferFunction (C, DefaultDelta);
+
+	(* Start the monitor task.	*)
+
+	CreateTask (MonitorTask, 1, "Control Monitor");
+
+	(* Start the controller running. *)
+
+	CreateTask (ControlTask, 2, "Control demo");
+
+	HandleOptions;
+
+	IF LoggingInProgress THEN
+	    LoggingInProgress := FALSE;  StopLogging;
+	END (*IF*);
+	Wait (ShutdownCompleted);	(* Twice, because we have to	*)
+	Wait (ShutdownCompleted);	(* wait for two tasks to exit.	*)
+
+	DestroyTransferFunction (FF);
+	DestroyTransferFunction (FB);
+	DestroyTransferFunction (C);
+	CloseWindow (diagram);
+	CloseWindow (titlewindow);
+
+    END RunTheController;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    (*TraceOn (19, 24, 40, 79);*)
+    RunTheController;
+END ControlDemo.
+
diff --git a/examples/Modula-2_Libraries/PMOS/control/sources/logger.def b/examples/Modula-2_Libraries/PMOS/control/sources/logger.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/control/sources/logger.def
@@ -0,0 +1,27 @@
+DEFINITION MODULE Logger;
+
+	(********************************************************)
+	(*							*)
+	(*		Data logger for control system		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	6 March 1991			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+
+PROCEDURE StartLogging(): BOOLEAN;
+
+    (* Opens the log file.  Returns FALSE if open failed.		*)
+
+PROCEDURE Log (VAR (*IN*) data: ARRAY OF INTEGER);
+
+    (* Sends the data to the log file (assumed to be already open).	*)
+
+PROCEDURE StopLogging;
+
+    (* Closes the log file, after writing out any pending data.		*)
+
+END Logger.
diff --git a/examples/Modula-2_Libraries/PMOS/control/sources/logger.mod b/examples/Modula-2_Libraries/PMOS/control/sources/logger.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/control/sources/logger.mod
@@ -0,0 +1,547 @@
+IMPLEMENTATION MODULE Logger;
+
+	(********************************************************)
+	(*							*)
+	(*		Logging data to disk file		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	17 August 1994			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+(* Depending on what device you are using for logging, you may need	*)
+(* to import only one of the following two modules.			*)
+
+IMPORT Floppy;
+(*IMPORT HardDisk;*)
+
+FROM Files IMPORT
+    (* type *)	File,
+    (* proc *)	OpenFile, CloseFile, WriteByte;
+
+FROM IOErrorCodes IMPORT
+    (* type *)	ErrorCode,
+    (* proc *)	TranslateErrorCode;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey, PutBack;
+
+FROM MaintenancePages IMPORT
+    (* type *)	MaintenancePage,
+    (* proc *)	CreateMaintenancePage, Associate;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, WriteString, WriteLn, EditString,
+		SetCursor, PressAnyKey, WriteChar;
+
+FROM NumericIO IMPORT
+    (* proc *)	ReadBufferedCardinal, WriteRJCard;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM LossyQueues IMPORT
+    (* type *)	LossyQueue,
+    (* proc *)	CreateQueue, PutQueue, GetQueue;
+
+FROM TaskControl IMPORT
+    (* proc *)	CreateTask;
+
+FROM Timer IMPORT
+    (* proc *)	Sleep;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure;
+
+FROM Mouse IMPORT
+    (* proc *)	MouseAvailable;
+
+FROM UserInterface IMPORT
+    (* type *)	UIWindow, Capability, CapabilitySet,
+    (* proc *)	AllowMouseControl;
+
+(************************************************************************)
+
+CONST testing = TRUE;
+VAR Mpage: MaintenancePage;
+    heading, debug: Window;
+
+CONST
+    ElementCapacity = 4;
+
+TYPE
+
+    (* For a lossy queue element, there are two special cases:	*)
+    (*		count = -1	means open the log file		*)
+    (*		count = 0	means close the log file	*)
+
+    LossyQueueElement = RECORD
+			    count: INTEGER;
+			    datum: ARRAY [0..ElementCapacity-1] OF INTEGER;
+			END (*RECORD*);
+
+VAR
+
+    (* The file to which data are being written.	*)
+
+    log: File;
+
+    (* The name of the log file.	*)
+
+    filename: ARRAY [0..31] OF CHAR;
+
+    (* The queue holding the data to be sent to the output file.	*)
+
+    Lossy: LossyQueue;
+
+    (* A screen window which is displayed while logging is in progress.	*)
+
+    LogWindow: Window;
+
+    (* Semaphore to control access to the log window.	*)
+
+    LogWindowAccess: Semaphore;
+
+    (* Second log window for testing purposes.  *)
+
+    Log2Window: Window;
+
+    (* Semaphore to synchronise file opening.	*)
+
+    FileOpenHandled: Semaphore;
+
+    (* Logging=TRUE while data logging is in progress.  AbortRequested	*)
+    (* can be set to TRUE to request that logging be terminated.	*)
+
+    Logging, AbortRequested: BOOLEAN;
+
+    (* A count of the number of data values yet to be collected.	*)
+
+    LogCount: CARDINAL;
+
+    (* Count of data which could not be sent to disk because the output	*)
+    (* queue overflowed.						*)
+
+    DataLost: CARDINAL;
+
+    (* Count of output errors.  We abort logging if it gets too large.	*)
+
+    ErrorCount: CARDINAL;
+
+    (* Flags involved in shutting down the module.	*)
+
+    ShutDownDesired: BOOLEAN;
+    ShutDownCompleted: Semaphore;
+
+(************************************************************************)
+(*			    ERROR MESSAGE HANDLER			*)
+(************************************************************************)
+
+PROCEDURE ReportError (code: ErrorCode);
+
+    (* Puts out a screen message about the I/O error, stops logging if	*)
+    (* error count gets too large.					*)
+
+    CONST ErrorLimit = 20;
+
+    VAR ErrorWindow: Window;  dummy: UIWindow;
+	messbuffer: ARRAY [0..39] OF CHAR;
+
+    BEGIN
+	OpenWindow (ErrorWindow, white, blue, 14, 17, 22, 58,
+					doubleframe, nodivider);
+	IF MouseAvailable() THEN
+	    dummy := AllowMouseControl (ErrorWindow, "Disk error message",
+				CapabilitySet {wshow, wmove, whide});
+	END (*IF*);
+	WriteString (ErrorWindow, "Disk error ");
+	TranslateErrorCode (code, messbuffer);
+	WriteString (ErrorWindow, messbuffer);
+	INC (ErrorCount);
+	IF ErrorCount > ErrorLimit THEN
+	    WriteLn (ErrorWindow);
+	    WriteString (ErrorWindow, "Too many errors, aborting logging.");
+	    ErrorCount := 0;  AbortRequested := TRUE;
+	END (*IF*);
+	PressAnyKey (ErrorWindow);  CloseWindow (ErrorWindow);
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "Return from ReportError");
+	END (*IF*);
+    END ReportError;
+
+(************************************************************************)
+(*				FILE OUTPUT				*)
+(************************************************************************)
+
+PROCEDURE PutChar (ch: CHAR);
+
+    (* Sends one character to the log file.	*)
+
+    VAR errorcode: ErrorCode;
+
+    BEGIN
+	IF testing THEN
+	    IF ch = CHR(13) THEN
+		WriteLn (Log2Window);
+	    ELSIF ch <> CHR(10) THEN
+		WriteChar (Log2Window, ch);
+	    END (*IF*);
+	END (*IF*);
+	errorcode := WriteByte (log, ch);
+	IF errorcode <> OK THEN
+	    ReportError (errorcode);
+	END (*IF*);
+    END PutChar;
+
+(************************************************************************)
+
+PROCEDURE PutInteger (value: INTEGER);
+
+    (* Converts value to ASCII, sends it to the log file.	*)
+
+    BEGIN
+	IF value < 0 THEN
+	    PutChar ("-");  value := -value;
+	END (*IF*);
+	IF value > 9 THEN
+	    PutInteger (value DIV 10);
+	    value := value MOD 10;
+	END (*IF*);
+	PutChar (CHR(ORD("0")+ORD(value)));
+    END PutInteger;
+
+(************************************************************************)
+(*		     SENDING QUEUED DATA TO THE LOG FILE		*)
+(************************************************************************)
+
+PROCEDURE LogTask;
+
+    (* Takes data from the lossy queue, converts it to ASCII and sends	*)
+    (* it to the log file.  Data received while the log file is closed	*)
+    (* (this is possible, if logging is aborted) are discarded.		*)
+
+    CONST CR = CHR(13);  LF = CHR(10);
+
+    VAR j: CARDINAL;  status: ErrorCode;
+	buffer: LossyQueueElement;
+	LogFileOpen: BOOLEAN;
+	w: Window;  dummy: UIWindow;
+
+    BEGIN
+	IF testing THEN
+	    OpenWindow (Log2Window,white,red,15,24,0,47,simpleframe,nodivider);
+	    Associate (Log2Window, Mpage);
+	    WriteString (Log2Window, "Log2Window opened.");
+	    WriteLn (Log2Window);
+	    OpenWindow (w,white,black, 11,14,0,79,simpleframe,nodivider);
+	    Associate (w, Mpage);
+	    IF MouseAvailable() THEN
+		dummy := AllowMouseControl (Log2Window, "Log task testing #2",
+				CapabilitySet {wshow, wmove, whide});
+		dummy := AllowMouseControl (w, "Log task progress",
+				CapabilitySet {wshow, wmove, whide});
+	    END (*IF*);
+	    WriteString (w, "LogTask started.");  WriteLn (w);
+	END (*IF*);
+	LogFileOpen := FALSE;
+	LOOP	(* until file closed and ShutDownDesired *)
+	    GetQueue (Lossy, buffer);
+	    IF testing THEN
+		WriteLn(w);
+		WriteString(w, "Return from GetQueue.");
+	    END (*IF*);
+	    WITH buffer DO
+		IF (count = -1) THEN
+		    IF testing THEN
+			WriteString(w, ".. count is -1");
+		    END (*IF*);
+		    ErrorCount := 0;
+		    IF NOT LogFileOpen THEN
+			IF testing THEN
+			    WriteLn (w);
+			    WriteString(w, "About to open log file");
+			END (*IF*);
+			status := OpenFile (log, filename, TRUE);
+			IF testing THEN
+			    WriteLn (w);
+			    WriteString(w, "Have opened log file");
+			END (*IF*);
+			IF status = OK THEN
+			    LogFileOpen := TRUE;
+			ELSE
+			    ReportError (status);  AbortRequested := TRUE;
+			END (*IF*);
+		    END (*IF*);
+		    Signal (FileOpenHandled);
+		ELSIF count = 0 THEN
+		    IF testing THEN
+			WriteString(w, ".. count is zero");
+		    END (*IF*);
+		    IF LogFileOpen THEN
+			IF testing THEN
+			    WriteLn(w);
+			    WriteString(w, "Closing log file.");
+			END (*IF*);
+			CloseFile (log);  LogFileOpen := FALSE;
+		    END (*IF*);
+		    IF ShutDownDesired THEN
+			IF testing THEN
+			    WriteLn(w);
+			    WriteString(w, "Stopping LogTask.");
+			END (*IF*);
+			EXIT (*LOOP*);
+		    END (*IF*);
+		ELSIF LogFileOpen THEN
+		    FOR j := 0 TO CARDINAL(count)-1 DO
+			PutInteger (datum[j]);
+			PutChar (" ");
+		    END (*FOR*);
+		    PutChar (CR);  PutChar (LF);
+		ELSE
+		    AbortRequested := TRUE;
+		END (*IF*);
+	    END (*WITH*);
+	END (*LOOP*);
+	IF testing THEN
+	    WriteLn(w);
+	    WriteString(w, "Left LogTask main loop.");
+	END (*IF*);
+	IF testing THEN
+	    WriteLn(w);
+	    WriteString(w, "LogTask is terminating.");
+	    CloseWindow (w);
+	END (*IF*);
+	Signal (ShutDownCompleted);
+    END LogTask;
+
+(************************************************************************)
+
+PROCEDURE PutSpecialBuffer (code: INTEGER);
+
+    (* Queues a command to open or close the log file.  This procedure	*)
+    (* is called only by user tasks and initialisation code.		*)
+
+    VAR buffer: LossyQueueElement;
+
+    BEGIN
+	buffer.count := code;
+	LOOP
+(*
+	    IF testing THEN
+		WriteLn (debug);
+		WriteString (debug, "Putting special buffer element.");
+	    END (*IF*);
+*)
+	    IF PutQueue (Lossy, buffer) THEN
+		EXIT (*LOOP*);
+	    END (*IF*);
+(*
+	    IF testing THEN
+		WriteString (debug, " - Put was unsuccessful.");
+	    END (*IF*);
+*)
+	    Sleep (1);
+	END (*LOOP*);
+(*
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "Leaving procedure PutSpecialBuffer.");
+	END (*IF*);
+*)
+    END PutSpecialBuffer;
+
+(************************************************************************)
+(*			THE USER-CALLABLE PROCEDURES			*)
+(************************************************************************)
+
+PROCEDURE StartLogging(): BOOLEAN;
+
+    (* Opens the log file.  Returns FALSE if open failed.		*)
+
+    CONST Return = CHR(13);
+
+    VAR ch: CHAR;  dummy: UIWindow;
+
+    BEGIN
+	IF Logging THEN
+	    Wait (LogWindowAccess);
+	    SetCursor (LogWindow, 1, 1);
+	    WriteString (LogWindow, "Logging is already in progress.");
+	    Signal (LogWindowAccess);
+	ELSE
+	    AbortRequested := FALSE;
+	    Wait (LogWindowAccess);
+	    OpenWindow (LogWindow,white,red,0,5,0,47,simpleframe,nodivider);
+	    IF MouseAvailable() THEN
+		dummy := AllowMouseControl (LogWindow, "Logger status",
+				CapabilitySet {wshow, wmove, whide});
+	    END (*IF*);
+	    WriteString (LogWindow, "Enter the name of the log file:");
+	    WriteLn (LogWindow);
+	    EditString (LogWindow, filename, HIGH(filename));
+	    ch := InKey();
+	    IF ch <> Return THEN PutBack(ch) END(*IF*);
+	    WriteLn (LogWindow);
+	    Signal (LogWindowAccess);
+	    PutSpecialBuffer (-1);
+	    Wait (FileOpenHandled);
+	    IF AbortRequested THEN
+		LogCount := 0
+	    ELSE
+		Wait (LogWindowAccess);
+		WriteString (LogWindow, "Maximum number of readings to log?");
+		LogCount := ReadBufferedCardinal (LogWindow, 6);
+		Signal (LogWindowAccess);
+		ch := InKey();
+		IF ch <> Return THEN PutBack(ch) END(*IF*);
+	    END (*IF*);
+	    Logging := TRUE;
+	    IF LogCount = 0 THEN
+		StopLogging;
+	    ELSE
+		DataLost := 0;
+		Wait (LogWindowAccess);
+		SetCursor (LogWindow, 4, 1);
+		WriteString (LogWindow, "Data lost:      0");
+		Signal (LogWindowAccess);
+	    END (*IF*);
+	END (*IF*);
+	RETURN Logging;
+    END StartLogging;
+
+(************************************************************************)
+
+PROCEDURE Log (VAR (*IN*) data: ARRAY OF INTEGER);
+
+    (* Sends the data to the log file (assumed to be already open).	*)
+    (* This is done via a lossy queue.					*)
+
+    CONST CR = CHR(13);  LF = CHR(10);
+
+    VAR j: CARDINAL;  success: BOOLEAN;
+	buffer: LossyQueueElement;
+
+    BEGIN
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "Entering procedure Log");
+	END (*IF*);
+	IF AbortRequested THEN
+	    StopLogging;
+	END (*IF*);
+	IF NOT Logging THEN RETURN END (*IF*);
+	WITH buffer DO
+	    count := HIGH(data)+1;
+	    IF count > ElementCapacity THEN
+		count := ElementCapacity;
+	    END (*IF*);
+	    FOR j := 0 TO CARDINAL(count-1) DO
+		datum[j] := data[j];
+	    END (*FOR*);
+	END (*WITH*);
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "Log: calling PutQueue");
+	END (*IF*);
+	success := PutQueue (Lossy, buffer);
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "Log: return from PutQueue");
+	END (*IF*);
+	IF NOT success THEN
+	    INC (DataLost);
+	    Wait (LogWindowAccess);
+	    SetCursor (LogWindow, 4, 12);
+	    WriteRJCard (LogWindow, DataLost, 6);
+	    Signal (LogWindowAccess);
+	    RETURN;
+	END (*IF*);
+	DEC (LogCount);
+	Wait (LogWindowAccess);
+	SetCursor (LogWindow, 3, 35);  WriteRJCard (LogWindow, LogCount, 6);
+	Signal (LogWindowAccess);
+	IF LogCount = 0 THEN
+	    StopLogging;
+	END (*IF*);
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "Leaving procedure Log");
+	END (*IF*);
+    END Log;
+
+(************************************************************************)
+
+PROCEDURE StopLogging;
+
+    (* Closes the log file, after writing out any pending data.		*)
+
+    BEGIN
+	IF Logging THEN
+	    PutSpecialBuffer (0);
+	    Wait (LogWindowAccess);
+	    CloseWindow (LogWindow);
+	    Signal (LogWindowAccess);
+	    Logging := FALSE;  AbortRequested := FALSE;
+	END (*IF*);
+    END StopLogging;
+
+(************************************************************************)
+(*			     PROGRAM CLOSEDOWN				*)
+(************************************************************************)
+
+PROCEDURE CloseDown;
+
+    BEGIN
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "Starting closedown of logger.");
+	END (*IF*);
+	StopLogging;
+	ShutDownDesired := TRUE;
+	PutSpecialBuffer(0);
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "Waiting for logger shutdown to complete.");
+	END (*IF*);
+	Wait (ShutDownCompleted);
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "Logger has shut down.");
+	END (*IF*);
+    END CloseDown;
+
+(************************************************************************)
+(*			   MODULE INITIALISATION			*)
+(************************************************************************)
+
+VAR dummy: UIWindow;
+
+BEGIN
+    IF testing THEN
+	CreateMaintenancePage (Mpage);
+	OpenWindow (heading, black, white, 0,2, 0,79, simpleframe, nodivider);
+	OpenWindow (debug, black, white, 18,23, 0,79, simpleframe, nodivider);
+	Associate (heading, Mpage);
+	Associate (debug, Mpage);
+	IF MouseAvailable() THEN
+	    dummy := AllowMouseControl (debug, "Logger debugging",
+				CapabilitySet {wshow, wmove, whide});
+	END (*IF*);
+	SetCursor (heading, 1, 22);
+	WriteString (heading,"Diagnostic output from Logger module");
+	WriteString (debug, "Logger: initialisation code executing");
+    END (*IF*);
+    Logging := FALSE;  ShutDownDesired := FALSE;  AbortRequested := FALSE;
+    SetTerminationProcedure (CloseDown);
+    CreateSemaphore (FileOpenHandled, 0);
+    CreateSemaphore (ShutDownCompleted, 0);
+    CreateSemaphore (LogWindowAccess, 1);
+    filename := "A:LOG.DAT";
+    CreateQueue (Lossy, 100, SIZE(LossyQueueElement));
+    CreateTask (LogTask, 2, "Log task");
+END Logger.
+
diff --git a/examples/Modula-2_Libraries/PMOS/control/sources/transfer.def b/examples/Modula-2_Libraries/PMOS/control/sources/transfer.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/control/sources/transfer.def
@@ -0,0 +1,42 @@
+DEFINITION MODULE TransferFunctions;
+
+	(********************************************************)
+	(*							*)
+	(*	     Second order transfer functions		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	24 February 1991		*)
+	(*  Status:		Mostly working, still testing	*)
+	(*							*)
+	(********************************************************)
+
+TYPE TransferFunction;	(* is private *)
+
+(************************************************************************)
+
+PROCEDURE CreateTransferFunction (VAR (*OUT*) G: TransferFunction;
+					SamplingInterval: REAL);
+
+    (* Creates a new transfer function, with value initially set to unity. *)
+
+PROCEDURE DestroyTransferFunction (VAR (*INOUT*) G: TransferFunction);
+
+    (* Discards a transfer function. *)
+
+PROCEDURE UpdateSamplingInterval (VAR (*INOUT*) G: TransferFunction;
+					SamplingInterval: REAL);
+
+    (* Recomputes the internal details of the transfer function to	*)
+    (* allow for a change in sampling interval.				*)
+
+PROCEDURE Filter (VAR (*INOUT*) G: TransferFunction;  input: REAL): REAL;
+
+    (* Computes the output from G with the given input.  Remark: G is	*)
+    (* an inout parameter because its internal state is affected.	*)
+
+PROCEDURE EditTransferFunction (VAR (*INOUT*) G: TransferFunction;
+						caption: ARRAY OF CHAR);
+
+    (* Allows the keyboard user to alter a transfer function.	*)
+
+END TransferFunctions.
diff --git a/examples/Modula-2_Libraries/PMOS/control/sources/transfer.mod b/examples/Modula-2_Libraries/PMOS/control/sources/transfer.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/control/sources/transfer.mod
@@ -0,0 +1,332 @@
+IMPLEMENTATION MODULE TransferFunctions;
+
+	(********************************************************)
+	(*							*)
+	(*		Second order transfer functions		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 February 1995		*)
+	(*  Status:		Working on screen editing	*)
+	(*							*)
+	(********************************************************)
+
+FROM Trace IMPORT
+    (* proc *)	NYI, Pause, InTrace, OutTrace;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, WriteChar, WriteString,
+		SetCursor, SaveCursor, CursorUp, CursorDown;
+
+FROM RealIO IMPORT
+    (* proc *)	WriteReal;
+
+FROM Menus IMPORT
+    (* type *)	Menu, ItemText,
+    (* proc *)	CreateMenu, PositionMenu, DestroyMenu, SelectFromMenu;
+
+FROM ScreenEditor IMPORT
+    (* type *)	Structure,
+    (* proc *)	MenuField, RealField, Combine, ScreenEdit, DeleteStructure;
+
+FROM TaskControl IMPORT
+    (* type *)	Lock,
+    (* proc *)	CreateLock, DestroyLock, Obtain, Release;
+
+(************************************************************************)
+
+TYPE
+    power = [0..2];
+
+    (* We represent a second order polynomial by its coefficients, in	*)
+    (* ascending power order.						*)
+
+    Poly = ARRAY power OF REAL;
+
+    (* A rational function is the ratio of two polynomials.	*)
+
+    Rational =	RECORD
+		    numerator, denominator: Poly
+		END (*RECORD*);
+
+    (* A transfer function has a state, and we represent it by two	*)
+    (* rational functions: a Laplace function form (SForm) and a Delta	*)
+    (* form (DForm).  This is redundant, since SForm and DForm are	*)
+    (* related by a bilinear transformation, but it tends to speed up	*)
+    (* the computations to have both forms available at all times.	*)
+    (* Remark: State[2] is a dummy which is never used.			*)
+
+    TransferFunction = POINTER TO
+			RECORD
+			    access: Lock;
+			    delta: REAL;
+			    State: Poly;
+			    SForm, DForm: Rational;
+			END (*RECORD*);
+
+(************************************************************************)
+(*			OPERATIONS ON POLYNOMIALS			*)
+(************************************************************************)
+
+PROCEDURE Fill (VAR (*OUT*) p: Poly;  value: REAL);
+
+    (* Fills all coefficients to the same given value. *)
+
+    VAR j: power;
+
+    BEGIN
+	FOR j := MIN(power) TO MAX(power) DO
+	    p[j] := value;
+	END (*FOR*);
+    END Fill;
+
+(************************************************************************)
+
+PROCEDURE StoDelta (P: Poly;  interval: REAL): Poly;
+
+    (* Converts an s-form polynomial to delta form. *)
+
+    VAR result: Poly;
+
+    BEGIN
+	InTrace ("StoDelta");
+	result[0] := P[0];
+	result[1] := P[1] + 2.0*interval*P[0];
+	result[2] := P[2] + interval * (P[1] + interval*P[0]);
+	OutTrace ("StoDelta");
+	RETURN result;
+    END StoDelta;
+
+(************************************************************************)
+
+PROCEDURE DisplayPoly (w: Window;  P: Poly);
+
+    (* Writes a polynomial to the screen, starting at the current	*)
+    (* screen location.							*)
+
+    BEGIN
+	InTrace ("DisplayPoly");
+	WriteReal (w, P[0], 6);  WriteString (w, " +   ");
+	WriteReal (w, P[1], 6);  WriteString (w, " s + ");
+	WriteReal (w, P[2], 6);  WriteString (w, " s");
+	CursorUp (w);  WriteChar (w, "2");
+	OutTrace ("DisplayPoly");
+    END DisplayPoly;
+
+(************************************************************************)
+(*		     OPERATIONS ON RATIONAL FUNCTIONS			*)
+(************************************************************************)
+
+PROCEDURE DisplayRational (w: Window;  R: Rational);
+
+    (* Writes a transfer function to the screen, starting at the	*)
+    (* current screen location.						*)
+
+    VAR row, col: CARDINAL;
+
+    BEGIN
+	InTrace ("DisplayRational");
+	SaveCursor (w, row, col);
+	DisplayPoly (w, R.numerator);
+	SetCursor (w, row+1, col);
+	WriteString (w, "_______________________________");
+	SetCursor (w, row+3, col);
+	DisplayPoly (w, R.denominator);
+	OutTrace ("DisplayRational");
+    END DisplayRational;
+
+(************************************************************************)
+
+PROCEDURE DiscreteVersion (SForm: Rational;  delta: REAL): Rational;
+
+    (* Computes the delta-transform equivalent of an s-domain function.	*)
+
+    VAR result: Rational;
+
+    BEGIN
+	InTrace ("DiscreteVersion");
+	result.numerator := StoDelta (SForm.numerator, delta);
+	result.denominator := StoDelta (SForm.denominator, delta);
+	OutTrace ("DiscreteVersion");
+	RETURN result;
+    END DiscreteVersion;
+
+(************************************************************************)
+
+PROCEDURE SetToUnity (VAR (*INOUT*) TF: Rational);
+
+    (* Sets the value of TF to unity. *)
+
+    BEGIN
+	WITH TF DO
+	    Fill (numerator, 1.0);
+	    denominator := numerator;
+	END (*WITH*);
+    END SetToUnity;
+
+(************************************************************************)
+(*		     OPERATIONS ON TRANSFER FUNCTIONS			*)
+(************************************************************************)
+
+PROCEDURE CreateTransferFunction (VAR (*OUT*) G: TransferFunction;
+					SamplingInterval: REAL);
+
+    (* Creates a new transfer function, with value initially set to unity. *)
+
+    BEGIN
+	NEW (G);
+	WITH G^ DO
+	    CreateLock (access);
+	    delta := SamplingInterval;
+	    Fill (State, 0.0);
+	    SetToUnity (SForm);
+	    SetToUnity (DForm);
+	END (*WITH*);
+    END CreateTransferFunction;
+
+(************************************************************************)
+
+PROCEDURE DestroyTransferFunction (VAR (*INOUT*) G: TransferFunction);
+
+    (* Discards a transfer function. *)
+
+    BEGIN
+	Obtain (G^.access);  DestroyLock (G^.access);
+	DISPOSE (G);
+    END DestroyTransferFunction;
+
+(************************************************************************)
+
+PROCEDURE UpdateSamplingInterval (VAR (*INOUT*) G: TransferFunction;
+					SamplingInterval: REAL);
+
+    (* Recomputes the internal details of the transfer function to	*)
+    (* allow for a change in sampling interval.				*)
+
+    BEGIN
+	WITH G^ DO
+	    Obtain (access);
+	    delta := SamplingInterval;
+	    DForm := DiscreteVersion (SForm, delta);
+	    Release (access);
+	END (*WITH*);
+    END UpdateSamplingInterval;
+
+(************************************************************************)
+
+PROCEDURE Filter (VAR (*INOUT*) G: TransferFunction;  input: REAL): REAL;
+
+    (* Computes the output from G with the given input.  Remark: G is	*)
+    (* an inout parameter because its internal state is affected.	*)
+
+    VAR temp, result: REAL;
+
+    BEGIN
+	WITH G^ DO
+	    Obtain (access);
+	    WITH DForm DO
+		temp := State[0] + delta * (input - denominator[1]*State[0]
+						- denominator[0]*State[1]);
+		State[1] := State[1] + delta*State[0];
+		State[0] := temp;
+		result :=
+		    (numerator[1] - denominator[1]*numerator[2]) * State[0]
+		    + (numerator[0] - denominator[0]*numerator[2]) * State[1]
+		    + numerator[2]*input;
+	    END (*WITH*);
+	    Release (access);
+	END (*WITH*);
+	RETURN result;
+    END Filter;
+
+(************************************************************************)
+
+PROCEDURE EditTransferFunction (VAR (*INOUT*) G: TransferFunction;
+						caption: ARRAY OF CHAR);
+
+    (* Allows the keyboard user to alter a transfer function.	*)
+
+    TYPE optionrange = [0..4];
+
+    VAR TF, oldTF: Rational;  w: Window;
+	j: power;
+	S: Structure;  M: Menu;
+	Messages: ARRAY optionrange OF ItemText;
+	option: CARDINAL;  abort: BOOLEAN;
+
+    BEGIN
+	InTrace ("EditTransferFunction");
+
+	OpenWindow (w, white, magenta, 14, 24, 10, 69, simpleframe, nodivider);
+	WriteString (w, caption);
+
+	Messages[0] := "Transfer function";
+	Messages[1] := "Accept";
+	Messages[2] := "Set to unity";
+	Messages[3] := "Cancel changes";
+	Messages[4] := "Edit";
+	CreateMenu (M, 1, Messages, MAX(optionrange));
+	PositionMenu (M, 2, 5+MAX(optionrange), 50, 75);
+
+	(* Note that all the editing is done on a copy, with the actual	*)
+	(* transfer function updated only after the user is satisfied	*)
+	(* with the changes.						*)
+
+	WITH G^ DO
+	    Obtain (access);  TF := SForm;  Release (access);
+	END (*WITH*);
+
+	(* Create the editing structure used by ScreenEditor.	*)
+
+	WITH TF DO
+	    S := RealField (numerator[0], 4, 2, 6);
+	    Combine (S, RealField (denominator[0], 7, 2, 6));
+	    FOR j := 1 TO 2 DO
+		Combine (S, RealField (numerator[j], 4, 2+11*j, 6));
+		Combine (S, RealField (denominator[j], 7, 2+11*j, 6));
+	    END (*FOR*);
+	END (*WITH*);
+
+	REPEAT
+	    SetCursor (w, 4, 2);
+	    DisplayRational (w, TF);
+	    option := SelectFromMenu (M);
+
+	    IF option = 2 THEN		(* Set to unity *)
+		SetToUnity (TF);
+	    ELSIF option = 3 THEN	(* Cancel changes *)
+		WITH G^ DO
+		    Obtain (access);  TF := SForm;  Release (access);
+		END (*WITH*);
+	    ELSIF option = 4 THEN	(* Edit *)
+		oldTF := TF;
+		ScreenEdit (w, S, abort);
+		IF abort THEN
+		    TF := oldTF;
+		END (*IF*);
+	    END (*IF*);
+
+
+	UNTIL option < 2;
+
+	IF option = 1 THEN		(* Accept *)
+	    WITH G^ DO
+		Obtain (access);
+		SForm := TF;
+		DForm := DiscreteVersion (TF, delta);
+		Release (access);
+	    END (*WITH*);
+	END (*IF*);
+
+	DestroyMenu (M);  DeleteStructure (S);
+	CloseWindow (w);
+	OutTrace ("EditTransferFunction");
+    END EditTransferFunction;
+
+(************************************************************************)
+
+END TransferFunctions.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/calculat.def b/examples/Modula-2_Libraries/PMOS/def/calculat.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/calculat.def
@@ -0,0 +1,21 @@
+DEFINITION MODULE Calculator;
+
+        (****************************************************************)
+        (*                                                              *)
+        (*                      Simple calculator                       *)
+        (*                                                              *)
+        (*  Programmer:         P. Moylan                               *)
+        (*  Last edited:        1 September 1993                        *)
+        (*  Status:             OK                                      *)
+        (*                                                              *)
+        (****************************************************************)
+
+PROCEDURE RunCalculator;
+
+    (* Displays a calculator window on the screen; this can be operated *)
+    (* from the numeric keypad.  On exit, the calculator window is      *)
+    (* closed.  However, calculation results are saved between          *)
+    (* invocations of this procedure.                                   *)
+
+END Calculator.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/circular.def b/examples/Modula-2_Libraries/PMOS/def/circular.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/circular.def
@@ -0,0 +1,49 @@
+DEFINITION MODULE CircularBuffers;
+
+        (****************************************************************)
+        (*                                                              *)
+        (*      Circular Buffer for passing character data              *)
+        (*              between a pair of tasks.                        *)
+        (*                                                              *)
+        (*      Author:         P. Moylan                               *)
+        (*      Last edited:    1 March 1998                            *)
+        (*                                                              *)
+        (*      Status:         OK.                                     *)
+        (*                                                              *)
+        (****************************************************************)
+
+TYPE CircularBuffer;    (* is private *)
+
+PROCEDURE CreateBuffer (VAR (*OUT*) B: CircularBuffer;  size: CARDINAL);
+
+    (* Allocates space for a circular buffer, and initializes it.  The  *)
+    (* caller specifies how many characters the buffer will hold.       *)
+
+PROCEDURE PutBuffer (B: CircularBuffer; item: CHAR);
+
+    (* Waits for space available, then puts item at the tail of the queue. *)
+
+PROCEDURE PutBufferImpatient (B: CircularBuffer;  item: CHAR;
+                                                TimeLimit: CARDINAL);
+
+    (* Like PutBuffer, but waits no longer than TimeLimit milliseconds  *)
+    (* for a buffer slot to become available.  If the time limit        *)
+    (* expires, the oldest item in the buffer is overwritten by the     *)
+    (* new data.                                                        *)
+
+PROCEDURE InsertAtFront (B: CircularBuffer;  item: CHAR);
+
+    (* Inserts an item at the head of the queue, rather than at the     *)
+    (* tail as usual.  If the buffer is full, the most recently added   *)
+    (* item is lost.                                                    *)
+
+PROCEDURE GetBuffer (B: CircularBuffer) : CHAR;
+
+    (* Takes one character from the head of the queue, waiting if necessary. *)
+
+PROCEDURE BufferEmpty (B: CircularBuffer): BOOLEAN;
+
+    (* Returns TRUE iff the buffer is empty. *)
+
+END CircularBuffers.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/configur.def b/examples/Modula-2_Libraries/PMOS/def/configur.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/configur.def
@@ -0,0 +1,59 @@
+DEFINITION MODULE ConfigurationOptions;
+
+        (********************************************************)
+        (*                                                      *)
+        (*      The function of this file is to collect         *)
+        (*      together some key configuration settings        *)
+        (*      which govern things like which PMOS             *)
+        (*      features are to be disabled.                    *)
+        (*                                                      *)
+        (*  Programmer:         P. Moylan                       *)
+        (*  Last edited:        17 August 1994                  *)
+        (*  Status:             OK                              *)
+        (*                                                      *)
+        (*      Remark: I'm gradually moving things out of      *)
+        (*      this module, and I might well decide to         *)
+        (*      eliminate this module entirely in a future      *)
+        (*      version of PMOS.                                *)
+        (*                                                      *)
+        (********************************************************)
+
+(************************************************************************)
+(*                      KERNEL SETTINGS                                 *)
+(************************************************************************)
+
+CONST
+    (* The following Boolean constant defines whether the PMOS kernel   *)
+    (* will permit round-robin time-slicing among tasks of equal        *)
+    (* priority.  For hard real-time applications this should typically *)
+    (* be set to FALSE, since time-slicing interferes with the          *)
+    (* predictability of execution times.  Disabling time-slicing also  *)
+    (* reduces kernel overheads because of the following special        *)
+    (* property: with time-slicing disallowed, the only tasks which     *)
+    (* participate in task switches and in priority inheritance         *)
+    (* calculations are those at the head of each ready queue.  (The    *)
+    (* key theoretical result is that there is at most one "active"     *)
+    (* task per priority level.)  With time-slicing enabled, any ready  *)
+    (* task could be an active task.                                    *)
+    (* For applications where keyboard/screen interaction is the        *)
+    (* dominant factor, setting TimeSlicingEnabled TRUE sometimes gives *)
+    (* a better illusion that multiple tasks are running in parallel.   *)
+
+    TimeSlicingEnabled = FALSE;
+
+    (* The next two constants define the maximum number of concurrent   *)
+    (* tasks which are permitted, and the stack size for each task.     *)
+
+    MaxTaskNumber = 31;
+    StackSize = 2048;
+
+(************************************************************************)
+(*                              MOUSE                                   *)
+(************************************************************************)
+
+    (* The mouse options are no longer specified in this module.        *)
+    (* Instead, they are specified in the PP.CFG file which is used     *)
+    (* in the PMOS installation operation.                              *)
+
+END ConfigurationOptions.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/conversi.def b/examples/Modula-2_Libraries/PMOS/def/conversi.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/conversi.def
@@ -0,0 +1,102 @@
+DEFINITION MODULE Conversions;
+
+        (********************************************************)
+        (*                                                      *)
+        (*              Miscellaneous type conversions          *)
+        (*                                                      *)
+        (*  Programmer:         P. Moylan                       *)
+        (*  Last edited:        17 March 2003                   *)
+        (*  Status:             Working                         *)
+        (*                                                      *)
+        (********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)  CARD8, CARD32;
+
+FROM Types IMPORT
+    (* type *)  CARD64;
+
+TYPE HexDigit = [0..15];
+     EightChar = ARRAY [0..7] OF CHAR;
+
+PROCEDURE atoi (a: LONGREAL;  i: CARDINAL): LONGREAL;
+
+    (* Calculates a**i.  This procedure does not really belong in this  *)
+    (* module, but it's missing from MATHLIB and there's no more        *)
+    (* logical place to put it.                                         *)
+
+PROCEDURE StringToHex (string: ARRAY OF CHAR): CARDINAL;
+PROCEDURE StringToCardinal (string: ARRAY OF CHAR): CARDINAL;
+PROCEDURE StringToLongCard (string: ARRAY OF CHAR): CARD32;
+PROCEDURE StringToReal (string: ARRAY OF CHAR): REAL;
+PROCEDURE StringToLongReal (string: ARRAY OF CHAR): LONGREAL;
+
+    (* Converts a text string to numeric.  Leading blanks are ignored.  *)
+    (* The conversion stops at the end of the array or at the first     *)
+    (* character which cannot be part of the number, and in the         *)
+    (* latter case all subsequent characters are ignored.               *)
+
+PROCEDURE HexToChar (number: HexDigit): CHAR;
+
+    (* Converts a one-digit hexadecimal number to its readable form.    *)
+
+PROCEDURE HexByteToString (value: CARD8;
+                        VAR (*OUT*) buffer: ARRAY OF CHAR;  pos: CARDINAL);
+
+    (* Converts a byte value to 2-character hexadecimal, with the       *)
+    (* result stored at buffer[pos] and buffer[pos+1].                  *)
+
+PROCEDURE HexToString (value: CARDINAL;  VAR (*OUT*) buffer: ARRAY OF CHAR);
+PROCEDURE LongHexToString (value: CARD32;  VAR (*OUT*) buffer: EightChar);
+
+    (* Converts 'value' to a string in hexadecimal notation.    *)
+
+PROCEDURE ShortCardToString (number: CARD8;
+                                        VAR (*OUT*) buffer: ARRAY OF CHAR;
+                                        fieldsize: CARDINAL);
+PROCEDURE CardinalToString (number: CARDINAL;
+                                        VAR (*OUT*) buffer: ARRAY OF CHAR;
+                                        fieldsize: CARDINAL);
+PROCEDURE LongCardToString (number: CARD32;
+                                        VAR (*OUT*) buffer: ARRAY OF CHAR;
+                                        fieldsize: CARDINAL);
+PROCEDURE Card64ToString (number: CARD64;
+                                        VAR (*OUT*) buffer: ARRAY OF CHAR;
+                                        fieldsize: CARDINAL);
+PROCEDURE RealToString (number: REAL;  VAR (*OUT*) buffer: ARRAY OF CHAR;
+                                        fieldsize: CARDINAL);
+PROCEDURE LongRealToString (number: LONGREAL;
+                                        VAR (*OUT*) buffer: ARRAY OF CHAR;
+                                        fieldsize: CARDINAL);
+
+    (* Converts the number to a decimal character string in array       *)
+    (* "buffer", right-justified in a field of fieldsize characters.    *)
+    (* In the case of reals the format depends on the size of the       *)
+    (* number relative to the size of the buffer.                       *)
+
+PROCEDURE CardinalToStringLJ (number: CARDINAL;
+                                      VAR (*OUT*) buffer: ARRAY OF CHAR);
+PROCEDURE Card64ToStringLJ (number: CARD64;
+                                      VAR (*OUT*) buffer: ARRAY OF CHAR);
+
+    (* Converts the number to a decimal character string in array       *)
+    (* "buffer", left justified.                                        *)
+
+PROCEDURE RealToF (number: REAL;  VAR (*INOUT*) fieldsize: CARDINAL;
+                        decimalplaces: CARDINAL;  LeftJustified: BOOLEAN;
+                        VAR (*OUT*) buffer: ARRAY OF CHAR);
+PROCEDURE LongRealToF (number: LONGREAL;  VAR (*INOUT*) fieldsize: CARDINAL;
+                        decimalplaces: CARDINAL;  LeftJustified: BOOLEAN;
+                        VAR (*OUT*) buffer: ARRAY OF CHAR);
+
+    (* Converts the number to an F-format string, of up to fieldsize    *)
+    (* characters with decimalplaces digits after the decimal point.    *)
+    (* The result is left justified if LeftJustified = TRUE is          *)
+    (* specified by the caller, and right justified with space fill     *)
+    (* otherwise.  On return fieldsize gives the number of character    *)
+    (* positions actually used.  The result string is terminated with   *)
+    (* at least one CHR(0) (which is not counted in fieldsize), except  *)
+    (* where the result fills the entire buffer.                        *)
+
+END Conversions.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/dumpfile.def b/examples/Modula-2_Libraries/PMOS/def/dumpfile.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/dumpfile.def
@@ -0,0 +1,36 @@
+DEFINITION MODULE DumpFile;
+
+        (****************************************************************)
+        (*                                                              *)
+        (*   Debugging aid: writes data out to a file DUMP.$$$          *)
+        (*                                                              *)
+        (*      Programmer:     P. Moylan                               *)
+        (*      Last edited:    16 October 1996                         *)
+        (*      Status:         OK                                      *)
+        (*                                                              *)
+        (****************************************************************)
+
+IMPORT SYSTEM;
+
+PROCEDURE Dump (data: ARRAY OF SYSTEM.LOC);
+
+    (* Writes the data to the dump file. *)
+
+PROCEDURE DumpString (message: ARRAY OF CHAR);
+
+    (* Writes a character string. *)
+
+PROCEDURE DumpCard (value: CARDINAL);
+
+    (* Converts the number to a text string and writes it to the dump file. *)
+
+PROCEDURE DumpHex (value: ARRAY OF SYSTEM.LOC);
+
+    (* Converts the value to a hexadecimal text string and writes it to the dump file. *)
+
+PROCEDURE DumpEOL;
+
+    (* Writes an "end of line" to the dump file. *)
+
+END DumpFile.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/fieldedi.def b/examples/Modula-2_Libraries/PMOS/def/fieldedi.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/fieldedi.def
@@ -0,0 +1,133 @@
+DEFINITION MODULE FieldEditor;
+
+        (********************************************************)
+        (*                                                      *)
+        (*              Screen editing utilities                *)
+        (*                                                      *)
+        (*  Programmer:         P. Moylan                       *)
+        (*  Last edited:        13 May 1998                     *)
+        (*  Status:             OK                              *)
+        (*                                                      *)
+        (********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)  ADDRESS;
+
+FROM Windows IMPORT
+    (* type *)  Window;
+
+(************************************************************************)
+(*                                                                      *)
+(*  The editor in this module is "generic" in a limited sense.  It      *)
+(*  performs screen editing of variables of arbitrary types, provided   *)
+(*  that those types have been declared by calls to DefineFieldType.    *)
+(*                                                                      *)
+(*  The caller is required, when calling DefineFieldType, to supply     *)
+(*  procedures which write and edit variables of that type.  The        *)
+(*  "write" procedures has three parameters: a window, a pointer to the *)
+(*  variable to be written or edited, and the number of character       *)
+(*  positions to use.  The "edit" procedure is similar but has an       *)
+(*  extra parameter: the third parameter is for the size of the         *)
+(*  variable itself, and the fourth parameter is for the number of      *)
+(*  character positions to use on the screen.  For field types where    *)
+(*  the number of character positions cannot be determined in advance,  *)
+(*  the caller is expected to supply 0 as the value of the third        *)
+(*  parameter, and the user-supplied procedures are expected to be able *)
+(*  to work out the actual width required.  The user-supplied           *)
+(*  procedures are expected, in all cases, to leave the screen cursor   *)
+(*  at the character position just beyond the written form of the       *)
+(*  field.  They must be prepared to deal with NIL addresses.  The      *)
+(*  user-supplied editor must handle all keystrokes which belong to it, *)
+(*  but leave intact (via Keyboard.Putback, for example) the keystroke  *)
+(*  which causes it to return.  Note that it will be very common for    *)
+(*  the editor to receive a cursor movement key implying that the user  *)
+(*  does not want to modify this field but is simply skipping over it.  *)
+(*  In such cases the editor still has the responsibility for showing   *)
+(*  the user where the cursor is, by using blinking, reverse video, etc.*)
+(*                                                                      *)
+(*  Given all of these rules, and the fact that all the hard work is to *)
+(*  be done by user-supplied procedures, you might by now be wondering  *)
+(*  whether there is any point in having this module.  The main point   *)
+(*  is that the rules impose some uniform standards which make it       *)
+(*  easier to develop readable software for applications which need a   *)
+(*  lot of screen editing.  They also help, in some applications, to    *)
+(*  avoid duplication of effort.  These properties are used to          *)
+(*  advantage in modules ListEditor and ScreenEditor.                   *)
+(*                                                                      *)
+(*  As an added bonus, this module exports some pre-defined field types *)
+(*  for commonly encountered cases.  For those cases, the user does not *)
+(*  need to call DefineFieldType, and therefore does not need to supply *)
+(*  the procedures for writing and editing variables of those types.    *)
+(*                                                                      *)
+(************************************************************************)
+
+TYPE
+    FieldType;          (* is private *)
+    WriteProc = PROCEDURE (Window, ADDRESS, CARDINAL);
+    EditProc = PROCEDURE (Window, VAR (*INOUT*) ADDRESS, CARDINAL, CARDINAL);
+
+(************************************************************************)
+(*                      THE PREDEFINED TYPES                            *)
+(************************************************************************)
+
+VAR Byte, Cardinal, Real, String: FieldType;
+
+(************************************************************************)
+(*                      DEFINING A NEW TYPE                             *)
+(************************************************************************)
+
+PROCEDURE DefineFieldType (Writer: WriteProc;  Editor: EditProc): FieldType;
+
+    (* Introduces a new field type into the system.  Writer is a        *)
+    (* user-supplied procedure to write a variable of the new type.     *)
+    (* Editor is the user-supplied procedure for editing a variable of  *)
+    (* that type.                                                       *)
+
+PROCEDURE DiscardFieldType (type: FieldType);
+
+    (* A notification from the user that this type will not be used     *)
+    (* again (unless it is redefined by another call to procedure       *)
+    (* DefineFieldType).  Use of this procedure is optional, but is     *)
+    (* recommended for the sake of "clean" memory management.           *)
+
+(************************************************************************)
+(*                         COMPARING TYPES                              *)
+(************************************************************************)
+
+PROCEDURE SameType (t1, t2: FieldType): BOOLEAN;
+
+    (* Returns TRUE iff t1 = t2.        *)
+
+(************************************************************************)
+(*                          SCREEN OUTPUT                               *)
+(************************************************************************)
+
+PROCEDURE WriteField (w: Window;  address: ADDRESS;  type: FieldType;
+                                                        width: CARDINAL);
+
+    (* Writes address^ on the screen at the current cursor position in  *)
+    (* window w.  The width parameter specifies how many character      *)
+    (* positions to use.  Use width=0 for variable-width fields for     *)
+    (* which the write procedure for that type must work out the width. *)
+
+(************************************************************************)
+(*                           THE EDITOR                                 *)
+(************************************************************************)
+
+PROCEDURE EditField (w: Window;  VAR (*INOUT*) address: ADDRESS;
+                              type: FieldType;  varsize, width: CARDINAL);
+
+    (* Edits the variable at the given address, and of the given type,  *)
+    (* at the current cursor position in window w.  The width parameter *)
+    (* specifies how many character positions are to be used on the     *)
+    (* screen.  Set width=0 for variable-width fields where the editor  *)
+    (* must determine the width.  We leave this procedure on seeing a   *)
+    (* keyboard character which does not belong to us.  The cursor is   *)
+    (* left just beyond the last character of the field as it is        *)
+    (* displayed.  The terminating keystroke is returned to the         *)
+    (* keyboard driver so that it can still be read by the caller.      *)
+    (* Note that the address is an inout parameter because there are    *)
+    (* cases where we allow the user to create and delete fields, i.e.  *)
+    (* address could be NIL on entry but not on exit, or vice versa.    *)
+
+END FieldEditor.
diff --git a/examples/Modula-2_Libraries/PMOS/def/files.def b/examples/Modula-2_Libraries/PMOS/def/files.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/files.def
@@ -0,0 +1,82 @@
+DEFINITION MODULE Files;
+
+        (****************************************************************)
+        (*                                                              *)
+        (*                      File operations                         *)
+        (*                                                              *)
+        (*      Note that the error code returned on an I/O             *)
+        (*      error is a rough guess, because of the lack of          *)
+        (*      correspondence between the library error codes and      *)
+        (*      the standard PMOS error codes.                          *)
+        (*                                                              *)
+        (*      Programmer:     P. Moylan                               *)
+        (*      Last edited:    8 May 1997                              *)
+        (*      Status:         Just starting ISO port                  *)
+        (*                                                              *)
+        (****************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)  BYTE, ADDRESS, CARD8;
+
+FROM IOErrorCodes IMPORT
+    (* type *)  ErrorCode;
+
+IMPORT RndFile;
+
+TYPE File = RndFile.ChanId;
+
+PROCEDURE OpenFile (VAR (*OUT*) f: File;  name: ARRAY OF CHAR;
+                                        newfile: BOOLEAN): ErrorCode;
+
+    (* Opens the file named by the given character string, and returns  *)
+    (* f as the identification to be used when specifying this file in  *)
+    (* future.  The caller must specify newfile = TRUE to create a new  *)
+    (* file, or newfile = FALSE if the intention is to open an existing *)
+    (* file.  It is illegal to open a new file with the same name as an *)
+    (* existing file; this is to protect against accidental deletions.  *)
+    (* The value returned is an error code (OK if no error).            *)
+
+PROCEDURE CloseFile (VAR (*INOUT*) f: File);
+
+    (* Closes file f.   *)
+
+PROCEDURE EOF (f: File): BOOLEAN;
+
+    (* Returns TRUE iff we are currently at the end of file f.  *)
+
+PROCEDURE ReadByte (f: File): CARD8;
+
+    (* Returns the next byte from the file.     *)
+
+PROCEDURE ReadRecord (f: File;  buffaddr: ADDRESS;  desired: CARDINAL;
+                                VAR (*OUT*) actual: CARDINAL): ErrorCode;
+
+    (* Reads up to "desired" bytes from file f to memory location       *)
+    (* "buffaddr".  On return, "actual" gives the number of bytes read. *)
+
+PROCEDURE WriteByte (f: File;  value: BYTE): ErrorCode;
+
+    (* Writes one byte to the file.     *)
+
+PROCEDURE WriteRecord (f: File;  buffaddr: ADDRESS;
+                                        count: CARDINAL): ErrorCode;
+
+    (* Writes count bytes from memory location buffaddr.        *)
+
+PROCEDURE SetPosition (f: File;  position: CARDINAL): ErrorCode;
+
+    (* Ensures that the next read or write on this file will be at      *)
+    (* byte number position in the file.  (The first byte in the file   *)
+    (* is byte number 0.)  If a position greater than the file size     *)
+    (* is specified, the length of the file will increase.              *)
+
+PROCEDURE SavePosition (f: File): CARDINAL;
+
+    (* Returns the current byte number in file f.       *)
+
+PROCEDURE FileSize (f: File): CARDINAL;
+
+    (* Returns the length of the file in bytes. *)
+
+END Files.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/filesort.def b/examples/Modula-2_Libraries/PMOS/def/filesort.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/filesort.def
@@ -0,0 +1,35 @@
+DEFINITION MODULE FileSort;
+
+        (********************************************************)
+        (*                                                      *)
+        (*      In-place file sort using the QuickSort method   *)
+        (*                                                      *)
+        (*  Programmer:         P. Moylan                       *)
+        (*  Last edited:        9 November 2001                 *)
+        (*  Status:             Replacing Files by FileOps      *)
+        (*                                                      *)
+        (********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)  ADDRESS;
+
+FROM QuickSortModule IMPORT
+    (* type *)  CompareProc;
+
+FROM FileOps IMPORT
+    (* type *)  ChanId;
+
+TYPE
+    RecordNumber = CARDINAL;
+
+PROCEDURE InplaceSort (f: ChanId;  from, to: RecordNumber;
+                        EltSize, offset: CARDINAL;  GE: CompareProc);
+
+    (* In-place sort of part of a file.  We sort record numbers         *)
+    (* from..to inclusive.  EltSize is the element size; offset is the  *)
+    (* number of bytes (zero, in most cases) before record number 0 in  *)
+    (* the file; and GE is a user-supplied function to compare elements *)
+    (* at two specified addresses.                                      *)
+
+END FileSort.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/finalexi.def b/examples/Modula-2_Libraries/PMOS/def/finalexi.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/finalexi.def
@@ -0,0 +1,56 @@
+DEFINITION MODULE FinalExit;
+
+        (****************************************************************)
+        (*                                                              *)
+        (*           Support for program termination procedures         *)
+        (*                                                              *)
+        (*  The facility provided is that the caller can specify any    *)
+        (*  number of parameterless procedures to be called when the    *)
+        (*  program terminates.  This allows each module which needs it *)
+        (*  to have a final cleanup procedure to do things like         *)
+        (*  releasing allocated memory, closing open files, etc.  The   *)
+        (*  termination procedures are called in a last-in first-out    *)
+        (*  order, which generally means that the higher-level modules  *)
+        (*  are dealt with before lower-level modules (which is usually *)
+        (*  what we want).                                              *)
+        (*                                                              *)
+        (*  Multipass termination processing is supported by allowing   *)
+        (*  any termination handler to itself install another handler.  *)
+        (*  In such a case the new handler is not executing until the   *)
+        (*  current list of waiting handlers is exhausted.  Multipass   *)
+        (*  processing is needed when, for example, part of a module    *)
+        (*  shutdown cannot be completed until it is guaranteed that    *)
+        (*  all multitasking has ceased.                                *)
+        (*                                                              *)
+        (*      Programmer:     P. Moylan                               *)
+        (*      Last edited:    23 October 1996                         *)
+        (*      Status:         OK                                      *)
+        (*                                                              *)
+        (****************************************************************)
+
+(*
+PROCEDURE SetTerminationProcedure (TP: PROC);
+
+    (* Adds TP to the list of procedures which will be called just      *)
+    (* before program termination.  The list is ordered such that the   *)
+    (* last procedure added will be the first one called.  Exception:   *)
+    (* if termination is already in progress when this procedure is     *)
+    (* called, then TP will not be called until all of the existing     *)
+    (* termination procedures have been called.  This rule permits      *)
+    (* multi-pass termination processing, where necessary, by letting   *)
+    (* termination procedures themselves install more termination       *)
+    (* procedures.                                                      *)
+
+PROCEDURE Crash (message: ARRAY OF CHAR);
+
+    (* Terminates the program with an error report.     *)
+
+PROCEDURE TerminationMessage (VAR (*OUT*) message: ARRAY OF CHAR): BOOLEAN;
+
+    (* Returns the message supplied by the caller of the Crash          *)
+    (* procedure.  The function result is TRUE if such a message        *)
+    (* exists, and FALSE if Crash was never called.                     *)
+*)
+
+END FinalExit.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/glasstty.def b/examples/Modula-2_Libraries/PMOS/def/glasstty.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/glasstty.def
@@ -0,0 +1,71 @@
+DEFINITION MODULE GlassTTY;
+
+        (********************************************************)
+        (*                                                      *)
+        (*           Simple screen output routines.             *)
+        (*                                                      *)
+        (*  This module handles screen output at a very low     *)
+        (*  level, without supplying the advanced features      *)
+        (*  which may be found in, for example, module Windows. *)
+        (*  It is intended for things like error message        *)
+        (*  output, and is designed for compactness rather      *)
+        (*  than comprehensiveness.                             *)
+        (*                                                      *)
+        (*  Programmer:         P. Moylan                       *)
+        (*  Last edited:        23 September 1996               *)
+        (*  Status:             OK                              *)
+        (*                                                      *)
+        (********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)  CARD8, BYTE, ADDRESS;
+
+PROCEDURE WriteChar (ch: CHAR);
+
+    (* Writes one character. *)
+
+PROCEDURE WriteString (text: ARRAY OF CHAR);
+
+    (* Writes a string of characters.   *)
+
+PROCEDURE WriteLn;
+
+    (* Moves the screen cursor to the beginning of the next line,       *)
+    (* scrolling if necessary.                                          *)
+
+PROCEDURE SetCursor (row, column: CARDINAL);
+
+    (* Moves the screen cursor to the specified row and column.         *)
+
+PROCEDURE SaveCursor;
+
+    (* Remembers the current cursor position, for use by a subsequent   *)
+    (* call to RestoreCursor.  Note that nesting is not supported, i.e. *)
+    (* a call to SaveCursor destroys the information saved by any       *)
+    (* earlier call to SaveCursor.                                      *)
+
+PROCEDURE RestoreCursor;
+
+    (* Sets the cursor back to where it was at the time of the last     *)
+    (* call to SaveCursor.                                              *)
+
+PROCEDURE WriteHexByte (number: CARD8);
+
+    (* Writes its argument as a two-digit hexadecimal number.           *)
+
+PROCEDURE WriteHexWord (number: CARDINAL);
+
+    (* Writes its argument as a four-digit hexadecimal number.          *)
+
+PROCEDURE WriteInt (number: INTEGER);
+PROCEDURE WriteCard (number: CARDINAL);
+(*PROCEDURE WriteLongCard (number: LONGCARD);*)
+
+    (* Writes a number to the screen.   *)
+
+PROCEDURE WriteAddress (addr: ADDRESS);
+
+    (* Writes a segmented address to the screen.        *)
+
+END GlassTTY.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/graphics.def b/examples/Modula-2_Libraries/PMOS/def/graphics.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/graphics.def
@@ -0,0 +1,172 @@
+DEFINITION MODULE Graphics;
+
+        (****************************************************************)
+        (*                                                              *)
+        (*                   Screen graphics output                     *)
+        (*                                                              *)
+        (*  Programmer:         P. Moylan                               *)
+        (*  Last edited:        5 November 1996                         *)
+        (*  Status:             OK                                      *)
+        (*                                                              *)
+        (*      The procedures in this module assume that the caller    *)
+        (*      has control of the entire screen.                       *)
+        (*      For multi-window graphics, see module GWindows.         *)
+        (*                                                              *)
+        (****************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)  ADDRESS, CARD8;
+
+FROM ScreenGeometry IMPORT
+    (* type *)  Rectangle;
+
+(************************************************************************)
+(*                                                                      *)
+(*  The constant BLorigin defined below is to support two different     *)
+(*  origin conventions.  When a reference is made to (x,y) coordinates  *)
+(*  in this module, the x value is the horizontal coordinate, with 0    *)
+(*  at the left of the the screen, and the y value is the vertical      *)
+(*  coordinate.  If BLorigin is TRUE then y=0 is at the bottom of the   *)
+(*  screen and y values increase upwards.  If BLorigin is FALSE then    *)
+(*  y=0 is at the top of the screen and y values increase downwards.    *)
+(*  You can choose whichever convention suits you best; the effect on   *)
+(*  execution speed is negligible.  Some other PMOS modules assume      *)
+(*  that you have selected the TRUE option.                             *)
+(*                                                                      *)
+(*  You might think that the inclusion of this choice will increase     *)
+(*  software overheads, but in fact any reasonable compiler will do     *)
+(*  the constant testing at compile time rather than at execution time, *)
+(*  eliminating the unreachable code.                                   *)
+(*                                                                      *)
+(************************************************************************)
+
+CONST BLorigin = TRUE;
+
+(************************************************************************)
+
+TYPE ColourType = CARDINAL;
+
+PROCEDURE SetMode (newmode: CARDINAL;  ClearScreen: BOOLEAN);
+
+    (* Sets the video mode. *)
+
+    (* Warning: the option ClearScreen=FALSE sometimes produces some    *)
+    (* strange effects, apparently because of some aspect of the BIOS   *)
+    (* that I don't yet understand.                                     *)
+
+PROCEDURE SetDefaultMode;
+
+    (* Sets the video mode to (our opinion of) the "best" graphics mode *)
+    (* supported by the hardware.                                       *)
+
+PROCEDURE GraphicsOff (ClearScreen: BOOLEAN);
+
+    (* Sets the video mode to a default text mode. *)
+
+PROCEDURE GetScreenShape (VAR (*OUT*) xmax, ymax: CARDINAL;
+                                VAR (*OUT*) maxcolour: ColourType;
+                                VAR (*OUT*) CharHeight: CARDINAL);
+
+    (* Returns the maximum values permitted by the current mode for     *)
+    (* x, y, and colour; and the number of rows in a character.         *)
+
+PROCEDURE SetFont (height, width: CARDINAL;  TablePtr: ADDRESS);
+
+    (* Specifies the font that will be used from now on (until the      *)
+    (* next mode setting) for drawing characters.  The first two        *)
+    (* parameters are the character size, and TablePtr points to the    *)
+    (* bitmap that defines the font.  This procedure is normally        *)
+    (* optional, since SetMode sets up a default font.                  *)
+
+    (* Implementation restriction: in the present version the 'width'   *)
+    (* parameter is ignored, and all characters are assumed to be       *)
+    (* eight pixels wide.                                               *)
+
+PROCEDURE SetPaletteColour (Palette_Index, Red, Green, Blue: CARD8);
+
+    (* Sets the colour for one palette register.  Applicable only to    *)
+    (* VGA or better.  The three colour codes are 6-bit numbers.        *)
+
+PROCEDURE PlotDot (x, y: CARDINAL;  colour: ColourType);
+
+    (* Writes a dot at screen position (x, y).  *)
+
+PROCEDURE PlotMark (x, y: CARDINAL;
+                        colour: ColourType;  pointtype: CARDINAL);
+
+    (* Writes a mark at screen position (x, y).  Currently, the options *)
+    (* for pointtype are:                                               *)
+    (*          0       dot                                             *)
+    (*          1       X                                               *)
+    (*          2       box                                             *)
+
+PROCEDURE PlotLine (x0, y0, x1, y1: CARDINAL;  colour: ColourType);
+
+    (* Plots a straight line from (x0,y0) to (x1,y1).  It is the        *)
+    (* caller's responsibility to ensure that the coordinates are in    *)
+    (* range for the current video mode.                                *)
+
+PROCEDURE PlotRectangle (R: Rectangle;  colour: ColourType);
+
+    (* Plots a rectangle, with clipping if necessary to keep the        *)
+    (* points within the screen boundary.                               *)
+
+PROCEDURE ClippedLine (x0, y0, x1, y1: CARDINAL;  colour: ColourType;
+                        left, right, ymin, ymax: CARDINAL);
+
+    (* Like PlotLine, but plots only that part of the line which lies   *)
+    (* in the rectangle (left <= x <= right), (ymin <= y <= ymax).      *)
+    (* The caller is expected to ensure, by appropriate definition of   *)
+    (* the rectangle, that all plotted points are in range for the      *)
+    (* current video mode.                                              *)
+
+PROCEDURE Fill (x0, y0, x1, y1: CARDINAL;  colour: ColourType);
+
+    (* Fills a rectangle with the indicated colour.  The rectangle is   *)
+    (* specified by giving two opposite corners (x0,y0) and (x1,y1).    *)
+
+PROCEDURE ACopy (xs, ys, width, height: CARDINAL;  dx, dy: INTEGER);
+
+    (* Copies a rectangular region by an offset (dx, dy).  The pair     *)
+    (* (xs,ys) gives the coordinates of the top left of the source      *)
+    (* rectangle.  Restrictions: this procedure is restricted to the    *)
+    (* case where distance to move the data is an integral number of    *)
+    (* bytes (i.e. if you want it to work for all modes then dx should  *)
+    (* be a multiple of 8); and in the case where the source and        *)
+    (* destination rectangles overlap then the move has to be upwards   *)
+    (* on the screen.  Thus we do not have a completely general "block  *)
+    (* copy" operation, but we do have something sufficient to support  *)
+    (* "scroll up" and similar operations.                              *)
+
+PROCEDURE DrawChar (ch: CHAR;  x, y: CARDINAL;  colour: ColourType);
+
+    (* Draws the single character ch.  The coordinates (x,y) are the    *)
+    (* location of the bottom left of the character.                    *)
+
+PROCEDURE PlotString (VAR (*IN*) text: ARRAY OF CHAR;
+                        x, y, length: CARDINAL;  colour: ColourType);
+
+    (* Draws a string of "length" characters starting at location (x,y) *)
+    (* It is the caller's responsibility to ensure that the string will *)
+    (* not run off the screen edges.                                    *)
+
+PROCEDURE ClippedString (VAR (*IN*) text: ARRAY OF CHAR;
+                        x, y, length: CARDINAL;  colour: ColourType;
+                        left, right, ymin, ymax: CARDINAL);
+
+    (* Like PlotString, but excludes any points which fall outside the  *)
+    (* clip rectangle defined by (left,right,ymin,ymax).                *)
+
+PROCEDURE PlotStringUp (VAR (*IN*) text: ARRAY OF CHAR;
+                        x, y, length: CARDINAL;  colour: ColourType);
+
+    (* Like PlotString, but with text written in the +Y direction       *)
+
+PROCEDURE ClippedUpString (VAR (*IN*) text: ARRAY OF CHAR;
+                        x, y, length: CARDINAL;  colour: ColourType;
+                        left, right, ymin, ymax: CARDINAL);
+
+    (* Like ClippedString, but with text written in the +Y direction.   *)
+
+END Graphics.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/gwindows.def b/examples/Modula-2_Libraries/PMOS/def/gwindows.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/gwindows.def
@@ -0,0 +1,154 @@
+DEFINITION MODULE GWindows;
+
+	(********************************************************)
+	(*							*)
+	(*	    Windows module for screen graphics		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	18 April 1994			*)
+	(*  Status:						*)
+	(*	Mostly working, still adding features.		*)
+	(*							*)
+	(********************************************************)
+
+FROM ScreenGeometry IMPORT
+    (* type *)	Point, Rectangle;
+
+FROM Graphics IMPORT
+    (* type *)	ColourType;
+
+(************************************************************************)
+
+TYPE
+    Window;	(* is private *)
+
+    BorderType = (single, double);
+
+(************************************************************************)
+
+PROCEDURE InitGraphics (mode: CARDINAL);
+
+    (* Sets up the Graphics mode.  Optional, since the module starts up	*)
+    (* with a best estimate of the "best" mode possible on the		*)
+    (* available hardware.						*)
+
+PROCEDURE OpenWindow (VAR (*OUT*) w: Window;
+				left, bottom, right, top: CARDINAL;
+				Foregrnd, Backgrnd: ColourType;
+				b: BorderType);
+
+    (* Creates a new window.	*)
+
+PROCEDURE OpenWindowR (VAR (*OUT*) w: Window;  location: Rectangle;
+					Foregrnd, Backgrnd: ColourType;
+					b: BorderType);
+
+    (* Same as OpenWindow, except for method of specifying location.	*)
+
+PROCEDURE WindowMemory (w: Window;  memory: BOOLEAN);
+
+    (* Specifying a FALSE value for the memory parameter means that	*)
+    (* subsequent data sent to this window will be written to the	*)
+    (* screen but not remembered.  This saves time and memory, the only	*)
+    (* penalty being that data covered by an overlapping window will	*)
+    (* be lost.  Specifying TRUE restores the default condition, where	*)
+    (* all window data are retained for refreshing the screen when	*)
+    (* necessary.							*)
+
+PROCEDURE CloseWindow (VAR (*INOUT*) w: Window);
+
+    (* Destroys the window.	*)
+
+PROCEDURE SetColour (w: Window;  colour: ColourType);
+
+    (* Specifies the foreground colour to be used until further notice.	*)
+
+PROCEDURE PutPixel (w: Window;  p: Point);
+
+    (* Plots a dot at the point (x,y) in window w.  The coordinates are	*)
+    (* relative to the bottom left of the window.  If the dot lies	*)
+    (* outside the window it will be ignored.				*)
+
+PROCEDURE PutPixel2 (w: Window;  x, y: INTEGER);
+
+    (* Same as PutPixel, with a different way of specifying the point.	*)
+
+PROCEDURE PutPixel2C (w: Window;  x, y: INTEGER;  colour: ColourType);
+
+    (* Same as PutPixel2, with the colour explicitly specified.	*)
+
+PROCEDURE Line (w: Window;  start, end: Point);
+
+    (* Draws a straight line.  The points are relative to the bottom	*)
+    (* left corner of w.  Parts of the line lying outside the window	*)
+    (* are clipped.							*)
+
+PROCEDURE Line2 (w: Window;  xstart, ystart, xend, yend: INTEGER);
+
+    (* The same operation as Line, with a different way of specifying	*)
+    (* the parameters.							*)
+
+PROCEDURE Line2C (w: Window;  xstart, ystart, xend, yend: INTEGER;
+							colour: ColourType);
+
+    (* The same operation as Line2, but with the colour explicitly	*)
+    (* specified.							*)
+
+PROCEDURE GString (w: Window;  x, y: CARDINAL;  text: ARRAY OF CHAR);
+
+    (* Writes a horizontal character string at graphics position (x,y)	*)
+    (* relative to window w.  Characters which do not fit are not	*)
+    (* displayed.  This is not considered to be a text operation since	*)
+    (* the text cursor is not affected and there is no line wrap.	*)
+
+PROCEDURE GStringUp (w: Window;  x, y: CARDINAL;  text: ARRAY OF CHAR);
+
+    (* Like GString, but the string is rotated counterclockwise by	*)
+    (* 90 degrees, i.e. it is written in the +Y direction.		*)
+
+PROCEDURE ClearWindow (w: Window);
+
+    (* Erases all data from w, but keeps it open.	*)
+
+(************************************************************************)
+(*			    TEXT OPERATIONS				*)
+(************************************************************************)
+(*									*)
+(*  Every open window has a "text cursor" which is used only for text	*)
+(*  operations and is independent of any operations on dots and lines.	*)
+(*  The text cursor is updated after any text operation in such a way	*)
+(*  that the characters follow one another in the way one would expect	*)
+(*  for non-graphics windows.						*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE SetCursor (w: Window;  row, column: CARDINAL);
+
+    (* Sets the text cursor to the specified row and column.  The row	*)
+    (* and column are measured in units of characters (not pixels),	*)
+    (* with (0,0) representing the first character position at the	*)
+    (* upper left of the window.					*)
+
+PROCEDURE SaveCursor (w: Window;  VAR (*OUT*) row, column: CARDINAL);
+
+    (* Returns the current row and column of the text cursor. *)
+
+PROCEDURE WriteChar (w: Window;  ch: CHAR);
+
+    (* Writes a horizontal character at the current text cursor		*)
+    (* position for window w.  The text cursor is updated.		*)
+
+PROCEDURE WriteString (w: Window;  text: ARRAY OF CHAR);
+
+    (* Writes a horizontal character string at the current text cursor	*)
+    (* position for window w.  Characters which do not fit on the	*)
+    (* current line are wrapped around to a new row.			*)
+
+PROCEDURE WriteLn (w: Window);
+
+    (* Sets the text cursor to the start of the next text line down.	*)
+    (* If the cursor reaches the bottom of the window, the text in the	*)
+    (* window is scrolled.						*)
+
+END GWindows.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/internet.def b/examples/Modula-2_Libraries/PMOS/def/internet.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/internet.def
@@ -0,0 +1,179 @@
+<* M2EXTENSIONS + *>
+
+DEFINITION MODULE ["SysCall"] Internet;
+
+        (********************************************************)
+        (*                                                      *)
+        (*       Definitions related to Internet sockets.       *)
+        (*     This module is imported by the Sockets module.   *)
+        (*                                                      *)
+        (*  Constants and structures defined by the internet    *)
+        (*  system, Per RFC 790, September 1981.                *)
+        (*                                                      *)
+        (*  Programmer:         P. Moylan                       *)
+        (*  Started:            18 August 1997                  *)
+        (*  Last edited:        3 December 1998                 *)
+        (*  Status:             Just started                    *)
+        (*                                                      *)
+        (*      This doesn't do much yet, it's just a           *)
+        (*      test whether I can talk properly to the API     *)
+        (*                                                      *)
+        (********************************************************)
+
+(********************************************************************************)
+(* This module is derived in part from the in.h file that comes with OS/2       *)
+(* Warp 4, and that file carries the following copyright notice:                *)
+(*                                                                              *)
+(* Copyright (c) 1982, 1985, 1986 Regents of the University of California.      *)
+(* All rights reserved.                                                         *)
+(*                                                                              *)
+(* Redistribution and use in source and binary forms are permitted              *)
+(* provided that this notice is preserved and that due credit is given          *)
+(* to the University of California at Berkeley. The name of the University      *)
+(* may not be used to endorse or promote products derived from this             *)
+(* software without specific prior written permission. This software            *)
+(* is provided ``as is'' without express or implied warranty.                   *)
+(*                                                                              *)
+(*      @(#)in.h        7.5 (Berkeley) 2/22/88                                  *)
+(*                                                                              *)
+(********************************************************************************)
+
+FROM SYSTEM IMPORT CARD8, CARD16, CARD32;
+
+TYPE EightByte = ARRAY [0..7] OF CARD8;
+CONST Zero8 = EightByte {0, 0, 0, 0, 0, 0, 0, 0};
+
+CONST
+    INADDR_ANY = 0;
+
+TYPE
+    (* In an internet socket address record, the port and addr fields must      *)
+    (* always be in network byte order - most significant byte first.           *)
+
+    InternetSocketAddress = RECORD
+                                port: CARD16;
+                                addr: CARD32;
+                                zero: EightByte;   (* Must be zero *)
+                            END (*RECORD*);
+
+    (* Remark: for a "bind" call, you can set the port to zero if you don't     *)
+    (* care which port you get - the system then assigns you a free port.       *)
+
+(********************************************************************************)
+
+PROCEDURE ["SysCall"] inet_addr (value: ARRAY OF CHAR): CARD32;
+
+    (* Translates an IP address from the dotted notation (e.g. "123.45.6.78")   *)
+    (* to 32-bit binary in Internet byte order (MSB first).                     *)
+
+END Internet.
+
+(************************************************************************)
+(*   THE FOLLOWING HAS NOT YET BEEN TRANSLATED                          *)
+(************************************************************************)
+
+/*
+ * Protocols
+ */
+#define IPPROTO_IP              0               /* dummy for IP */
+#define IPPROTO_ICMP            1               /* control message protocol */
+#define IPPROTO_IGMP            2               /* group management protocol*/
+#define IPPROTO_GGP             3               /* gateway^2 (deprecated) */
+#define IPPROTO_TCP             6               /* tcp */
+#define IPPROTO_EGP             8               /* exterior gateway protocol */
+#define IPPROTO_PUP             12              /* pup */
+#define IPPROTO_UDP             17              /* user datagram protocol */
+#define IPPROTO_IDP             22              /* xns idp */
+
+#define IPPROTO_RAW             255             /* raw IP packet */
+#define IPPROTO_MAX             256
+
+
+/*
+ * Ports < IPPORT_RESERVED are reserved for
+ * privileged processes (e.g. root).
+ * Ports > IPPORT_USERRESERVED are reserved
+ * for servers, not necessarily privileged.
+ */
+#define IPPORT_RESERVED         1024
+#define IPPORT_USERRESERVED     5000
+
+/*
+ * Link numbers
+ */
+#define IMPLINK_IP              155
+#define IMPLINK_LOWEXPER        156
+#define IMPLINK_HIGHEXPER       158
+
+/*
+ * Definitions of bits in internet address integers.
+ * On subnets, the decomposition of addresses to host and net parts
+ * is done according to subnet mask, not the masks here.
+ */
+#define IN_CLASSA(i)            (((long)(i) & 0x80000000L) == 0)
+#define IN_CLASSA_NET           0xff000000L
+#define IN_CLASSA_NSHIFT        24
+#define IN_CLASSA_HOST          0x00ffffffL
+#define IN_CLASSA_MAX           128
+
+#define IN_CLASSB(i)            (((long)(i) & 0xc0000000L) == 0x80000000L)
+#define IN_CLASSB_NET           0xffff0000L
+#define IN_CLASSB_NSHIFT        16
+#define IN_CLASSB_HOST          0x0000ffffL
+#define IN_CLASSB_MAX           65536L
+
+#define IN_CLASSC(i)            (((long)(i) & 0xe0000000L) == 0xc0000000L)
+#define IN_CLASSC_NET           0xffffff00L
+#define IN_CLASSC_NSHIFT        8
+#define IN_CLASSC_HOST          0x000000ffL
+
+#define IN_CLASSD(i)            (((long)(i) & 0xf0000000L) == 0xe0000000L)
+#define IN_CLASSD_NET           0xffffffffL
+#define IN_CLASSD_HOST          0x00000000L
+#define IN_MULTICAST(i)         IN_CLASSD(i)
+
+#define IN_EXPERIMENTAL(i)      (((long)(i) & 0xe0000000L) == 0xe0000000L)
+#define IN_BADCLASS(i)          (((long)(i) & 0xf0000000L) == 0xf0000000L)
+
+#define INADDR_BROADCAST        (unsigned long)0xffffffffL     /* must be masked */
+
+#define INADDR_UNSPEC_GROUP     (unsigned long )0xe0000000      /* 224.0.0.0   */
+#define INADDR_ALLHOSTS_GROUP   (unsigned long)0xe0000001      /* 224.0.0.1   */
+#define INADDR_MAX_LOCAL_GROUP  (unsigned long)0xe00000ff      /* 224.0.0.255 */
+
+#ifndef KERNEL
+#define INADDR_NONE             0xffffffffL             /* -1 return */
+#endif
+
+#define IN_LOOPBACKNET          127                     /* official! */
+
+/*
+ * Options for use with [gs]etsockopt at the IP level.
+ */
+#define IP_OPTIONS      1               /* set/get IP per-packet options */
+
+#define IP_MULTICAST_IF    2            /* set/get IP multicast interface*/
+#define IP_MULTICAST_TTL   3            /* set/get IP multicast timetolive*/
+#define IP_MULTICAST_LOOP  4            /* set/get IP multicast loopback */
+#define IP_ADD_MEMBERSHIP  5            /* add  an IP group membership   */
+#define IP_DROP_MEMBERSHIP 6            /* drop an IP group membership   */
+
+#define IP_DEFAULT_MULTICAST_TTL  1     /* normally limit m'casts to 1 hop */
+#define IP_DEFAULT_MULTICAST_LOOP 1     /* normally hear sends if a member */
+#define IP_MAX_MEMBERSHIPS       20     /* per socket; must fit in one mbuf*/
+
+/*
+ * Argument structure for IP_ADD_MEMBERSHIP and IP_DROP_MEMBERSHIP.
+ */
+struct ip_mreq {
+        struct in_addr  imr_multiaddr;  /* IP multicast address of group */
+        struct in_addr  imr_interface;  /* local IP address of interface */
+};
+
+struct in_addr _System inet_makeaddr(unsigned long, unsigned long);
+unsigned long _System inet_network(char *);
+char * _System inet_ntoa(struct in_addr);
+unsigned long _System inet_lnaof(struct in_addr);
+unsigned long _System inet_netof(struct in_addr);
+
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/ioerrorc.def b/examples/Modula-2_Libraries/PMOS/def/ioerrorc.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/ioerrorc.def
@@ -0,0 +1,92 @@
+DEFINITION MODULE IOErrorCodes;
+
+	(********************************************************)
+	(*							*)
+	(*		I/O subsystem error codes.		*)
+	(*							*)
+	(*  This module defines a set of error codes which may	*)
+	(*  be used uniformly throughout the file system.	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	11 May 1994			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+
+TYPE
+    ErrorCode = (
+
+	OK,			(* Normal return, no error	*)
+	OperationAborted,	(* Operator forced abort	*)
+
+	(* Error codes from module Files.	*)
+
+	FileNotOpen,		(* Should have opened file first  *)
+
+	(* Error codes from module Devices.	*)
+
+	NoSuchDevice,		(* Illegal device *)
+	NoSuchUnit,		(* Illegal unit number *)
+
+	(* Error codes from module Directories.	*)
+
+	FeatureNotImplemented,	(* Cannot yet handle this case *)
+	InvalidFileNameString,	(* Could not parse filename string *)
+	DirectoryNotFound,	(* Subdirectory name not found *)
+	NotADirectory,		(* Supposed directory name is not a dir	*)
+	NameNotFound,		(* File name not found in directory *)
+	DuplicateFileName,	(* File name already exists *)
+	DeviceFull,		(* No room to create/extend file *)
+	DirectoryFull,		(* No room to create new directory entry *)
+
+	(* Error codes from the disk device drivers.	*)
+
+	BadDMAAddress,		(* Operation uses a memory buffer which	*)
+				(* the DMA hardware cannot handle	*)
+	IllegalBlockNumber,	(* The caller requested an operation on	*)
+				(*  a non-existent disk block.		*)
+	BadCommand,		(* We tried to do something illegal.	*)
+	ControllerNotListening,	(* Could not get the disk controller	*)
+				(*  to accept a command.		*)
+	ControllerOutOfSync,	(* Status information from the disk	*)
+				(*  controller does not make sense.	*)
+	TimeoutError,		(* Data request interrupt did not	*)
+				(*  arrive within a reasonable time.	*)
+	CalibrationFailure,	(* Did not succeed in driving the head	*)
+				(*  back to its home position.		*)
+	SeekFailure,		(* Failed to seek to the desired track.	*)
+	DriveNotReady,		(* Could be an equipment failure, but	*)
+				(*  more commonly means that the drive	*)
+				(*  door is open or there is no disk in	*)
+				(*  the drive.				*)
+	SectorNotFound,		(* Missing sector, cylinder mismatch,	*)
+				(*  and similar errors.  This could	*)
+				(*  mean a badly formatted disk, it	*)
+				(*  could be just one faulty block, or	*)
+				(*  it could mean that a recalibration	*)
+				(*  is needed.				*)
+	BadBlock,		(* The sector has its "bad block"	*)
+				(*  mark set - should not be used.	*)
+	BadData,		(* Something on the disk is corrupted.	*)
+				(*  Could be a transient error, e.g.	*)
+				(*  read error caused by a speck of	*)
+				(*  dust, but it could also be true	*)
+				(*  corruption of the medium.		*)
+	WriteFault,		(* Occurs only with hard disk, reflects	*)
+				(*  a hardware fault signal.		*)
+	WriteProtected,		(* Attempted write to a write-protected	*)
+				(*  disk.				*)
+	UndiagnosedFailure	(* Miscellaneous error.			*)
+
+	);		(* End of the list of error codes *)
+
+(************************************************************************)
+
+PROCEDURE TranslateErrorCode (code: ErrorCode;
+				VAR (*OUT*) string: ARRAY OF CHAR);
+
+    (* Converts code to its textual representation. *)
+
+END IOErrorCodes.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/kbdriver.def b/examples/Modula-2_Libraries/PMOS/def/kbdriver.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/kbdriver.def
@@ -0,0 +1,2 @@
+Obsolete
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/keyboard.def b/examples/Modula-2_Libraries/PMOS/def/keyboard.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/keyboard.def
@@ -0,0 +1,92 @@
+DEFINITION MODULE Keyboard;
+
+        (************************************************)
+        (*                                              *)
+        (*      Module to deal with keyboard input.     *)
+        (*                                              *)
+        (*  Programmer:         P. Moylan               *)
+        (*  Last edited:        9 August 1999           *)
+        (*  Status:             OK                      *)
+        (*                                              *)
+        (************************************************)
+
+FROM Semaphores IMPORT
+    (* type *)  Semaphore;
+
+CONST
+    ScrollLock = 16;
+    NumLock = 32;
+    CapsLock = 64;
+
+PROCEDURE KeyPressed(): BOOLEAN;
+
+    (* Returns TRUE iff a character is available. *)
+
+PROCEDURE InKey (): CHAR;
+
+    (* Reads a single character code from the keyboard. *)
+
+PROCEDURE PutBack (ch: CHAR);
+
+    (* This is an "un-read" operation, i.e. the character ch will       *)
+    (* re-appear on the next call to InKey.  This facility is provided  *)
+    (* for the use of software which can overshoot by one character     *)
+    (* when reading its input - a situation which can often occur.      *)
+    (* Some versions of this module will allow several calls to PutBack *)
+    (* before the next call to InKey, but no guarantee is made in that  *)
+    (* case of uniform treatment from version to version.               *)
+
+PROCEDURE StuffKeyboardBuffer (ch: CHAR);
+
+    (* Stores ch as if it had come from the keyboard, so that a         *)
+    (* subsequent InKey() will pick it up.                              *)
+
+    (* NOTE: Procedures PutBack and StuffKeyboardBuffer do almost the   *)
+    (* same thing, but not quite.  The differences are:                 *)
+    (*  1. StuffKeyboardBuffer stores characters in a first-in-first-out*)
+    (*     order, whereas PutBack uses last-in-first-out.               *)
+    (*  2. StuffKeyboardBuffer is intended for the case of a task       *)
+    (*     sending data to another task (where that other task is       *)
+    (*     expecting keyboard input), and PutBack is designed for the   *)
+    (*     case of a task talking to itself (i.e. the PutBack(ch) and   *)
+    (*     the InKey() are in the same task).  If you get this the      *)
+    (*     wrong way around then you could have timing-related          *)
+    (*     problems, up to and including deadlock.                      *)
+
+PROCEDURE StuffKeyboardBuffer2 (ch: CHAR);
+
+    (* Like StuffKeyboardBuffer, but stores a two-byte sequence: Nul    *)
+    (* followed by ch.                                                  *)
+
+PROCEDURE SetLocks (code: CARDINAL);
+
+    (* Set/clear the caps lock, num lock, and scroll lock conditions.   *)
+    (* The codes are defined at the beginning of this module.           *)
+
+PROCEDURE LockStatus (): CARDINAL;
+
+    (* Returns the current state of the caps lock, num lock, and scroll *)
+    (* lock conditions.                                                 *)
+    (* The codes are defined at the beginning of this module.           *)
+
+PROCEDURE HotKey (FunctionKey: BOOLEAN;  code: CHAR;  S: Semaphore);
+
+    (* After this procedure is called, typing the key combination for   *)
+    (* 'code' will cause a Signal(S).  Set FunctionKey=TRUE to trap one *)
+    (* of the two-character special function keys, and FALSE otherwise. *)
+    (* The character is consumed; if it should be passed on, then the   *)
+    (* user's hot key handler can do a PutBack().  Note: there is no    *)
+    (* provision for having multiple hot key handlers for the same key; *)
+    (* any existing hot key mapping will be overridden.                 *)
+
+PROCEDURE IsFullScreen(): BOOLEAN;
+
+    (* Returns TRUE if this is a full-screen OS/2 session. *)
+
+PROCEDURE NotDetached(): BOOLEAN;
+
+    (* Returns TRUE unless called by a process running detached.        *)
+    (* (A detached process may not do keyboard, screen, or mouse I/O.)  *)
+
+END Keyboard.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/ktrace.def b/examples/Modula-2_Libraries/PMOS/def/ktrace.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/ktrace.def
@@ -0,0 +1,47 @@
+DEFINITION MODULE KTrace;
+
+	(****************************************************************)
+	(*								*)
+	(*	Trace routines for Modula 2 program development.	*)
+	(*								*)
+	(*  This is the version which does NOT use windows.  It is	*)
+	(*  intended for low-level tracing of the kernel, where a	*)
+	(*  window-based tracing facility would be unsuitable because	*)
+	(*  of critical section problems.  However, it is quite		*)
+	(*  adequate for any application where we don't care too much	*)
+	(*  about a pretty screen layout.				*)
+	(*								*)
+	(*  Note, however, that this module is missing the "Press any	*)
+	(*  key to continue" option which my other trace modules have.	*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	21 January 1989				*)
+	(*  Status:		OK					*)
+	(*								*)
+	(****************************************************************)
+
+PROCEDURE NYI (name: ARRAY OF CHAR);
+
+	(* Types a "not yet implemented" message.	*)
+
+PROCEDURE InTrace (name: ARRAY OF CHAR);
+
+	(* Types "Entering 'name'".	*)
+
+PROCEDURE OutTrace (name: ARRAY OF CHAR);
+
+	(* Types "Leaving 'name'".	*)
+
+PROCEDURE TraceOn;
+
+	(* Turns on tracing.	*)
+
+PROCEDURE TraceOff;
+
+	(* Turns off tracing.		*)
+
+PROCEDURE TraceStatus(): BOOLEAN;
+
+	(* Says whether tracing is currently on.	*)
+
+END KTrace.
diff --git a/examples/Modula-2_Libraries/PMOS/def/listboxe.def b/examples/Modula-2_Libraries/PMOS/def/listboxe.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/listboxe.def
@@ -0,0 +1,153 @@
+DEFINITION MODULE ListBoxes;
+
+        (********************************************************)
+        (*                                                      *)
+        (*               Scrollable listboxes                   *)
+        (*                                                      *)
+        (*  Programmer:         P. Moylan                       *)
+        (*  Started:            2 December 1997                 *)
+        (*  Last edited:        9 January 2003                  *)
+        (*  Status:             OK                              *)
+        (*                                                      *)
+        (********************************************************)
+
+
+FROM Windows IMPORT
+    (* type *)  Window, Colour;
+
+(************************************************************************)
+
+TYPE ListBox;              (* is private *)
+
+PROCEDURE CreateListBox (w: Window;  firstrow, leftcol,
+                                       rows, columns: CARDINAL): ListBox;
+
+    (* Creates a new ListBox.  Window w must already exist, and "rows"  *)
+    (* and "columns" should match the number of rows and columns that   *)
+    (* will be visible in the window.  The parameters firstrow and      *)
+    (* leftcol specify an offset from the window origin.                *)
+
+PROCEDURE DestroyListBox (LB: ListBox);
+
+    (* Deletes LB. *)
+
+PROCEDURE WindowOf (LB: ListBox): Window;
+
+    (* Identifies the window in which this ListBox lives. *)
+
+PROCEDURE ClearListBox (LB: ListBox);
+
+    (* Removes all stored data rows. *)
+
+PROCEDURE HighlightOn (LB: ListBox);
+
+    (* Enables reverse video for the current item. *)
+
+PROCEDURE HighlightOff (LB: ListBox);
+
+    (* Disables reverse video for the current item. *)
+
+PROCEDURE PaintCurrentItem (LB: ListBox;  fore, back: Colour);
+
+    (* Sets the foreground and background colours of the current item. *)
+
+PROCEDURE Repaint (LB: ListBox);
+
+    (* Rewrites the screen.  This also cancels the effect of a previous *)
+    (* DisableScreenOutput call.                                        *)
+
+PROCEDURE DisableScreenOutput (LB: ListBox);
+
+    (* Disables all screen updating until the next Repaint call. *)
+
+PROCEDURE LBAppend (LB: ListBox;  newitem: ARRAY OF CHAR);
+
+    (* Adds a new item after the last item. *)
+
+PROCEDURE LBInsertBefore (LB: ListBox;  newitem: ARRAY OF CHAR);
+
+    (* Adds a new item before the current item, and makes the newly     *)
+    (* inserted item the current item.                                  *)
+
+PROCEDURE LBInsertAt (LB: ListBox;  newitem: ARRAY OF CHAR;
+                                    position: CARDINAL);
+
+    (* Adds a new item at sequence number 'position'.  The current item *)
+    (* selection is left unchanged.  Does not redisplay the box.        *)
+    (* Because calls to this procedure insert items out of sequence,    *)
+    (* they can leave gaps and inconsistencies in the item numbers.     *)
+    (* To fix this, call LBUpdateItemNumbers after finishing all the    *)
+    (* insertions.                                                      *)
+
+PROCEDURE LBUpdateItemNumbers (LB: ListBox);
+
+    (* Makes a pass through the entire list making sure that the item   *)
+    (* numbers are consistent, and then redisplays the listbox.         *)
+
+PROCEDURE LBInsertAfter (LB: ListBox;  newitem: ARRAY OF CHAR);
+
+    (* Adds a new item after the current item, and makes the newly      *)
+    (* inserted item the current item.                                  *)
+
+PROCEDURE LBSort (LB: ListBox);
+
+    (* Sorts the contents of LB, then redisplays it. *)
+
+PROCEDURE ItemNumberOf (LB: ListBox;  entry: ARRAY OF CHAR): CARDINAL;
+
+    (* Returns the ordinal number of the item that matches 'entry'.     *)
+    (* The result is zero iff the list is empty.  If the list is        *)
+    (* nonempty, the first item number is 1.                            *)
+
+PROCEDURE LBCurrentItemNumber (LB: ListBox): CARDINAL;
+
+    (* Returns the ordinal number of the current item.  The result is   *)
+    (* zero if the list is empty.                                       *)
+
+PROCEDURE LBCurrentRowNumber (LB: ListBox): CARDINAL;
+
+    (* Returns the row number, within the window, of the current item.  *)
+    (* Note: a result of 0 could mean either that the top item is the   *)
+    (* current item, or that there are no items.                        *)
+
+PROCEDURE LBCurrent (LB: ListBox;  VAR (*OUT*) item: ARRAY OF CHAR);
+
+    (* Returns the (string) value of the current item. *)
+
+PROCEDURE ReplaceCurrent (LB: ListBox;  VAR (*IN*) item: ARRAY OF CHAR);
+
+    (* Updates the string value of the current item. *)
+
+PROCEDURE LBDeleteCurrent (LB: ListBox);
+
+    (* Removes the current entry. *)
+
+PROCEDURE LBDeleteNext (LB: ListBox);
+
+    (* Removes the entry after the current entry, if any.  The screen   *)
+    (* cursor is not moved.                                             *)
+
+PROCEDURE LBGoto (LB: ListBox;  N: CARDINAL);
+
+    (* Moves the cursor forward or backward to entry number N. *)
+
+PROCEDURE CursorBackward (LB: ListBox): BOOLEAN;
+
+    (* Moves the cursor one row backward.  Returns TRUE if we did       *)
+    (* move backward, FALSE if we ran off the top.                      *)
+
+PROCEDURE CursorForward (LB: ListBox): BOOLEAN;
+
+    (* Moves the cursor one row forward.  Returns TRUE if we did  *)
+    (* move forward, FALSE if we ran off the bottom.              *)
+
+PROCEDURE CursorMovements (LB: ListBox): BOOLEAN;
+
+    (* Moves the cursor position in response to keyboard characters     *)
+    (* (cursor up/down, Home, End, PgUp, PgDn).  On return, the         *)
+    (* first keyboard key that we didn't use remains available to be    *)
+    (* read by the caller.  The function result is TRUE iff the user    *)
+    (* moved the cursor off the top of the ListBox.                     *)
+
+END ListBoxes.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/listedit.def b/examples/Modula-2_Libraries/PMOS/def/listedit.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/listedit.def
@@ -0,0 +1,87 @@
+DEFINITION MODULE ListEditor;
+
+	(********************************************************)
+	(*							*)
+	(*		"Generic" list editor			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	13 February 1991		*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	ADDRESS;
+
+FROM Windows IMPORT
+    (* type *)	Window;
+
+FROM FieldEditor IMPORT
+    (* type *)	FieldType, WriteProc, EditProc;
+
+(************************************************************************)
+(*									*)
+(*  The editor in this module is "generic" in a limited sense.  It	*)
+(*  performs screen editing of a linear list, but obviously it has to	*)
+(*  make some assumptions about the linkage method by which the list	*)
+(*  is implemented.  The list must have the general form		*)
+(*									*)
+(*	 TYPE List = POINTER TO	RECORD					*)
+(*				    next: List;				*)
+(*				    component: some pointer type;	*)
+(*				END (*RECORD*)				*)
+(*									*)
+(*  Notice however that this definition module actually defines lists	*)
+(*  and components in terms of type ADDRESS, so that there is no	*)
+(*  requirement that the caller's types and field names match the	*)
+(*  above definition.							*)
+(*									*)
+(*  The caller is required to supply, via FieldEditor.DefineFieldType,	*)
+(*  procedures which write and edit list components.			*)
+(*									*)
+(*  The procedures in this module obey the rules set by module		*)
+(*  FieldEditor.  In the case where a list of lists is being edited,	*)
+(*  the component editor can simply call EditList to do its job for it.	*)
+(*									*)
+(************************************************************************)
+
+TYPE
+    ListFormat;		(* is private *)
+    List = ADDRESS;
+
+(************************************************************************)
+
+PROCEDURE DefineListFormat (header, separator, trailer: ARRAY OF CHAR;
+				ComponentType: FieldType): ListFormat;
+
+    (* Sets up the output format for a class of lists.  The header is	*)
+    (* what is written before the first component; the separator is	*)
+    (* what is written between the components; and the trailer is what	*)
+    (* is written after the last component.  For an empty list, only	*)
+    (* the header and trailer will be written.  ComponentType		*)
+    (* implicitly specifies the procedures which will be used to write	*)
+    (* and edit the components of the list.				*)
+
+PROCEDURE DiscardFormat (format: ListFormat);
+
+    (* A notification from the user that this format will not be used	*)
+    (* again (unless it is redefined by another call to procedure	*)
+    (* DefineListFormat).  Use of this procedure is optional, but is	*)
+    (* recommended for the sake of "clean" memory management.		*)
+
+PROCEDURE WriteList (w: Window;  L: List;  format: ListFormat);
+
+    (* Writes L on the screen, including its delimiters.  This		*)
+    (* procedure is not actually used in this module, but is provided	*)
+    (* as something that a client module may find useful.		*)
+
+PROCEDURE EditList (w: Window;  VAR (*INOUT*) L: List;  format: ListFormat);
+
+    (* Edits a list at the current cursor position in window w.  We	*)
+    (* leave this procedure on seeing a keyboard character which does	*)
+    (* not belong to us.  The cursor is left just beyond the "trailer"	*)
+    (* string which terminates the displayed form of the list.  The	*)
+    (* terminating keystroke is returned to the keyboard driver so that	*)
+    (* it can still be read by the caller.				*)
+
+END ListEditor.
diff --git a/examples/Modula-2_Libraries/PMOS/def/lowlevel.def b/examples/Modula-2_Libraries/PMOS/def/lowlevel.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/lowlevel.def
@@ -0,0 +1,332 @@
+DEFINITION MODULE LowLevel;
+
+        (********************************************************)
+        (*                                                      *)
+        (*         Miscellaneous low-level procedures           *)
+        (*                                                      *)
+        (*  Programmer:         P. Moylan                       *)
+        (*  Last edited:        1 September 1998                *)
+        (*  Status:             Working                         *)
+        (*                                                      *)
+        (*      Now appears to be working, but:                 *)
+        (*       (a) untested, more checking needed;            *)
+        (*       (b) it's still not clear that what's           *)
+        (*           provided is what the clients needed,       *)
+        (*           particularly in relation to 16 bit/32 bit  *)
+        (*           distinctions.                              *)
+        (*                                                      *)
+        (*      Note that the implementation of this module     *)
+        (*      is heavily compiler-dependent.  This version    *)
+        (*      is for use with the XDS compiler,               *)
+        (*                                                      *)
+        (*      NOTE: Much of this module was originally        *)
+        (*      designed for 16-bit words, and I'm gradually    *)
+        (*      changing that.  What I need to look at is what  *)
+        (*      the client modules really need (e.g. who really *)
+        (*      uses a procedure like "HighByte").              *)
+        (*                                                      *)
+        (*      NOTE: Some procedures commented out, because I  *)
+        (*      haven't yet worked out the details.             *)
+        (*                                                      *)
+        (********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)  CARD8, INT8, CARD16, INT16, LOC, ADDRESS;
+
+FROM Types IMPORT
+    (* type *)  FarPointer;
+
+(************************************************************************)
+(*                           MISCELLANEOUS                              *)
+(************************************************************************)
+
+PROCEDURE EVAL (f: ARRAY OF LOC);
+
+    (* A do-nothing procedure - we use it for evaluating a function and *)
+    (* ignoring the result.                                             *)
+
+PROCEDURE Assert (arg: BOOLEAN);
+
+    (* Halts the program if arg is FALSE. *)
+
+(************************************************************************)
+(*                         STORAGE ALLOCATION                           *)
+(************************************************************************)
+
+PROCEDURE ALLOCATE64 (VAR (*OUT*) p: ADDRESS;  amount: CARDINAL);
+
+    (* Like Storage.ALLOCATE, but this procedure tries to ensure that   *)
+    (* the allocated block does not cross a 64K boundary in memory.     *)
+    (* This restriction is required when passing data to and from the   *)
+    (* 16-bit API procedures (Vio, etc.)                                *)
+
+(************************************************************************)
+(*                          BITWISE LOGIC                               *)
+(************************************************************************)
+
+PROCEDURE IAND (first, second: CARDINAL): CARDINAL;
+
+    (* Bit-by-bit logical AND.  *)
+
+PROCEDURE IANDB (first, second: CARD8): CARD8;
+
+    (* Bit-by-bit logical AND for bytes. *)
+
+PROCEDURE IOR (first, second: CARDINAL): CARDINAL;
+
+    (* Bit-by-bit inclusive OR. *)
+
+PROCEDURE IORB (first, second: CARD8): CARD8;
+
+    (* Bit-by-bit inclusive OR. *)
+
+PROCEDURE IXOR (first, second: CARDINAL): CARDINAL;
+
+    (* Bit-by-bit exclusive OR. *)
+
+PROCEDURE IXORB (first, second: CARD8): CARD8;
+
+    (* Bit-by-bit exclusive OR. *)
+
+PROCEDURE INOT (value: CARDINAL): CARDINAL;
+
+    (* Bit-by-bit Boolean complement.   *)
+
+PROCEDURE INOTB (value: CARD8): CARD8;
+
+    (* Bit-by-bit Boolean complement.   *)
+
+PROCEDURE ROL (value: CARDINAL;  count: CARDINAL): CARDINAL;
+
+    (* Left rotation of "value" by "count" bit positions.       *)
+
+PROCEDURE ROLB (value: CARD8;  count: CARDINAL): CARD8;
+
+    (* Left rotation of "value" by "count" bit positions.       *)
+
+PROCEDURE LS (value: CARDINAL;  count: CARDINAL): CARDINAL;
+
+    (* Left shift of "value" by "count" bit positions, with zero fill.  *)
+
+PROCEDURE LSB (value: CARD8;  count: CARDINAL): CARD8;
+
+    (* Left shift of "value" by "count" bit positions, with zero fill.  *)
+
+PROCEDURE ROR (value: CARDINAL;  count: CARDINAL): CARDINAL;
+
+    (* Right rotation of "value" by "count" bit positions.      *)
+
+PROCEDURE RORB (value: CARD8;  count: CARDINAL): CARD8;
+
+    (* Right rotation of "value" by "count" bit positions.      *)
+
+PROCEDURE RS (value, count: CARDINAL): CARDINAL;
+
+    (* Right shift of "value" by "count" bit positions, with zero fill. *)
+
+PROCEDURE RSB (value: CARD8;  count: CARDINAL): CARD8;
+
+    (* Right shift of "value" by "count" bit positions, with zero fill. *)
+
+(************************************************************************)
+(*                          POINTER OPERATIONS                          *)
+(************************************************************************)
+
+PROCEDURE Far (A: ADDRESS): FarPointer;
+
+    (* Converts a pointer to a far pointer. *)
+
+PROCEDURE MakePointer (segment: CARD16; offset: CARDINAL): FarPointer;
+
+    (* Creates a pointer, given the segment and offset within segment.  *)
+
+PROCEDURE SEGMENT (A: ADDRESS): CARD16;
+
+    (* Returns the segment part of an address.  *)
+
+PROCEDURE FarSEGMENT (A: FarPointer): CARD16;
+
+    (* Returns the segment part of an address.  *)
+
+PROCEDURE OFFSET (A: ADDRESS): CARDINAL;
+
+    (* Returns the offset part of an address.   *)
+
+PROCEDURE AddOffset (A: ADDRESS;  increment: CARDINAL): ADDRESS;
+
+    (* Returns a pointer to the memory location whose physical address  *)
+    (* is Physical(A)+increment.  In the present version, it is assumed *)
+    (* that the caller will never try to run off the end of a segment.  *)
+
+PROCEDURE SubtractOffset (A: ADDRESS;  decrement: CARDINAL): ADDRESS;
+
+    (* Like AddOffset, except that we go backwards in memory.  Running  *)
+    (* off the beginning of the segment is an undetected error.         *)
+
+PROCEDURE FarAddOffset (A: FarPointer;  increment: CARDINAL): FarPointer;
+
+    (* Like AddOffset, except for the parameter types. *)
+
+PROCEDURE FarSubtractOffset (A: FarPointer; decrement: CARDINAL): FarPointer;
+
+    (* Like SubtractOffset, except for the parameter types. *)
+
+(*PROCEDURE Virtual (PA: LONGCARD): FarPointer;*)
+
+    (* Converts a physical address to a virtual address, if possible.   *)
+    (* There are no guarantees in the case where there is no such       *)
+    (* virtual address.                                                 *)
+
+(*PROCEDURE Physical (A: ADDRESS): LONGCARD;*)
+
+    (* Converts a virtual address to a physical address.  Use with care!*)
+
+(************************************************************************)
+(*                      BYTE/WORD/LONGCARD CONVERSIONS                  *)
+(************************************************************************)
+
+PROCEDURE LowByte (w: CARDINAL): CARD8;
+
+    (* Returns the low-order byte of its argument.      *)
+
+PROCEDURE HighByte (w: CARD16): CARD8;
+
+    (* Returns the high-order byte of its argument.     *)
+
+PROCEDURE MakeWord (high, low: CARD8): CARD16;
+
+    (* Combines two bytes into a word.  The first argument becomes the  *)
+    (* most significant byte of the result.                             *)
+
+PROCEDURE SignExtend (val: INT8): INTEGER;
+
+    (* Converts a signed 8-bit number to signed integer. *)
+
+PROCEDURE LowWord (w: CARDINAL): CARD16;
+
+    (* Returns the low-order word of its argument.      *)
+
+PROCEDURE HighWord (w: CARDINAL): CARD16;
+
+    (* Returns the high-order word of its argument.     *)
+
+PROCEDURE MakeLongword (high, low: CARD16): CARDINAL;
+
+    (* Combines two words into a longword.  The first argument becomes  *)
+    (* the most significant word of the result.                         *)
+
+(************************************************************************)
+(*                      MISCELLANEOUS ARITHMETIC                        *)
+(************************************************************************)
+
+PROCEDURE INCV (VAR (*INOUT*) dest: CARDINAL;  src: CARDINAL): BOOLEAN;
+
+    (* Computes dest := dest + src, and returns TRUE iff the addition   *)
+    (* produced a carry.                                                *)
+
+PROCEDURE INCVB (VAR (*INOUT*) dest: CARD8;  src: CARD8): BOOLEAN;
+
+    (* Computes dest := dest + src, and returns TRUE iff the addition   *)
+    (* produced a carry.                                                *)
+
+PROCEDURE DECV (VAR (*INOUT*) dest: CARDINAL;  src: CARDINAL): BOOLEAN;
+
+    (* Computes dest := dest - src, and returns TRUE iff the            *)
+    (* subtraction produced a borrow.                                   *)
+
+PROCEDURE DECVB (VAR (*INOUT*) dest: CARD8;  src: CARD8): BOOLEAN;
+
+    (* Computes dest := dest - src, and returns TRUE iff the            *)
+    (* subtraction produced a borrow.                                   *)
+
+PROCEDURE Mul (A, B: CARD16): CARDINAL;
+
+    (* Same as A*B, except for the type of the result.  We provide this *)
+    (* as a general-purpose function since this combination of operands *)
+    (* is often precisely what is wanted.                               *)
+
+PROCEDURE MulB (A, B: CARD8): CARD16;
+
+    (* Same as A*B, except for the type of the result.  We provide this *)
+    (* as a general-purpose function since this combination of operands *)
+    (* is often precisely what is wanted.                               *)
+
+PROCEDURE IMul (A, B: INT16): INTEGER;
+
+    (* Like Mul, but signed. *)
+
+PROCEDURE IMulB (A, B: INT8): INT16;
+
+    (* Like MulB, but signed. *)
+
+PROCEDURE DivB (A: CARD16;  B: CARD8): CARD8;
+
+    (* Same as A DIV B, except for the type of A.  We provide this as   *)
+    (* a general-purpose function since this combination of operands    *)
+    (* is often precisely what is wanted.                               *)
+
+PROCEDURE Div (A: CARDINAL;  B: CARD16): CARD16;
+
+    (* Same as A DIV B, except for the type of A.  We provide this as   *)
+    (* a general-purpose function since this combination of operands    *)
+    (* is often precisely what is wanted.                               *)
+
+(************************************************************************)
+(*                           BLOCK MOVES                                *)
+(************************************************************************)
+
+PROCEDURE Copy (source, destination: ADDRESS;  bytecount: CARDINAL);
+
+    (* Copies an array of bytes from the source address to the          *)
+    (* destination address.  In the case where the two arrays overlap,  *)
+    (* the destination address should be lower in physical memory than  *)
+    (* the source address.                                              *)
+
+PROCEDURE FarCopy (source, destination: FarPointer;  bytecount: CARDINAL);
+
+    (* Copies an array of bytes from the source address to the          *)
+    (* destination address.  In the case where the two arrays overlap,  *)
+    (* the destination address should be lower in physical memory than  *)
+    (* the source address.                                              *)
+
+PROCEDURE CopyUp (source, destination: FarPointer;  bytecount: CARDINAL);
+
+    (* A variant of Copy which does the move backwards, in order        *)
+    (* to handle the case where the destination address is inside the   *)
+    (* source array.  In this special case Copy cannot be used,         *)
+    (* because it would overwrite data it was about to copy.            *)
+
+PROCEDURE BlockFill (destination: FarPointer;
+                                bytecount: CARDINAL;  value: CARD8);
+
+    (* Fills the destination array with the given value.        *)
+
+PROCEDURE BlockFillWord (destination: FarPointer;  wordcount: CARDINAL;
+                                                        value: CARD16);
+
+    (* Fills the destination array with the given value.        *)
+
+(************************************************************************)
+(*                          INPUT AND OUTPUT                            *)
+(*           I haven't yet worked out how to do this in OS/2            *)
+(************************************************************************)
+
+(*PROCEDURE OutByte (port: CARDINAL; value: BYTE);*)
+
+    (* Puts the value out to an output port.    *)
+
+(*PROCEDURE InByte (port: CARDINAL): BYTE;*)
+
+    (* Reads a byte from an input port. *)
+
+(*PROCEDURE InStringWord (port: CARDINAL;  BufferAddress: ADDRESS;
+                                                count: CARDINAL); *)
+
+    (* Reads count words from an input port.    *)
+
+(*PROCEDURE OutStringWord (port: CARDINAL;  BufferAddress: ADDRESS;
+                                                count: CARDINAL);*)
+
+    (* Writes count words to an output port.    *)
+
+END LowLevel.
diff --git a/examples/Modula-2_Libraries/PMOS/def/mailboxe.def b/examples/Modula-2_Libraries/PMOS/def/mailboxe.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/mailboxe.def
@@ -0,0 +1,43 @@
+DEFINITION MODULE Mailboxes;
+
+        (********************************************************)
+        (*                                                      *)
+        (*      Mailboxes for intertask communication           *)
+        (*                                                      *)
+        (*  Programmer:         P. Moylan                       *)
+        (*  Last edited:        30 September 1996               *)
+        (*  Status:             Working                         *)
+        (*                                                      *)
+        (********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)  ADDRESS;
+
+TYPE Mailbox;           (* is private *)
+
+PROCEDURE CreateMailbox (LengthLimit: CARDINAL): Mailbox;
+
+    (* Creates a new mailbox.  LengthLimit is the maximum number of     *)
+    (* characters in a single message.  (A limit is needed so that a    *)
+    (* task reading the mailbox knows how much space to allocate.)      *)
+
+PROCEDURE SendMessage (MB: Mailbox;  messageptr: ADDRESS;
+                                        length: CARDINAL): BOOLEAN;
+
+    (* Copies a string, specified by its address and length, into the   *)
+    (* specified mailbox.  Returns TRUE if successful, and FALSE if the *)
+    (* message is too long or the mailbox does not exist.               *)
+
+PROCEDURE ReceiveMessage (MB: Mailbox;  VAR (*OUT*) message: ARRAY OF CHAR;
+                                        TimeLimit: CARDINAL): CARDINAL;
+
+    (* Returns the next message (after waiting if necessary) from       *)
+    (* mailbox MB.  TimeLimit is a timeout value in milliseconds.       *)
+    (* (Specify TimeLimit=0 for infinite patience.)  The function       *)
+    (* return value is the message length; this is zero if no message   *)
+    (* was obtained, either because of a faulty mailbox or because of   *)
+    (* timeout.  Note: it is also possible to have a genuine message of *)
+    (* zero length.                                                     *)
+
+END Mailboxes.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/maintena.def b/examples/Modula-2_Libraries/PMOS/def/maintena.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/maintena.def
@@ -0,0 +1,37 @@
+DEFINITION MODULE MaintenancePages;
+
+        (********************************************************)
+        (*                                                      *)
+        (*      Support for "maintenance page" screen output    *)
+        (*                                                      *)
+        (*  Programmer:         P. Moylan                       *)
+        (*  Last edited:        12 March 1993                   *)
+        (*  Status:             OK                              *)
+        (*                                                      *)
+        (********************************************************)
+
+FROM Windows IMPORT
+    (* type *)  Window;
+
+TYPE MaintenancePage;   (* is private *)
+
+PROCEDURE CreateMaintenancePage (VAR (*OUT*) page: MaintenancePage);
+
+    (* Creates a new maintenance page.  *)
+
+PROCEDURE Associate (w: Window;  page: MaintenancePage);
+
+    (* Before calling this procedure, both w and page must have been    *)
+    (* created.  This procedure ensures that window w is visible on     *)
+    (* the screen only when the given maintenance page is active.       *)
+    (* The association lasts until the window is closed or the page     *)
+    (* is removed.                                                      *)
+
+PROCEDURE RemoveMaintenancePage (VAR (*INOUT*) page: MaintenancePage);
+
+    (* Destroys all associations between the given page and its screen  *)
+    (* windows (but does not close the windows), and permanently        *)
+    (* removes this page from the collection of maintenance pages.      *)
+
+END MaintenancePages.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/md5.def b/examples/Modula-2_Libraries/PMOS/def/md5.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/md5.def
@@ -0,0 +1,51 @@
+DEFINITION MODULE MD5;
+
+        (********************************************************)
+        (*                                                      *)
+        (*                  MD5 ENCRYPTION                      *)
+        (*                                                      *)
+        (*  MD5 message-digest algorithm as defined in RFC 1321 *)
+        (*                                                      *)
+        (*  Processes a data sequence of arbitrary length,      *)
+        (*  producing a 16-byte "digest" as a secure signature  *)
+        (*  of this data sequence.                              *)
+        (*                                                      *)
+        (*  Programmer:         P. Moylan                       *)
+        (*  Started:            14 September 1998               *)
+        (*  Last edited:        07 August 2002                  *)
+        (*  Status:             Working                         *)
+        (*                                                      *)
+        (*  This module is derived from the RSA Data Security,  *)
+        (*  Inc. MD5 Message-Digest Algorithm.                  *)
+        (*                                                      *)
+        (********************************************************)
+
+FROM SYSTEM IMPORT CARD32, LOC;
+
+TYPE
+    MD5_CTX;    (* is private *)
+    DigestType = ARRAY [0..3] OF CARD32;
+
+
+PROCEDURE MD5Init(): MD5_CTX;
+
+    (* MD5 initialization. Begins an MD5 operation, creating a new context. *)
+
+PROCEDURE MD5Update (context: MD5_CTX;  data: ARRAY OF LOC;  length: CARDINAL);
+
+    (* MD5 block update operation. Continues an MD5 message-digest operation,   *)
+    (* adding more data to what has already been processed for this context.    *)
+
+PROCEDURE MD5Final (VAR (*INOUT*) context: MD5_CTX;  VAR (*OUT*) digest: DigestType);
+
+    (* MD5 finalization. Ends an MD5 message-digest operation, returning    *)
+    (* the message digest and discarding the context.                       *)
+
+PROCEDURE MD5DigestToString (VAR (*IN*) digest: DigestType;
+                             VAR (*OUT*) result: ARRAY OF CHAR);
+
+    (* Converts the digest to a 32-character string.  If there is not enough    *)
+    (* space for 32 characters, produces a leading substring of the full result.*)
+
+END MD5.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/menus.def b/examples/Modula-2_Libraries/PMOS/def/menus.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/menus.def
@@ -0,0 +1,203 @@
+DEFINITION MODULE Menus;
+
+        (****************************************************************)
+        (*                                                              *)
+        (*      Displays menus on screen, allows terminal user to       *)
+        (*                      select from them.                       *)
+        (*                                                              *)
+        (*  Programmer:         P. Moylan                               *)
+        (*  Last edited:        11 May 1997                             *)
+        (*  Status:             OK                                      *)
+        (*                                                              *)
+        (****************************************************************)
+
+(************************************************************************)
+(*                                                                      *)
+(*  NOTE: This module gives you the choice of specifying your own       *)
+(*  window in which to display the menu, or using a window which is     *)
+(*  created for you when SelectFromMenu is called.  In either case,     *)
+(*  you use CreateMenu to define the menu initially, SelectFromMenu     *)
+(*  to prompt the user to choose from the menu, and DestroyMenu when    *)
+(*  you have finished using the menu.  You can also control some        *)
+(*  aspects of menu behaviour by calling the optional procedures        *)
+(*  MenuColours, SetOptions, and OffEdge after calling CreateMenu.      *)
+(*                                                                      *)
+(*  In most applications, you will want to let this module look after   *)
+(*  the screen window for you.  You need to call PositionMenu to        *)
+(*  define where on the screen the menu will be displayed, but you      *)
+(*  don't need to open a window explicitly.  The menu does not appear   *)
+(*  on the screen until SelectFromMenu is called, and - unless you      *)
+(*  have specified the MNoClose option - it disappears from the         *)
+(*  screen as soon as the keyboard user has made a selection.           *)
+(*  You may, if you wish, use a new call to PositionMenu before each    *)
+(*  call to SelectFromMenu, although the more common case would be to   *)
+(*  call PositionMenu just once, after the call to CreateMenu.          *)
+(*                                                                      *)
+(*  The alternative is to open your own screen window, and to call      *)
+(*  DisplayMenu to show the menu on the screen.  (This also means       *)
+(*  that DisplayMenu defines the location of the menu on the screen,    *)
+(*  so in this case PositionMenu should not be called.)  After that,    *)
+(*  you call SelectFromMenu to prompt the user to choose an item.       *)
+(*  This possibility is provided for applications where, for example,   *)
+(*  you want multiple menus within the same screen window.              *)
+(*                                                                      *)
+(*  Note for users of earlier versions of this module: the earlier      *)
+(*  distinction between Normal Mode and Special Mode is now obsolete.   *)
+(*                                                                      *)
+(************************************************************************)
+
+FROM Windows IMPORT
+    (* type *)  Window, Colour, RowRange, ColumnRange;
+
+TYPE
+    Menu;               (* is private *)
+    ItemText = ARRAY ColumnRange OF CHAR;
+    MenuColumn = CARDINAL;
+
+    (* Note the dual use of the word "column".  A variable of type      *)
+    (* ColumnRange refers to a horizontal screen position.  But in      *)
+    (* menus we use "column" to a column of character strings, which    *)
+    (* is why we have the separate type MenuColumn.  The type           *)
+    (* MenuColumn is defined primarily to make it clear which type of   *)
+    (* column is being referred to in every case.                       *)
+
+    MenuOption = (MTitle, MNoTitle, MBorder, MNoBorder, MClose, MNoClose,
+                        MKeyBack, MNoKeyBack, MFastSelect, MNoFastSelect,
+                        MMouse, MNoMouse, MCloseonClickOutside,
+                        MNoCloseonClickOutside);
+
+    MO = SET OF MenuOption;
+
+    (* The options have the following meanings:                         *)
+    (*  MTitle          Messages[0], as specified in the CreateMenu     *)
+    (*                  call, is used as a menu title to be displayed.  *)
+    (*  MNoTitle        No title is displayed, Messages[0] is ignored.  *)
+    (*  MBorder         The menu has a border.                          *)
+    (*  MNoBorder       The menu has no border.                         *)
+    (*  MClose          The window containing the menu is closed after  *)
+    (*                  a selection has been made.                      *)
+    (*  MNoClose        The window containing the menu is kept open on  *)
+    (*                  return from SelectFromMenu (and the same window *)
+    (*                  will be re-used on the next call).              *)
+    (*  MKeyBack        The keystroke that caused an exit from          *)
+    (*                  SelectFromMenu remains available to the caller, *)
+    (*                  via InKey() or equivalent.                      *)
+    (*  MNoKeyBack      On return from SelectFromMenu, the keystroke    *)
+    (*                  that caused the exit has been consumed.         *)
+    (*  MFastSelect     A menu item reached by selection key or mouse   *)
+    (*                  click is selected immediately.                  *)
+    (*  MNoFastSelect   The user has to type Space or Return to select  *)
+    (*                  the highlighted menu item.                      *)
+    (*  MMouse          The user may move and hide the menu with the    *)
+    (*                  mouse, if a mouse driver is present.            *)
+    (*  MNoMouse        User may click on the menu but may not move it  *)
+    (*                  with the mouse.                                 *)
+    (*  MCloseonClickOutside                                            *)
+    (*                  If user clicks outside the menu, we return as   *)
+    (*                  if Esc had been typed, and the click remains    *)
+    (*                  available to be interpreted by whatever windows *)
+    (*                  are on the screen.                              *)
+    (*  MNoCloseonClickOutside                                          *)
+    (*                  Any mouse click outside the menu is consumed    *)
+    (*                  but otherwise ignored.                          *)
+    (* Note that some of the options are mutually contradictory.  This  *)
+    (* way of specifying options was chosen to make it easy to specify  *)
+    (* "no change to previously set option", e.g. if you specify        *)
+    (* neither MTitle nor MNoTitle then the behaviour of the menu with  *)
+    (* respect to the title display remains at what was already in      *)
+    (* force.  If you specify contradictory options (e.g. MTitle and    *)
+    (* MNoTitle) at the same time then the result is not guaranteed to  *)
+    (* be consistent between versions of this module.                   *)
+
+    OffEdgeOption = (stick, wrap, escape, return);
+
+    (* An OffEdgeOption specifies what is to be done when the user      *)
+    (* tries to run the menu cursor off the edge of the menu.  The      *)
+    (* possibilities are:                                               *)
+    (*  stick           The cursor refuses to move in that direction.   *)
+    (*  wrap            The cursor wraps to the opposite edge.          *)
+    (*  escape          Return to caller with a result of 0.            *)
+    (*  return          Return to caller with a result that reflects    *)
+    (*                  the currently highlighted item.                 *)
+
+(************************************************************************)
+
+PROCEDURE CreateMenu (VAR (*OUT*) M: Menu;  columns: MenuColumn;
+                        VAR (*IN*) Messages: ARRAY OF ItemText;
+                        NumberOfItems: CARDINAL);
+
+    (* Introduces a menu into the system, but does not display it yet.  *)
+    (* For a simple vertical menu, columns = 1.  Use columns > 1 for    *)
+    (* shorter and wider menus.  Messages[0] is the label to put into   *)
+    (* the menu header, if present.  The remaining entries in Messages  *)
+    (* are the items displayed when the menu is put on the screen.      *)
+    (* Special case: if you specify NumberOfItems = 0 then the whole of *)
+    (* array Messages is used.                                          *)
+    (* For each entry of Messages, the selection character is the       *)
+    (* character following a "\".  If there is no "\", the selection    *)
+    (* character is the first character.  The selection character must  *)
+    (* be alphanumeric.  To disable the selection character feature,    *)
+    (* put the "\" in front of a non-alphanumeric character or put it   *)
+    (* at the end of the string.                                        *)
+
+PROCEDURE PositionMenu (M: Menu;  startline, endline: RowRange;
+                                leftcol, rightcol: ColumnRange);
+
+    (* Sets the screen position and size to be used when this menu is   *)
+    (* displayed by a call to SelectFromMenu.  This procedure does not  *)
+    (* actually display the menu - that doesn't happen until            *)
+    (* SelectFromMenu is called.                                        *)
+
+PROCEDURE MenuColours (M: Menu;  fore, back, hfore, hback, select: Colour);
+
+    (* Set the colours for the screen display of the menu.  The colours *)
+    (* fore and back are used as the normal foreground and background   *)
+    (* colours, and the highlighted menu item is displayed in colours   *)
+    (* hfore, hback.  The "select" colour is for highlighting the       *)
+    (* selection character.  This procedure is optional.                *)
+
+PROCEDURE SetOptions (M: Menu;  options: MO);
+
+    (* See the MenuOptions declaration for the possible options.  This  *)
+    (* procedure is optional.  If it is not called, the default options *)
+    (* are {MTitle,MBorder,MClose,MNoKeyBack,MNoFastSelect,MMouse,      *)
+    (* MCloseonClickOutside}.                                           *)
+
+PROCEDURE OffEdge (M: Menu;  top, bottom, left, right: OffEdgeOption);
+
+    (* Sets the menu behaviour when the user runs the cursor off the    *)
+    (* edge of the menu.  There is one parameter for each edge of the   *)
+    (* menu.                                                            *)
+    (* See the OffEdgeOption type declaration for the possible options. *)
+
+PROCEDURE SelectFromMenu (M: Menu): CARDINAL;
+
+    (* Displays menu M on the screen, allows terminal user to use       *)
+    (* cursor keys to move about the menu and the ENTER key to select   *)
+    (* an item.  (The space bar is also accepted, as an alternative to  *)
+    (* the ENTER key, to select an item.)  An item may also be selected *)
+    (* by typing its initial letter, followed by space or ENTER.        *)
+    (* Returns the number of the item which was selected.               *)
+    (* (Item numbers start from 1).  An answer of 0 indicates that the  *)
+    (* user typed the ESC key to return without selecting anything.     *)
+
+PROCEDURE DestroyMenu (M: Menu);
+
+    (* Removes a menu from the system, freeing up the space it used.    *)
+
+(************************************************************************)
+(*                      ALTERNATIVE DISPLAY PROCEDURE                   *)
+(************************************************************************)
+
+PROCEDURE DisplayMenu (w: Window;  M: Menu;
+                                rows, columns, initialvalue: CARDINAL);
+
+    (* Displays menu M at the current cursor position in window w,      *)
+    (* with initialvalue specifying a field to highlight.  The space    *)
+    (* reserved on the screen is "rows" screen rows in height and       *)
+    (* "columns" character positions wide.  (The remainder of window w  *)
+    (* may of course be used for other purposes, including other        *)
+    (* menus.)  When SelectFromMenu is called, it will use window w.    *)
+
+END Menus.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/miscpmos.def b/examples/Modula-2_Libraries/PMOS/def/miscpmos.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/miscpmos.def
@@ -0,0 +1,125 @@
+DEFINITION MODULE MiscPMOS;
+
+        (************************************************)
+        (*                                              *)
+        (*      Miscellaneous PMOS procedures           *)
+        (*                                              *)
+        (*  Programmer:         P. Moylan               *)
+        (*  Last edited:        8 May 1997              *)
+        (*  Status:             OK                      *)
+        (*                                              *)
+        (************************************************)
+
+IMPORT SYSTEM;
+
+TYPE RegisterPacket =
+                (* We don't bother covering everything here, just       *)
+                (* the registers we have a need for.                    *)
+                RECORD
+                    CASE :BOOLEAN OF
+                     | FALSE:   AL, AH, BL, BH, CL, CH, DL, DH: SYSTEM.BYTE;
+                     | TRUE:    AX, BX, CX, DX, BP, SI, DI, DS, ES: CARDINAL;
+                    END (*CASE*);
+                END (*RECORD*);
+
+     CMOSaddress = CARDINAL[0..63];
+
+(************************************************************************)
+(*                              STRING COPY                             *)
+(************************************************************************)
+
+PROCEDURE CopyString (source: ARRAY OF CHAR;  VAR (*OUT*) dest: ARRAY OF CHAR);
+
+    (* Copies a string, with truncation or null termination as needed.  *)
+    (* This function is provided in order to help software portability, *)
+    (* i.e. to avoid having to rewrite code for no reason other than    *)
+    (* a change of compilers.                                           *)
+
+(************************************************************************)
+(*                          STRING COMPARISON                           *)
+(************************************************************************)
+
+PROCEDURE Compare (first, second: ARRAY OF SYSTEM.LOC): INTEGER;
+
+    (* Returns >0 if first>second, 0 if first=second, <0 if             *)
+    (* first<second.  The comparison is bytewise, from the left,        *)
+    (* treating each byte as an unsigned number.                        *)
+
+(************************************************************************)
+(*                   MISCELLANEOUS LOW-LEVEL OPERATIONS                 *)
+(************************************************************************)
+
+PROCEDURE EnterCriticalSection(): CARDINAL;
+
+    (* Saves the processor flags word, including the current "interrupt *)
+    (* enable" status, on the caller's stack, and returns with          *)
+    (* interrupts disabled.   NOTE: this procedure and the following    *)
+    (* one should be used as a matched pair.                            *)
+
+PROCEDURE LeaveCriticalSection (savedPSW: CARDINAL);
+
+    (* Restores the processor flags word, including the "interrupt      *)
+    (* enable" status, from the stack.  NOTE: this procedure and the    *)
+    (* one above should be used as a matched pair.                      *)
+
+(************************************************************************)
+(*       The remaining procedures in this module are unavailable,       *)
+(*             because of incompatibility with OS/2                     *)
+(************************************************************************)
+
+(*
+(************************************************************************)
+(*                      PROCEDURES TO ACCESS CMOS                       *)
+(************************************************************************)
+(*                                                                      *)
+(*  The first 14 bytes of CMOS are used for the real-time clock - see   *)
+(*  module TimeOfDay for details.                                       *)
+(*                                                                      *)
+(*  The contents of the remaining bytes would take too long to describe *)
+(*  here, so only the ones of current interest are mentioned:           *)
+(*                                                                      *)
+(*      10H     Diskette drive type.  The high order 4 bits describe    *)
+(*              drive A, the lower order 4 bits describe drive B.       *)
+(*              The encoding is:                                        *)
+(*                      0       no drive present                        *)
+(*                      1       double sided drive, 48 TPI              *)
+(*                      2       high capacity drive, 96 TPI             *)
+(*                      4       3.5" 1.44MB drive                       *)
+(*                  (other values are reserved).                        *)
+(*                                                                      *)
+(************************************************************************)
+
+PROCEDURE ReadCMOS (location: CMOSaddress): SYSTEM.BYTE;
+
+    (* Returns the value at the given CMOS location.    *)
+
+PROCEDURE WriteCMOS (location: CMOSaddress;  value: SYSTEM.BYTE);
+
+    (* Stores a value at the given CMOS location.       *)
+
+(************************************************************************)
+(*                         BIOS/MS-DOS CALLS                            *)
+(************************************************************************)
+
+PROCEDURE BIOS (InterruptNumber: CARDINAL;
+                        VAR (*INOUT*) Registers: RegisterPacket);
+
+    (* Performs a software interrupt, with the given interrupt number,  *)
+    (* after loading the components of variable "Registers" into the    *)
+    (* machine registers.  After the handler returns, the updated       *)
+    (* register values are put back into variable "Registers".          *)
+
+PROCEDURE ProcessorStatus(): CARDINAL;
+
+    (* Returns the current value of the processor flags word.   *)
+
+PROCEDURE ShortDelay (amount: CARDINAL);
+
+    (* Provides a time delay for those cases where the required delay   *)
+    (* is not long enough to justify a Sleep() operation.               *)
+    (* The present version is not entirely satisfactory - needs to be   *)
+    (* re-tuned for different compiler options, different processor     *)
+    (* models, etc.  This should be seen as an interim solution only.   *)
+*)
+
+END MiscPMOS.
diff --git a/examples/Modula-2_Libraries/PMOS/def/mouse.def b/examples/Modula-2_Libraries/PMOS/def/mouse.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/mouse.def
@@ -0,0 +1,80 @@
+DEFINITION MODULE Mouse;
+
+        (********************************************************)
+        (*                                                      *)
+        (*                  Mouse driver                        *)
+        (*                                                      *)
+        (*  Programmer:         P. Moylan                       *)
+        (*  Last edited:        14 October 1996                 *)
+        (*  Status:             OK                              *)
+        (*                                                      *)
+        (********************************************************)
+
+IMPORT Mouse0;
+
+TYPE
+    Buttons      = Mouse0.Buttons;
+    ButtonSet    = Mouse0.ButtonSet;
+    Events       = Mouse0.Events;
+    EventSet     = Mouse0.EventSet;
+    EventHandler = Mouse0.EventHandler;
+
+(************************************************************************)
+
+PROCEDURE MouseAvailable (): BOOLEAN;
+
+    (* Returns TRUE iff a mouse driver is loaded, a mouse exists, and   *)
+    (* mouse operation is permitted in module ConfigurationOptions.     *)
+
+PROCEDURE ResetMouse (VAR (*OUT*) MousePresent: BOOLEAN;
+                        VAR (*OUT*) NumberOfButtons: CARDINAL);
+
+    (* Initializes mouse, returning MousePresent as FALSE if no mouse   *)
+    (* available and as TRUE if it is, and NumberOfButtons as the       *)
+    (* number of buttons for the mouse if installed.                    *)
+
+PROCEDURE GetTextMousePosition (VAR (*OUT*) Xposition: CARDINAL;
+                                VAR (*OUT*) Yposition: CARDINAL);
+
+    (* Returns the current position of the mouse cursor. *)
+
+PROCEDURE GetTextMouseStatus (VAR (*OUT*) buttons: ButtonSet;
+                                VAR (*OUT*) Xposition: CARDINAL;
+                                VAR (*OUT*) Yposition: CARDINAL);
+
+    (* Returns the current mouse position and state of the buttons.     *)
+
+PROCEDURE SetTextMousePosition (Xposition: CARDINAL; Yposition: CARDINAL);
+
+    (* Initialises the mouse position. *)
+
+PROCEDURE SetTextMousePage (page: CARDINAL);
+
+    (* Sets the hardware screen page where the mouse is visible. *)
+
+PROCEDURE SetMouseCursorLimits (top, bottom: CARDINAL;
+                                        left, right: CARDINAL);
+
+    (* Specifies a rectangular region outside which the mouse cursor    *)
+    (* may not go.                                                      *)
+
+PROCEDURE ShowMouseCursor;
+
+    (* Makes the mouse cursor visible on the screen. *)
+
+PROCEDURE HideMouseCursor;
+
+    (* Makes the mouse cursor invisible. *)
+
+PROCEDURE InstallEventHandler (DetectedEvents: EventSet;
+                                        Handler: EventHandler);
+
+    (* Nominates the procedure to be called whenever an event in the    *)
+    (* set DetectedEvents occurs.  Note: the Handler is like an         *)
+    (* interrupt procedure, in that it is executing in the context of   *)
+    (* an unknown task; typically it should probably restrict its       *)
+    (* actions to fairly elementary things, like a Signal to wake up    *)
+    (* the task that really wants to know about the event.              *)
+
+END Mouse.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/mouse0.def b/examples/Modula-2_Libraries/PMOS/def/mouse0.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/mouse0.def
@@ -0,0 +1,29 @@
+DEFINITION MODULE Mouse0;
+
+        (********************************************************)
+        (*                                                      *)
+        (*      Common definitions for the mouse drivers        *)
+        (*                                                      *)
+        (*  Programmer:         P. Moylan                       *)
+        (*  Last edited:        10 October 1996                 *)
+        (*  Status:             OK                              *)
+        (*                                                      *)
+        (********************************************************)
+
+TYPE
+    Buttons = (LeftButton, RightButton, MiddleButton);
+
+    ButtonSet = SET OF Buttons;
+
+    Events =  (Motion, LeftDown, LeftUp, RightDown, RightUp, MiddleDown,
+              MiddleUp);
+
+    EventSet = SET OF Events;
+
+    EventHandler = PROCEDURE (EventSet,         (* condition mask *)
+                                ButtonSet,      (* Button state *)
+                                CARDINAL,       (* horizontal cursor position *)
+                                CARDINAL);      (* vertical cursor position *)
+
+END Mouse0.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/multiscr.def b/examples/Modula-2_Libraries/PMOS/def/multiscr.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/multiscr.def
@@ -0,0 +1,91 @@
+DEFINITION MODULE MultiScreen;
+
+        (****************************************************************)
+        (*                                                              *)
+        (*  This module allows the creation of multiple virtual screens *)
+        (*  - complete screens, not just windows - with three keyboard  *)
+        (*      "hot keys" used to navigate around the screens.         *)
+        (*                                                              *)
+        (*  We support a two-level hierarchy: a virtual screen is a     *)
+        (*  collection of windows, and each virtual screen is a member  *)
+        (*  of a group.  (In addition, there is a pseudo-group made up  *)
+        (*  of all windows which are not associated with any virtual    *)
+        (*  screen, to handle the "normal output" which bypasses this   *)
+        (*  module.)  The virtual screen switching is done using hot    *)
+        (*  keys, as follows:                                           *)
+        (*     Hotkey1   steps to the previous group                    *)
+        (*     Hotkey2   steps to the next group                        *)
+        (*     Hotkey3   steps to the next virtual screen of the        *)
+        (*               currently active group.                        *)
+        (*                                                              *)
+        (*  In the present version, the client module has to call       *)
+        (*  EnableHotKeys to define the three hot keys.                 *)
+        (*                                                              *)
+        (*      Programmer:         P. Moylan                           *)
+        (*      Last edited:        4 September 1998                    *)
+        (*      Status:             OK                                  *)
+        (*                                                              *)
+        (****************************************************************)
+
+FROM Windows IMPORT
+    (* type *)  Window, DisplayPage;
+
+TYPE ScreenGroup;       (* is private *)
+     VirtualScreen;     (* is private *)
+
+PROCEDURE EnableScreenSwitching (enable: BOOLEAN);
+
+    (* Enables hot key screen switching if enable is TRUE, or disables  *)
+    (* it if enable is FALSE.                                           *)
+
+PROCEDURE EnableHotKeys (flag1: BOOLEAN;  key1: CHAR;
+                         flag2: BOOLEAN;  key2: CHAR;
+                         flag3: BOOLEAN;  key3: CHAR);
+
+    (* Creates the "hot key" tasks, and enable the hot keys.  The first *)
+    (* and second pair of parameters define the previous/next group     *)
+    (* switching hot keys, and the third pair defines the hot key for   *)
+    (* cycling within a group.                                          *)
+    (* The "flag" part of each parameter pair is FALSE for a normal     *)
+    (* key, and TRUE for an extended key defined by a two-character     *)
+    (* sequence (where the first character is CHR(0).                   *)
+
+PROCEDURE CreateScreenGroup (hardwarepage: DisplayPage): ScreenGroup;
+
+    (* Creates a new screen group, and maps it to the specified display *)
+    (* page in the screen hardware.  It is permissible to map more than *)
+    (* one group to the same hardware page.  Note that any group on     *)
+    (* hardware page 0 shares the screen with "normal output" which     *)
+    (* does not belong to any virtual page.  This is permitted, but     *)
+    (* on aesthetic grounds is usually not a good idea.                 *)
+
+PROCEDURE CreateVirtualScreen (group: ScreenGroup): VirtualScreen;
+
+    (* Adds a new virtual screen to the specified group.        *)
+
+PROCEDURE MapToVirtualScreen (w: Window;  screen: VirtualScreen);
+
+    (* Before calling this procedure, both w and screen must have been  *)
+    (* created.  This procedure ensures that window w is visible on     *)
+    (* the screen only when the given virtual screen page is active.    *)
+    (* The association lasts until the window is closed or the virtual  *)
+    (* screen is removed.                                               *)
+
+PROCEDURE VirtualScreenOf (w: Window): VirtualScreen;
+
+    (* Returns the virtual screen, if any, with which window w is       *)
+    (* associated.  It is possible that no such association exists, in  *)
+    (* which case we return a NIL result.                               *)
+
+PROCEDURE RemoveVirtualScreen (VAR (*INOUT*) screen: VirtualScreen);
+
+    (* Destroys all associations between the given virtual screen and   *)
+    (* its windows (but does not close the windows), and permanently    *)
+    (* removes this screen from the collection of virtual screens.      *)
+
+PROCEDURE RemoveScreenGroup (VAR (*INOUT*) group: ScreenGroup);
+
+    (* As above, but removes an entire group.   *)
+
+END MultiScreen.
+
diff --git a/examples/Modula-2_Libraries/PMOS/def/music.def b/examples/Modula-2_Libraries/PMOS/def/music.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/music.def
@@ -0,0 +1,64 @@
+DEFINITION MODULE Music;
+
+	(********************************************************)
+	(*							*)
+	(*		Module to play music.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	28 May 1989			*)
+	(*  Status:						*)
+	(*	Initial version working well.  Still testing.	*)
+	(*							*)
+	(********************************************************)
+
+PROCEDURE SetNoteDuration (D: CARDINAL);
+
+    (* Sets the duration of each of the following notes, until further	*)
+    (* notice, to D milliseconds.  The precision of this setting is	*)
+    (* limited by the clock interrupt frequency used in module Timer;	*)
+    (* the resolution can be as poor as 1/9 second.  The duration can	*)
+    (* subsequently be modified by the * and / options (see below), or	*)
+    (* by another call to SetNoteDuration.				*)
+
+PROCEDURE PlayMusic (notes: ARRAY OF CHAR);
+
+    (* Plays the tune specified in array "notes".  The playing is done	*)
+    (* asynchronously; that is, this procedure returns before the music	*)
+    (* is over.  However, a return from this procedure does imply that	*)
+    (* array "notes" can be re-used or destroyed; the notes might not	*)
+    (* yet have been played, but the data necessary to play them have	*)
+    (* been processed and the necessary information stored.		*)
+
+PROCEDURE WaitForMusicFinished;
+
+    (* Blocks the calling task until there is no more music playing.	*)
+    (* This is a guard against things like premature task termination.	*)
+
+(************************************************************************)
+(*									*)
+(*  In the "notes" argument to PlayMusic, the following options are	*)
+(*  accepted:								*)
+(*	C D E F G A B	the usual notation for a note.			*)
+(*	b #		flat or sharp, modifying the previously given	*)
+(*			 note.  There is no legality checking; for	*)
+(*			 example, B# is illegal but the software does	*)
+(*			 check for this.				*)
+(*	R		a rest.						*)
+(*	*		double the duration of the following notes.	*)
+(*	/		halve the duration of the following notes.	*)
+(*	3		divide the duration of the following notes	*)
+(*			 by 3.  The *, /, and 3 options take effect for	*)
+(*			 all following notes, until the duration is	*)
+(*			 modified again by one of these options or by	*)
+(*			 an explicit call to SetNoteDuration.		*)
+(*	u		go up one octave.				*)
+(*	d		go down one octave.  In many cases the u and d	*)
+(*			 options are not needed because PlayMusic	*)
+(*			 chooses the appropriate octave based on the	*)
+(*			 assumption that successive notes will be	*)
+(*			 close to each other; but u and d can override	*)
+(*			 this assumption.				*)
+(*									*)
+(************************************************************************)
+
+END Music.
diff --git a/examples/Modula-2_Libraries/PMOS/def/musicdem.def b/examples/Modula-2_Libraries/PMOS/def/musicdem.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/musicdem.def
@@ -0,0 +1,22 @@
+DEFINITION MODULE MusicDemonstration;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of module Music.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	24 June 1989			*)
+	(*  Status:						*)
+	(*	Working.  Musically, it could be polished up a	*)
+	(*	little, but from the software development	*)
+	(*	viewpoint it is complete - module Music does	*)
+	(*	indeed work as desired.				*)
+	(*							*)
+	(********************************************************)
+
+PROCEDURE WaitForEndOfMusic;
+
+    (* Synchronization procedure: does not return until the music	*)
+    (* demonstration is over.						*)
+
+END MusicDemonstration.
diff --git a/examples/Modula-2_Libraries/PMOS/def/netdb.def b/examples/Modula-2_Libraries/PMOS/def/netdb.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/def/netdb.def
@@ -0,0 +1,208 @@
+<* M2EXTENSIONS + *>
+
+DEFINITION MODULE ["SysCall"] NetDB;
+
+        (********************************************************)
+        (*                                                      *)
+        (*             Network database library.                *)
+        (*                                                      *)
+        (*  Structures returned by network data base library.   *)
+        (*  All addresses are supplied in host order, and       *)
+        (*  returned in network order.                          *)
+        (*                                                      *)
+        (*  Programmer:         P. Moylan                       *)
+        (*  Started:            27 February 1998                *)
+        (*  Last edited:        17 August 2000                  *)
+        (*  Status:             Partly implemented              *)
+        (*                                                      *)
+        (*          I haven't bothered to implement the         *)
+        (*          procedures I don't need.                    *)
+        (*                                                      *)
+        (********************************************************)
+
+(********************************************************************************)
+(*                                                                              *)
+(* This module is derived in part from the netdb.h file that comes with OS/2    *)
+(* Warp 4, and that file carries the following copyright notice:                *)
+(*                                                                              *)
+(* Copyright (c) 1980,1983,1988 Regents of the University of California.        *)
+(* All rights reserved.                                                         *)
+(*                                                                              *)
+(* Redistribution and use in source and binary forms are permitted              *)
+(* provided that this notice is preserved and that due credit is given          *)
+(* to the University of California at Berkeley. The name of the University      *)
+(* may not be used to endorse or promote products derived from this             *)
+(* software without specific prior written permission. This software            *)
+(* is provided ``as is'' without express or implied warranty.                   *)
+(*                                                                              *)
+(*      @(#)netdb.h     5.9 (Berkeley) 4/5/88                                   *)
+(*                                                                              *)
+(********************************************************************************)
+
+FROM SYSTEM IMPORT CARD32;
+
+FROM Sockets IMPORT AddressFamily;
+
+CONST
+    MAXALIASES = 35;
+    MAXADDRS   = 35;
+
+TYPE
+    Subscript = [0..511];
+    AddressPointerArrayPointer = POINTER TO ARRAY [0..MAXADDRS]
+                                             OF POINTER TO CARDINAL;
+
+    (* The fields in a HostEnt structure are defined as follows.                *)
+    (*   h_name         Official name of the host                               *)
+    (*   h_aliases      Zero-terminated array of alternative names for the host *)
+    (*   h_addrtype     The address family of the network address being         *)
+    (*                        returned, always set to AF_INET                   *)
+    (*   h_length       Length of the address in bytes                          *)
+    (*   h_addr_list    Pointer to array of pointers to addresses returned by   *)
+    (*                  the name server.  Each address is in network byte order *)
+
+    HostEntPtr = POINTER TO
+                   RECORD
+                       h_name: POINTER TO ARRAY Subscript OF CHAR;
+                       h_aliases: POINTER TO ARRAY [0..MAXALIASES-1] OF
+                                          POINTER TO ARRAY Subscript OF CHAR;
+                       h_addrtype: CARDINAL;
+                       h_length: CARDINAL;
+                       h_addr_list: AddressPointerArrayPointer;
+                   END (*RECORD*);
+
+PROCEDURE ["SysCall"] gethostname (VAR (*OUT*) name: ARRAY OF CHAR;
+                                                  namelength: CARDINAL): BOOLEAN;
+
+    (* Returns our own host name in "name".  The function result is TRUE iff    *)
+    (* there was an error.                                                      *)
+
+PROCEDURE ["SysCall"] gethostbyname (name: ARRAY OF CHAR): HostEntPtr;
+
+    (* Result: a pointer to a hostent structure maintained by the library,      *)
+    (* which gives details of the host name.  The result could be NIL if there  *)
+    (* was an error.                                                            *)
+
+PROCEDURE ["SysCall"] gethostbyaddr (VAR (*IN*) addr: CARD32;  addrlength: CARDINAL;
+                                               family: AddressFamily): HostEntPtr;
+
+    (* Input: addr is a 32-bit Internet address in network-byte order.  The     *)
+    (* second and third parameters should always be equal to SIZE(CARD32) and   *)
+    (* AF_INET, as far as I can tell.                                           *)
+    (* Result: a pointer to a hostent structure maintained by the library,      *)
+    (* which gives details of the host name.  The result could be NIL if there  *)
+    (* was an error.                                                            *)
+
+PROCEDURE ["SysCall"] tcp_h_errno(): CARDINAL;
+
+    (* Returns the error code from the last gethostbyname or gethostbyaddr call.*)
+    (* The values are                                                           *)
+    (*      0     no error                                                      *)
+    (*      1     host not found                                                *)
+    (*      2     nameserver failure, try again later                           *)
+    (*      3     unrecoverable error                                           *)
+    (*      4     address is valid, but does not have a nameserver entry.       *)
+    (* Discovery: this is often returning an error code 1 after gethostbyname   *)
+    (* or gethostbyaddr even though the host was found.  I conclude that this   *)
+    (* function must be buggy, at least for some releases of tcp/ip.            *)
+
+END NetDB.
+
+(********************************************************************************)
+(*                The following part has not yet been translated                *)
+(********************************************************************************)
+
+/*
+ * Assumption here is that a network number
+ * fits in 32 bits -- probably a poor one.
+ */
+struct  netent {
+        char            *n_name;        /* official name of net */
+        char            **n_aliases;    /* alias list */
+        int             n_addrtype;     /* net address type */
+        unsigned long   n_net;          /* network # */
+};
+
+struct  servent {
+        char    *s_name;        /* official service name */
+        char    **s_aliases;    /* alias list */
+        int     s_port;         /* port # */
+        char    *s_proto;       /* protocol to use */
+};
+
+struct  protoent {
+        char    *p_name;        /* official protocol name */
+        char    **p_aliases;    /* alias list */
+        int     p_proto;        /* protocol # */
+};
+
+#include <stdio.h>
+#include <string.h>
+#include <netinet\in.h>
+#define _MAXALIASES     35
+#define _MAXADDRS       35
+#define _MAXLINELEN     1024
+#define _HOSTBUFSIZE    (BUFSIZ + 1)
+
+/*
+ * After a successful call to gethostbyname_r()/gethostbyaddr_r(), the
+ * structure hostent_data will contain the data to which pointers in
+ * the hostent structure will point to.
+ */
+
+struct  hostent_data {
+        struct    in_addr host_addr;              /* host address pointer */
+        char      *h_addr_ptrs[_MAXADDRS + 1];    /* host address         */
+        char      hostaddr[_MAXADDRS];
+        char      hostbuf[_HOSTBUFSIZE + 1];      /* host data            */
+        char      *host_aliases[_MAXALIASES];
+        char      *host_addrs[2];
+        FILE      *hostf;
+        int       stayopen;                       /* AIX addon            */
+        unsigned  long  host_addresses[_MAXADDRS];/* As per defect 48367. */
+};                                                /*    Actual Addresses. */
+
+struct  servent_data {          /* should be considered opaque */
+        FILE *serv_fp;
+        char line[_MAXLINELEN];
+        char *serv_aliases[_MAXALIASES];
+        int _serv_stayopen;
+};
+
+int _System getservbyname_r(char *, char *, struct servent *, struct servent_data *);
+struct hostent * _System _gethtbyname( char * );
+struct hostent * _System _gethtbyaddr( char *, int, int );
+struct netent * _System getnetbyname( char * );
+struct netent * _System getnetbyaddr( unsigned long, int );
+struct servent * _System getservbyname( char *, char * );
+struct servent * _System getservbyport( int, char * );
+struct servent * _System getservent( void );
+struct protoent * _System getprotobyname( char * );
+struct protoent * _System getprotobynumber( int );
+void _System sethostent( int );
+struct hostent * _System gethostent( void );
+void _System endhostent(void);
+void _System setnetent( int );
+struct netent * _System getnetent( void );
+void _System endnetent(void);
+void _System setprotoent( int );
+struct protoent * _System getprotoent( void );
+void _System endprotoent(void);
+void _System setservent( int );
+struct servent * _System getservent( void );
+void _System endservent(void);
+
+/*
+ * Error return codes from gethostbyname() and gethostbyaddr()
+ * (left in extern int h_errno).
+ */
+
+#define h_errno (tcp_h_errno())   /* Thread Re-entrant */
+
+#define HOST_NOT_FOUND  1 /* Authoritative Answer Host not found */
+#define TRY_AGAIN       2 /* Non-Authoritive Host not found, or SERVERFAIL */
+#define NO_RECOVERY     3 /* Non recoverable errors, FORMERR, REFUSED, NOTIMP */
+#define NO_DATA         4 /* Valid name, no data record of requested type */
+#define NO_ADDRESS      NO_DATA         /* no address, look for MX record */
+
+#endif /* __NETDB_32H  */
diff --git a/examples/Modula-2_Libraries/PMOS/doc/lowlevel.def b/examples/Modula-2_Libraries/PMOS/doc/lowlevel.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/doc/lowlevel.def
@@ -0,0 +1,293 @@
+DEFINITION MODULE LowLevel;
+
+	(********************************************************)
+	(*							*)
+	(*	   Miscellaneous low-level procedures		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	11 March 1995			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(*	This is a "documentation" version of		*)
+	(*	LowLevel.DEF.  It is provided because the	*)
+	(*	original is hard to read, being full of		*)
+	(*	compiler pragmas and in-line machine code.	*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE, WORD, ADDRESS;
+
+FROM Types IMPORT
+    (* type *)	FarPointer;
+
+(************************************************************************)
+(*			    BITWISE LOGIC				*)
+(************************************************************************)
+
+PROCEDURE IAND (first, second: WORD): WORD;
+
+    (* Bit-by-bit logical AND.	*)
+
+PROCEDURE IANDB (first, second: BYTE): BYTE;
+
+    (* Bit-by-bit logical AND for bytes. *)
+
+PROCEDURE IOR (first, second: WORD): WORD;
+
+    (* Bit-by-bit inclusive OR.	*)
+
+PROCEDURE IORB (first, second: BYTE): BYTE;
+
+    (* Bit-by-bit inclusive OR.	*)
+
+PROCEDURE IXOR (first, second: WORD): WORD;
+
+    (* Bit-by-bit exclusive OR.	*)
+
+PROCEDURE IXORB (first, second: BYTE): BYTE;
+
+    (* Bit-by-bit exclusive OR.	*)
+
+PROCEDURE INOT (value: WORD): WORD;
+
+    (* Bit-by-bit Boolean complement.	*)
+
+PROCEDURE INOTB (value: BYTE): BYTE;
+
+    (* Bit-by-bit Boolean complement.	*)
+
+PROCEDURE ROL (value: WORD;  count: CARDINAL): WORD;
+
+    (* Left rotation of "value" by "count" bit positions.	*)
+
+PROCEDURE ROLB (value: BYTE;  count: CARDINAL): BYTE;
+
+    (* Left rotation of "value" by "count" bit positions.	*)
+
+PROCEDURE LS (value: WORD;  count: CARDINAL): WORD;
+
+    (* Left shift of "value" by "count" bit positions, with zero fill.	*)
+
+PROCEDURE LSB (value: BYTE;  count: CARDINAL): BYTE;
+
+    (* Left shift of "value" by "count" bit positions, with zero fill.	*)
+
+PROCEDURE ROR (value: WORD;  count: CARDINAL): WORD;
+
+    (* Right rotation of "value" by "count" bit positions.	*)
+
+PROCEDURE RORB (value: BYTE;  count: CARDINAL): BYTE;
+
+    (* Right rotation of "value" by "count" bit positions.	*)
+
+PROCEDURE RS (value: WORD;  count: CARDINAL): WORD;
+
+    (* Right shift of "value" by "count" bit positions, with zero fill.	*)
+
+PROCEDURE RSB (value: BYTE;  count: CARDINAL): BYTE;
+
+    (* Right shift of "value" by "count" bit positions, with zero fill.	*)
+
+(************************************************************************)
+(*			    POINTER OPERATIONS				*)
+(************************************************************************)
+
+PROCEDURE Far (A: ADDRESS): FarPointer;
+
+    (* Converts a pointer to a far pointer. *)
+
+PROCEDURE MakePointer (segment, offset: WORD): FarPointer;
+
+    (* Creates a pointer, given the segment and offset within segment.	*)
+
+PROCEDURE SEGMENT (A: ADDRESS): WORD;
+
+    (* Returns the segment part of an address.	*)
+
+PROCEDURE FarSEGMENT (A: FarPointer): WORD;
+
+    (* Returns the segment part of an address.	*)
+
+PROCEDURE OFFSET (A: ADDRESS): WORD;
+
+    (* Returns the offset part of an address.	*)
+
+PROCEDURE AddOffset (A: ADDRESS;  increment: CARDINAL): ADDRESS;
+
+    (* Returns a pointer to the memory location whose physical address	*)
+    (* is Physical(A)+increment.  In the present version, it is assumed	*)
+    (* that the caller will never try to run off the end of a segment.	*)
+
+PROCEDURE SubtractOffset (A: ADDRESS;  decrement: CARDINAL): ADDRESS;
+
+    (* Like AddOffset, except that we go backwards in memory.  Running	*)
+    (* off the beginning of the segment is an undetected error.		*)
+
+PROCEDURE FarAddOffset (A: FarPointer;  increment: CARDINAL): FarPointer;
+
+    (* Like AddOffset, except for the parameter types. *)
+
+PROCEDURE FarSubtractOffset (A: FarPointer; decrement: CARDINAL): FarPointer;
+
+    (* Like SubtractOffset, except for the parameter types. *)
+
+PROCEDURE Virtual (PA: LONGCARD): FarPointer;
+
+    (* Converts a physical address to a virtual address, if possible.	*)
+    (* There are no guarantees in the case where there is no such	*)
+    (* virtual address.							*)
+
+PROCEDURE Physical (A: ADDRESS): LONGCARD;
+
+    (* Converts a virtual address to a physical address.  Use with care!*)
+
+(************************************************************************)
+(*			BYTE/WORD/LONGCARD CONVERSIONS			*)
+(************************************************************************)
+
+PROCEDURE LowByte (w: WORD): BYTE;
+
+    (* Returns the low-order byte of its argument.	*)
+
+PROCEDURE HighByte (w: WORD): BYTE;
+
+    (* Returns the high-order byte of its argument.	*)
+
+PROCEDURE MakeWord (high, low: BYTE): WORD;
+
+    (* Combines two bytes into a word.  The first argument becomes the	*)
+    (* most significant byte of the result.				*)
+
+PROCEDURE SignExtend (val: BYTE): INTEGER;
+
+    (* Converts a signed 8-bit number to signed integer. *)
+
+PROCEDURE LowWord (w: LONGCARD): WORD;
+
+    (* Returns the low-order word of its argument.	*)
+
+PROCEDURE HighWord (w: LONGCARD): WORD;
+
+    (* Returns the high-order word of its argument.	*)
+
+PROCEDURE MakeLongword (high, low: WORD): LONGCARD;
+
+    (* Combines two words into a longword.  The first argument becomes	*)
+    (* the most significant word of the result.				*)
+
+(************************************************************************)
+(*			MISCELLANEOUS ARITHMETIC			*)
+(************************************************************************)
+
+PROCEDURE INCV (VAR (*INOUT*) dest: CARDINAL;  src: CARDINAL): BOOLEAN;
+
+    (* Computes dest := dest + src, and returns TRUE iff the addition	*)
+    (* produced a carry.						*)
+
+PROCEDURE INCVB (VAR (*INOUT*) dest: BYTE;  src: BYTE): BOOLEAN;
+
+    (* Computes dest := dest + src, and returns TRUE iff the addition	*)
+    (* produced a carry.						*)
+
+PROCEDURE DECV (VAR (*INOUT*) dest: CARDINAL;  src: CARDINAL): BOOLEAN;
+
+    (* Computes dest := dest - src, and returns TRUE iff the		*)
+    (* subtraction produced a borrow.					*)
+
+PROCEDURE DECVB (VAR (*INOUT*) dest: BYTE;  src: BYTE): BOOLEAN;
+
+    (* Computes dest := dest - src, and returns TRUE iff the		*)
+    (* subtraction produced a borrow.					*)
+
+PROCEDURE Mul (A, B: CARDINAL): LONGCARD;
+
+    (* Same as A*B, except for the type of the result.  We provide this	*)
+    (* as a general-purpose function since this combination of operands	*)
+    (* is often precisely what is wanted.				*)
+
+PROCEDURE MulB (A, B: BYTE): CARDINAL;
+
+    (* Same as A*B, except for the type of the result.  We provide this	*)
+    (* as a general-purpose function since this combination of operands	*)
+    (* is often precisely what is wanted.				*)
+
+PROCEDURE IMul (A, B: INTEGER): LONGINT;
+
+    (* Like Mul, but signed. *)
+
+PROCEDURE IMulB (A, B: BYTE): INTEGER;
+
+    (* Like MulB, but signed. *)
+
+PROCEDURE DivB (A: CARDINAL;  B: BYTE): BYTE;
+
+    (* Same as A DIV B, except for the type of A.  We provide this as	*)
+    (* a general-purpose function since this combination of operands	*)
+    (* is often precisely what is wanted.				*)
+
+PROCEDURE Div (A: LONGCARD;  B: CARDINAL): CARDINAL;
+
+    (* Same as A DIV B, except for the type of A.  We provide this as	*)
+    (* a general-purpose function since this combination of operands	*)
+    (* is often precisely what is wanted.				*)
+
+(************************************************************************)
+(*			     BLOCK MOVES				*)
+(************************************************************************)
+
+PROCEDURE Copy (source, destination: ADDRESS;  bytecount: CARDINAL);
+
+    (* Copies an array of bytes from the source address to the		*)
+    (* destination address.  In the case where the two arrays overlap,	*)
+    (* the destination address should be lower in physical memory than	*)
+    (* the source address.						*)
+
+PROCEDURE FarCopy (source, destination: FarPointer;  bytecount: CARDINAL);
+
+    (* Copies an array of bytes from the source address to the		*)
+    (* destination address.  In the case where the two arrays overlap,	*)
+    (* the destination address should be lower in physical memory than	*)
+    (* the source address.						*)
+
+PROCEDURE CopyUp (source, destination: FarPointer;  bytecount: CARDINAL);
+
+    (* A variant of Copy which does the move backwards, in order	*)
+    (* to handle the case where the destination address is inside the	*)
+    (* source array.  In this special case Copy cannot be used,		*)
+    (* because it would overwrite data it was about to copy.		*)
+
+PROCEDURE BlockFill (destination: FarPointer;
+				bytecount: CARDINAL;  value: BYTE);
+
+    (* Fills the destination array with the given value.	*)
+
+PROCEDURE BlockFillWord (destination: FarPointer;  wordcount: CARDINAL;
+							value: WORD);
+
+    (* Fills the destination array with the given value.	*)
+
+(************************************************************************)
+(*			    INPUT AND OUTPUT				*)
+(************************************************************************)
+
+PROCEDURE OutByte (port: CARDINAL; value: BYTE);
+
+    (* Puts the value out to an output port.	*)
+
+PROCEDURE InByte (port: CARDINAL): BYTE;
+
+    (* Reads a byte from an input port.	*)
+
+PROCEDURE InStringWord (port: CARDINAL;  BufferAddress: ADDRESS;
+						count: CARDINAL);
+
+    (* Reads count words from an input port.	*)
+
+PROCEDURE OutStringWord (port: CARDINAL;  BufferAddress: ADDRESS;
+						count: CARDINAL);
+
+    (* Writes count words to an output port.	*)
+
+END LowLevel.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/demo/bardemo.mod b/examples/Modula-2_Libraries/PMOS/sources/demo/bardemo.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/demo/bardemo.mod
@@ -0,0 +1,182 @@
+MODULE BarDemo;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of module WGraph			*)
+	(*		Draws some bar graphs			*)
+	(*							*)
+	(*  Programmer:		S.P. Lontis, P. Moylan.		*)
+	(*  Last edited:	27 January 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	This is a copy of the Lontis version,		*)
+	(*	which I'm gradually modifying.			*)
+	(*							*)
+	(*	See comments inside the code.  This is		*)
+	(*	basically working, but I'm still fiddling with	*)
+	(*	the details.					*)
+	(*							*)
+	(********************************************************)
+
+FROM Graphics IMPORT
+    (* proc *)	GetScreenShape;
+
+FROM GWindows IMPORT
+    (* type *)	Window, BorderType,
+    (* proc *)	InitGraphics, WriteString, WriteLn, GString, GStringUp,
+		OpenWindow, CloseWindow, ClearWindow;
+
+FROM WGraph IMPORT
+    (* type *)	Graph, BarType, GraphType, LineType, MarkType,
+    (* proc *)	OpenGraph, DrawXAxis, DrawAxes, BarGraph;
+
+FROM MATHLIB IMPORT
+    (* proc *)	Sin, Cos, Log;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey;
+
+FROM Timer IMPORT
+    (* proc *)	Sleep;
+
+(************************************************************************)
+
+PROCEDURE Pause;
+
+    VAR t, i: INTEGER;
+	dummy: CHAR;
+
+    BEGIN
+	Sleep (2000);
+	(* dummy := InKey(); *)
+(*
+	FOR i := 1 TO 1000 DO
+	    FOR t := 1 TO 250 DO
+	    END (* FOR *);
+	END (* FOR *);
+*)
+    END Pause;
+
+(************************************************************************)
+
+PROCEDURE RunTheDemo;
+
+    VAR G1, G2, G3, G4, G5, G6: Graph;
+	i : [0..4];
+	w1, comments, w3: Window;
+	x, y, z, t: ARRAY [0..4] OF LONGREAL;
+	Xmax, Ymax, maxcolour, CharHeight: CARDINAL;
+	barwidth: LONGREAL;
+	ibw: CARDINAL;
+
+    BEGIN
+	GetScreenShape (Xmax, Ymax, maxcolour, CharHeight);
+
+	(* Set up the demonstration data arrays.	*)
+
+	FOR i := 0 TO 4 DO
+	    y[i] := -5.0*Sin(6.24*LONGREAL(i))+1.0;
+	    x[i] := 5.0*Cos(6.24*LONGREAL(i))+0.5;
+	    t[i] := x[i] + LONGREAL(i)*0.6;
+	    z[i] := 0.5*LONGREAL(i) + 1.0;
+	END (* FOR *);
+
+	(* Opening comments *)
+
+	OpenWindow (comments, 0, 0, Xmax, Ymax DIV 4 - 1, 0, 2, double);
+	WriteString (comments,'The Graph application also draws bar charts');
+	WriteLn(comments);
+	WriteString (comments, '   for example:'); WriteLn(comments);
+	WriteString (comments, '           Simple bar graphs');
+	Pause;
+
+	(* A simple bar graph - G1 in w1.	*)
+
+	OpenWindow (w1, 0, Ymax DIV 4, Xmax, Ymax, 7, 6, single);
+	barwidth := LONGREAL(Xmax-180)/25.0;
+	OpenGraph (G1,w1,bar,joined,100,30,Xmax-80,3*Ymax DIV 4 - 20,
+				barwidth,0.0,4.0*barwidth,10.0,none);
+	DrawAxes (G1, 0.0, 0, 2, TRUE, 1.0, 0, 2, TRUE);
+	BarGraph (G1, y, 5, One);
+
+	Pause;
+
+	(* Graph G6 in w3 is another bar graph.	*)
+
+	OpenWindow (w3, Xmax DIV 2, Ymax DIV 2, Xmax, Ymax, 1, 3, double);
+	OpenGraph (G6,w3,bar,joined,50,40,Xmax DIV 2 - 30,Ymax DIV 2 - 20,
+				10.0,0.0,30.0,10.0,none);
+	DrawAxes (G6, 0.0, 0, 2, TRUE, 1.0, 0, 2, TRUE);
+	BarGraph (G6,z,5,One);
+
+	Pause;
+
+	WriteString (comments,' - to which you can add labelling');
+	WriteLn(comments);
+	Pause;
+
+	(* Add some text to G1.	*)
+
+	GStringUp (w1, 20, 3*Ymax DIV 8 - 70, 'RainFall * 100 mm');
+	GString (w1, Xmax DIV 2, 5, 'Months');
+	GString (w1, Xmax DIV 2 -100, 3*Ymax DIV 4 - 50,
+				'GRAPH OF MONTHLY RAINFALL');
+	Pause;
+
+	(* And then some text to G6.	*)
+
+	GStringUp (w3, 20, Ymax DIV 4, 'Population');
+	GString (w3, Xmax DIV 4, 5, 'Time in Days.');
+	Pause;
+
+	(* G2 is a copy of G1, in the same window, but with different	*)
+	(* scale and bar pattern.					*)
+
+	WriteString (comments, "           Here's a similar graph, with a different scale for the Y axis");
+	WriteLn(comments);
+	Pause;
+	ibw := CARDINAL(barwidth);
+	OpenGraph(G2,w1,bar,joined,100+ibw,30,Xmax-80,3*Ymax DIV 4 - 20,
+				barwidth,0.0,4.0*barwidth,2.0,none);
+	DrawAxes (G2, 0.0, 0, 2, TRUE, 0.25, 45, 2, TRUE);
+	BarGraph (G2,y,5,Two);
+	Pause;
+
+	(*  G3, G4, and G5 are plotted on the same axes as G1	*)
+
+	OpenGraph(G3,w1,bar,joined,100+2*ibw,30,Xmax-80,3*Ymax DIV 4 - 20,
+				barwidth,0.0,4.0*barwidth,10.0,none);
+	WriteString (comments, '           Extra Bars can be added to the existing graph.');
+	WriteLn(comments);
+	Pause;
+	DrawXAxis (G3, 0.0, 0, 2, TRUE);
+	BarGraph (G3,x,5,Three);
+	Pause;
+
+	OpenGraph(G4,w1,bar,joined,100+3*ibw,30,Xmax-80,3*Ymax DIV 4 - 20,
+					barwidth,0.0,4.0*barwidth,10.0,none);
+	OpenGraph (G5,w1,bar,joined,100+4*ibw,30,Xmax-80,3*Ymax DIV 4 - 20,
+					barwidth,0.0,4.0*barwidth,10.0,none);
+
+	WriteString (comments, '           With five different types of bar patterns.');
+	WriteLn(comments);
+	Pause;
+
+	DrawXAxis (G4, 0.0, 0, 2, TRUE);
+	BarGraph(G4,t,5,Four);
+	DrawXAxis (G5, 0.0, 0, 2, TRUE);
+	BarGraph(G5,z,5,Five);
+	Pause;
+	CloseWindow(w1);  Pause;
+	CloseWindow(w3);  Pause;
+	CloseWindow(comments);
+
+    END RunTheDemo;
+
+(************************************************************************)
+
+BEGIN
+    InitGraphics (18);
+    RunTheDemo;
+END BarDemo.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/demo/grafdemo.mod b/examples/Modula-2_Libraries/PMOS/sources/demo/grafdemo.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/demo/grafdemo.mod
@@ -0,0 +1,280 @@
+MODULE GrafDemo;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of module WGraph			*)
+	(*		Draws some graphs			*)
+	(*							*)
+	(*  Programmer:		S.P. Lontis, P. Moylan.		*)
+	(*  Last edited:	27 February 1995		*)
+	(*  Status:		Working				*)
+	(*	This was a copy of the Lontis version,		*)
+	(*	but by now has been substantially modified.	*)
+	(*							*)
+	(********************************************************)
+
+FROM GWindows IMPORT
+    (* type *)	Window, BorderType,
+    (* proc *)	WriteString, WriteLn, SetCursor,
+		GString, GStringUp, Line, PutPixel, OpenWindow, CloseWindow,
+		ClearWindow;
+
+FROM WGraph IMPORT
+    (* type *)	Graph, BarType, GraphType, LineType, MarkType,
+    (* proc *)	OpenGraph, DrawLines, DrawAxes, DrawXAxis, DrawYAxis,
+		AddPoint, BarGraph;
+
+FROM MATHLIB IMPORT
+    (* proc *)	Sin, Cos, Log, Exp, ATan;
+
+FROM Timer IMPORT
+    (* proc *)	Sleep;
+
+(************************************************************************)
+
+PROCEDURE Pause;
+
+    BEGIN
+	Sleep(1800);
+    END Pause;
+
+(************************************************************************)
+
+PROCEDURE BodeDemo (w: Window);
+
+    (* Plots a log-linear graph.	*)
+
+    VAR G: Graph;
+	i: [1..100];
+
+    BEGIN
+	OpenGraph(G,w,loglinear,joined,50,30,570,140,1.0,-20.0,100.0,0.0,none);
+	ClearWindow(w);
+	WriteString(w,'                   BODE DIAGRAM ');
+	DrawAxes (G, 1.0, 0, 3, TRUE, 5.0, 0, 2, TRUE);
+	GString (w, 200, 5, 'Frequency (Hz)');
+	GStringUp (w, 10, 30, 'Magnitude (dB)');
+	FOR i := 1 TO 100 BY 5 DO
+	    IF (i<=20) THEN AddPoint (G, VAL(LONGREAL,i), 0.0)
+	    ELSE
+		AddPoint(G, VAL(LONGREAL,i), -0.25*VAL(LONGREAL,i-20))
+	    END (* IF *)
+	END (* FOR *);
+	Pause;
+    END BodeDemo;
+
+(************************************************************************)
+
+PROCEDURE TransferFunctionDemo;
+
+    VAR w4, w5, w6, w7: Window;
+	s1, s2, s3, s4: Graph;
+	t, t1, t2: LONGREAL;
+
+    BEGIN
+	OpenWindow(w4,10,10,315,100,1,3,double);
+	GString (w4, 100, 4, 'time (secs)');
+	OpenGraph(s1,w4,linear,joined,40,30,275,70,0.0,0.0,0.5,10.0,none);
+	DrawAxes (s1, 0.125, 0, 2, TRUE, 5.0, 0, 2, TRUE);
+
+	OpenWindow(w5,325,10,630,100,1,3,double);
+	WriteString(w5,'Transfer Function-');WriteLn(w5);WriteLn(w5);
+	WriteString(w5,'   H(s) =   10 / ( s + 10) ');
+	GString (w5, 100, 4, 'Re(H)');
+	GStringUp (w5, 9, 20, 'Im(H)');
+	OpenGraph(s4,w5,linear,dots,40,30,275,50,-20.0,0.0,0.0,5.0,cross);
+	DrawAxes (s4, 10.0, 0, 2, TRUE, 5.0, 0, 2, TRUE);
+	AddPoint (s4,-10.0,0.0);
+
+	OpenWindow(w6,10,110,315,200,1,3,double);
+	GString (w6, 100, 4, 'w (rad/sec)');
+	GStringUp (w6, 9, 4, 'Mag H (dB)');
+	OpenGraph (s2,w6,loglinear,joined,40,30,275,70,1.0,-50.0,100.0,0.0,none);
+	DrawAxes (s2, 1.0, 0, 2, TRUE, 25.0, 0, 2, TRUE);
+
+	OpenWindow(w7,325,110,630,200,1,3,double);
+	GString (w7, 100, 4, 'w (rad/sec)');
+	GStringUp (w7, 9, 20, 'Phase');
+	OpenGraph (s3,w7,loglinear,joined,40,30,275,70,1.0,-90.0,1000.0,20.0,none);
+	DrawAxes (s3, 1.0, 0, 2, TRUE, 45.0, 0, 2, TRUE);
+
+	t := 0.0;  t1 := 1.0;  t2 := 1.0;
+
+	WHILE (t<=0.5) OR (t1<=100.0) OR (t2<=1000.0) DO
+
+	    AddPoint(s1,t,10.0*Exp(-10.0*t));
+	    AddPoint(s2,t1,-10.0*Log(1.0+0.01*t1*t1));
+	    AddPoint(s3,t2,-57.295*ATan(0.01*t2));
+	    t := t + 0.025;
+	    t1 := t1 + 5.0;
+	    IF t2>100.0 THEN t2:=t2+100.0
+	    ELSE t2:= t2 + 10.0
+	    END (* IF *);
+
+	END (* WHILE *);
+
+	Pause;
+	CloseWindow (w4);
+	CloseWindow (w5);
+	CloseWindow (w6);
+	CloseWindow (w7);
+
+    END TransferFunctionDemo;
+
+(************************************************************************)
+
+PROCEDURE LogLogDemo (w: Window);
+
+    VAR i: INTEGER;
+	G8: Graph;
+
+    BEGIN
+	OpenGraph(G8,w,loglog,joined,30,20,570,150,1.0,1.0,100.0,100.0,none);
+	DrawAxes (G8, 1.0, 0, 3, TRUE, 1.0, 0, 3, TRUE);
+	FOR i := 1 TO 100 BY 2 DO
+	    IF i <= 8 THEN
+		AddPoint (G8, VAL(LONGREAL,i), 1.0);
+	    ELSE
+		AddPoint (G8, VAL(LONGREAL,i), 10.0*Log(VAL(LONGREAL,i))-20.0)
+	    END (* IF *)
+	END (* FOR *);
+	Pause;
+    END LogLogDemo;
+
+(************************************************************************)
+
+PROCEDURE ScaleDemo;
+
+    VAR a1, a2, a3, a4: Graph;
+	w: Window;
+
+    BEGIN
+	OpenWindow (w, 55, 50, 580, 310, 14, 3, double);
+	SetCursor (w, 7, 17);
+	WriteString (w, 'Scales can be offset from the graph origin');
+	OpenGraph(a1,w,linear,joined,100,60,400,250,0.0,0.0,5.0,5.0,none);
+	OpenGraph(a2,w,linear,joined,100,60,400,250,-10.0,0.0,5.0,5.0,none);
+	OpenGraph(a3,w,linear,joined,100,60,400,250,-5.0,-5.0,5.0,5.0,none);
+	OpenGraph(a4,w,linear,joined,100,60,400,250,-5.0,-5.0,5.0,10.0,none);
+	DrawAxes (a1, 1.0, 0, 2, TRUE, 1.0, 0, 2, TRUE);
+	DrawXAxis (a2, 2.0, 15, 2, TRUE);
+	DrawAxes (a3, 1.0, 30, 2, TRUE, 1.0, 28, 2, TRUE);
+	DrawYAxis (a4, 1.0, 56, 2, TRUE);
+	Pause;
+	CloseWindow (w);
+    END ScaleDemo;
+
+(************************************************************************)
+
+PROCEDURE RunTheDemo;
+
+    (* Note that this procedure is badly designed (in the original	*)
+    (* version, the entire demo was a single main program (!), and I	*)
+    (* have not yet finished breaking it up into procedures.		*)
+
+    VAR background, text, w3: Window;
+	g1, g2, g3, g4, g5, g6: Graph;
+	G4, G5, G6: Graph;
+	i: [0..63];
+	x: INTEGER;
+	t: LONGREAL;
+	qx, q1y, q2y, q3y: ARRAY [0..63] OF LONGREAL;
+
+    BEGIN
+
+	OpenWindow (background, 0, 0, 800, 500, 0, 7, single);
+	OpenWindow (text, 15, 210, 620, 310, 14, 0, double);
+	WriteString (text,'   Different types of graphs can be drawn. ');
+	WriteLn (text);
+	WriteString (text, '   For example:');  WriteLn(text);
+	WriteString (text, '              Simple linear-linear Plots');       
+	WriteLn (text);
+
+	(* Straight-line graph: g1 in w3.	*)
+
+	OpenWindow (w3, 25, 30, 610, 190, 2, 4, double);
+	OpenGraph(g1,w3,linear,joined,30,20,570,150,0.0,0.0,10.0,10.0,none);
+	DrawAxes(g1, 2.0, 0, 2, TRUE, 2.0, 0, 2, TRUE);
+	FOR x := 0 TO 8 DO
+	    AddPoint(g1, VAL(LONGREAL,x), VAL(LONGREAL,x-2))
+	END (* FOR *);
+	Pause;
+
+	WriteString(text, '              with 5 different types of markers. ');
+	WriteLn(text);
+
+	(* Add a few more graphs in the same window.	*)
+
+	OpenGraph(g2,w3,linear,joined,30,20,570,150,0.0,0.0,10.0,10.0,square);
+	OpenGraph(g3,w3,linear,joined,30,20,570,150,0.0,0.0,10.0,10.0,cross);
+	OpenGraph(g4,w3,linear,joined,30,20,570,150,0.0,0.0,10.0,10.0,plus);
+	OpenGraph(g5,w3,linear,joined,30,20,570,150,0.0,0.0,10.0,10.0,diamond);
+
+	FOR x := 0 TO 8 DO
+	    AddPoint (g2, VAL(LONGREAL,x), VAL(LONGREAL,x-1));
+	    AddPoint (g4, VAL(LONGREAL,x), VAL(LONGREAL,x+1));
+	    AddPoint (g3, VAL(LONGREAL,x), VAL(LONGREAL,x));
+	    AddPoint(g5, VAL(LONGREAL,x), VAL(LONGREAL,x+2));
+	END (* FOR *);
+
+	OpenGraph(G6,w3,linear,joined,30,20,570,150,0.0,0.0,10.0,10.0,none);
+	OpenGraph(G5,w3,linear,joined,30,20,570,150,0.0,0.0,10.0,10.0,none);
+
+	OpenGraph(G4,w3,linear,joined,30,20,570,150,0.0,0.0,10.0,10.0,none);
+
+	t := 0.0;
+	FOR i := 0 TO 63 DO
+	    qx[i] := 4.0*Sin(t)+5.0;
+	    q1y[i] := 4.0*Cos(t)+5.0;
+	    q2y[i] := 4.0*Cos(3.0*t)+5.0;
+	    q3y[i] := 4.0*Cos(5.0*t)+5.0;
+	    t := t+0.1;
+	END (* FOR *);
+
+	Pause;
+	ClearWindow(w3);
+	WriteLn (text);
+	WriteString(text,
+		'   It is also possible to plot arrays of x and y values.');
+	WriteLn(text);
+
+	DrawAxes (G6, 2.0, 0, 2, TRUE, 2.0, 0, 2, TRUE);
+	DrawLines(G6,qx,q1y); Pause; ClearWindow(w3);
+	DrawAxes (G5, 2.0, 0, 2, TRUE, 2.0, 0, 2, TRUE);
+	DrawLines(G5,qx,q2y); Pause; ClearWindow(w3);
+	DrawAxes (G4, 2.0, 0, 2, TRUE, 2.0, 0, 2, TRUE);
+	DrawLines(G4,qx,q3y); Pause;
+
+	(* Demonstration of graphs with different scales.	*)
+
+	ScaleDemo;
+
+	ClearWindow(text);
+	WriteString(text,'You can draw semi-log graphs ');
+
+	BodeDemo (w3);
+
+	WriteString(text,'and log-log graphs');
+	ClearWindow(w3);
+	LogLogDemo (w3);
+
+	CloseWindow (w3);
+
+	WriteLn(text);
+	WriteString(text,'And of course you can have multiple graphs on the screen.');
+
+	TransferFunctionDemo;
+
+	WriteLn (text);
+	WriteString (text,'End of graph demonstration');  Pause;
+	CloseWindow (text);
+	CloseWindow (background);
+
+    END RunTheDemo;
+
+(************************************************************************)
+
+BEGIN
+    RunTheDemo;
+END GrafDemo.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/demo/graftest.mod b/examples/Modula-2_Libraries/PMOS/sources/demo/graftest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/demo/graftest.mod
@@ -0,0 +1,183 @@
+MODULE GrafTest;
+
+	(****************************************************************)
+	(*								*)
+	(*		Test of music and graphics.			*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	7 March 1994				*)
+	(*  Status:		Working					*)
+	(*								*)
+	(****************************************************************)
+
+FROM Timer IMPORT
+    (* proc *)	Sleep;
+
+FROM MusicDemonstration IMPORT
+    (* proc *)	WaitForEndOfMusic;
+
+FROM Graphics IMPORT
+    (* proc *)	SetMode, PlotMark, PlotLine;
+
+FROM MATHLIB IMPORT
+    (* proc *)	Sin, Cos, Sqrt, ATan;
+
+(************************************************************************)
+
+CONST colour = 1;
+      stretch = 2.0;
+      PI = LONGREAL(3.14159265358979323);
+
+(************************************************************************)
+
+PROCEDURE PlotScaledLine (x0, y0, x1, y1: LONGREAL);
+
+    (* Draws a line from (x0,y0) to (x1,y1), with coordinates scaled to	*)
+    (* the standards expected by procedure Triangle, below.		*)
+
+    CONST xorg = 159.5;  yorg = 99.5;  scale = 99.5;
+
+    VAR intx0, inty0, intx1, inty1: CARDINAL;
+
+    BEGIN
+	intx0 := TRUNC (stretch*(xorg+scale*x0)+0.5);
+	inty0 := TRUNC (yorg+scale*y0+0.5);
+	intx1 := TRUNC (stretch*(xorg+scale*x1)+0.5);
+	inty1 := TRUNC (yorg+scale*y1+0.5);
+	PlotLine (intx0,inty0,intx1,inty1,colour);
+    END PlotScaledLine;
+
+(************************************************************************)
+
+PROCEDURE Triangle (x0, y0, side, theta, alpha: LONGREAL);
+
+    (* Plots an equilateral triangle, starting at (x0, y0), with each	*)
+    (* side being "side" units long, and tilted at angle theta to the	*)
+    (* the horizontal.  The units are scaled such that the centre of	*)
+    (* the screen is point (0.0,0.0), and side=1.0 gives the biggest	*)
+    (* triangle which will fit in the first quadrant.  Part of the	*)
+    (* second side is deliberately omitted - only the first "alpha" of	*)
+    (* it (0<alpha<1) is plotted.					*)
+
+    VAR x1, y1, x2, y2: LONGREAL;
+
+    BEGIN
+	x1 := x0 + side*Cos(theta);  x2 := x0 + side*Cos(theta + PI/3.0);
+	y1 := y0 + side*Sin(theta);  y2 := y0 + side*Sin(theta + PI/3.0);
+	PlotScaledLine (x0,y0, x1,y1);
+	PlotScaledLine (x1,y1,(1.0-alpha)*x1+alpha*x2,(1.0-alpha)*y1+alpha*y2);
+	PlotScaledLine (x2,y2, x0,y0);
+    END Triangle;
+
+(************************************************************************)
+
+PROCEDURE FilledTriangle (k: CARDINAL);
+
+    (* Plots a sequence of nested triangles, with the outer one		*)
+    (* oriented at 60k degrees from the horizontal.			*)
+
+    CONST alpha = 0.1;  small = 0.01;
+
+    VAR xorigin, yorigin, side: LONGREAL;
+	theta: LONGREAL;
+
+    BEGIN
+	xorigin := 0.0;  yorigin := 0.0;  side := 1.0;
+	theta := LONGREAL(k)*PI/3.0;
+	REPEAT
+	    Triangle (xorigin, yorigin, side, theta, alpha);
+	    xorigin := xorigin + alpha*side*Cos(theta);
+	    yorigin := yorigin + alpha*side*Sin(theta);
+	    theta := theta + ATan(alpha*Sqrt(3.0)/(2.0-3.0*alpha));
+	    side := side * Sqrt(1.0 - 3.0*alpha*(1.0-alpha));
+	UNTIL side < small;
+    END FilledTriangle;
+
+(************************************************************************)
+
+PROCEDURE Hexagon;
+
+    (* Plots an interesting hexagon shape. *)
+
+    VAR j: [0..5];
+
+    BEGIN
+	SetMode (16, TRUE);
+	FOR j := 0 TO 5 DO
+	    FilledTriangle(j);
+	END (*FOR*);
+	Sleep (3000);
+    END Hexagon;
+
+(************************************************************************)
+
+PROCEDURE Doyley (vertices: CARDINAL);
+
+    (* Plots a polygon, with lines between all pairs of vertices.	*)
+    (* Assumption: "vertices" is a prime number.  If not, the procedure	*)
+    (* still does something but the resulting picture is not as		*)
+    (* interesting.							*)
+
+    CONST colour = 1;
+	  stretch = 2.0;
+
+    TYPE Subscript = [0..30];
+
+    VAR previous, next: Subscript;
+	step, j: CARDINAL;
+	X, Y: ARRAY Subscript OF CARDINAL;
+	xcentre, ycentre, radius, theta, angle: LONGREAL;
+
+    BEGIN
+	SetMode (16, TRUE);
+
+	(* Set up the vertex coordinates in arrays X and Y. *)
+
+	xcentre := 160.0;  ycentre := 99.5;  radius := 99.5;
+	theta := 2.0*PI/LONGREAL(FLOAT(vertices));
+	FOR j := 0 TO vertices-1 DO
+	    angle := LONGREAL(j)*theta;
+	    X[j] := TRUNC (stretch*(xcentre + radius*Cos(angle) + 0.5));
+	    Y[j] := TRUNC (ycentre + radius*Sin(angle) + 0.5);
+	END (*FOR*);
+
+	(* Now the actual plotting. *)
+
+	FOR step := 1 TO vertices DIV 2 DO
+	    previous := 0;
+	    FOR j := 1 TO vertices DO
+		next := (previous + step) MOD vertices;
+		    PlotLine (X[previous], Y[previous], X[next], Y[next],
+								colour);
+		previous := next;
+	    END (*FOR*)
+	END (*FOR*);
+
+	Sleep (3000);
+    END Doyley;
+
+(************************************************************************)
+
+PROCEDURE RunGraphicsTest;
+
+    (* Runs us through a sequence of graphics tests.	*)
+
+    VAR N: [3..23];
+
+    BEGIN
+	FOR N := 3 TO 23 BY 2 DO
+	    Doyley (N);
+	END (*FOR*);
+	Hexagon;
+    END RunGraphicsTest;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    RunGraphicsTest;
+    RunGraphicsTest;
+    WaitForEndOfMusic;
+END GrafTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/demo/linedemo.mod b/examples/Modula-2_Libraries/PMOS/sources/demo/linedemo.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/demo/linedemo.mod
@@ -0,0 +1,490 @@
+MODULE LineDemo;
+
+	(********************************************************)
+	(*							*)
+	(*		Demonstration of GWindows		*)
+	(*							*)
+	(*  Programmer:		S. Lontis, P. Moylan		*)
+	(*  Last edited:	23 January 1994			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	Note: This is an EGA demonstration.  I've	*)
+	(*	done some scaling to make it work with other	*)
+	(*	screen resolutions, but I lost patience for	*)
+	(*	covering the completely general case.		*)
+	(*							*)
+	(********************************************************)
+
+FROM TaskControl IMPORT
+    (* type *)	Lock,
+    (* proc *)	CreateTask, CreateLock, Obtain, Release;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM ScreenGeometry IMPORT
+    (* type *)	Point;
+
+FROM Graphics IMPORT
+    (* type *)	ColourType,
+    (* proc *)	GetScreenShape;
+
+FROM GWindows IMPORT
+    (* type *)	Window, BorderType,
+    (* proc *)	OpenWindow, Line, PutPixel2, WriteString, ClearWindow,
+		CloseWindow, WindowMemory, SetColour, InitGraphics;
+
+FROM MATHLIB IMPORT
+    (* proc *)	Sin, Cos, Exp;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey;
+
+FROM Timer IMPORT
+    (* proc *)	Sleep;
+
+(************************************************************************)
+
+CONST pi = 3.14159;
+
+TYPE Vector2 = RECORD
+		    x, y: LONGREAL;
+	       END;
+
+VAR
+    Xmax, Ymax, CharHeight: CARDINAL;
+    maxcolour: ColourType;
+
+(************************************************************************)
+
+(*
+PROCEDURE Sleep (time: CARDINAL);
+
+    (* Dummy procedure to prevent Timer.Sleep from being called.	*)
+    (* Needed only during debugging.					*)
+
+    BEGIN
+    END Sleep;
+*)
+
+(************************************************************************)
+(*		    "PRESS ANY KEY TO CONTINUE"				*)
+(************************************************************************)
+
+PROCEDURE Pause;
+
+    VAR dummy: CHAR;  w: Window;
+
+    BEGIN
+	OpenWindow(w,Xmax DIV 2,30,Xmax DIV 2 + 205,40+CharHeight,0,3,single);
+	WriteString (w, "Press any key to continue");
+	dummy := InKey();
+	CloseWindow (w);
+    END Pause;
+
+(************************************************************************)
+(*			FLOATING POINT ROUND				*)
+(************************************************************************)
+
+PROCEDURE ROUND (x: LONGREAL): INTEGER;
+
+    VAR negative: BOOLEAN;  result: INTEGER;
+
+    BEGIN
+	negative := FALSE;
+	IF x < 0.0 THEN
+	    x := -x;  negative := TRUE;
+	END (*IF*);
+	x := x + 0.5;
+	IF x >= VAL(LONGREAL, MAX(INTEGER)) THEN result := MAX(INTEGER)
+	ELSE result := VAL (INTEGER, x);
+	END (*IF*);
+	IF negative THEN RETURN -result
+	ELSE RETURN result;
+	END (*IF*);
+    END ROUND;
+
+(************************************************************************)
+
+PROCEDURE Round2 (fpoint: Vector2): Point;
+
+    (* Converts floating point (x,y) coordinates to cardinal.	*)
+
+    VAR result: Point;
+
+    BEGIN
+	result.x := ROUND (fpoint.x);
+	result.y := ROUND (fpoint.y);
+	RETURN result;
+    END Round2;
+
+(************************************************************************)
+(*			   CRO SIMULATION				*)
+(************************************************************************)
+
+VAR
+    (* Data shared between the DataGenerator and CROdemo tasks. *)
+
+    ToPlot: RECORD
+		ready: Semaphore;
+		access: Lock;
+		datum: LONGREAL;
+	    END (*RECORD*);
+
+(************************************************************************)
+
+PROCEDURE DataGenerator;
+
+    (* Runs as a separate task, generating data for task CROdemo to plot.*)
+
+    CONST tincr = 0.01;  M0 = 0.8;
+	  alpha = 5.0;  omega = 15.0;
+
+    VAR t, value, M: LONGREAL;
+
+    BEGIN
+	t := 0.0;  M := M0;
+	LOOP
+	    value := M*(1.0 - 2.0*Exp(-alpha*t)*Cos(omega*t));
+	    WITH ToPlot DO
+		Obtain (access);
+		datum := value;
+		Release (access);
+		Signal (ready);
+	    END (*WITH*);
+	    t := t + tincr;
+	    IF t > 1.0 THEN
+		t := 0.0;  M := -M;
+	    END (*IF*);
+	    Sleep (120);
+	END (*LOOP*);
+    END DataGenerator;
+
+(************************************************************************)
+
+TYPE index = [10..190];
+
+VAR data: ARRAY index OF CARDINAL;
+
+PROCEDURE CROdemo;
+
+    (* Runs as a separate task, plotting a moving waveform *)
+
+    (* Colours on the default palette are:				*)
+    (*	 0 black	 1 blue		 2 green	 3 cyan		*)
+    (*	 4 red		 5 magenta	 6 brown	 7 white	*)
+    (*	 8 grey		 9 lt blue	10 lt green	11 lt cyan	*)
+    (*	12 lt red	13 lt magenta	14 yellow	15 very white	*)
+
+    CONST colour = 10;
+
+    VAR CRO: Window;  t: index;
+	newval: LONGREAL;  scaledval: INTEGER;
+	background: CARDINAL;
+
+    PROCEDURE Blob (x, y: INTEGER);
+	BEGIN
+	    PutPixel2 (CRO, x, y);
+	    PutPixel2 (CRO, x+1, y);
+	    PutPixel2 (CRO, x, y+1);
+	    PutPixel2 (CRO, x+1, y+1);
+	    PutPixel2 (CRO, x, y-1);
+	    PutPixel2 (CRO, x+1, y-1);
+	END Blob;
+
+    (********************************************************************)
+
+    BEGIN
+	IF maxcolour > 8 THEN background := 8
+	ELSE background := 0
+	END (*IF*);
+	OpenWindow (CRO,Xmax-200,Ymax-CharHeight-140,Xmax,Ymax-CharHeight-10,
+						0,background,single);
+	WindowMemory (CRO, FALSE);
+	WITH ToPlot DO
+	    CreateSemaphore (ready, 0);
+	    CreateLock (access);
+	END (*WITH*);
+	FOR t := MIN(index) TO MAX(index) DO
+	    PutPixel2 (CRO, t, 30);
+	    data[t] := 30;
+	END (*FOR*);
+	CreateTask (DataGenerator, 4, "Data for CRO");
+	t := MIN(index);
+	LOOP
+	    WITH ToPlot DO
+		Wait (ready);
+		Obtain (access);
+		newval := datum;
+		Release (access);
+	    END (*WITH*);
+	    scaledval := 60 + VAL(INTEGER,30.0*newval);
+
+(* Original version: non-shifting:
+
+	    SetColour (CRO, background);
+	    PutPixel2 (CRO, t, data[t]);
+	    SetColour (CRO, colour);
+	    PutPixel2 (CRO, t, scaledval);
+	    data[t] := scaledval;
+	    IF t = MAX(index) THEN t := MIN(index) ELSE INC(t) END(*IF*);
+*)
+	    (* New version: shift data in window *)
+
+	    FOR t := MIN(index) TO MAX(index)-1 DO
+		SetColour (CRO, background);
+		PutPixel2 (CRO, t, data[t]);
+		data[t] := data[t+1];
+		SetColour (CRO, colour);
+		PutPixel2 (CRO, t, data[t]);
+	    END (*FOR*);
+	    t := MAX(index);
+	    SetColour (CRO, background);
+	    Blob (t, data[t]);
+	    data[t] := scaledval;
+	    SetColour (CRO, 15);
+	    Blob (t, scaledval);
+	END (*LOOP*);
+	CloseWindow (CRO);
+    END CROdemo;
+
+(************************************************************************)
+(*			MISCELLANEOUS DEMO PLOTS			*)
+(************************************************************************)
+
+PROCEDURE Spiral (w: Window; centre: Point;
+				radius, ang: LONGREAL; n: CARDINAL);
+
+    CONST thinc = 0.05*pi;
+
+    VAR theta, r: LONGREAL;
+	i, ptnumber: CARDINAL;
+	pt, pt1: Point;
+
+    BEGIN
+	theta := ang;  pt := centre;
+	ptnumber := 40*n;
+	FOR i := 1 TO ptnumber DO
+	    theta := theta+thinc;  r:= radius*LONGREAL(i)/LONGREAL(ptnumber);
+	    pt1.x := ROUND(3.0*LONGREAL(r)*Cos(theta)) + centre.x;
+	    pt1.y := ROUND(2.0*LONGREAL(r)*Sin(theta)) + centre.y;
+	    Line (w, pt, pt1);
+	    pt := pt1;
+	END (* FOR *)
+    END Spiral;
+
+(************************************************************************)
+
+PROCEDURE Rose(w: Window; xoffset, yoffset: INTEGER;
+				scale, m, n: CARDINAL);
+
+    VAR inner, outer: ARRAY [1..100] OF Point;
+	i, j: CARDINAL;
+	r, theta, thinc: LONGREAL;
+
+    BEGIN
+	thinc := 2.0*pi/LONGREAL(n);
+	FOR i := 1 TO n DO
+	    inner[i].x := xoffset;
+	    inner[i].y := yoffset;
+	END (* FOR *);
+	FOR j := 1 TO m DO
+	    theta := -LONGREAL(j)*pi/LONGREAL(n);
+	    r:=LONGREAL(j*scale)/LONGREAL(m);
+	    FOR i := 1 TO n DO
+		theta := theta+thinc;
+		outer[i].x := xoffset + ROUND (3.0*LONGREAL(r)*Cos(theta));
+		outer[i].y := yoffset + ROUND (2.0*LONGREAL(r)*Sin(theta));
+	    END (* FOR *);
+	    FOR i:= 1 TO n DO
+		Line (w, outer[i], outer[(i MOD n) + 1]);
+		Line (w, outer[(i MOD n) + 1], inner[i]);
+		Line (w, inner[i], outer[i]);
+		inner[i] := outer[i];
+	    END (* FOR *);
+	END (* FOR *)
+    END Rose;
+
+(************************************************************************)
+
+PROCEDURE SquareinSquare (w: Window; xoffset, yoffset, size: LONGREAL);
+
+    VAR pt, ptd: ARRAY[1..4] OF Vector2;
+	i, j, nextj: INTEGER;
+	mu, um: LONGREAL;
+	pti: Point;
+
+    BEGIN
+	pt[1].x:=  xoffset+size*2.5; pt[1].y:=  yoffset+size*2.0;
+	pt[2].x:=  xoffset+size*2.5; pt[2].y:=  yoffset;
+	pt[3].x:=  xoffset; pt[3].y:=   yoffset;
+	pt[4].x:=  xoffset; pt[4].y:=   yoffset+size*2.0;
+	mu:= 0.1; um:= 1.0-mu;
+	FOR i:= 1 TO 21 DO
+	    pti := Round2 (pt[4]);
+	    FOR j:= 1 TO 4 DO
+		Line(w, Round2 (pt[j]), pti);
+		pti := Round2 (pt[j]);
+		nextj:= (j MOD 4) + 1;
+		ptd[j].x:= um*pt[j].x + mu*pt[nextj].x;
+		ptd[j].y:= um*pt[j].y + mu*pt[nextj].y
+	    END (* FOR *);
+	    FOR j:= 1 TO 4 DO  pt[j]:= ptd[j]   END (* FOR *)
+	END (* FOR *)
+    END SquareinSquare;
+
+(************************************************************************)
+
+PROCEDURE SpiroGraph(w: Window; xcenter, ycenter: INTEGER;
+					a, b, d: CARDINAL);
+
+    CONST Scale= 6.0;  steps = 50;
+
+    VAR pt, oldpt: Point;
+	i: CARDINAL;
+	Xscale, phi, theta, thinc: LONGREAL;
+
+    (********************************************************************)
+
+    PROCEDURE hcf (i, j: CARDINAL) : CARDINAL;
+
+	VAR remain: CARDINAL;
+
+	BEGIN
+	    REPEAT
+		remain := i MOD j;
+		i := j;  j := remain;
+	    UNTIL remain = 0;
+	    RETURN i;
+	END hcf;
+
+    (********************************************************************)
+
+    BEGIN
+	Xscale := 1.6*Scale;
+	theta := 0.0;  thinc:= 2.0*pi/LONGREAL(steps);
+	oldpt.x := INTEGER (xcenter) + ROUND(Xscale*LONGREAL(a - b + d));
+	oldpt.y := ycenter;
+	FOR i := 1 TO steps*(b DIV hcf(a,b)) DO
+	    theta:= theta + thinc;  phi:= theta*LONGREAL(a-b)/LONGREAL(b);
+	    pt.x := xcenter+ROUND(Xscale*(LONGREAL(a-b)*Cos(theta)
+				+ LONGREAL(d)*Cos(phi)));
+	    pt.y := ycenter+ROUND(Scale*(LONGREAL(a-b)*Sin(theta)
+				- LONGREAL(d)*Sin(phi)));
+	    Line (w, pt, oldpt);
+	    oldpt := pt;
+	END (* FOR *)
+    END SpiroGraph;
+
+(************************************************************************)
+
+PROCEDURE StringPoly (w: Window; xcentre, ycentre, radius, n: CARDINAL);
+
+    (* Draws a polygon of n vertices, with every vertex connected to	*)
+    (* every other.							*)
+
+    VAR pt: ARRAY[1..100] OF Point;
+	i, j: CARDINAL;
+	theta, thinc: LONGREAL;
+
+    BEGIN
+	theta:=0.0; thinc:= 2.0*pi/LONGREAL(n);
+	FOR i := 1 TO n DO
+	    pt[i].x := INTEGER(xcentre) + ROUND(LONGREAL(3*radius-20)*Cos(theta));
+	    pt[i].y := INTEGER(ycentre) + ROUND(LONGREAL(2*radius)*Sin(theta));
+	    theta:= theta + thinc;
+	END (* FOR *);
+	FOR i:= 1 TO n-1 DO
+	    FOR j:= i+1 TO n DO
+		Line (w, pt[i], pt[j]);
+	    END (* FOR *)
+	END (* FOR *);
+    END StringPoly;
+
+(************************************************************************)
+(*			THE MAIN DEMONSTRATION TASK			*)
+(************************************************************************)
+
+PROCEDURE RunTheDemo;
+
+    VAR w1, w2, w3, w4, w5: Window;
+	i: [5..15];  b, c: [1..4];
+	point: Point;
+	xc, yc: CARDINAL;
+	radius: LONGREAL;
+
+    BEGIN
+	OpenWindow(w5,15,Ymax-CharHeight-8,275,Ymax,1,3,single);
+	WriteString (w5,' Demonstration of line graphics');
+
+	IF Xmax > 400 THEN
+	    xc := Xmax-201;
+	    CreateTask (CROdemo, 3, "CRO demo");
+	ELSE
+	    xc := 3*Xmax DIV 4;
+	END (*IF*);
+	yc := 7*Ymax DIV 8;
+	OpenWindow(w1,0,0,xc,yc,7,6,single);
+
+	WriteString (w1,'Spiral');
+	xc := xc DIV 2;  yc := yc DIV 2;
+	IF xc DIV 3 < yc DIV 2 THEN
+	    radius := 0.3*LONGREAL(xc);
+	ELSE
+	    radius := 0.5*LONGREAL(yc);
+	END (*IF*);
+	point.x := xc;  point.y := yc;
+	Spiral (w1, point, radius, 0.0, 8);
+	Sleep(2000);
+
+	FOR i:= 5 TO 15 BY 2 DO
+	    ClearWindow (w1);
+	    WriteString (w1, 'Rose Pattern');
+	    Rose (w1,xc,yc,CARDINAL(radius),i,i);
+	    Sleep (1000);
+	END (* FOR *);
+
+	xc := xc DIV 2;
+	yc := yc DIV 2;
+	radius := 0.5*radius;
+	OpenWindow(w4,Xmax DIV 3,Ymax DIV 3,
+		Xmax DIV 3+2*xc,Ymax DIV 3+2*yc,0,3,double);
+	StringPoly (w4,xc,yc,CARDINAL(radius),17);
+	Sleep(1000);
+
+	OpenWindow(w2,320,40,620,180,4,7,single);
+
+	WriteString (w2,' Rotating Squares');
+	SquareinSquare (w2, 125.0, 20.0, 50.0);
+	SquareinSquare (w2, 15.0, 30.0, 40.0);
+	Sleep(1000);
+
+	OpenWindow(w3,20,20,240,180,14,6,double);
+	FOR b := 2 TO 3 DO
+	    ClearWindow(w3);
+	    WriteString (w3,'SpiroGraphs');
+	    FOR c := 2 TO 4 DO
+		SpiroGraph(w3,110,70,9,b,c);
+		Sleep(1000);
+	    END (* FOR *)
+	END (* FOR *);
+
+	Pause;
+
+	Sleep(1000);  CloseWindow (w1);
+	Sleep(1000);  CloseWindow (w2);
+	Sleep(1000);  CloseWindow (w3);
+	Sleep(1000);  CloseWindow (w4);
+	Sleep(1000);  CloseWindow (w5);
+
+    END RunTheDemo;
+
+(************************************************************************)
+
+BEGIN
+    (*InitGraphics(16);*)
+    GetScreenShape (Xmax, Ymax, maxcolour, CharHeight);
+    RunTheDemo;
+END LineDemo.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/demo/m3d01.mod b/examples/Modula-2_Libraries/PMOS/sources/demo/m3d01.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/demo/m3d01.mod
@@ -0,0 +1,92 @@
+MODULE M3D01;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of module Music3.			*)
+	(*							*)
+	(*	J.S. Bach: Prelude from Cello Suite No. 1	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(*	Note that this music has only a single voice.	*)
+	(*							*)
+	(********************************************************)
+
+FROM Music3 IMPORT
+    (* proc *)	Voice1, SetDuration, PlayTheMusic, SetInstrument;
+
+(************************************************************************)
+
+PROCEDURE EncodeMusic;
+
+    (* Plays a piece of music. *)
+
+    BEGIN	(* EncodeMusic *)
+
+	(********************************************************)
+	(* Opening of J.S. Bach, Cello Suite No. 1, Prelude.	*)
+	(********************************************************)
+
+	SetDuration (130);
+	SetInstrument (7, 6000, 500, 30000);
+
+	Voice1 ("dDuAuF#EF#dAuF#dAddDuuAuF#EF#dAuF#dA");
+	Voice1 ("dDuBuGF#GdBuGdBddDuuBuGF#GdBuGdB");
+	Voice1 ("DC#GF#GC#GC#ddDuuC#GF#GC#GC#");
+	Voice1 ("dDuDF#EF#DF#DddDuuDF#EF#DF#C#");
+	Voice1 ("dDuBuF#EF#DC#DBDC#DdF#AG#F#");
+	Voice1 ("G#uDEDEDEDdG#uDEDEDED");
+	Voice1 ("C#EAG#AEDEC#EDEdAC#BA");
+	Voice1 ("dBuF#uDC#DdF#uDdF#dBuF#uDC#DdF#uDdF#");
+	Voice1 ("dBuG#ABAG#F#EuDC#BuAG#F#ED");
+	Voice1 ("C#BAuAEAdC#EdABC#EDC#BA");
+	Voice1 ("uD#dACBCAuD#dAuF#dACBCAuD#dA");
+	Voice1 ("GBEF#GEBAGBEF#GEC#B");
+	Voice1 ("A#C#A#C#EC#EC#A#C#A#C#EC#EC#");
+	Voice1 ("DC#BDC#DEC#DC#BAGF#ED");
+
+	(* Page 2. *)
+
+	Voice1 ("C#GAGAGAGC#GAGAGAG");
+	Voice1 ("DF#uCBCdF#uCdF#DF#uCBCdF#uCdF#");
+	Voice1 ("DGBABGBGDGBABGBG");
+	Voice1 ("DuC#GF#GC#GC#dDuC#GF#GC#GC#d");
+	Voice1 ("DuAuF#EF#DC#BAGF#EDC#BA");
+	Voice1 ("G#uEuBC#DBC#DddG#uEuBC#DBC#D");
+	Voice1 ("ddGuEABC#ABC#ddGuEABC#ABC#");
+	Voice1 ("ddGuEAC#EG#*A/AdEF#GABC#D");
+	Voice1 ("EC#ABC#DEF#GEC#DEF#GA");
+	Voice1 ("BbAG#AAGF#GGEC#BAEF#G");
+	Voice1 ("dAuEAC#EF#GEF#DAGF#DEF#");
+	Voice1 ("dADF#ADEF#DG#FEFFED#E");
+	Voice1 ("EDC#DDBG#F#EG#BDEG#AG#");
+	Voice1 ("AEC#BC#EdAC#dEAG#F#EDC#B");
+
+	(* Page 3. *)
+
+	Voice1 ("*A/uuGF#EDC#BAuGF#EDC#BA");
+	Voice1 ("GuF#EDC#BAGF#uEDC#BAGF#");
+	Voice1 ("EuDC#BC#EdAuEBEC#EDEBE");
+	Voice1 ("C#EdAuEDEBEC#EdAuEDEBE");
+	Voice1 ("C#EdAuEBEC#EDdEuEdEuF#EddAuEu");
+	Voice1 ("EdEuF#EGEddAuuEF#EGEAEF#E");
+	Voice1 ("GEF#EGEdEuEF#EdEuEF#EDE");
+	Voice1 ("EdEuDEdEuEC#EDEC#EDEBE");
+	Voice1 ("C#EdABCdAuC#dAuDdAuuD#ddAuuEddAuuFddA");
+	Voice1 ("uuF#ddAuuGddAuuG#ddAuuAddAuuBbddAuuBddAuuCddAuuC#ddA");
+	Voice1 ("uuDdF#dAuF#uDdF#uDdF#uDdF#dAuF#uDdF#uDdF#");
+	Voice1 ("uDdEdAuEuDdEuDdEuDdEdAuEuDdEuDdE");
+	Voice1 ("uC#dGdAuGuC#dGuC#dGuC#dGdAuGuC#dGuC#dG");
+	Voice1 ("u***D");
+
+    END EncodeMusic;
+
+(************************************************************************)
+
+BEGIN
+    EncodeMusic;
+    PlayTheMusic;
+END M3D01.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/demo/m3d02.mod b/examples/Modula-2_Libraries/PMOS/sources/demo/m3d02.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/demo/m3d02.mod
@@ -0,0 +1,94 @@
+MODULE M3D02;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of module Music3.			*)
+	(*							*)
+	(*	     J.S. Bach: Minuet from the			*)
+	(*	 "Notenbuch vor Anna Magdalena Bach"		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM Music3 IMPORT
+    (* proc *)	Voice1, Voice2, SetDuration, PlayTheMusic, SetInstrument,
+		SetEnvelope, SetWaveform;
+
+(************************************************************************)
+
+PROCEDURE EncodeMusic;
+
+    (* Plays a piece of music. *)
+
+    BEGIN	(* EncodeMusic *)
+
+	(************************)
+	(* J.S. Bach, Minuet	*)
+	(************************)
+
+	SetWaveform (1, 2);
+	SetEnvelope (1, 20000, 2000, 0);
+	SetWaveform (2, 1);
+	SetEnvelope (2, 10000, 40000, 50000);
+
+	Voice1 ("u");
+	Voice1 ("D/dGABC*DdGG uE/CDEF#*GdGG");
+	Voice1 ("C/DCBA*B/CBAG *F#/GABG*6A/3");
+	Voice1 ("D/dGABC*DdGG uE/CDEF#*GdGG");
+	Voice1 ("C/DCBA*B/CBAG *A/BAGF#*6G/3u");
+
+	Voice2 ("d");
+	Voice2 ("*G/A*3B CB");
+	Voice2 ("AG /3uDd*2G/2uD/DCBA");
+	Voice2 ("*4B/2AGBG *3C/3B/CBAG");
+	Voice2 ("*4A/2F#*2G/2B C*2D/2dGuDdG");
+
+	(* Repeat of the first part. *)
+
+	Voice1 ("D/dGABC*DdGG uE/CDEF#*GdGG");
+	Voice1 ("C/DCBA*B/CBAG *F#/GABG*6A/3");
+	Voice1 ("D/dGABC*DdGG uE/CDEF#*GdGG");
+	Voice1 ("C/DCBA*B/CBAG *A/BAGF#*6G/3u");
+
+	Voice2 ("*G/A*3B CB");
+	Voice2 ("AG /3uDd*2G/2uD/DCBA");
+	Voice2 ("*4B/2AGBG *3C/3B/CBAG");
+	Voice2 ("*4A/2F#*2G/2B C*2D/2dGuDdG");
+
+	(* Page 2. *)
+
+	Voice1 ("B/GABG*A/dDEF#D *G/EF#GD*C#/BC#*A");
+	Voice1 ("/ABC#DEF#*GF#E F#dAC#*3D/3");
+	Voice1 ("D/dGF#*GuE/dGF#*G uDCB/AGF#G*A");
+	Voice1 ("/dDEF#GAB*CBA /BD*dGF#*3G/3u");
+
+	Voice2 ("uGDGF#AdD EGEAdAuA");
+	Voice2 ("dAuAdABDC# DdF#ADDC");
+	Voice2 ("*2B/2B*2C/2C BAGuDRRd");
+	Voice2 ("RRF#EGF# GBDdGuDdG");
+
+	(* Repeat of the second part. *)
+
+	Voice1 ("B/GABG*A/dDEF#D *G/EF#GD*C#/BC#*A");
+	Voice1 ("/ABC#DEF#*GF#E F#dAC#*3D/3");
+	Voice1 ("D/dGF#*GuE/dGF#*G uDCB/AGF#G*A");
+	Voice1 ("/dDEF#GAB*CBA /BD*dGF#*3G/3u");
+
+	Voice2 ("uGDGF#AdD EGEAdAuA");
+	Voice2 ("dAuAdABDC# DdF#ADDC");
+	Voice2 ("*2B/2B*2C/2C BAGuDRRd");
+	Voice2 ("RRF#EGF# GBDdGuDdG");
+
+    END EncodeMusic;
+
+(************************************************************************)
+
+BEGIN
+    SetDuration (280);
+    EncodeMusic;
+    PlayTheMusic;
+END M3D02.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/demo/m3d03.mod b/examples/Modula-2_Libraries/PMOS/sources/demo/m3d03.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/demo/m3d03.mod
@@ -0,0 +1,97 @@
+MODULE M3D03;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of module Music3.			*)
+	(*							*)
+	(*	     Fernando Sor: Estudio VII from		*)
+	(*	the Segovia edition of "Twenty Studies for	*)
+	(*			the Guitar"			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM Music3 IMPORT
+    (* proc *)	Voice1, Voice2, Voice3, SetDuration, SetInstrument,
+		PlayTheMusic;
+
+(************************************************************************)
+
+PROCEDURE EncodeMusic;
+
+    (* Plays a piece of music. *)
+
+    VAR repeat: [1..2];
+
+    BEGIN	(* EncodeMusic *)
+
+	SetInstrument (3, 40000, 1000, 500);
+
+	(************************)
+	(* F. Sor, Estudio VII	*)
+	(************************)
+
+	Voice2("d");  Voice3("d");
+
+	FOR repeat := 1 TO 2 DO
+
+	    Voice1 ("CCC  *3/2C/3CDE  FGAGFE *EDR");
+	    Voice2 ("AABb *3/2A/3ABbC DEFEDC *CBbR");
+	    Voice3 ("RFE  *3/2FR      *2R    R/3");
+
+	    Voice1 ("DDD    D/3DCBCEF GEBbGECBbGC");
+	    Voice2 ("BbBbBb BbRR      *3R");
+	    Voice3 ("RGF    E RR      RRE");
+
+	    Voice1 ("*3BbAR /3CDEFAG/2GF*2EF Gd*8/9C/8R*8C/8R*9*3CC");
+	    Voice2 ("R      /9ABbGACBbAGA        *3Bb/3REFGABb");
+	    Voice3 ("*2F/2R *3R                  /3R/3RCDEFG");
+
+	    Voice1 ("/3CDEFAG/2GF*2EF Gd*8/9C/8R*8C/8R*9*3CC /3CDEFGABbCA");
+	    Voice2 ("ABbGACBbAGA          *3Bb/3REFGABb          ABbCDEFGAF");
+	    Voice3 ("*3/2FR*2RR           R/3RCDEFG              *3FRR");
+
+	    Voice1 ("*3GFE           FED         CCR");
+	    Voice2 ("EdGuEDdG#uDCAC *3DCB        /3CEdGCdEG*3R");
+	    Voice3 ("*3R            /9RFARGCRGBb *3RRdC");
+
+	END (*FOR*);
+
+	(* Second section. *)
+
+	FOR repeat := 1 TO 2 DO
+
+	    Voice1 ("/3uGE*8/9C/8R*8C/8R*8C/8R*8C/8R*8C/8R*8C/8R*8C/8R*9"
+		+ " CDEFAGFGA BbGE*8/9C/8R*8C/8R*8C/8R*8C/8R*8C/8R*8C/8R*9");
+	    Voice2 ("RRBb ARR RRBb");
+	    Voice3 ("RRE  FRR GGE");
+
+	    Voice1 ("CBCDEFF#GG#" +
+		" Ad*8/9D/8R*8D/8R*8D/8R*8D/8R*8D/8R*9D*8/9G/8R*8G/8R*9"
+		+ " Gd*8/9C/8R*8C/8R*8C/8R*8C/8R*8C/8R*8C/8R*8F/8R*8F/8R*9");
+	    Voice2 ("ARR RC/2BbR *4Bb/2A");
+	    Voice3 ("FRR RF#/2GR *2REF");
+
+	    Voice1 ("FDG*3FE      /3FCBCDEFGG# *3A/2BbR*2B");
+	    Voice2 ("/3RRBbRACRGC *3ARR        /3RCEb*3/2DR*2/3RDF*3");
+	    Voice3 ("dBb/3CRRCRR  *3FRR        F/2BbR*2G");
+
+	    Voice1 ("/2CR*2C#/2DR      *4dF/2E         *2F/2Rd");
+	    Voice2 ("/2ER*2/3REG*3/2FR *4dA/2R         *2A/2R");
+	    Voice3 ("/2CR*2A/2BbR      *2/3dCFACAFCuGBb *3dFuFR");
+
+	END (*FOR*);
+
+    END EncodeMusic;
+
+(************************************************************************)
+
+BEGIN
+    SetDuration (324);
+    EncodeMusic;
+    PlayTheMusic;
+END M3D03.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/demo/m3d04.mod b/examples/Modula-2_Libraries/PMOS/sources/demo/m3d04.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/demo/m3d04.mod
@@ -0,0 +1,71 @@
+MODULE M3D04;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of module Music3.			*)
+	(*							*)
+	(*	 J.S. Bach: O Haupt voll Blut und Wunden,	*)
+	(*	from the Passion according to Saint Matthew	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM Music3 IMPORT
+    (* proc *)	Voice1, Voice2, Voice3, SetDuration, PlayTheMusic,
+		SetInstrument;
+
+(************************************************************************)
+
+PROCEDURE EncodeMusic;
+
+    (* Plays a piece of music. *)
+
+    VAR repeat: [1..2];
+
+    BEGIN	(* EncodeMusic *)
+
+	(*******************************************)
+	(* J.S. Bach, O Haupt voll Blut und Wunden *)
+	(*******************************************)
+
+	SetInstrument (0, 8000, 50, 20000);
+
+	Voice3("d");
+
+	FOR repeat := 1 TO 2 DO
+
+	    Voice1 ("B EDCB        *2A/2BuF#");
+	    Voice2 ("G CGGG        RRGR");
+	    Voice3 ("G CB/2dEF#*2G CDdGF#");
+
+	    Voice1 ("GG/2F#E*2F#  *3E/3");
+	    Voice2 ("BBB/2BA      *6B/3");
+	    Voice3 ("/2EF#GA*2BD# *3dE/3");
+
+	END (*FOR*);
+
+	Voice1 ("G /2F#E*2DEF#");
+	Voice2 ("B CGCC");
+	Voice3 ("E AB/2CB*2A");
+
+	Voice1 ("*2G/2GD   EDCC *3B/3uG /2F#G*2AGF#");
+	Voice2 ("C/2BA*2BR CBBA *3G#/3A DR/2BC#*2D");
+	Voice3 ("*2G/2GG   CG#/2ABCD    *6E/3C# DC#BA");
+
+	Voice1 ("*2E/2F#dB CBAD      *3B");
+	Voice2 ("BC#DB     AGAF#     *3G");
+	Voice3 ("G#ADdG    A/2BC*2DD *3dG");
+
+    END EncodeMusic;
+
+(************************************************************************)
+
+BEGIN
+    SetDuration (400);
+    EncodeMusic;
+    PlayTheMusic;
+END M3D04.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/demo/m3d05.mod b/examples/Modula-2_Libraries/PMOS/sources/demo/m3d05.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/demo/m3d05.mod
@@ -0,0 +1,273 @@
+MODULE M3D05;
+
+	(********************************************************)
+	(*							*)
+	(*		  Test of module Music3B.		*)
+	(*							*)
+	(*		     Francisco Tarrega			*)
+	(*		 Recuerdos de la Alhambra		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	I'm still not completely happy with the		*)
+	(*		closing chords.				*)
+	(*							*)
+	(********************************************************)
+
+FROM Music3 IMPORT
+    (* proc *)	Voice1, Voice2, Voice3, SetDuration,
+		SetWaveform, SetEnvelope, EnableVoice, PlayTheMusic;
+
+(************************************************************************)
+
+PROCEDURE Section1;
+
+    (* First section (first page and a half of the music). *)
+
+    BEGIN
+	Voice1 ("REEEEEEEEEEEEEEEDDDDDDDD CCCCCCCCCCCCCCCCDDDDDDDD");
+	Voice2 ("R   E  uC  dE  uB  dE    R   E   A   E  uB  dE   ");
+	Voice3 ("A                        A                       ");
+
+	Voice1 ("EEEEEEEEEEEEEEEEEEEEEEEE EEEEEEEEEEEEEEEEFFFFFFFF");
+	Voice2 ("R   E  uC  dE  uC  dE    R   E  uC  dE  uD  dG  ");
+	Voice3 ("A                        A                       ");
+
+	Voice1 ("GGGGGGGGGGGGGGGGFFFFFFFF EEEEEEEEEEEEEEEEFFFFFFFF");
+	Voice2 ("R   G  uE  dG  uD  dG    R   G   C   G  uD  dG   ");
+	Voice3 ("C                        C                       ");
+
+	Voice1 ("GGGGGGGGGGGGGGGGGGGGGGGG GGGGGGGGGGGGGGGGGGGGGGGG");
+	Voice2 ("R   G  uE  dG  uE  dG    R   G  uE  dG  uE  dG   ");
+	Voice3 ("C                        C                       ");
+
+	Voice1 ("CCCCCCCCCCCCCCCCBBBBBBBB AAAAAAAAAAAAAAAABBBBBBBB");
+	Voice2 ("R   C  uA  dC  uG  dC    R   C   F   C  dD  uF   ");
+	Voice3 ("F                        F                       ");
+
+	Voice1 ("AAAAAA*2/3ABA*3/2G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#");
+	Voice2 ("R  dB            E       B       E       B       ");
+	Voice3 ("dE                                               ");
+	Voice1 ("G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#");
+	Voice2 ("R       D       E       D       E       D       ");
+	Voice3 ("E                                               ");
+
+	(* Page 2. *)
+
+	Voice1 ("BbBbBbBbBbBbBbBbBbBbBbBbBbBbBbBbAAAAAAAA");
+	Voice2 ("R       C#      E       C#      E   C#  ");
+	Voice3 ("A                                       ");
+	Voice1 ("GGGGGGGGGGGGGGGGAAAAAAAA");
+	Voice2 ("R   A  uE  dA  uF  dA   ");
+	Voice3 ("C#                      ");
+
+	Voice1 ("GGGGGG*2/3GAG*3/2FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFF");
+	Voice2 ("R  uE            D   A   D   A    R   A   D   A   D   A   ");
+	Voice3 ("D                                 D                       ");
+
+	Voice1 ("EEEEEEEEEEEEEEEEDDDDDDDD CCCCCCCCCCCCCCCCDDDDDDDD");
+	Voice2 ("R   A   B   A   B   A    R   Eb  A   Eb  A   Eb  ");
+	Voice3 ("D                        dF                      ");
+
+	Voice1 ("CCCCCC*2/3CDC*3/2BBBBBBBBBBBBBBBB BBBBBBBBBBBBBBBBBBBBBBBB");
+	Voice2 ("R   E            G#  E   G#  E    R   E   G#  E   G#  E   ");
+	Voice3 ("E                                 E                       ");
+
+    END Section1;
+
+(************************************************************************)
+
+PROCEDURE Section2;
+
+    (* Last three lines of page 2, plus first four and a half lines of	*)
+    (* page 3.								*)
+
+    BEGIN
+
+	(* Page 2, line 5 (where key changes to A major). *)
+
+	Voice1 ("EEEEEEEEEEEEEEEEDDDDDDDD");
+	Voice2 ("R   E  uC# dE  uB  dE   ");
+	Voice3 ("A                       ");
+	Voice1 ("C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#DDDDDDDD");
+	Voice2 ("R       E       A       E      uB  dE   ");
+	Voice3 ("A                                       ");
+
+	Voice1 ("EEEEEEEEEEEEEEEEEEEEEEEE EEEEEEEEEEEEEEEEEEEEEEEE");
+	Voice2 ("R   E  uC# dE  uC# dE    R   E  uC# dE  uC# dE   ");
+	Voice3 ("A                        A                       ");
+
+	Voice1 ("F#F#F#F#F#F#F#F#F#F#F#F#F#F#F#F#F#F#F#F#F#F#F#F#");
+	Voice2 ("R       F#     uD      dF#     uD      dF#      ");
+	Voice3 ("A                                               ");
+	Voice1 ("uDDDDDDDDDDDDDDDDdF#F#F#F#F#F#F#F#");
+	Voice2 (" R  uD  uB  dD    D      dF#      ");
+	Voice3 (" A                                ");
+
+	(* Page 3. *)
+
+	Voice1 ("F#F#F#F#F#F#*2/3F#G#F#*3/2EEEEEEEEEEEEEEEE");
+	Voice2 ("R      uD                 C# dE  uC# dE   ");
+	Voice3 ("A                                         ");
+	Voice1 ("EEEEEEEEEEEEEEEEEEEEEEEE");
+	Voice2 ("R   E  uC# dE  uC# dE   ");
+	Voice3 ("A                       ");
+
+	Voice1 ("AAAAAAAAAAAAAAAAAAAAAAAA");
+	Voice2 ("R   F#  A   C#  A   F#  ");
+	Voice3 ("F#                      ");
+	Voice1 ("G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#DDDDDDDD");
+	Voice2 ("R       G#      C       D#      C   G#  ");
+	Voice3 ("G#                                      ");
+
+	Voice1 ("F#F#F#F#F#F#F#F#EEEEEEEEEEEEEEEE EEEEEEEEEEEEEEEEEEEEEEEE");
+	Voice2 ("R       G#      C#  G#  C#  G#   R   G#  C#  G#  C#  G#  ");
+	Voice3 ("C#                               C#                      ");
+
+	Voice1 ("DDDDDDDDDDDDDDDDDDDDDDDD");
+	Voice2 ("R   F   F   D   E   F   ");
+	Voice3 ("B                       ");
+	Voice1 ("C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#BBBBBBBB");
+	Voice2 ("R       E       E       E      dE  uD   ");
+	Voice3 ("dE                                      ");
+
+	Voice1 ("BBBBBB*2/3BC#B*3/2AAAAAAAAAAAAAAAA");
+	Voice2 ("R   E             E   E   F#  G#  ");
+	Voice3 ("A                                 ");
+
+    END Section2;
+
+(************************************************************************)
+
+PROCEDURE EncodeMusic;
+
+    (* Plays a piece of music. *)
+
+    CONST BaseDuration = 48;
+
+    BEGIN	(* EncodeMusic *)
+
+	SetDuration (BaseDuration);
+	SetWaveform (1, 1);
+	SetWaveform (2, 1);
+	SetWaveform (3, 6);
+	SetEnvelope (1, 50000, 10000, 10000);
+	SetEnvelope (2, 50000, 3000, 0);
+	SetEnvelope (3, 50000, 2000, 0);
+
+	EnableVoice (1, TRUE);
+	EnableVoice (2, TRUE);
+	EnableVoice (3, TRUE);
+
+	(****************************************)
+	(* F. Tarrega, Recuerdos de la Alhambra	*)
+	(****************************************)
+
+	Voice2("d*4");  Voice3("dd*4*6");
+
+	(* Two repeats of the A minor section. *)
+
+	Section1;
+	Section1;
+
+	(* Two repeats of the A major section, with slightly different	*)
+	(* endings.							*)
+
+	Section2;
+	Voice1 ("AAAAAAAAAAAABBBBC#C#C#C#DDDD");
+	Voice2 ("R   E   C#  E   A       B  d");
+	Voice3 ("A                           ");
+
+	Section2;
+	Voice1 ("AAAAAAAAAAAABBBBCCCCDDDD");
+	Voice2 ("R   E   E   G#  A   B  d");
+	Voice3 ("A                       ");
+
+	(* D.C. al S/S. *)
+
+	Section1;
+	Section2;
+	Voice1 ("AAAAAAAAAAAABBBBCCCCDDDD");
+	Voice2 ("R   E   E   G#  A   B  d");
+	Voice3 ("A                       ");
+
+	(* Continue with the remainder of the A major section. *)
+
+	Voice1 ("AAAAAAAAAAAAAAAAAAAAAAAA");
+	Voice2 ("R   E   E   E   E   E   ");
+	Voice3 ("A                       ");
+
+	Voice1 ("AAAAAAAAAAAAAAAAAAAAAAAA BBBBBBBBCCCCCCCCDDDDDDDD");
+	Voice2 ("R   F   F   F   F   F    R   F   A   F   A   F   ");
+	Voice3 ("A                        A                       ");
+
+	(* Page 4. *)
+
+	Voice1 ("EEEEEEEEEEEEEEEEEEEEEEEE EEEEEEEEEEEEEEEEEEEEEEEE");
+	Voice2 ("R   E  uC# dE  uC# dE    R   E  uC# dE  uC# dE   ");
+	Voice3 ("A                        A                       ");
+
+	Voice1 ("EEEEEEEEEEEEEEEEEEEEEEEE DDDDDDDDC#C#C#C#C#C#C#C#BBBBBBBB");
+	Voice2 ("R   G#  G#  G#  G#  G#   R   F   E       E      dE  uD   ");
+	Voice3 ("E                        E                               ");
+
+	Voice1 ("AAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAA");
+	Voice2 ("R   E   E   E#  F#  E#   R   E   E   E   E   E   ");
+	Voice3 ("A                        A                       ");
+
+	Voice1 ("AAAAAAAAAAAAAAAAAAAAAAAA BBBBBBBBCCCCCCCCDDDDDDDD");
+	Voice2 ("R   F   F   F   F   F    R   F   A   F   A   F   ");
+	Voice3 ("A                        A                       ");
+
+	Voice1 ("EEEEEEEEEEEEEEEEEEEEEEEE EEEEEEEEEEEEEEEEEEEEEEEE");
+	Voice2 ("R   E  uC# dE  uC# dE    R   E  uC# dE  uC# dE   ");
+	Voice3 ("A                        A                       ");
+
+	Voice1 ("G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#G#");
+	Voice2 ("R       E      uE      dE      uE      dE       ");
+	Voice3 ("E                                               ");
+	Voice1 ("F#F#F#F#F#F#F#F#EEEEEEEEDDDDDDDD");
+	Voice2 ("R       E      uC# dE  uB  dE   ");
+	Voice3 ("E                               ");
+
+	Voice1 ("C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#");
+	Voice2 ("R       E       A       E       F#      A       ");
+	Voice3 ("A                                               ");
+	SetDuration (9*BaseDuration DIV 8);
+	Voice2("*4");  Voice3("*4*6");
+	Voice1 ("C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#");
+	Voice2 ("R       E       A      dE      uC       C#      ");
+	Voice3 ("A                                               ");
+
+	SetDuration (6*BaseDuration DIV 5);
+	Voice2("*4");  Voice3("*4*6");
+
+	Voice1 ("C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#");
+	Voice2 ("R       E       A      dE      uC       C#      ");
+	Voice3 ("A                                               ");
+	Voice1 ("*4*6R                   ");
+	Voice2 ("R   E   A   C#  E   A   ");
+	Voice3 ("A                       ");
+
+	SetEnvelope (1, 50000, 20000, 20000);
+	SetEnvelope (2, 50000, 20000, 20000);
+	SetEnvelope (3, 50000, 20000, 20000);
+	SetWaveform (3, 1);
+
+	SetDuration (36*BaseDuration);
+
+	Voice1 ("uE *2/3 ddA");
+	Voice2 (" A *2/3  dE");
+	Voice3 (" A *2/3   A");
+
+    END EncodeMusic;
+
+(************************************************************************)
+
+BEGIN
+    EncodeMusic;
+    PlayTheMusic;
+END M3D05.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/demo/m3d06.mod b/examples/Modula-2_Libraries/PMOS/sources/demo/m3d06.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/demo/m3d06.mod
@@ -0,0 +1,94 @@
+MODULE M3D06;
+
+	(********************************************************)
+	(*							*)
+	(*		  Test of module Music3B.		*)
+	(*							*)
+	(*		Fernando Sor, Estudio XVII		*)
+	(*		  of the Segovia edition		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Status:		Incomplete			*)
+	(*							*)
+	(*	I'm not yet sure I'll have the patience		*)
+	(*		  to finish this.			*)
+	(*							*)
+	(********************************************************)
+
+FROM Music3 IMPORT
+    (* proc *)	Voice1, Voice2, Voice3, SetDuration, SetInstrument,
+		SetWaveform, SetEnvelope, EnableVoice, PlayTheMusic;
+
+(************************************************************************)
+
+PROCEDURE EncodeMusic;
+
+    (* Plays a piece of music. *)
+
+    CONST BaseDuration = 130;
+
+    BEGIN	(* EncodeMusic *)
+
+	SetDuration (BaseDuration);
+	SetInstrument (1, 65535, 2000, 0);
+	SetEnvelope (2, 65535, 3000, 0);
+	SetWaveform (1, 1);
+	SetWaveform (2, 1);
+	SetWaveform (3, 1);
+
+	EnableVoice (1, TRUE);
+	EnableVoice (2, TRUE);
+	EnableVoice (3, TRUE);
+
+	Voice1 ("d*3");  Voice2("d");  Voice3("dd*4*3");
+
+	Voice1 ("R  B  E  E    E  B  B  B  ");
+	Voice2 ("REGREGREGREG  REGREGREGREG");
+	Voice3 ("E             E           ");
+
+	Voice1 ("R  B  E  G    *2G    F#   /2 R  F# F# F# ");
+	Voice2 ("REGREGREGREG  REACdEAREACdEA REAREAREAREA");
+	Voice3 ("E             E              E           ");
+
+	Voice1 ("F# dB   B  dC    uR  F#  G   F# *2F#     E    /2");
+	Voice2 ("RD#ARD#ARD#ARD#A RD#ARD#ARD#ARD#A REABdEAREGBdEG");
+	Voice3 ("E                uB               dE            ");
+
+	Voice1 ("R   G    G    G      G  F# *2F#/2 R  A  A  A  ");
+	Voice2 ("REuBRdEuBRdEuBRdEuC# RADRADRADRAD RCDRCDRCDRCD");
+	Voice3 ("E                    *3/4uD /3D   *3F#   /3F# ");
+
+	Voice1 ("A  G*2G/2    R  B  B  B   B  A*2A   /2");
+	Voice2 ("RBDRBDRBDRBD RBDRBDRBDRBD RCERCERCERCE");
+	Voice3 ("*3G    /3G   *4dG         *3/4C  /3C  ");
+
+	Voice1 ("R     G     G     G      G   F#*2F# /2 R  F# F# F# ");
+	Voice2 ("RdBbuERdBbuERdBbuERdBbuE RdADRADRADRAD RADRADRADRAD");
+	Voice3 ("*4C#                     *3/4D   /3D   *2C   R     ");
+
+	Voice1 ("F#   G   *2G/2       R    A    A    A    A#   B  *2B/2     ");
+	Voice2 ("RdGuDRdGuDRdGuDRdGuD RdDuCRdDuCRdDuCRdDuCRdDuBRdDuBRdDuBRdDG");
+	Voice3 ("*3/2B        /3B    *4dF#            /4*3G            /3G   ");
+
+	(* Some faults still exist in the next two lines. *)
+
+	Voice1 ("R  G  G  G   R  A  R  C    R dF# F# F# ");
+	Voice2 ("RGBRGBRGBRGB RCERCERCERCE dRACRACRACRAC");
+	Voice3 ("*3E   /3uE  *2C    A       D   /2R  D# ");
+
+	Voice1 ("F# G *2G  /2 R     F     F     F     F  E  R  A  ");
+	Voice2 ("RACRGBRGBRGB RG#uDdRG#uDdRG#uDdRG#uD RADRACRCERCE");
+	Voice3 ("*3E    /3E  *4B                      /2C   A     ");
+
+	(* Page 2. *)
+
+    END EncodeMusic;
+
+(************************************************************************)
+
+BEGIN
+    EncodeMusic;
+    PlayTheMusic;
+END M3D06.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/demo/m3d07.mod b/examples/Modula-2_Libraries/PMOS/sources/demo/m3d07.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/demo/m3d07.mod
@@ -0,0 +1,192 @@
+MODULE M3D07;
+
+	(********************************************************)
+	(*							*)
+	(*		  Test of module Music3			*)
+	(*							*)
+	(*		W.A. Mozart: Variations on		*)
+	(*		"Ah! vous dirais-je, Maman"		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM Music3 IMPORT
+    (* proc *)	Voice1, Voice2, Voice3, SetDuration, PlayTheMusic,
+		SetInstrument, EnableVoice;
+
+(************************************************************************)
+
+PROCEDURE Theme;
+
+    VAR repeat: [1..2];
+
+    BEGIN
+
+	Voice3 ("*2d");
+
+	FOR repeat := 1 TO 2 DO
+	    Voice1 ("CC uGG AA GG FF EE D*3/4D/3E *8C/2");
+	    Voice2 ("CuC EC FC EC DB CA FG        *2dC/2");
+	    Voice3 ("R   R  R  R  R  R  R           R   ");
+	END (*FOR*);
+
+	FOR repeat := 1 TO 2 DO
+	    Voice1 ("uGG  FF   EE DD GG   FF   E*3/4E/3F*4 ED");
+	    Voice2 ("uEdG uDdG CG BG uEdG uDdG C*3/4C/3D*4 CBd");
+	    Voice3 ("R    R    R  R  R    R    R           G  ");
+
+	    Voice1 ("CC uGG AA GG FF EE D*3/4D/3E *8C/2");
+	    Voice2 ("CuC EC FC EC DB CA FG *2dC/2");
+	    Voice3 ("R   R   R  R R  R  R  R   ");
+	END (*FOR*);
+
+	Voice3 ("/2");
+
+    END Theme;
+
+(************************************************************************)
+
+PROCEDURE Variation1;
+
+    VAR repeat: [1..2];
+
+    BEGIN
+	Voice3 ("*2");
+
+	FOR repeat := 1 TO 2 DO
+	    Voice1 ("/4DCBCBCBC uAGF#GF#GF#G G#ACBDCBA AGuEDCBAG GFuDCBAGF FEuCBAGFE *2DuAGdB *2CR");
+	    Voice2 ("CuC EC FC E*3/4R/3C#*4 D*3/4R/3B*4 C*3/4R/3A*4 FG");
+	    IF repeat = 1 THEN
+		Voice2 ("/2CGEG*2d");
+	    ELSE
+		Voice2 ("CdC");
+	    END (*IF*);
+	    Voice3 ("R   R   R  /2CR*2 R  R  R  R   ");
+	END (*FOR*);
+
+	FOR repeat := 1 TO 2 DO
+	    Voice1 ("/4uAGF#GF#GAG GFEFEFGF FED#ED#EFE");
+	    Voice2 ("uEdG          uDdG     CG        ");
+	    Voice3 (" R            R        R         ");
+
+	    Voice1 ("EDC#DC#DED uAGF#GuECAG GFEFuDBGF FED#EuCGFE *3G/3E*4D/4 DCBCBCBC");
+	    Voice2 ("uFdG *2uF D/2 C*3/4R/3C *3E/3C*4B dCuC");
+	    Voice3 ("R    G    G/2 GR*2      G         R   ");
+
+	    Voice1 ("uAGF#GF#GF#G G#ACBDCBA AGuEDCBAG    GFuDCBAGF   FEuCBAGFE   *2DuAGdB *2CR");
+	    Voice2 ("EC           FC        E*3/4R/3C#*4 D*3/4R/3B*4 C*3/4R/3A*4 FG       CdC ");
+	    Voice3 ("R            R        /2CR*2        R           R           R        R   ");
+	END (*FOR*);
+	Voice3 ("/2");
+
+    END Variation1;
+
+(************************************************************************)
+
+PROCEDURE Variation2;
+
+    VAR repeat: [1..2];
+
+    BEGIN
+	Voice2 ("*2u");
+
+	FOR repeat := 1 TO 2 DO
+	    Voice1 ("C/2RC*2 uG/2RG*2 A/2RA*2 G/2RG   RFRF   RERE RDRD *2CR");
+	    Voice2 ("R       R        R    *3/4R/3E   RERD   RDRC RCRB *4R ");
+	    Voice3 ("/2RC*2E /2RE*2C  /2RF*2C /2RE*2C /2DRBR CRAR FRGR RC*2dCu");
+	END (*FOR*);
+
+	FOR repeat := 1 TO 2 DO
+
+	    Voice1 ("uG/2RG *2F#/2RF *2E/2REb *2D/2RdG *2uG/2R/2GF# *4F/2R/2FE *4Eb/2R/2F#G *4D/2R/2FD *4C/2R/2CE");
+	    Voice2 ("R        R        R        R        R            R          R            R          R       ");
+	    Voice3 ("/2RE*2dG /2RuD*2dG /2RC*2G /2RB*2G /2RuE*2dG   /2RuD*2dG  /2RC*2G      /2RB*2G   /2R/2dCE*4G");
+
+	    Voice1 ("*4G/2R/2GE *4A/2R/2AC *4G/2R/2EG *2R/2GF#*2R/2DF *2R/2FE*2R/2GE *2R/2C#D*2R/2FD *2R/2BC*4R");
+	    Voice2 ("R            R         R          R               R               R               R       ");
+	    Voice3 ("/2R/2CE*4G /2R/2FA*4dC /2R/2EG*4dC /2DRBR         CRdER          FRGR            CR*2dCu  ");
+
+	END (*FOR*);
+
+	Voice2 ("/2d");
+
+    END Variation2;
+
+(************************************************************************)
+
+PROCEDURE Variation3;
+
+    VAR repeat: [1..2];
+
+    BEGIN
+	Voice1 ("/2");
+	Voice2 ("/2");
+	Voice3 ("d/4");
+
+	FOR repeat := 1 TO 2 DO
+
+	    Voice1 ("C R C R uG R G R  A R A R  G R G R ");
+	    Voice2 ("G R G R uE R E R  G R F R  F R E R ");
+	    Voice3 ("CBCBCBCB CBCBCDEC FEFEFGAB CBCBCDEC");
+
+	    Voice1 ("F  R F R  E R E  R  D R B  R   *2CR/2     ");
+	    Voice2 ("E  R D R  D R C  R  A R F  R   *2GR/2     ");
+	    Voice3 ("DC#DCBABA CBCBAG#AG FEFDGF#GdG CGEG*4dCu/4");
+
+	END (*FOR*);
+
+	FOR repeat := 1 TO 2 DO
+
+	    Voice1 ("/2dGF#GF#GF#GF# GF#GF#GABG CBCDEDEF# GF#GF#GF#GF#");
+	    Voice2 ("*2E      E      F     F    E   E     D     D     ");
+	    Voice3 ("*4G      G     uD     D    C   C     B     B     ");
+
+	    Voice1 ("GF#GF#GF#GF# GF#GF#GABG CBCDEDEF# GAFGEFDE*2");
+	    Voice2 ("G     G      F     F    E   E     D   R   /2");
+	    Voice3 ("E     E      D     D    C   C     B   R   /4");
+
+	    Voice1 ("C R C R uG R G R  A R A R  G R G R ");
+	    Voice2 ("G R G R uE R E R  G R F R  F R E R ");
+	    Voice3 ("CBCBCBCB CBCBCDEC FEFEFGAB CBCBCDEC");
+
+	    Voice1 ("F  R F R  E R E  R  D R B  R   *2CR/2     ");
+	    Voice2 ("E  R D R  D R C  R  A R F  R   *2GR/2     ");
+	    Voice3 ("DC#DCBABA CBCBAG#AG FEFDGF#GdG CGEG*4dCu/4");
+
+	END (*FOR*);
+
+    END Variation3;
+
+(************************************************************************)
+
+PROCEDURE EncodeMusic;
+
+    (* Plays a piece of music. *)
+
+    VAR repeat: [1..2];
+
+    BEGIN	(* EncodeMusic *)
+
+	SetInstrument (2, 60000, 1200, 0);
+	EnableVoice (1, TRUE);
+
+	Voice2("d");  Voice3 ("d");
+
+	Theme;
+	Variation1;
+	Variation2;
+	Variation3;
+
+    END EncodeMusic;
+
+(************************************************************************)
+
+BEGIN
+    SetDuration (400);
+    EncodeMusic;
+    PlayTheMusic;
+END M3D07.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/demo/menutest.mod b/examples/Modula-2_Libraries/PMOS/sources/demo/menutest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/demo/menutest.mod
@@ -0,0 +1,232 @@
+MODULE MenuTest;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of the "Menus" module.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	13 December 1994		*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, WriteString, WriteLn;
+
+FROM NumericIO IMPORT
+    (* proc *)	WriteCard;
+
+FROM Mouse IMPORT
+    (* proc *)	MouseAvailable;
+
+FROM UserInterface IMPORT
+    (* type *)	UIWindow, Capability, CapabilitySet,
+    (* proc *)	AllowMouseControl;
+
+FROM Menus IMPORT
+    (* type *)	Menu, ItemText, MO, MenuOption, OffEdgeOption,
+    (* proc *)	CreateMenu, SetOptions, OffEdge, PositionMenu, DestroyMenu,
+		SelectFromMenu;
+
+(****************************************************************)
+
+PROCEDURE DisplayAnswer (w: Window; number: CARDINAL);
+
+    BEGIN
+	WriteString (w, "The result is ");
+	WriteCard (w, number);  WriteLn (w);
+    END DisplayAnswer;
+
+(****************************************************************)
+
+PROCEDURE CreateMenu0(): Menu;
+
+    (* Creates the top-level menu. *)
+
+    VAR menu: Menu;
+	menutext: ARRAY [0..6] OF ItemText;
+
+    BEGIN
+	menutext[0] := "MENU 0";
+	menutext[1] := " \Default";
+	menutext[2] := " \Border only";
+	menutext[3] := " \Title only";
+	menutext[4] := " \Naked";
+	menutext[5] := "";
+	menutext[6] := " E\xit";
+	CreateMenu (menu, 6, menutext, 6);
+	SetOptions (menu, MO{MNoTitle,MNoBorder,MNoClose,MFastSelect});
+	OffEdge (menu, stick, return, wrap, wrap);
+	PositionMenu (menu, 0, 0, 0, 79);
+	RETURN menu;
+    END CreateMenu0;
+
+(****************************************************************)
+
+PROCEDURE CreateMenu1(): Menu;
+
+    (* Creates submenu number 1. *)
+
+    VAR menu: Menu;
+	menutext: ARRAY [0..25] OF ItemText;
+
+    BEGIN
+	menutext[0] := "MENU 1";
+	menutext[1] := "The";
+	menutext[2] := "quick";
+	menutext[3] := "brown";
+	menutext[4] := "fox";
+	menutext[5] := "jumps";
+	menutext[6] := "over";
+	menutext[7] := "the";
+	menutext[8] := "lazy";
+	menutext[9] := "dog";
+	menutext[10] := "Now";
+	menutext[11] := "is";
+	menutext[12] := "the";
+	menutext[13] := "time";
+	menutext[14] := "for";
+	menutext[15] := "all";
+	menutext[16] := "good";
+	menutext[17] := "men";
+	menutext[18] := "to";
+	menutext[19] := "come";
+	menutext[20] := "to";
+	menutext[21] := "the";
+	menutext[22] := "aid";
+	menutext[23] := "of";
+	menutext[24] := "the";
+	menutext[25] := "party";
+	CreateMenu (menu, 3, menutext, 25);
+	PositionMenu (menu, 1, 8, 0, 25);
+	RETURN menu;
+    END CreateMenu1;
+
+(****************************************************************)
+
+PROCEDURE CreateMenu2(): Menu;
+
+    (* Creates submenu number 2. *)
+
+    VAR menu: Menu;
+	menutext: ARRAY [0..6] OF ItemText;
+
+    BEGIN
+	menutext[0] := "MENU 2";
+	menutext[1] := "Mary";
+	menutext[2] := "had";
+	menutext[3] := "a";
+	menutext[4] := "little";
+	menutext[5] := "roast";
+	menutext[6] := "beef";
+	CreateMenu (menu, 4, menutext, 6);
+	SetOptions (menu, MO{MNoTitle,MNoMouse});
+	OffEdge (menu, escape, wrap, wrap, wrap);
+	PositionMenu (menu, 1, 3, 12, 40);
+	RETURN menu;
+    END CreateMenu2;
+
+(****************************************************************)
+
+PROCEDURE CreateMenu3(): Menu;
+
+    (* Creates submenu number 3. *)
+
+    VAR menu: Menu;
+	menutext: ARRAY [0..3] OF ItemText;
+
+    BEGIN
+	menutext[0] := " MENU 3";
+	menutext[1] := " Y\et";
+	menutext[2] := " An\other";
+	menutext[3] := " \menu";
+	CreateMenu (menu, 1, menutext, 3);
+	SetOptions (menu, MO{MNoBorder,MFastSelect});
+	OffEdge (menu, escape, wrap, stick, stick);
+	PositionMenu (menu, 1, 5, 28, 36);
+	RETURN menu;
+    END CreateMenu3;
+
+(****************************************************************)
+
+PROCEDURE CreateMenu4(): Menu;
+
+    (* Creates submenu number 4. *)
+
+    VAR menu: Menu;
+	menutext: ARRAY [0..12] OF ItemText;
+
+    BEGIN
+	menutext[0] := "MENU 4";
+	menutext[1] := "This";
+	menutext[2] := "is";
+	menutext[3] := "an";
+	menutext[4] := "example";
+	menutext[5] := "of";
+	menutext[6] := "a";
+	menutext[7] := "menu";
+	menutext[8] := "without";
+	menutext[9] := "a";
+	menutext[10] := "border";
+	menutext[11] := "or";
+	menutext[12] := "title";
+	CreateMenu (menu, 2, menutext, 0);
+	SetOptions (menu, MO{MNoBorder,MNoTitle});
+	OffEdge (menu, escape, wrap, wrap, wrap);
+	PositionMenu (menu, 1, 6, 39, 55);
+	RETURN menu;
+    END CreateMenu4;
+
+(****************************************************************)
+
+PROCEDURE RunTheTest;
+
+    VAR menu0, menu1, menu2, menu3, menu4: Menu;
+	result: CARDINAL;
+	resultwindow: Window;  UIW: UIWindow;
+
+    BEGIN
+	OpenWindow (resultwindow, white, magenta, 10, 24, 32, 70,
+			doubleframe, nodivider);
+	IF MouseAvailable() THEN
+	    UIW := AllowMouseControl (resultwindow, "Menu selection result",
+			CapabilitySet {wshow, wmove, whide});
+	END (*IF*);
+	menu0 := CreateMenu0();
+	menu1 := CreateMenu1();
+	menu2 := CreateMenu2();
+	menu3 := CreateMenu3();
+	menu4 := CreateMenu4();
+	LOOP
+	    result := SelectFromMenu (menu0);
+	    WriteString (resultwindow, "Submenu ");
+	    WriteCard (resultwindow, result);
+	    WriteString (resultwindow, ": ");
+	    CASE result OF
+		| 0,6:	EXIT (*LOOP*);
+		| 1:	result := SelectFromMenu (menu1);
+		| 2:	result := SelectFromMenu (menu2);
+		| 3:	result := SelectFromMenu (menu3);
+		| 4:	result := SelectFromMenu (menu4);
+		| 5:	WriteString (resultwindow, "Not a valid menu");
+			WriteLn (resultwindow);
+	    END (*CASE*);
+	    DisplayAnswer (resultwindow, result);
+	END (*LOOP*);
+	DestroyMenu (menu4);
+	DestroyMenu (menu3);
+	DestroyMenu (menu2);
+	DestroyMenu (menu1);
+	DestroyMenu (menu0);
+	CloseWindow (resultwindow);
+    END RunTheTest;
+
+(****************************************************************)
+(*			    MAIN PROGRAM			*)
+(****************************************************************)
+
+BEGIN
+    RunTheTest;
+END MenuTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/demo/mptest.mod b/examples/Modula-2_Libraries/PMOS/sources/demo/mptest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/demo/mptest.mod
@@ -0,0 +1,241 @@
+MODULE MPTest;
+
+	(********************************************************)
+	(*							*)
+	(*	Test of the "maintenance page" facility		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	14 February 1994		*)
+	(*  Status:		Working				*)
+	(*	Bugs:						*)
+	(*		None known at present			*)
+	(*	Shortcomings:					*)
+	(*	   1.	(Fixed)					*)
+	(*	   2.	Mapping the same window to several	*)
+	(*		different groups is almost, but not	*)
+	(*		quite, supported.  I think that the	*)
+	(*		only enhancement needed to support this	*)
+	(*		is a better way to decide whether to	*)
+	(*		hide a newly introduced window.		*)
+	(*	   3.	Need to look into whether the order of	*)
+	(*		Unhide operations is satisfactory.	*)
+	(*							*)
+	(********************************************************)
+
+FROM TaskControl IMPORT
+    (* proc *)	CreateTask;
+
+FROM Timer IMPORT
+    (* proc *)	Sleep;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait;
+
+FROM Keyboard IMPORT
+    (* proc *)	HotKey;
+
+IMPORT Floppy;	(* for the sake of displaying an extra maintenance page *)
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, ChangeScrollingRegion, CloseWindow, PressAnyKey,
+		WriteChar, WriteString, WriteLn, ShiftWindowRel,
+		ReadChar, ReadCharWithoutEcho;
+
+FROM MaintenancePages IMPORT
+    (* type *)	MaintenancePage,
+    (* proc *)	CreateMaintenancePage, Associate;
+
+FROM UserInterface IMPORT
+    (* type *)	UIWindow, Capability, CapabilitySet,
+    (* proc *)	AllowMouseControl;
+
+FROM RandCard IMPORT
+    (* proc *)	RandCardinal;
+
+(************************************************************************)
+
+VAR page1, page2: MaintenancePage;
+
+(************************************************************************)
+
+PROCEDURE Task1;
+
+    VAR w1: Window;  dummy: UIWindow;
+
+    BEGIN
+	OpenWindow (w1, blue, cyan, 6, 12, 8, 34, simpleframe, nodivider);
+	Associate (w1, page1);
+	dummy := AllowMouseControl (w1, "Task 1",
+				CapabilitySet {wshow, whide, wmove});
+	LOOP
+	   WriteString (w1, "Message from Task 1 ... ");
+	   Sleep (400);
+	END (*LOOP*);
+	PressAnyKey (w1);
+	CloseWindow (w1);
+    END Task1;
+
+(************************************************************************)
+
+PROCEDURE Task2;
+
+    VAR w2: Window;  dummy: UIWindow;
+
+    BEGIN
+	OpenWindow (w2, white, magenta, 12, 22, 20, 63, doubleframe, nodivider);
+	Associate (w2, page2);
+	dummy := AllowMouseControl (w2, "Task 2",
+				CapabilitySet {wshow, whide, wmove});
+	LOOP
+	    WriteString (w2, "This is output from Task 2 on Page 2 ... ");
+	    Sleep (600);
+	END (*LOOP*);
+	PressAnyKey (w2);
+	CloseWindow (w2);
+    END Task2;
+
+(************************************************************************)
+
+PROCEDURE Task3;
+
+    VAR w1: Window;  dummy: UIWindow;
+
+    BEGIN
+	OpenWindow (w1, black, green, 10, 20, 50, 78, doubleframe, nodivider);
+	Associate (w1, page1);
+	dummy := AllowMouseControl (w1, "Task 3",
+				CapabilitySet {wshow, whide, wmove});
+	LOOP
+	   WriteString (w1, "Task 3 also uses page 1 ... ");
+	   Sleep (200);
+	END (*LOOP*);
+	PressAnyKey (w1);
+	CloseWindow (w1);
+    END Task3;
+
+(************************************************************************)
+
+PROCEDURE Random(): INTEGER;
+
+    (* Returns a small unsigned random number.	*)
+
+    BEGIN
+	RETURN INTEGER (RandCardinal() MOD 3) - 1;
+    END Random;
+
+(************************************************************************)
+
+PROCEDURE Task4;
+
+    VAR w1: Window;  count: CARDINAL;  flip: BOOLEAN;
+
+    BEGIN
+	OpenWindow (w1, brown, black, 3, 6, 60, 66, simpleframe, nodivider);
+	Associate (w1, page1);
+	count := 0;  flip := FALSE;
+	LOOP
+	    INC (count);
+	    IF count >= 5 THEN
+		ShiftWindowRel (w1, Random(), Random());
+		count := 0;
+	    END (*IF*);
+	    flip := NOT flip;
+	    IF flip THEN WriteString (w1, "/\/\/")
+	    ELSE WriteString (w1, "\/\/\")
+	    END (*IF*);
+	    Sleep (400);
+	END (*LOOP*);
+	PressAnyKey (w1);
+	CloseWindow (w1);
+    END Task4;
+
+(************************************************************************)
+
+PROCEDURE InputTask1;
+
+    VAR w1: Window;  dummy: UIWindow;  ch: CHAR;
+
+    BEGIN
+	OpenWindow (w1, black, white, 14, 20, 3, 30, doubleframe, nodivider);
+	Associate (w1, page1);
+	dummy := AllowMouseControl (w1, "Input Task 1",
+				CapabilitySet {wshow, whide, wmove});
+	LOOP
+	   WriteLn (w1);
+	   WriteString (w1, "Press any key");
+	   ReadCharWithoutEcho (w1, ch);
+	   WriteLn (w1);
+	   WriteString (w1, "The key you pressed was ");
+	   WriteChar (w1, ch);
+	END (*LOOP*);
+	PressAnyKey (w1);
+	CloseWindow (w1);
+    END InputTask1;
+
+(************************************************************************)
+
+PROCEDURE InputTask2;
+
+    VAR w1: Window;  dummy: UIWindow;  ch: CHAR;
+
+    BEGIN
+	OpenWindow (w1, magenta, black, 4, 9, 40, 70,simpleframe,simpledivider);
+	Associate (w1, page1);
+	dummy := AllowMouseControl (w1, "Input Task 2",
+				CapabilitySet {wshow, whide, wmove});
+	WriteString (w1, "You can type into this window");
+	ChangeScrollingRegion (w1, 3, 4);
+	LOOP
+	   ReadChar (w1, ch);
+	END (*LOOP*);
+	PressAnyKey (w1);
+	CloseWindow (w1);
+    END InputTask2;
+
+(************************************************************************)
+
+PROCEDURE RunTheTest;
+
+    CONST Esc = CHR(1BH);
+
+    VAR w0, header1, header2: Window;
+	closedown: Semaphore;
+
+    BEGIN
+	CreateSemaphore (closedown, 0);
+	HotKey (FALSE, Esc, closedown);
+	OpenWindow (w0, yellow, red, 8, 13, 20, 59, simpleframe, nodivider);
+	WriteString (w0, "TEST OF THE MAINTENANCE PAGE FACILITY");
+	WriteLn (w0);
+	WriteString (w0, "Type ^P to toggle maintenance function");
+	WriteLn (w0);
+	WriteString (w0, "  Then F6 to cycle through the pages");
+	WriteLn (w0);
+	WriteString (w0, "         Esc to exit program");
+	CreateMaintenancePage (page1);
+	OpenWindow (header1, white, black, 1, 3, 30, 49, doubleframe, nodivider);
+	Associate (header1, page1);
+	WriteString (header1, "MAINTENANCE PAGE 1");
+	CreateMaintenancePage (page2);
+	OpenWindow (header2, white, black, 1, 3, 30, 49, doubleframe, nodivider);
+	Associate (header2, page2);
+	WriteString (header2, "MAINTENANCE PAGE 2");
+	CreateTask (Task1, 2, "Task 1");
+	CreateTask (Task2, 2, "Task 2");
+	CreateTask (Task3, 2, "Task 3");
+	CreateTask (Task4, 2, "Task 4");
+	CreateTask (InputTask1, 2, "Input Task 1");
+	CreateTask (InputTask2, 2, "Input Task 2");
+	Wait (closedown);
+    END RunTheTest;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    RunTheTest;
+END MPTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/demo/playvoc.mod b/examples/Modula-2_Libraries/PMOS/sources/demo/playvoc.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/demo/playvoc.mod
@@ -0,0 +1,313 @@
+MODULE PlayVOC;
+
+	(********************************************************)
+	(*							*)
+	(*		Plays sound from a VOC file		*)
+	(*		    to the PC speaker			*)
+	(*							*)
+	(*  Programmer:		T. Channon			*)
+	(*		with some modifications by P. Moylan	*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	This module has been reorganised a little	*)
+	(*	by PM, but it's still basically TC's code.	*)
+	(*							*)
+	(*	Changes:					*)
+	(*	  - some code lifted out of lower-level		*)
+	(*	    modules.					*)
+	(*	  - declarations shifted around to make them	*)
+	(*	    as local as possible.			*)
+	(*	  - sample rate doubling for input data with	*)
+	(*	    slow sampling.				*)
+	(*							*)
+	(********************************************************)
+
+IMPORT Lib, Str;
+
+FROM FileSys IMPORT
+    (* type *)	File,
+    (* proc *)	OpenFile, SetPosition, ReadByte, ReadRecord, CloseFile;
+
+FROM IOErrorCodes IMPORT
+    (* type *)	ErrorCode,
+    (* proc *)	TranslateErrorCode;
+
+FROM PlayList IMPORT
+    (* type *)	BufferList, OutputBufferPointer,
+    (* proc *)	CreateList, AddToList, PlayFromList, DiscardList;
+
+FROM PlayBuff IMPORT
+    (* const*)	OutputBufferSize,
+    (* proc *)	SetCycleCount;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, WriteString, WriteChar, WriteLn, PressAnyKey,
+		SetCursor;
+
+FROM NumericIO IMPORT
+    (* proc *)	WriteCard, WriteRJCard;
+
+FROM LowLevel IMPORT
+    (* proc *)	Far, Copy, BlockFill;
+
+(************************************************************************)
+
+CONST
+    (* Size of an input buffer. *)
+
+    SIZESOUNDBUFFER = 16384;
+
+    (* Sampling rate below which we decide to make the output rate	*)
+    (* twice the input rate.						*)
+
+    SlowRate = 11000;  (* Hz *)
+
+TYPE
+    SoundBufferType = ARRAY [0..SIZESOUNDBUFFER-1] OF BYTE;
+
+    HeadType =  RECORD
+		    name : ARRAY [0..12H] OF CHAR;
+		    eof  : CHAR;
+		    ofs  : CARDINAL;
+		    vers : CARDINAL;
+		    verx : CARDINAL;
+		END (*RECORD*);
+
+VAR
+    (* The screen window used for log messages. *)
+
+    log: Window;
+
+    (* PWM span - this depends on sampling rate. *)
+
+    span: SHORTCARD; (* PWM span *)
+
+(************************************************************************)
+(*			MESSAGES TO SCREEN				*)
+(************************************************************************)
+
+PROCEDURE Err(s : ARRAY OF CHAR);
+
+    BEGIN
+	WriteLn (log);   WriteString (log, 'Error: ');
+	WriteString (log, s);
+	PressAnyKey (log);
+	HALT;
+    END Err;
+
+(************************************************************************)
+(*			SETTING THE SAMPLING RATE			*)
+(************************************************************************)
+
+PROCEDURE SetSampleRate (Hz : CARDINAL);
+
+    (* Sets internal rate, module defaults to 13 kHz. *)
+
+    CONST
+	(* MAXPWM sets minimum allowed sample rate.  Timer rate is	*)
+	(* 1.19318MHz, 200 is approx 6khz.  MINPWM sets max allowed	*)
+	(* rate, would stress computer, 54 is 22.05kHz ie. half CD rate *)
+
+	MAXPWM = 200;  MINPWM = 54;
+
+    BEGIN
+	span := SHORTCARD (1.1931817E6 / VAL(LONGREAL, Hz));
+	IF (span >= MINPWM) & (span < MAXPWM) THEN
+	    (* If error use last rate, default if never previously set. *)
+	    SetCycleCount(span);
+	END;
+    END SetSampleRate;
+
+(************************************************************************)
+(*			DATA FORMAT CONVERSION				*)
+(************************************************************************)
+
+PROCEDURE ScaledValue (val: SHORTCARD;  scale: CARDINAL): SHORTINT;
+
+    (* Requantizes val to suit the desired output range.  The basic	*)
+    (* operation is to scale the value up and then take the high-order	*)
+    (* bits of the product, adding some random noise for dithering.	*)
+    (* The final step is a "round up" based on the most significant	*)
+    (* of the ignored bits.						*)
+
+    VAR ti: INTEGER;
+
+    BEGIN
+	ti := INTEGER(CARDINAL(val) * scale)
+					+ INTEGER(Lib.RANDOM(256))-128;
+	RETURN SHORTINT(ti DIV 128 + (ti MOD 128) DIV 64);
+    END ScaledValue;
+
+(************************************************************************)
+
+PROCEDURE LoadBlock (f: File;  dlen: LONGCARD;  RepeatCount: CARDINAL;
+				VAR (*INOUT*) OutList:BufferList);
+
+    (* Converts one block of input data to the form we want, appends	*)
+    (* the result to OutList.  Parameter dlen specifies the number of	*)
+    (* input samples.  RepeatCount specifies how many output samples	*)
+    (* will be produced for each input sample.  We pad out the data at	*)
+    (* the end, if necessary, to give an integral number of output	*)
+    (* buffers.								*)
+
+    VAR scale: CARDINAL;
+	OutBuffer: OutputBufferPointer;
+	OutIndex: [0..OutputBufferSize-1];
+	OutCount: CARDINAL;
+	InData: POINTER TO SoundBufferType;
+	InIndex: [0..SIZESOUNDBUFFER-1];
+	InCount: CARDINAL;
+	rptcount: CARDINAL;
+	status: ErrorCode;
+
+    BEGIN
+	NEW (InData);  InIndex := 0;  rptcount := RepeatCount;
+	NEW (OutBuffer);  OutIndex := 0;  OutCount := 1;
+	SetCursor (log, 3, 1);
+	WriteString (log, "     1 output buffers");
+	scale := CARDINAL(span DIV 2)-2; (*reduce amplitude slightly: dither *)
+	WHILE dlen > 0 DO
+	    IF dlen > LONGCARD(SIZESOUNDBUFFER-1) THEN
+		status := ReadRecord(f, ADR(InData^[InIndex]),
+					SIZESOUNDBUFFER, InCount);
+	    ELSE
+		status := ReadRecord (f, ADR(InData^[InIndex]),
+					CARDINAL(dlen), InCount);
+	    END(*IF*);
+	    LOOP
+		IF dlen = 0 THEN EXIT END(*IF*);
+		OutBuffer^[OutIndex] := ScaledValue (InData^[InIndex], scale);
+		IF OutIndex = OutputBufferSize-1 THEN
+		    AddToList (OutList, OutBuffer);
+		    NEW (OutBuffer);  OutIndex := 0;
+		    INC (OutCount);
+		    SetCursor (log, 3, 1);
+		    WriteRJCard (log, OutCount, 6);
+		ELSE
+		    INC (OutIndex);
+		END (*IF*);
+		DEC (rptcount);
+		IF rptcount = 0 THEN
+		    DEC(dlen);  rptcount := RepeatCount;
+		    IF InIndex < (SIZESOUNDBUFFER-1) THEN
+			INC (InIndex);
+		    ELSE
+			InIndex := 0;  EXIT;
+		    END(*IF*);
+		END (*IF*);
+	    END(*LOOP*);
+	END(*WHILE*);
+	IF OutIndex < OutputBufferSize-1 THEN
+	    BlockFill (Far(ADR(OutBuffer^[OutIndex])),
+	    			OutputBufferSize - 1 - OutIndex, span DIV 2);
+	END (*IF*);
+	AddToList (OutList, OutBuffer);
+	WriteLn (log);
+	DISPOSE (InData);
+    END LoadBlock;
+
+(************************************************************************)
+(*			THE MAIN PROCEDURE				*)
+(************************************************************************)
+
+PROCEDURE Play (f: File);
+
+    (* Assumption: file f is already open.  Takes all the input data	*)
+    (* from file f, converts it to our output format, and calls the	*)
+    (* player procedure.						*)
+
+    VAR blocktype : SHORTCARD;
+	sam       : SHORTCARD;
+	rl        : CARDINAL;
+	dlen : LONGCARD;
+	samplerate: CARDINAL; (* Hz *)
+	RepeatCount: CARDINAL;
+	comp: SHORTCARD;
+	OutList: BufferList;
+	status: ErrorCode;
+
+    BEGIN
+	CreateList (OutList);
+	LOOP
+	    IF (ReadRecord(f, ADR(blocktype), 1, rl) <> OK)
+				OR (blocktype = 0) THEN EXIT END(*IF*);
+	    CASE blocktype OF
+	      | 1:	dlen := 0;
+			status := ReadRecord (f, ADR(dlen), 3, rl);
+			DEC (dlen, 2);
+			RepeatCount := 1;
+			sam := ReadByte (f);
+			samplerate := VAL(CARDINAL,
+				1.0E6 / VAL(LONGREAL, 256-CARDINAL(sam)));
+			IF samplerate < SlowRate THEN
+			    RepeatCount := 2;
+			    samplerate := 2*samplerate;
+			END (*IF*);
+			SetSampleRate (samplerate);
+			WriteString (log, 'Sample rate ');
+			WriteCard (log, samplerate);
+			WriteString (log, ' kHz');  WriteLn (log);
+			comp := ReadByte (f);
+			LoadBlock (f, dlen, RepeatCount, OutList);
+	       ELSE
+			Err('Unknown block header byte');
+	    END(*CASE*);
+	END(*LOOP*);
+	PlayFromList (OutList);
+	DiscardList (OutList);
+    END Play;
+
+(************************************************************************)
+
+PROCEDURE Init(): File;
+
+    CONST DEFAULTPWM = 13000; (* 13kHz *)
+
+    VAR s: ARRAY [0..79] OF CHAR;
+	rl: CARDINAL;
+	head: HeadType;
+	f: File;
+	status: ErrorCode;
+
+    BEGIN
+	SetSampleRate (DEFAULTPWM);
+	OpenWindow (log, black, green, 8, 16, 10, 70, simpleframe, nodivider);
+	IF Lib.ParamCount() = 0 THEN
+	    Err ("Missing file name");
+	ELSIF Lib.ParamCount() = 1 THEN
+	    Lib.ParamStr(s, 1);
+	ELSE
+	    Err ("Only one file name may be specified");
+	END(*IF*);
+	WriteString (log, "File: ");
+	WriteString (log, s);
+	WriteLn (log);
+	status := OpenFile (f, s, FALSE);
+	IF status <> OK THEN
+	    TranslateErrorCode (status, s);
+	    Err (s);
+	END (*IF*);
+	status := ReadRecord (f, ADR(head), SIZE(head), rl);
+	IF Str.Pos(head.name, 'Creative Voice File') = MAX(CARDINAL) THEN
+	    Err ('Not VOC file');
+	END(*IF*);
+	status := SetPosition (f, LONGCARD(head.ofs));
+	Lib.RANDOMIZE;
+	RETURN f;
+    END Init;
+
+(************************************************************************)
+
+VAR f: File;
+
+BEGIN
+    f := Init();
+    Play (f);
+    CloseFile (f);
+END PlayVOC.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/demo/uitest.mod b/examples/Modula-2_Libraries/PMOS/sources/demo/uitest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/demo/uitest.mod
@@ -0,0 +1,185 @@
+MODULE UITest;
+
+	(****************************************************************)
+	(*								*)
+	(*		Test of module UserInterface			*)
+	(*								*)
+	(*	Programmer:	M. Walsh				*)
+	(*	Modifications:	P. Moylan				*)
+	(*	Last edited:	26 July 1994				*)
+	(*	Status:		Working					*)
+	(*								*)
+	(****************************************************************)
+
+FROM Conversions IMPORT
+    (* proc *)	CardinalToString;
+
+FROM TaskControl IMPORT
+    (* proc *)	CreateTask;
+
+FROM Timer IMPORT
+    (* proc *)	Sleep;
+
+FROM SoundEffects IMPORT Beep;
+
+FROM Mouse IMPORT
+    (* type *)	Buttons, ButtonSet,
+    (* proc *)	GetTextMouseStatus, GetTextMousePosition,
+		ShowMouseCursor, HideMouseCursor;
+
+FROM Windows IMPORT
+    (* type *)	Window,Colour,FrameType,DividerType,
+		MaxRowNumber,MaxColumnNumber, ColumnRange,RowRange,
+    (* proc *)	OpenWindow, WriteString, SetCursor;
+
+FROM UserInterface IMPORT
+    (* type *)	UIWindow, Capability, CapabilitySet,
+    (* proc *)	AllowMouseControl, AddActiveRegion;
+
+CONST
+    LeftOnly = ButtonSet {LeftButton};
+    RightOnly = ButtonSet {RightButton};
+
+(************************************************************************)
+
+PROCEDURE BEEP (w: Window;  r: RowRange;  c: ColumnRange);
+
+    BEGIN
+	Beep;
+    END BEEP;
+
+(************************************************************************)
+
+PROCEDURE BEEPBEEP (w: Window;  r: RowRange;  c: ColumnRange);
+
+    BEGIN
+	Beep;  Beep;
+    END BEEPBEEP;
+
+(************************************************************************)
+
+PROCEDURE Spawned;
+
+    VAR w: Window;  Test: UIWindow;
+
+    BEGIN
+	OpenWindow (w,white,black,1,12,1,18,doubleframe,nodivider);
+	Test := AllowMouseControl (w, "Spawned",
+					CapabilitySet{wmove, whide, wshow});
+	AddActiveRegion(Test,1,10,1,16,LeftOnly,BEEP);
+	AddActiveRegion(Test,1,10,1,16,RightOnly,BEEPBEEP);
+	LOOP
+	    WriteString(w,'Testing and it appears to work - Amazing');
+	    Sleep(100);
+	END (*LOOP*);
+    END Spawned;
+
+(************************************************************************)
+
+PROCEDURE Spawned2;
+
+    VAR w: Window;  Test: UIWindow;
+
+    BEGIN
+	OpenWindow (w,white,black,14,23,1,18,doubleframe,nodivider);
+	Test := AllowMouseControl (w, "Spawned as well",
+				CapabilitySet {wmove, whide, wshow});
+	AddActiveRegion(Test,1,8,1,16,LeftOnly,BEEP);
+	LOOP
+	    WriteString (w,'Testing and also working ---------- !!!!!!!!!');
+	    Sleep(100);
+	END (*LOOP*);
+    END Spawned2;
+
+(************************************************************************)
+
+PROCEDURE MouseWindow;
+
+    VAR w: Window;  MousePos: UIWindow;
+	X: ColumnRange;  Y: RowRange;  LastX, LastY: CARDINAL;
+	string: ARRAY [0..2] OF CHAR;
+
+    BEGIN
+	OpenWindow (w,black,white,15,18,20,27,doubleframe,nodivider);
+	MousePos := AllowMouseControl (w, "MousePos",
+				CapabilitySet {wmove, whide, wshow});
+	SetCursor (w, 1, 2);  WriteString (w, "X");
+	SetCursor (w, 2, 2);  WriteString (w, "Y");
+	AddActiveRegion(MousePos,1,2,1,6,LeftOnly,BEEP);
+	LastX := MAX(ColumnRange) + 1;
+	LOOP
+	    GetTextMousePosition (X, Y);
+	    IF (LastX <> X) OR (LastY <> Y) THEN
+		HideMouseCursor;
+		CardinalToString (X, string, 3);
+		SetCursor (w, 1, 3);  WriteString (w, string);
+		CardinalToString (Y, string, 3);
+		SetCursor (w, 2, 3);  WriteString (w, string);
+		ShowMouseCursor;
+		LastX := X;
+		LastY := Y;
+	    END (*IF*);
+	    Sleep(50);
+	END (*LOOP*);
+    END MouseWindow;
+
+(************************************************************************)
+
+PROCEDURE ScrollWindowtask;
+
+    VAR w: Window;  LoopCount:CARDINAL;  ScrollWindow: UIWindow;
+
+    BEGIN
+	OpenWindow (w,intensewhite,red,2,12,40,75,doubleframe,nodivider);
+	ScrollWindow := AllowMouseControl (w, "ScrollWindow",
+				CapabilitySet {wmove, whide, wshow});
+	AddActiveRegion(ScrollWindow,1,9,1,34,LeftOnly,BEEP);
+	Sleep(100);
+	LOOP
+	    FOR LoopCount := 1 TO 10 DO
+		WriteString(w,"Scrolling Text Is Fast. Faster than you can read !");
+	    END (*FOR*);
+	    Sleep(100);
+	END (*LOOP*);
+
+    END ScrollWindowtask;
+
+(************************************************************************)
+
+PROCEDURE ScrollWindow2task;
+
+    VAR LoopCount:CARDINAL;  ScrollWindow2: UIWindow;  w: Window;
+
+    BEGIN
+	OpenWindow (w,blue,black,14,20,40,75,doubleframe,nodivider);
+	ScrollWindow2 := AllowMouseControl (w, "ScrollWindow Too",
+				CapabilitySet {wmove, whide, wshow});
+	AddActiveRegion(ScrollWindow2,1,5,1,34,LeftOnly,BEEP);
+	Sleep(100);
+	LOOP
+	    FOR LoopCount := 1 TO 10 DO
+		WriteString(w,"Scrolling Text Is Fast. Faster than you can read !");
+	    END (*FOR*);
+	    Sleep(100);
+	END (*LOOP*);
+
+    END ScrollWindow2task;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+VAR buttons: ButtonSet;  X:ColumnRange;  Y:RowRange;
+
+BEGIN
+    CreateTask(MouseWindow,5,"Mouse");
+    CreateTask(ScrollWindowtask,2,"SW");
+    CreateTask(ScrollWindow2task,3,"SW2");
+    CreateTask(Spawned,2,"Spawned");
+    CreateTask(Spawned2,2,"Spawned2");
+    REPEAT
+        Sleep(40);
+        GetTextMouseStatus(buttons, X, Y);
+    UNTIL ButtonSet{LeftButton,RightButton} <= buttons;
+
+END UITest.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/games/pong/pong.mod b/examples/Modula-2_Libraries/PMOS/sources/games/pong/pong.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/games/pong/pong.mod
@@ -0,0 +1,223 @@
+MODULE Pong;
+
+(****************************************************************)   
+(*                      *)
+(* Original author:  probably Michael Walsh     *)
+(*    (The copy I got came without comments)    *)
+(* Debugging by:  Peter Moylan            *)
+(* Last edited:   7 December 1993            *)
+(* Status:                    *)
+(*    - not yet clear what this program is supposed   *)
+(*      to do.  It makes pretty pictures on the *)
+(*      screen, but purpose is unclear.      *)
+(*    - apparently not responding to keyboard.  *)
+(*                      *)
+(****************************************************************)   
+
+FROM Storage IMPORT
+   ALLOCATE,DEALLOCATE;
+
+FROM SoundEffects IMPORT
+    (* proc *) Beep;
+
+FROM Graphics IMPORT
+    (* type *) ColourType,
+    (* proc *) Fill,SetMode,PlotMark,PlotLine,GetScreenShape;
+
+FROM Keyboard IMPORT
+    (* proc *) InKey, KeyPressed;
+
+CONST
+   Up = 'k';
+   Down = 'm';
+   NewBall = ' ';
+   Quit = 'q';
+   None = 'a';
+   PaddleSpeed = 1;
+   SpeedOfBall = 1;
+   
+TYPE
+
+
+   BallPtr=POINTER TO Ball;
+
+   Ball=RECORD
+      Xcoord:CARDINAL;
+      Ycoord:CARDINAL;
+      Xdir:INTEGER;
+      Ydir:INTEGER;
+      Colour:ColourType;
+      NextBall:BallPtr;
+   END; (*Ball Record*)
+VAR
+   Balls,LastBall:BallPtr;
+   KeyIn:CHAR;
+   Xmax,Ymax,PaddlePos,PaddleMoveCount:CARDINAL;
+   LastColour,LastCol,ColourMax:ColourType;
+   DirLast:INTEGER;
+   EndOfGame,FirstBall:BOOLEAN;
+
+
+PROCEDURE MovePaddle(Direction:CHAR; VAR Position:CARDINAL);
+VAR
+   Dir:INTEGER;
+BEGIN
+   IF Direction = Up
+   THEN
+      Dir := 5;
+   ELSE
+      Dir := -5;
+   END(*IF*);
+   IF NOT (((Position <= 5) AND (Direction = Down))
+      OR ((Position + 55 >= Ymax) AND (Direction = Up)))
+   THEN
+      Fill(10,Position,10,Position + 50,0);
+      IF Dir > 0 THEN
+             Position := Position + ORD(Dir);
+      ELSE
+            Position := Position - ORD(Dir);
+      END(*iF*);
+      Fill(10,Position,10,Position + 50,3);
+   END(*IF*);
+   
+END MovePaddle;
+
+PROCEDURE EraseBall(Ball:BallPtr);
+BEGIN
+   Fill(Ball^.Xcoord,Ball^.Ycoord,(Ball^.Xcoord + 10),(Ball^.Ycoord + 10),0);
+END EraseBall;
+
+PROCEDURE DrawBall(Ball:BallPtr);
+   
+BEGIN
+   Fill(Ball^.Xcoord,Ball^.Ycoord,(Ball^.Xcoord + 10),(Ball^.Ycoord + 10),(Ball^.Colour));
+END DrawBall;
+
+PROCEDURE CreateNewBall(VAR BallList,LastBallOnList:BallPtr;
+      VAR First:BOOLEAN;
+      VAR LastDir:INTEGER;
+      VAR LastCol:ColourType);   
+BEGIN
+   
+            IF First THEN
+                                 NEW ( LastBall );
+                    BallList := LastBallOnList;
+               First := FALSE;
+                                ELSE
+               NEW ( LastBallOnList^.NextBall );
+               LastBallOnList := LastBallOnList^.NextBall;
+            END; (* if *)
+            
+            WITH LastBallOnList^ DO
+               NextBall := NIL;
+					Xcoord := Xmax DIV 2;
+					Ycoord := Ymax DIV 2;
+					Xdir := ((LastDir MOD 2) *2) -1;
+					Ydir := ((LastDir DIV 2) * 2) -1;
+					Colour := LastCol;
+					LastCol:= (((LastCol + 3) MOD 7) + 1);
+				END (*WITH*);
+				DirLast :=(DirLast +1) MOD 4;
+END CreateNewBall;
+
+PROCEDURE MoveBalls(StartOfList:BallPtr;PaddlePosition,BallSpeed:CARDINAL);
+	VAR
+		CurrentBall:BallPtr;
+				
+
+	BEGIN
+	CurrentBall := StartOfList;
+
+	WHILE	CurrentBall <> NIL
+	DO
+		
+		WITH CurrentBall^ DO
+			IF (Xcoord >= 2*Xmax - 10 - BallSpeed) OR (Xcoord  <= BallSpeed)
+			THEN
+				Xdir := -(Xdir);
+				Colour := ((Colour +1) MOD 7) + 1;
+			END (*IF*);
+
+			IF 	(Ycoord >= (Ymax -10 - BallSpeed)) OR (Ycoord <= BallSpeed)
+			THEN 	
+				Ydir := -(Ydir);
+				Colour := ((Colour + 1) MOD 7) + 1;
+			END(*IF*);
+		
+			IF ((Ycoord+10 > PaddlePosition)
+				AND (Ycoord < PaddlePosition + 50)
+				AND (Xcoord <= 10 + BallSpeed)
+				AND (Xdir = -1))
+			THEN
+				Xdir := -(Xdir);
+			END(*IF*);
+		END(*WITH*);
+		
+		EraseBall(CurrentBall);
+
+		WITH CurrentBall^ DO
+		IF Xdir > 0 THEN
+		   Xcoord := Xcoord + BallSpeed;
+		ELSE
+		   Xcoord := Xcoord  - BallSpeed;
+		END(*IF*);
+		IF Ydir > 0 THEN
+		   Ycoord := Ycoord + BallSpeed;
+		ELSE
+		   Ycoord := Ycoord - BallSpeed;
+		END(*IF*);
+		END(*WITH*);
+		
+		DrawBall(CurrentBall);
+		CurrentBall := CurrentBall^.NextBall;
+	END (*DO*);	
+ 			
+	END MoveBalls;
+
+(****************************************************************)	
+
+PROCEDURE RunTheGame;
+
+    BEGIN
+	PlotLine(0,0,0,Ymax,3);
+	PlotLine(0,Ymax,Xmax,Ymax,3);
+	PlotLine(Xmax,Ymax,Xmax,0,3);
+	PlotLine(Xmax,0,0,0,3);
+	FirstBall := TRUE;
+	Balls := NIL;
+	DirLast := 0;
+	LastColour := 5;
+	PaddlePos := 1;
+	KeyIn := None;
+	REPEAT	
+	    (*PaddleMoveCount := 0;
+	    REPEAT
+		CASE KeyIn OF
+		    Up 	: MovePaddle(Up,PaddlePos);|
+		    Down	: MovePaddle(Down,PaddlePos);|
+		    Quit  	: EndOfGame := TRUE;|
+		    NewBall : CreateNewBall(Balls,LastBall,FirstBall,DirLast,LastColour);|
+		    None : |
+		ELSE
+		    CreateNewBall(Balls,LastBall,FirstBall,DirLast,LastColour);
+		END(*CASE*);
+		IF KeyPressed() THEN
+		    Beep;  KeyIn := InKey();
+		ELSE
+		    KeyIn := None;
+		END(*IF*);
+		PaddleMoveCount := PaddleMoveCount + 1;
+	    UNTIL (EndOfGame) OR (PaddleMoveCount = PaddleSpeed);*)
+	    CreateNewBall(Balls,LastBall,FirstBall,DirLast,LastColour);
+	    MoveBalls(Balls,PaddlePos,SpeedOfBall);
+		
+	UNTIL EndOfGame;
+    END RunTheGame;
+
+(****************************************************************)	
+
+BEGIN
+    SetMode(16, TRUE);
+    GetScreenShape(Xmax,Ymax,ColourMax);
+    RunTheGame;
+END Pong.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/games/tank/blastwin.mod b/examples/Modula-2_Libraries/PMOS/sources/games/tank/blastwin.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/games/tank/blastwin.mod
@@ -0,0 +1,1327 @@
+(*****************************************************************************)
+(*  TANKBLAST SVGA  A PMOS DEMONSTRATION PROGRAM                             *)
+(*  AUTHOR : JASON HARPER                                                    *)
+(*           ELEC 460   1993                                                 *)
+(*									*)
+(*	Modifications by P. Moylan					*)
+(*	Last edited:	23 February 1994				*)
+(*	Status:		A long way to go!				*)
+(*		My original assumption was that this could be made to	*)
+(*		work with relatively little work.  It is now evident	*)
+(*		that he has been using his own custom modifications to	*)
+(*		various PMOS modules, and I don't have the source for	*)
+(*		those modifications so I have to re-create alternatives.*)
+(*									*)
+(*                                                                           *)
+(*  THIS PROGRAM WAS WRITTEN TO DEMONSTRATE EXISTING AND NEW FEATURES OF     *)
+(*  PMOS WITH EMPHASIS ON GRAPHICS.                                          *)
+(*                                                                           *)
+(*  STATUS:  WORKING OK EXCEPT FOR :                                         *)
+(*           :OCCASIONALY THE KEYS 'LOCK UP'.  THIS CAN BE FIXED BY PRESSING *)
+(*            THE Ctrl KEY OR ARROW KEYS UNTIL NORMAL CONTROL IS REGAINED.   *)
+(*           :OCCASIONALY A THE PROGRAM CRASHES WHEN A VARIABLE GOES OUT OF  *)
+(*            RANGE. COULD BE TRACKED DOWN BUT IT ONLY HAPPENS RARELY.       *)
+(*                                                                           *)
+(*  DEMONSTRATION FEATURES:                                                  *)
+(*    :  PLOTTING OF VOLATILE LINES AND POINTS IN GRAPHICS WINDOWS.          *)
+(*    :  PLOTTING TEXT IN GRAPHICS WINDOWS.                                  *)
+(*    :  THE USE OF 256 COLOUR PALLETTE, AND CHANGING THE PALLETTE.          *)
+(*    :  USING AND WRITING TO TEXT WINDOWS.                                  *)
+(*    :  USING MENUS.                                                        *)
+(*    :  USING RANDOM FUNCTIONS.                                             *)
+(*    :  USING SOUND.                                                        *)
+(*    :  AND MUCH MORE ...                                                   *)
+(*                                                                           *)
+(*****************************************************************************)
+
+
+
+MODULE BlastWin;
+
+FROM Conversions IMPORT
+    (* proc *)	CardinalToString;
+
+FROM Graphics IMPORT
+    (* type *)	ColourType;
+
+FROM GWindows IMPORT OpenWindow,SetColour,Window,single,double,SetCursor,
+     ClearWindow,WriteString,WriteLn,CloseWindow,PutPixel2C,Line2C,
+     InitGraphics;
+
+FROM Random IMPORT RANDOM,Randomize;
+FROM IO IMPORT WrChar,WrReal,WrLn,WrInt;
+FROM Graphics IMPORT SetDefaultMode,SetMode,SetPaletteColour,PlotDot,Fill,PlotLine,GetScreenShape;
+FROM Timer IMPORT Sleep;
+FROM ScreenGeometry IMPORT Point;
+FROM MATHLIB IMPORT Sin,Cos,Sqrt;
+FROM Keyboard IMPORT InKey;
+FROM Music IMPORT PlayMusic,SetNoteDuration,WaitForMusicFinished(*,SetOctave*);
+FROM Menu2 IMPORT initvalu,BlastMenu,playertype;
+FROM KBdriver IMPORT GetScanCode;
+FROM Tank IMPORT MainTank;
+FROM Explode IMPORT ExplodeSound;
+VAR j,l:LONGCARD;
+    x,y,down1,up2,down2,up1,k,bombsize,
+    music,screensize,damage1,damage2,MaxGround,
+    RightBorder,TopBorder,stars,Weapon:INTEGER;
+    a,b,Vel1,Vel2,wind,Wind,velocity:REAL;
+    angle1,angle2:LONGREAL;
+    GroundLine:ARRAY [-10..1280] OF INTEGER;
+    DirtFall:ARRAY [1..1280] OF INTEGER;
+    Weapons1: ARRAY [0..3] OF INTEGER;
+    Weapons2: ARRAY [0..3] OF INTEGER;
+    BkgrndColr:ARRAY [0..63] OF ColourType;
+    GroundColour:ARRAY [0..63] OF ColourType;
+    w1,w2,wmain,wblast,wquit,wback:Window;
+    Tank1,Tank2,explode,CompExplode:Point;
+    colr1,colr2,MaxColour:ColourType;
+    key2,PlayAgain:CHAR;
+    L,B,T,R,left,bottom,right,top,count,XMAX,YMAX:CARDINAL;
+    sunset,Sound,Trace,CtrlPress,Tank1Explode,Tank2Explode,HitToLeft,HitToRight,
+    MorAng,SmartCom,Human,AnglChanged,VelChanged,initialised:BOOLEAN;
+    init:initvalu;
+    ScanCode:BYTE;
+
+CONST pi          = 3.141592654;
+      player1     = 1;
+      player2     = 2;
+      quitnow     = -99.0;
+      CtrlCode    = BYTE(1DH);
+      CtrlRelease = BYTE(9DH);
+      Up          = BYTE(48H);
+      Down        = BYTE(50H);
+      Left        = BYTE(4BH);
+      Right       = BYTE(4DH);
+      Enter       = BYTE(9CH);
+      Space       = BYTE(185);
+      Alt         = BYTE(184);
+      F           = BYTE(161);
+      W           = BYTE(91H);
+      Esc         = BYTE(129);
+      RANDNUM     = 923925;
+
+(************************************************************************)
+(*			SOME BASIC WRITE OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE WriteCard (w: Window;  number: CARDINAL;  colour: ColourType);
+
+    VAR buffer: ARRAY [0..5] OF CHAR;
+
+    BEGIN
+	SetColour (w, colour);
+	CardinalToString (number, buffer, 5);
+	WriteString (w, buffer);
+    END WriteCard;
+
+(************************************************************************)
+
+PROCEDURE WriteStringC (w: Window;  str: ARRAY OF CHAR;  colour: ColourType);
+
+    BEGIN
+	SetColour (w, colour);
+	WriteString (w, str);
+    END WriteStringC;
+
+(************************************************************************)
+PROCEDURE Fire (w:Window;Velh,Vely,Gravity:REAL;
+		wind,x0,y0,player:INTEGER;colr:ColourType); FORWARD;
+PROCEDURE PlotCircle2(w1:Window;x,y,radius:INTEGER;  colr: ColourType); FORWARD;
+
+
+
+(*************************************************************************
+    A very crude way of delting a number of characters.  I'm sure there
+    must be an easier way but I couldn't find it.   CHR(219) doesnt seem
+    to work in graphics mode.
+**************************************************************************)
+PROCEDURE DelChar (w:Window;row,column,numchars:CARDINAL);
+VAR i,r,c:CARDINAL;
+BEGIN
+    r:=row;
+    c:=column;
+    FOR i:=1 TO numchars DO
+        SetCursor(w,r,c);
+        WriteStringC(w,CHR(7),0);
+        SetCursor(w,r,c);
+        WriteStringC(w,CHR(8),0);
+        INC(c);
+        END;
+        SetCursor(w,row,column);
+END DelChar;
+
+(*************************************************************************)
+(*  WriteWin :   writes   fireing specifications as they are changed     *)
+(*************************************************************************)
+PROCEDURE WriteWin(w:Window;Weapon,WeaponsLeft,damage,screen,
+	wind,player,changed:INTEGER;colr:ColourType;angle:LONGREAL;Vel:REAL);
+BEGIN
+        CASE changed OF
+        1:
+            DelChar(w,0,17,3);
+            WriteCard(w,CARDINAL(0.5+angle*180.0/pi),2);
+        |
+        2:
+            DelChar(w,0,30,4);
+            WriteCard(w,CARDINAL(10.0*Vel),2);
+        |
+        3:
+            DelChar(w,4,9,20);
+            WriteCard(w,CARDINAL(WeaponsLeft),2);
+            CASE Weapon OF
+              0:     WriteStringC(w,"  Missile",2);
+              |
+              1:     WriteStringC(w,"  Super Missile",2);
+              |
+              2:     IF screen = 1 THEN
+                        WriteStringC(w,"  Vertical Guidance",2);
+                     ELSE WriteStringC(w,"  Vertical Guide",2);
+                     END;
+              |
+
+              3:     WriteStringC(w,"  Dirt Blaster",2);
+
+              END (* CASE*);
+         END (*CASE*);
+END WriteWin;
+
+(*************************************************************************
+** Sets up display of Player, and initial fireing specs                 **
+*************************************************************************)
+PROCEDURE SetWin(w:Window;wind,damage,player:INTEGER;colr:ColourType);
+BEGIN
+       IF player = 1 THEN WriteStringC(w,"PLAYER 1 ",colr);
+            ELSE               WriteStringC(w,"PLAYER 2 ",colr);
+            END;
+
+            WriteStringC(w,"ANGLE      VELOCITY",colr);
+            SetCursor(w,2,0);
+            WriteStringC(w,"WIND ",colr);
+            SetCursor(w,2,5);
+            WriteCard(w,CARDINAL(ABS(10*wind)),2);
+            IF wind < 0 THEN WriteStringC(w," <-- ",colr); END;
+            IF wind >0  THEN WriteStringC(w," --> ",colr); END;
+
+            SetCursor(w,2,29);
+            WriteCard(w,CARDINAL(damage),2);
+            SetCursor(w,2,21);
+            WriteStringC(w,"DAMAGE:   %",colr);
+            SetCursor(w,4,0);
+
+         WriteStringC(w,"WEAPON: ",colr);
+
+END SetWin;
+
+(***************************************************************************
+**  Returns a background colour at a particular height                    **
+***************************************************************************)
+PROCEDURE ColourY(y,colr :INTEGER):ColourType;
+BEGIN
+    IF colr <> -1 THEN RETURN VAL(ColourType,colr)
+      ELSE RETURN BkgrndColr[INTEGER(REAL(y)/(REAL(TopBorder)/63.0))];
+    END;
+END ColourY;
+
+(***************************************************************************
+**  Produces stars in the background.                                     **
+***************************************************************************)
+PROCEDURE StaryNight(w:Window);
+VAR a,b:REAL;
+    y1,y2,x1,x2,stars,stars2:CARDINAL;
+    BEGIN
+        FOR stars := 1 TO 5 DO
+        a:=RANDOM();
+        b:=RANDOM();
+        y1:=CARDINAL(a*REAL(TopBorder+10));
+        y2:=CARDINAL(b*REAL(TopBorder+10));
+        x1:=CARDINAL(a*REAL(RightBorder-2))+1;
+        x2:=CARDINAL(b*REAL(RightBorder-2))+1;
+
+        IF (stars <3) AND(y2 > CARDINAL(GroundLine[x1])+30)AND(y2<CARDINAL(TopBorder)-5) THEN
+           PutPixel2C(w,x1,y2,15); END;
+        IF (x2>5) AND (x2 <CARDINAL(RightBorder-5)) AND
+           (y1 > CARDINAL(GroundLine[x2])+20) AND
+           (y1 > CARDINAL(GroundLine[x2+5])+20) AND
+           (y1 > CARDINAL(GroundLine[x2-5])+20)
+        THEN
+           PlotCircle2(w,x2,y1,9,0);END;
+        END;
+    END StaryNight;
+
+
+
+
+
+(*************************************************************************)
+(*  Aim :   Accept user input to aim the tanks fire.                     *)
+(*************************************************************************)
+PROCEDURE Aim(Weapons:ARRAY OF INTEGER; damage,screen,player,x,y:INTEGER;
+	angle:LONGREAL;colr:ColourType;Vel,wind:REAL;w,wmain:Window):LONGREAL;
+VAR key:CHAR;
+    x1,y1,wind2,changed:INTEGER;
+    ang:CHAR;
+    scan:BYTE;
+    CtrlPress:BOOLEAN;
+    Velh,vel2:REAL;
+
+BEGIN
+    CtrlPress:=FALSE;
+    x1:=x;
+    y1:=y;
+    wind2:=INTEGER(wind);
+    Weapon:=0;     (* missile*)
+    SetWin(w,wind2,damage,player,colr);
+    FOR changed:=1 TO 3 DO
+        WriteWin(w,Weapon,Weapons[Weapon],damage,screen,wind2,player,changed,colr,angle,Vel);
+        END; (*FOR*)
+    changed:=6;
+
+    SetNoteDuration(3);
+    (*SetOctave(0);*)
+
+    LOOP
+       IF (stars=1) THEN StaryNight(wmain); END;
+       WriteWin(w,Weapon,Weapons[Weapon],damage,screen,wind2,player,changed,colr,angle,Vel);
+       Line2C(wmain,x,y,x1,y1,ColourY(y1,-1));
+       Line2C(wmain,x+1,y,x1+1,y1,ColourY(y1,-1));
+       x1:= x+INTEGER(8.0*Cos(angle));
+       y1:= y+VAL(INTEGER,8.0*Sin(angle));
+       Line2C(wmain,x,y,x1,y1,colr);
+       Line2C(wmain,x+1,y,x1+1,y1,colr);
+       IF (NOT Human) AND (player = 2) THEN EXIT; END;
+       scan:=GetScanCode();
+       (* decrease velocity: down arrow *)
+       IF (scan=Down) AND (Vel >0.0) THEN
+           IF Sound THEN PlayMusic("D"); END;
+           IF CtrlPress THEN
+              Vel :=Vel -1.0;
+              ELSE Vel:=Vel -10.0;
+              END;
+           IF Vel < 0.0 THEN Vel := 0.0; END;
+           changed:=2;
+           a:=RANDOM();
+           (* increase  angle: left arrow *)
+       ELSIF (scan=Left) AND (angle <pi) THEN
+           IF CtrlPress THEN
+              angle := angle +1.0 *pi/180.0;
+              ELSE angle := angle +5.0 *pi/180.0;
+              END;
+           IF Sound THEN PlayMusic("C");END;
+           IF angle >180.0 THEN angle :=180.0; END;
+           changed:=1;
+           (* decrease angle: right arrow *)
+       ELSIF (scan=Right) AND (angle >0.0) THEN
+           IF CtrlPress THEN
+              angle := angle -1.0*pi/180.0;
+              ELSE angle := angle -5.0*pi/180.0;
+              END;
+           IF Sound THEN PlayMusic("C"); END;
+           IF angle < 0.0 THEN angle :=0.0; END;
+           changed:=1;
+           (* increase velocity: up arrow *)
+       ELSIF (scan=Up) AND (Vel <200.0) THEN
+           changed:=2;
+           IF Sound THEN PlayMusic("D");END;
+           IF CtrlPress THEN
+              Vel := Vel +1.0;
+              ELSE Vel := Vel +10.0;
+              END;
+           IF Vel >200.0 THEN Vel := 200.0; END;
+       ELSIF(scan = Esc) THEN RETURN quitnow;
+       ELSIF (scan = Enter)OR(scan=Space) THEN EXIT;
+       ELSIF (scan = CtrlCode ) THEN CtrlPress:=TRUE;
+       ELSIF (scan=CtrlRelease) THEN CtrlPress:=FALSE;
+       ELSIF (scan=W)OR(scan=Alt) THEN
+             REPEAT
+                   IF Sound THEN PlayMusic("uu**E//dd"); END;
+                   IF Weapon = 3 THEN Weapon :=0;
+                   ELSE INC(Weapon);
+                   END (*IF*);
+             UNTIL Weapons[Weapon]  <> 0;
+             changed:=3;
+       END (*IF*);
+
+       END;(*LOOP*)
+       IF (NOT Human) AND (player = 2) AND (NOT SmartCom) THEN
+        IF VelChanged THEN
+             VelChanged:=FALSE;
+             AnglChanged:=TRUE;
+             IF (CompExplode.x < Tank1.x) THEN
+               angle := angle -5.0*pi/180.0;
+               ELSE angle := angle +5.0 *pi/180.0;
+               END;
+             IF angle >3.0*pi/4.0 THEN angle:=3.0*pi/4.0; END;
+             WriteWin(w,Weapon,Weapons[Weapon],damage,screen,wind2,player,1,colr,angle,Vel);
+
+          ELSE
+             AnglChanged:=FALSE;
+             VelChanged:=TRUE;
+             IF CompExplode.x < Tank1.x THEN
+              Vel:=Vel-10.0;
+              ELSE Vel:=Vel+10.0;
+              END;
+             IF Vel < 40.0 THEN Vel:=40.0; END;
+             WriteWin(w,Weapon,Weapons[Weapon],damage,screen,wind2,player,2,colr,angle,Vel);
+
+         END;
+
+
+       ELSIF (SmartCom) AND (player = 2) THEN
+               IF (MorAng) AND(CompExplode.x >Tank1.x) THEN
+                angle := angle -5.0*pi/180.0;
+                IF angle >3.0*pi/4.0 THEN angle:=3.0*pi/4.0; END;
+
+
+               ELSE
+                IF ((HitToLeft AND (CompExplode.x > Tank1.x)) OR
+                   (HitToRight AND (CompExplode.x < Tank1.x))) AND
+                   (CompExplode.x <> 9999) THEN
+                   velocity:=velocity/2.0;
+                  END;
+
+                IF CompExplode.x < Tank1.x THEN
+                  HitToLeft:=TRUE;
+                  HitToRight:=FALSE;
+                  Vel:=Vel-velocity;
+                 ELSE Vel:=Vel+velocity;
+                  HitToRight:=TRUE;
+                 END;
+
+               END;
+               WriteWin(w,Weapon,Weapons[Weapon],damage,screen,wind2,player,2,colr,angle,Vel);
+
+        END;
+
+
+       IF player = 1 THEN
+          DEC(Weapons1[Weapon]);
+          Vel1:=Vel;
+       ELSE
+          DEC(Weapons2[Weapon]);
+          Vel2 :=Vel;
+       END;
+
+        Velh := Vel*VAL(REAL,Cos(angle));
+        IF (SmartCom) AND (player = 2) THEN Velh:=Velh-REAL(wind2);END;
+
+       Fire(wmain,Velh,Vel*VAL(REAL,Sin(angle)),9.8,wind2,x1,y1,player,colr);
+       RETURN angle;
+   END Aim;
+
+
+(*************************************************************************)
+(*  TankDraw : Draw a Tank.                                              *)
+(*************************************************************************)
+PROCEDURE TankDraw (wmain:Window; x,y,colr:INTEGER);
+
+BEGIN
+
+
+    Line2C(wmain,x-4,y+1,x+4,y+1,ColourY(y+1,colr));
+    Line2C(wmain,x-5,y+2,x+5,y+2,ColourY(y+2,colr));
+    IF colr <>-1 THEN
+        PutPixel2C(wmain,x-2,y+2,0);
+        PutPixel2C(wmain,x,y+2,0);
+        PutPixel2C(wmain,x+2,y+2,0);
+        END (*IF*);
+    Line2C(wmain,x-6,y+3,x+6,y+3,ColourY(y+3,colr));
+    Line2C(wmain,x-5,y+4,x+5,y+4,ColourY(y+4,colr));
+    Line2C(wmain,x-2,y+5,x+2,y+5,ColourY(y+5,colr));
+    Line2C(wmain,x-3,y+6,x+3,y+6,ColourY(y+6,colr));
+END TankDraw;
+
+(*************************************************************************)
+(*  DrawLandscape: Draw the landscape.                                   *)
+(*************************************************************************)
+PROCEDURE DrawLandscape(w1:Window);
+
+VAR     c,i,w,z,ClrXY,num:INTEGER;
+        rand,up,down,right2,top2,left2,ClrX,ClrY:REAL;
+        count:CARDINAL;
+
+BEGIN
+          right2:=REAL(RightBorder);
+          top2:=REAL(TopBorder);
+
+    IF (stars<>1) THEN
+    FOR count := 1 TO TopBorder+1 DO
+        Line2C(w1,1,count,RightBorder-1,count,ColourY(INTEGER(count),-1));
+        END;
+    END;
+
+FOR num := -10 TO 0 DO
+    GroundLine[num]:=y;
+    END;
+
+    x:=1;
+    WHILE x< RightBorder DO
+          rand:=RANDOM();
+
+          IF (x>INTEGER(right2/3.2)) AND (x<INTEGER(right2/2.3)) THEN
+                 up:= VAL(REAL,up1);
+                 z:=TRUNC(up*rand);
+                 y:=y+z-up2;
+          ELSIF (x<INTEGER(right2/1.5)) AND (x>INTEGER(right2/1.9))  THEN
+                 down:= VAL(REAL,down1);
+                 z:=TRUNC(down*rand);
+                 y:=y+z-down2;
+          ELSE
+                 z:=TRUNC(5.0*rand);
+                 y:=y+z-2;
+
+          END;  (*IF*)
+
+          IF y>INTEGER(top2/1.2) THEN y:=y-5;
+          END (*FOR*);
+          IF y<20 THEN y:=23;
+          END (*FOR*) ;
+          IF y>MaxGround THEN MaxGround :=y;END;
+          GroundLine[x]:=y;
+          FOR count:= y TO 13 BY -12 DO
+             ClrX:=((26.0+REAL(GroundLine[x]-GroundLine[x-10]))*64.0/52.0);
+             ClrY:=  30.0;
+             ClrXY:=INTEGER((REAL(count)*ClrX+REAL(y-INTEGER(count))*ClrY)/REAL(y));
+             IF ClrXY > 63 THEN ClrXY := 63;
+             ELSIF ClrXY < 0 THEN ClrXY :=0;
+               END;
+               Line2C(w1,x,count,x,count-12,GroundColour[ClrXY]);
+
+           END;
+           Line2C(w1,x,12,x,1,GroundColour[ClrXY]);
+
+          (* draw snow *)
+          IF y >INTEGER(top2/1.5) THEN Line2C(w1,x,y,x,INTEGER(top2/1.5)-INTEGER(5.0*rand),7); END;
+          x:=x+1;
+          END; (*while*)
+
+          END DrawLandscape;
+
+(****************************************************************************
+**  Plots the explosion circle and calculates the distance for dirt to fall **
+******************************************************************************)
+PROCEDURE PlotCircle2(w1:Window;x,y,radius:INTEGER;  colr: ColourType);
+VAR       a,c,r,p,s,t:INTEGER;
+          u,v,w:LONGREAL;
+
+BEGIN
+    IF y-radius<0 THEN s:= -y+1;
+    ELSE s:= 1-radius;
+    END;
+    FOR s:= s TO radius-1 DO
+        v:=VAL(LONGREAL,s);
+        w:=VAL(LONGREAL,radius);
+        u:=w*w-v*v;
+        t:=VAL(INTEGER,Sqrt(u));
+        IF x-t<1 THEN r:=1;
+        ELSE r:=x-t; END;
+        IF x+t >= RightBorder THEN p:=RightBorder-1;
+        ELSE p:=x+t;
+        END;
+        IF s+y >=TopBorder THEN s:=radius-1;
+        ELSE Line2C(w1,r,s+y,p,s+y,ColourY(s+y,colr));
+             IF s+x > 0 THEN DirtFall[s+x]:=y+t; END;
+             END;
+       END;
+END PlotCircle2;
+
+
+
+
+(************************************************************************
+**   EXPLODE **  When missile hits ground or tank:  Draw explosion flash,
+                 Remove dirt, landslide dirt, reset ground level.
+*************************************************************************)
+PROCEDURE Explode (w:Window;x,y,radius:INTEGER);
+          VAR i,colr:SHORTCARD;
+              x1,x2,y1,l,k:INTEGER;
+          BEGIN
+
+
+          explode.x :=x;
+          explode.y:=y;
+          k:=GroundLine[200];
+          PlotCircle2(w,x,y,radius,4);    (* Draw explosion *)
+          Sleep(100);
+          PlotCircle2(w,x,y,radius,6);
+          Sleep(100);
+          PlotCircle2(w,x,y,radius,12);
+          Sleep(100);
+          PlotCircle2(w,x,y,radius,14);
+          Sleep(100);
+          PlotCircle2(w,x,y,radius,-1);
+
+          IF x-radius+1 > 0 THEN x2 :=x-radius+1;
+          ELSE x2:=1;
+          END;
+           LOOP
+            FOR x1:=x2 TO x+radius-1 DO             (* Dirt falling down*)
+              l:=1;
+              IF x1 >=RightBorder THEN EXIT; END;
+              IF GroundLine[x1] > DirtFall[x1] THEN  (* after explosion  *)
+                 WHILE l<= 2*(DirtFall[x1]-y)+1 DO
+                  PutPixel2C(w,x1,GroundLine[x1],ColourY(GroundLine[x1],-1));
+                  PutPixel2C(w,x1,DirtFall[x1]-l+1,GroundColour[40]);
+                  GroundLine[x1]:=GroundLine[x1]-1;
+                  IF DirtFall[x1]-l =0 THEN l:=2*DirtFall[x1];END;         (* reset ground *)
+                  INC(l);
+                  END (*WHILE*);                              (* after explosion*)
+              ELSIF GroundLine[x1] > 2*y-DirtFall[x1] THEN
+                    GroundLine[x1]:=2*y-DirtFall[x1];
+          (*    Sleep(100);*)
+              END (*IF*);
+              IF GroundLine[x1] <1 THEN GroundLine[x1] :=0; END;
+            END (*FOR*);
+            EXIT (*LOOP*);
+           END (*LOOP*);
+          END Explode;
+
+PROCEDURE TankExplode(w:Window;x,y,bombsize2:INTEGER);
+BEGIN
+     Explode(w,x,y,bombsize2);
+     IF Sound THEN ExplodeSound(2);END;
+     Explode(w,x-5,y,5);
+     Explode(w,x+5,y,5);
+     END TankExplode;
+
+
+(*******Shoot a line . When it hits the ground or tank call explode.***)
+PROCEDURE Fire (w:Window; Velh,Vely,Gravity:REAL;wind,x0,y0,player:INTEGER;colr:SHORTCARD);
+VAR maxy,x,y,xt,j,count,upoctave,downoctave:INTEGER;
+    time,Vel1:REAL;
+    Vel2:CARDINAL;
+
+BEGIN
+
+      x:=20;
+      xt:=x0;
+
+     IF Sound THEN SetNoteDuration(0);  (**** setting NoteDuraton ****)
+        END;
+     time:=0.07;
+     count:=0;
+     maxy:=y0;
+     LOOP
+              y:= y0+VAL(INTEGER,Vely*time -Gravity*time*time/2.0);
+              IF y>maxy THEN maxy:=y; END;
+              x:=x0+VAL(INTEGER,(Velh+REAL(wind))*time);
+              IF (x>RightBorder) OR(x<1) THEN EXIT; END;
+           IF Sound THEN
+              Vel1:=ABS(VAL(REAL,Sqrt(VAL(LONGREAL,((Vely-9.8*time)*(Vely-9.8*time))))));
+
+               Vel2:=CARDINAL(Vel1/35.0);
+               SetOctave(Vel2);
+
+               (*
+               (* Use this if NoteDuration is set >= 1                      *)
+               (* as the velocity of projectile increase the more often the *)
+               (* sound must be played. This is a poor substitute to not    *)
+               (* being able to make the note duration small enough         *)
+               IF   ((Vel2<50)AND((count MOD 15) = 0))
+                 OR ((Vel2<100)AND((count MOD 10) = 0))
+                 OR ((Vel2<150)AND((count MOD 7) = 0))
+                 OR ((Vel2<200)AND((count MOD 5) = 0))
+                 OR ((Vel2>250)AND((count MOD 2) = 0))
+               THEN PlayMusic("C");END;
+               *)
+
+                (* Use this if NoteDuration is set to zero *)
+                (* produces smooth continuous notes but    *)
+                (* the volume is low and changing octave   *)
+                (* has no noticable effect.                *)
+
+                PlayMusic("C");
+               END;
+
+
+           IF  Trace AND ((count MOD 15) = 0) AND (x<RightBorder) AND
+               (x>1) AND (y<TopBorder) AND (y>1) THEN
+               PutPixel2C(w,x,y,colr);
+               PutPixel2C(w,x,y+1,colr);
+               END (*IF*);
+
+
+
+       IF Weapon = 1 THEN bombsize:=30;
+       ELSE bombsize := 15;
+       END;
+
+
+
+
+       (*** Hit Tank1 ***)
+    IF (Weapon<>3)AND((x > Tank1.x-9) AND (x < Tank1.x +9) AND (y<Tank1.y+9 )AND (y>Tank1.y-5)) THEN
+
+       TankExplode(w,x,y,bombsize);
+       Tank1Explode:=TRUE;
+       EXIT;
+
+       (*** Hit Tank2  ***)
+    ELSIF (Weapon<>3)AND((x > Tank2.x-9) AND (x < Tank2.x +9) AND (y<Tank2.y+9 )AND (y>Tank2.y-5)) THEN
+       TankExplode(w,x,y,bombsize);
+       Tank2Explode:=TRUE;
+       EXIT;
+
+       (*** vertical guidence hit Tank1***)
+    ELSIF (Weapon = 2) AND (x > Tank1.x-3) AND (x < Tank1.x +3) AND
+          (y-GroundLine[Tank1.x]<INTEGER(REAL(Tank2.x-Tank1.x)/4.0)) THEN
+       IF (Trace) THEN Line2C(w,Tank1.x,y,Tank1.x,Tank1.y,colr); END;
+       TankExplode(w,Tank1.x,Tank1.y,bombsize);
+       Tank1Explode:=TRUE;
+       EXIT;
+
+       (*** vertical guidence hit Tank2 ***)
+    ELSIF (Weapon = 2) AND (x > Tank2.x-3) AND (x < Tank2.x +3) AND
+          (y-GroundLine[Tank2.x]<INTEGER(REAL(Tank2.x-Tank1.x)/4.0)) THEN
+       IF (Trace) THEN Line2C(w,Tank2.x,y,Tank2.x,Tank2.y,colr); END;
+       TankExplode(w,Tank2.x,Tank2.y,bombsize);
+       Tank2Explode:=TRUE;
+       EXIT;
+
+
+
+    ELSIF (x<RightBorder-2)AND((GroundLine[x]>=y)
+       OR ((GroundLine[x]<=y) AND (GroundLine[x+1] >=y))) THEN
+       IF (Weapon =3) THEN
+          Explode(w,x,y+8,10);
+          IF Sound THEN ExplodeSound(4);END;
+          Explode(w,x-5,y+4,10);
+          IF Sound THEN ExplodeSound(4);END;
+          Explode(w,x+5,y+4,10);
+          IF Sound THEN ExplodeSound(4);END;
+         ELSE
+          IF Sound THEN
+          IF (Weapon =2) THEN ExplodeSound(3);
+             ELSE ExplodeSound(1); END;
+             END;
+          Explode(w,x,y,bombsize);
+         END;
+
+        EXIT;
+       END;
+
+    INC(count);
+    time:=time+0.01;
+    xt:=x;
+    END;  (*loop*)
+    IF player = 2 THEN
+       CompExplode.x:=x;
+       CompExplode.y:=y;
+       IF y < maxy THEN MorAng:=FALSE;
+          ELSE MorAng:=TRUE;
+          END;
+       END;
+
+    END Fire;
+
+(******************************************************************************
+** Tests to see if the tank has been hit or fallen. Redraw the tank in its   **
+** new position.                                                             **
+******************************************************************************)
+PROCEDURE TankFall(w:Window;colr1,colr2:SHORTCARD);
+VAR x1,x2,y1,y2:INTEGER;
+BEGIN
+    x1:=Tank1.x+INTEGER(8.0*Cos(angle1));
+    y1:=Tank1.y+7+INTEGER(8.0*Sin(angle1));
+    x2:=Tank2.x+INTEGER(8.0*Cos(angle2));
+    y2:=Tank2.y+7+INTEGER(8.0*Sin(angle2));
+
+    (* Tank1 has fallen *)
+    IF Tank1.y <> GroundLine[Tank1.x] THEN
+            TankDraw(w,Tank1.x,Tank1.y,-1);
+            Line2C(w,Tank1.x,Tank1.y+7,x1,y1,ColourY(Tank1.y+7,-1));
+            Line2C(w,Tank1.x+1,Tank1.y+7,x1+1,y1,ColourY(Tank1.y+7,-1));
+
+            IF (Weapon=1) THEN INC(damage1,40);
+               ELSIF(Weapon<>3) THEN INC(damage1,20);
+               END;
+
+            IF (damage1 >99) THEN
+               TankExplode(w,Tank1.x,Tank1.y,15);
+               Tank1Explode:=TRUE;
+               ELSE Tank1.y := GroundLine[Tank1.x];
+                    TankDraw(w,Tank1.x,Tank1.y,INTEGER(colr1));
+                    Line2C(w,Tank1.x,Tank1.y+7,Tank1.x+8,Tank1.y+7,colr1);
+                    angle1:=0.0;
+                    Vel1:=50.0;
+               END;
+
+            (* Tank2 has fallen *)
+       ELSIF Tank2.y <> GroundLine[Tank2.x] THEN
+            TankDraw(w,Tank2.x,Tank2.y,-1);
+            Line2C(w,Tank2.x,Tank2.y+7,x2,y2,ColourY(Tank2.y+7,-1));
+            Line2C(w,Tank2.x+1,Tank2.y+7,x2+1,y2,ColourY(Tank2.y+7,-1));
+
+            IF (Weapon=1) THEN INC(damage2,40);
+               ELSIF(Weapon<>3) THEN INC(damage2,20);
+               END;
+
+            IF (damage2 >99) THEN
+               TankExplode(w,Tank2.x,Tank2.y,15);
+               Tank2Explode:=TRUE;
+               ELSE Tank2.y := GroundLine[Tank2.x];
+                    TankDraw(w,Tank2.x,Tank2.y,INTEGER(colr2));
+                    IF Human THEN
+                       angle2:=pi;
+                       Line2C(w,Tank2.x,Tank2.y+7,Tank2.x-8,Tank2.y+7,colr2);
+                    ELSE angle2:=3.0*pi/4.0;
+                       Line2C(w,Tank2.x,Tank2.y+7,Tank2.x-5,Tank2.y+12,colr2);
+                    END;
+                    Vel2:=50.0;
+               END;
+
+      (* Tank1 hit but has not fallen *)
+      ELSIF (Tank1.x > explode.x-bombsize-7) AND (Tank1.x < explode.x +bombsize+7) AND
+            (Tank1.y<explode.y+bombsize) THEN
+            Line2C(w,Tank1.x,Tank1.y+7,x1,y1,ColourY(Tank1.y+7,-1));
+            Line2C(w,Tank1.x+1,Tank1.y+7,x1+1,y1,ColourY(Tank1.y+7,-1));
+
+            IF (Weapon=1) THEN INC(damage1,40);
+               ELSIF(Weapon<>3) THEN INC(damage1,20);
+               END;
+
+            IF (damage1 >99) THEN
+               TankExplode(w,Tank1.x,Tank1.y,15);
+               Tank1Explode:=TRUE;
+               ELSE TankDraw(w,Tank1.x,Tank1.y,INTEGER(colr1));
+                    Line2C(w,Tank1.x,Tank1.y+7,Tank1.x+8,Tank1.y+7,colr1);
+                    angle1:=0.0;
+                    Vel1:=50.0;
+               END;
+
+      (* Tank2 hit but has not fallen *)
+      ELSIF (Tank2.x > explode.x-bombsize-7) AND (Tank2.x < explode.x +bombsize+7) AND
+            (Tank2.y< explode.y+bombsize) THEN
+            Line2C(w,Tank2.x,Tank2.y+7,x2,y2,ColourY(Tank2.y+7,-1));
+            Line2C(w,Tank2.x+1,Tank2.y+7,x2+1,y2,ColourY(Tank2.y+7,-1));
+
+            IF (Weapon=1) THEN INC(damage2,40);
+               ELSIF(Weapon<>3) THEN INC(damage2,20);
+               END;
+
+            IF (damage2 >99) THEN
+               TankExplode(w,Tank2.x,Tank2.y,15);
+               Tank2Explode:=TRUE;
+               ELSE TankDraw(w,Tank2.x,Tank2.y,INTEGER(colr2));
+
+                    IF Human THEN
+                       angle2:=pi;
+                       Line2C(w,Tank2.x,Tank2.y+7,Tank2.x-8,Tank2.y+7,colr2);
+                    ELSE angle2:=3.0*pi/4.0;
+                       Line2C(w,Tank2.x,Tank2.y+7,Tank2.x-5,Tank2.y+12,colr2);
+                    END;
+                   IF NOT (SmartCom)THEN  Vel2:=50.0;
+                   ELSE Vel2:=0.9*Vel2;
+                   END;
+               END;
+
+            END;
+
+END TankFall;
+
+(*****************************************************************************
+** Set the colour of tanks.                                                 **
+*****************************************************************************)
+PROCEDURE TankColour(wblast:Window;colrin:SHORTCARD;player:INTEGER):SHORTCARD;
+VAR key:CHAR;
+    colr:SHORTCARD;
+BEGIN
+
+
+    colr:=13;
+    key := "~";
+
+    WriteStringC(wblast,"          TANKBLAST  SVGA",4);
+    WriteLn(wblast);
+    WriteLn(wblast);
+    WriteStringC(wblast,"   A PMOS demonstration program",2);
+    WriteLn(wblast);
+    WriteLn(wblast);
+    WriteStringC(wblast,    "         By  JASON HARPER ",2);
+    WriteLn(wblast);
+    WriteLn(wblast);
+
+    WriteStringC(wblast,    "         ELEC 460   1993",2);
+
+    SetCursor(wblast,12,3);
+        IF player = 1 THEN
+           WriteStringC(wblast, "Player1 choose your tank colour",colr1);
+           ELSE WriteStringC(wblast, "Player2 choose your tank colour",colr2)
+        END (*IF*);
+        WriteLn(wblast);
+        WriteLn(wblast);
+        WriteStringC(wblast,'  "C"    ',14);
+        WriteStringC(wblast,'To change colour ',9);
+        WriteLn(wblast);
+        WriteLn(wblast);
+        WriteStringC(wblast,"  SPACE  ",14);
+        WriteStringC(wblast,"when done  ",9);
+
+
+    WHILE (CAP(key) <> " ")AND (key<>CHR(0DH)) DO
+
+
+
+           IF (CAP(key) = 'C')  THEN
+              IF colr > 14 THEN colr:=1;
+              ELSIF (colr = 12) AND (NOT Human) THEN colr:=13;
+              ELSE INC(colr);
+              END;
+           END;
+           IF colr <> colrin THEN
+              MainTank(wblast,150,50,colr);
+              key:=InKey();
+              ELSE INC(colr);
+              END;
+           END (*WHILE *);
+    ClearWindow(wblast,colr);
+    RETURN colr;
+END TankColour;
+
+(*****************************************************************************
+** Set the palette colours for a 'random'  sky.                             **
+*****************************************************************************)
+PROCEDURE Sky;
+VAR red,green,blue:SHORTCARD;
+    rand,rand2:INTEGER;
+    colour,r,g,b:SHORTCARD;
+    R,G,B:REAL;
+
+BEGIN
+     rand:=INTEGER(4.0*RANDOM());
+     rand2:=INTEGER(11.0*RANDOM());
+     FOR colour:= 64 TO 127  DO
+     BkgrndColr[INTEGER(colour-64)]:= colour;
+     CASE rand OF
+          0:   red :=191-colour;            (* SUNSET *)
+               green:=90;
+               blue:=42+SHORTCARD(REAL(colour)/1.5);
+          |
+          1:   red:= 0;   (* STARY NIGHT *)
+               green:=0;
+               blue:=0;
+          |
+          2:   red :=191-colour;         (* DAY *)
+               green:=191-colour;
+               blue:=84+SHORTCARD(REAL(colour)/3.0);
+          |
+          3:   red:=0;     (* STORMY *)
+               green:=0;
+               blue:=colour;
+          END (*CASE*);
+     CASE rand2 OF
+          0:    R:=0.75;
+                G:=0.5;
+                B:= 0.0;
+          |
+          1:    R:=0.5;
+                G:=0.5;
+                B:=0.25;
+          |
+          2:    R:=0.75;
+                G:=0.45;
+                B:= 0.3;
+          |
+          3:    R:= 0.0;
+                G:=0.99;
+                B:= 0.0;
+          |
+          4:    R:=0.25;
+                G:=0.5;
+                B:= 0.0;
+          |
+          5:    R:=0.4;
+                G:=0.85;
+                B:= 0.45;
+          |
+          6:    R:=0.65;
+                G:=0.50;
+                B:= 0.25;
+          |
+          7:    R:=0.68;
+                G:=0.55;
+                B:= 0.4;
+          |
+          8:    R:=0.75;
+                G:=0.75;
+                B:=0.75;
+          |
+          9:    R:=0.5;
+                G:=0.5;
+                B:= 0.25;
+          |
+         10:    R:=0.35;
+                G:=0.45;
+                B:= 0.45;
+         END (*CASE*);
+
+     r:=SHORTCARD(R*REAL(colour-64));
+     g:=SHORTCARD(G*REAL(colour-64));
+     b:=SHORTCARD(B*REAL(colour-64));
+
+     GroundColour[INTEGER(colour-64)]:=colour+64;
+     SetPaletteColour(colour+64,r,g,b);
+     SetPaletteColour(colour,red,green,blue);
+
+
+
+     END;
+     stars :=rand;
+
+
+END Sky;
+
+(*****************************************************************************
+** Draws a rectangle.                                                       **
+*****************************************************************************)
+PROCEDURE DrawRectangle(w:Window;left,bottom,right,top:INTEGER;colr:SHORTCARD);
+BEGIN
+     Line2C(w,left,bottom,right,bottom,colr);
+     Line2C(w,left,bottom,left,top,colr);
+     Line2C(w,left,top,right,top,colr);
+     Line2C(w,right,bottom,right,top,colr);
+END DrawRectangle;
+
+
+(******************************************************************************
+** Draw a border around the playing window.                                  **
+******************************************************************************)
+PROCEDURE DrawBackground;
+VAR cnt1,cnt2,cnt3:CARDINAL;
+    incr:BOOLEAN;
+    BackColour:ARRAY [0..63] OF SHORTCARD;
+    colour:SHORTCARD;
+    ran1,ran2,ran3:REAL;
+BEGIN
+
+        ran1:=RANDOM();
+        ran2:=RANDOM();
+        ran3:=RANDOM();
+       incr:=TRUE;
+       cnt2:=0;
+       cnt3:=0;
+       FOR colour:= 0 TO 63  DO
+          BackColour[INTEGER(colour)]:=colour+192;
+          SetPaletteColour(colour+192,SHORTCARD(ran1*REAL(colour)),
+                SHORTCARD(ran2*REAL(colour)),SHORTCARD(ran3*REAL(colour)));
+          END;
+       LOOP;
+       FOR cnt1 :=63 TO 0 BY -1 DO
+          INC(cnt2);
+          DrawRectangle(wback,cnt2,cnt2,XMAX-cnt2-1,YMAX-cnt2,BackColour[cnt1]);
+          IF 2*cnt2>YMAX THEN EXIT; END;
+          IF 2*cnt2>XMAX THEN EXIT; END;
+         END;
+       FOR cnt1 :=0 TO  63 DO
+          INC(cnt2);
+          DrawRectangle(wback,cnt2,cnt2,XMAX-cnt2-1,YMAX-cnt2,BackColour[cnt1]);
+         IF 2*cnt2>YMAX THEN EXIT; END;
+         IF 2*cnt2>XMAX THEN EXIT; END;
+         END;
+
+
+       END (*LOOP*);
+END DrawBackground;
+
+
+(*****************************************************************************
+**  The main function.                                                      **
+*****************************************************************************)
+PROCEDURE Battle;
+BEGIN
+
+
+       MaxGround:=0;
+       Sky();
+       GetScreenShape(XMAX,YMAX,MaxColour);
+       OpenWindow(wback,0,0,XMAX-1,YMAX-1,1,0,single);
+       DrawBackground();
+       Sky();
+       colr1:=13;         (* the colour of tank1                  *)
+       colr2:=12;         (* the colour of tank2                  *)
+       left:=  INTEGER(0.127*REAL(XMAX));
+       bottom:=INTEGER(0.17*REAL(YMAX));
+       right:= INTEGER(0.875*REAL(XMAX));
+       top:=   INTEGER(0.83*REAL(YMAX));
+       L:= left;
+       R:=right;
+       B:=bottom;
+       T:=top;
+
+
+       OpenWindow(wblast,95,95,XMAX-100,YMAX-100,2,0,single);
+        (** set tank colours **)
+       colr1:=TankColour(wblast,16,1);
+       IF Human THEN colr2:=TankColour(wblast,colr1,2); END;
+       TankDraw(wblast,150,100,0);
+       CloseWindow(wblast);
+       DrawBackground();
+
+       OpenWindow(wblast,CARDINAL(REAL(XMAX)/2.0)-150,
+       CARDINAL(REAL(YMAX)/2.0)-45,CARDINAL(REAL(XMAX)/2.0)+150,
+       CARDINAL(REAL(YMAX)/2.0)+45,2,0,single);
+
+       SetCursor(wblast,0,0);
+       WriteStringC(wblast,"  Position and size playing window ",14);
+       WriteLn(wblast);
+       WriteLn(wblast);
+       WriteStringC(wblast,"  CURSOR keys to move window",2);
+       WriteLn(wblast);
+       WriteLn(wblast);
+       WriteStringC(wblast,"  Ctrl - CURSOR keys to",3);
+       WriteLn(wblast);
+       WriteStringC(wblast,"  resize the window",3);
+       WriteLn(wblast);
+       WriteLn(wblast);
+       WriteStringC(wblast,"  'F' for full screen ",5);
+       WriteLn(wblast);
+       WriteLn(wblast);
+       WriteStringC(wblast,"  ENTER or SPACE when done",4);
+
+       CtrlPress:=FALSE;
+
+       LOOP   (** draw and position the playing window **)
+
+          DrawRectangle(wback,L-1,B-1,R+1,T+1,0);
+          DrawRectangle(wback,L,B,R,T,0);
+          DrawRectangle(wback,L+1,B+1,R-1,T-1,0);
+          DrawRectangle(wback,left-1,bottom-1,right+1,top+1,1);
+          DrawRectangle(wback,left,bottom,right,top,2);
+          DrawRectangle(wback,left+1,bottom+1,right-1,top-1,12);
+          L:=left;
+          R:=right;
+          B:=bottom;
+          T:=top;
+          ScanCode:=GetScanCode();
+          CASE ScanCode OF
+               Up:        IF CtrlPress THEN
+                             (* increase vertical size*)
+                             IF top < YMAX-10 THEN INC(top,10);
+                                ELSIF top - bottom >11 THEN DEC(bottom,10);
+                                END;
+                             (* move window up *)
+                            ELSIF top <YMAX-10 THEN
+                              INC(top,10);
+                              INC(bottom,10);
+                           END;
+               |
+
+               Left:
+                           (* decrease horizontal size of window *)
+                           IF CtrlPress THEN
+                              IF right-left >280 THEN DEC(right,10);
+                                END;
+                           (* move window left *)
+                           ELSIF left >11 THEN
+                              DEC(left,10);
+                              DEC(right,10);
+                           END;
+               |
+               Right:  (* Increase horizontal size of window *)
+                           IF CtrlPress THEN
+                              IF right < XMAX-10 THEN INC(right,10);
+                              ELSIF right-left >11 THEN DEC(left,10);
+                              END;
+                           (* move window right *)
+                           ELSIF right < XMAX-10 THEN
+                             INC(right,10);
+                             INC(left,10);
+                           END;
+               |
+               Down:  (* decrease vertical size of window *)
+                           IF CtrlPress THEN
+                                IF top - bottom >130 THEN DEC(top,10);
+                                END;
+                        (* Move window down *)
+                           ELSIF bottom >11 THEN
+                             DEC(bottom,10);
+                             DEC(top,10);
+                           END;
+
+               |
+               CtrlCode:  CtrlPress:=TRUE;
+               |
+               CtrlRelease:       CtrlPress:=FALSE;
+
+               |
+               F:
+                     (* FULL SCREEN *)
+                        left:=1;
+                        right:=XMAX-1;
+                        bottom:=1;
+                        top:=YMAX;
+
+               |
+               Space,Enter:       EXIT;
+                  END (*CASE*);
+
+            END;  (*LOOP*)
+
+    CloseWindow(wblast);
+    DrawBackground();
+
+    DEC(top,50);
+    PlayAgain := "Y";
+    WHILE CAP(PlayAgain) ="Y" DO
+
+        Weapons1[0]:=99;         (* 99 Missiles           *)
+        Weapons2[0]:=99;
+        Weapons1[1]:=2;          (* 2 Super Missiles       *)
+        Weapons2[1]:=2;
+        Weapons1[2]:=1;          (* 1 Vertical Guidance   *)
+        Weapons2[2]:=1;
+        Weapons1[3]:=1;          (* 1 DirtBlaster         *)
+        Weapons2[3]:=1;
+        HitToLeft:=FALSE;
+        HitToRight:=FALSE;
+        velocity:=10.0;
+        damage1:=0;
+        damage2:=0;
+        explode.x:=-100;   (* dummy values out of range*)
+        explode.y:=-100;
+        a:=RANDOM();       (* generate random numbers *)
+        b:=RANDOM();
+
+        up1:=2*TRUNC(4.0*a) +3;            (* values used to generate random landscape *)
+        up2:= TRUNC(4.0*b) +TRUNC(4.0*a);
+        up2:=up2-1;
+
+        a:=RANDOM();
+        b:=RANDOM();
+        down1:=2*TRUNC(4.0*b)+3;
+        down2:= TRUNC(4.0*a)+TRUNC(4.0*b);
+        down2:=down2-0;
+
+        screensize := 1;
+        y:=INTEGER(REAL(top-bottom)/15.0)*INTEGER(1.0+10.0*a);
+        x:=1;
+        RightBorder := right-left;
+        TopBorder:= top-bottom;
+        OpenWindow(wmain,left,bottom,right,top,4,0,single);
+        Sky();  (* generate sky colours *)
+        DrawLandscape(wmain);
+        IF (stars=1) THEN
+           FOR count:= 1 TO 5 DO StaryNight(wmain); END;
+           END;
+        a:=RANDOM();
+        b:=RANDOM();
+
+        Tank1.x := INTEGER(REAL(right-left)*a/3.2)+15;
+        Tank1.y :=GroundLine[Tank1.x];
+        Tank2.x := INTEGER(REAL(right-left)*b/3.2)+INTEGER(REAL(right-left)/1.66);
+        Tank2.y := GroundLine[Tank2.x];
+        CompExplode.x:=9999;
+
+        VelChanged:=TRUE;
+        angle1 := 0.0;     (* intiial angle of the barrel of tank1 *)
+        Vel1:=50.0;        (* initial tank1 fireing velocity       *)
+        IF SmartCom THEN
+          IF Tank2.y >Tank1.y THEN
+            Vel2:=REAL( 10*(Tank2.x-Tank1.x) -6*(Tank2.y-Tank1.y))/100.0 +10.0;
+          ELSE
+            Vel2:=REAL( 10*(Tank2.x-Tank1.x) -15*(Tank2.y-Tank1.y))/100.0 +10.0;
+          END;
+        ELSE Vel2:=50.0;        (* initial tank2 fireing velocity       *)
+        END;
+       IF Vel2 <30.0 THEN Vel2:=30.0; END;
+       IF Human THEN
+          angle2 := pi;      (* initial angle of the barrel of tank2 *)
+       ELSE angle2:= 2.35619;  (* 3pi/4 *)
+       END;
+
+       TankDraw(wmain,Tank1.x,Tank1.y,INTEGER(colr1));
+
+       TankDraw(wmain,Tank2.x,Tank2.y,INTEGER(colr2));
+       IF Human THEN
+          Line2C(wmain,Tank2.x,Tank2.y+7,Tank2.x-7,Tank2.y+7,colr2);
+       ELSE Line2C(wmain,Tank2.x,Tank2.y+7,Tank2.x-5,Tank2.y+12,colr2);
+       END;
+
+       Tank1Explode:=FALSE;
+       Tank2Explode:=FALSE;
+
+       LOOP
+             (* RefreshDisplay; *)
+             OpenWindow(w1,left,top+3,right,top+50,colr1,0,single);
+             wind := Wind*(21.0*RANDOM() -10.0);
+             angle1:=Aim(Weapons1,damage1,screensize,player1,Tank1.x,Tank1.y+7,angle1,colr1,Vel1,wind,w1,wmain);
+             CloseWindow(w1);
+             IF angle1= quitnow THEN
+                        PlayAgain := "N";
+                        EXIT; END;
+             IF Tank1Explode OR Tank2Explode THEN EXIT (*LOOP*);
+             END (*IF*);
+             TankFall(wmain,colr1,colr2);
+             IF Tank1Explode OR Tank2Explode THEN EXIT (*LOOP*);
+             END (*IF*);
+
+
+
+             OpenWindow(w2,left,top+3,right,top+50,colr2,0,single);
+             wind:=Wind*(21.0*RANDOM() -10.0) ;
+             angle2:=Aim(Weapons2,damage2,screensize,player2,Tank2.x,Tank2.y+7,angle2,colr2,Vel2,wind,w2,wmain);
+
+             CloseWindow(w2);
+             IF angle2= quitnow THEN
+                        PlayAgain := "N";
+                        EXIT; END;
+             IF Tank1Explode OR Tank2Explode THEN EXIT (*LOOP*);
+             END (*IF*);
+             TankFall(wmain,colr1,colr2);
+             IF Tank1Explode OR Tank2Explode THEN EXIT (*LOOP*);
+             END (*IF*);
+
+
+
+        END (*LOOP*);
+
+      IF (angle1<>quitnow)AND (angle2<>quitnow) THEN
+        OpenWindow(wquit,left+20,bottom+20,left+270,bottom+70,1,0,double);
+        WriteLn(wquit);
+        IF Tank2Explode THEN
+             WriteStringC(wquit,"  PLAYER 1 WON THAT BATTLE ",14);
+        ELSE WriteStringC(wquit,"  PLAYER 2 WON THAT BATTLE ",14);
+        END;
+        WriteLn(wquit);
+        WriteLn(wquit);
+        WriteStringC(wquit,"  Fight Another Battle?  Y/N ",12);
+        REPEAT
+        PlayAgain:= InKey();
+        UNTIL (CAP(PlayAgain) = "Y") OR (CAP(PlayAgain) = "N");
+        CloseWindow(wquit);
+       END;
+        CloseWindow(wmain);
+        END (*WHILE*);
+      CloseWindow(wback);
+     END Battle;
+
+(***************************************************************************
+**** THE MAIN PROGRAM                                                     **
+***************************************************************************)
+BEGIN
+
+
+    PlayMusic("ABCDEFG");
+    init.Play:=TRUE;
+
+    Randomize(RANDNUM);     (* a new seed for the random number generator *)
+    WHILE init.Play DO
+          InitGraphics(2);
+          init:=BlastMenu();
+          IF init.Play THEN
+            IF init.Player2 = human THEN Human:=TRUE;
+              ELSE Human:=FALSE; END;
+            IF init.Player2 = SmartComp THEN SmartCom :=TRUE;
+              ELSE SmartCom:=FALSE; END;
+            Sound:=init.Sound;
+            Wind:=init.Wind;
+            Trace:=init.Trace;
+            IF init.ScreenRes = 1 THEN InitGraphics(SVG1b);
+            ELSIF init.ScreenRes= 2 THEN InitGraphics(SVG2b);
+            ELSE InitGraphics(SVG3b);
+            END;
+            Battle;
+          END; (*IF*)
+
+
+    END;   (*WHILE*)
+END BlastWin.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/games/tank/explode.def b/examples/Modula-2_Libraries/PMOS/sources/games/tank/explode.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/games/tank/explode.def
@@ -0,0 +1,7 @@
+DEFINITION MODULE Explode;
+(*****************************************************************************)
+(*** procedures to produce sound effects.                                   **)
+(*****************************************************************************)
+
+PROCEDURE ExplodeSound(Explosion:CARDINAL);
+END Explode.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/games/tank/explode.mod b/examples/Modula-2_Libraries/PMOS/sources/games/tank/explode.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/games/tank/explode.mod
@@ -0,0 +1,41 @@
+IMPLEMENTATION MODULE Explode;
+(*****************************************************************************)
+(**  Procedures to produce sound effects.                                   **)
+(*****************************************************************************)
+
+FROM Music IMPORT SetNoteDuration,SetOctave,PlayMusic,WaitForMusicFinished;
+
+
+PROCEDURE ExplodeSound(Explosion:CARDINAL);
+
+BEGIN
+    SetNoteDuration(5);
+    SetOctave(2);
+    CASE Explosion OF
+         1:     SetNoteDuration(5);
+                SetOctave(2);
+                PlayMusic("CC#uCC#dCC#EE");  (* Hit Dirt with missile *)
+         |
+         2:       (*  tank explode *)
+                SetOctave(5);
+                SetNoteDuration(10);
+                PlayMusic("CCDCDEdCDECDDCDFdCFDEFDECFDdCFDEFCDABCDdCDEFEFEDdCDFEEFDEDED");
+
+
+         |
+         3:     (* Vertical Guidence hit dirt*)
+                SetOctave(4);
+                SetNoteDuration(5);
+                PlayMusic("GuGuGCdCdC");
+         |
+         4:     (* Dirt Blaster *)
+                SetNoteDuration(30);
+                SetOctave(2);
+                PlayMusic("E#EE#EE#CC#GGuG");
+         END; (*CASE*)
+
+
+END ExplodeSound;
+
+END Explode.    	   	
+    	
diff --git a/examples/Modula-2_Libraries/PMOS/sources/games/tank/menu2.def b/examples/Modula-2_Libraries/PMOS/sources/games/tank/menu2.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/games/tank/menu2.def
@@ -0,0 +1,19 @@
+DEFINITION MODULE Menu2;
+(*****************************************************************************)
+(**  Menu routines to set up and start a game.                              **)
+(*****************************************************************************)
+
+TYPE playertype = (human,DumbComp,SmartComp);
+
+TYPE initvalu = RECORD
+              Wind: REAL;
+              Sound:BOOLEAN;
+              Trace:BOOLEAN;
+              Play:BOOLEAN;
+              ScreenRes:SHORTCARD;
+              Player2:playertype;
+              END (*RECORD*);
+
+PROCEDURE BlastMenu():initvalu;
+
+END Menu2.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/games/tank/menu2.mod b/examples/Modula-2_Libraries/PMOS/sources/games/tank/menu2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/games/tank/menu2.mod
@@ -0,0 +1,139 @@
+IMPLEMENTATION MODULE Menu2;
+(*****************************************************************************)
+(**   Menu routines to set up and start the game.                           **)
+(*****************************************************************************)
+
+FROM Windows IMPORT Window,Colour,OpenWindow,FrameType,DividerType,SetCursor,
+             WriteString,WriteLn,EraseLine;
+FROM Menus IMPORT CreateMenu,SelectFromMenu,DestroyMenu,PositionMenu,DisplayMenu,
+           Menu,ItemText;
+FROM TankHelp IMPORT Help;
+
+VAR i:initvalu;
+
+PROCEDURE BlastMenu():initvalu;
+VAR M,wind,sound,trace,res,play:Menu;
+    items,WindOn,TraceOn,SoundOn,Res,Play2:ARRAY [0..9] OF ItemText;
+    MenuItem,count,select:CARDINAL;
+    Init:initvalu;
+    w:Window;
+BEGIN
+    Init.Wind:=1.0;
+    Init.Sound:=TRUE;
+    Init.Trace:=TRUE;
+    Init.ScreenRes:=1;
+    Init.Player2:=human;
+    items[0]:= "TankBlast Startup Menu";
+    items[1]:=" Instructions";
+    items[2]:=" Sound ";
+    items[3]:=" Wind  ";
+    items[4]:=" Projectile Traces";
+    items[5]:=" Screen Resolution";
+    items[6]:=" Player 2 ";
+    items[7]:=" BEGIN THE BATTLE";
+    items[8]:=" QUIT";
+    WindOn[0]:="WIND";
+    WindOn[1]:="ON";
+    WindOn[2]:="OFF";
+    TraceOn[0]:="Projectile Traces";
+    TraceOn[1]:="ON";
+    TraceOn[2]:="OFF";
+    SoundOn[0]:="Sound";
+    SoundOn[1]:="ON";
+    SoundOn[2]:="OFF";
+    Res[0]:="Screen Resolution";
+    Res[1]:="640 x 480";
+    Res[2]:="800 x 600";
+    Res[3]:="1024 x 768";
+    Play2[0]:="PLAYER 2";
+    Play2[1]:="HUMAN";
+    Play2[2]:="COMPUTER";
+    Play2[3]:="SUPER COMPUTER";
+    CreateMenu(M,1,items,8);
+    PositionMenu(M,intensewhite,blue,10,21,10,33);
+    CreateMenu(wind,1,WindOn,2);
+    PositionMenu(wind,intensewhite,blue,10,21,34,45);
+    CreateMenu(sound,1,SoundOn,2);
+    PositionMenu(sound,intensewhite,blue,10,21,34,45);
+    CreateMenu(trace,1,TraceOn,2);
+    PositionMenu(trace,intensewhite,blue,10,21,34,54);
+    CreateMenu(res,1,Res,3);
+    PositionMenu(res,intensewhite,blue,10,21,34,54);
+    CreateMenu(play,1,Play2,3);
+    PositionMenu(play,intensewhite,blue,10,21,34,54);
+
+    OpenWindow(w,intensewhite,blue,10,21,34,45,simpleframe,nodivider);
+    SetCursor(w,4,1);
+    FOR count:= 1 TO 3 DO
+        WriteString(w,"ON");
+        WriteLn(w);
+        END (*FOR*);
+    WriteString(w,Res[1]);
+    WriteLn(w);
+    WriteString(w,Play2[1]);
+    Init.Play:=TRUE;
+    REPEAT
+    MenuItem:=SelectFromMenu(M);
+    CASE MenuItem OF
+         1:       Help;
+         |
+         2:       SetCursor(w,4,1);
+                  EraseLine(w,0);
+                  IF SelectFromMenu(sound) = 2 THEN
+                     Init.Sound:=FALSE;
+                     WriteString(w,"OFF");
+                  ELSE Init.Sound:=TRUE;
+                     WriteString(w,"ON");
+                  END;
+         |
+         3:       SetCursor(w,5,1);
+                  EraseLine(w,0);
+                  IF SelectFromMenu(wind) = 2 THEN
+                     Init.Wind:=0.0;
+                     WriteString(w,"OFF");
+                  ELSE Init.Wind :=1.0;
+                     WriteString(w,"ON");
+                  END;
+         |
+         4:       SetCursor(w,6,1);
+                  EraseLine(w,0);
+                  IF SelectFromMenu(trace) = 2 THEN
+                     Init.Trace:=FALSE;
+                     WriteString(w,"OFF");
+                  ELSE Init.Trace:=TRUE;
+                     WriteString(w,"ON");
+                  END;
+         |
+         5:     SetCursor(w,7,1);
+                EraseLine(w,0);
+                select:=SelectFromMenu(res);
+                IF select= 1 THEN
+                   Init.ScreenRes:=1;
+                   WriteString(w,"640 x 480");
+                ELSIF select = 2 THEN
+                    Init.ScreenRes := 2;
+                    WriteString(w,"800 x 600");
+                ELSE Init.ScreenRes:=3;
+                     WriteString(w,"1024 x 768");
+                END;
+         |
+         6:     SetCursor(w,8,1);
+                EraseLine(w,0);
+                select:=SelectFromMenu(play);
+                IF select= 1 THEN
+                   Init.Player2:=human;
+                   WriteString(w,"HUMAN");
+                ELSIF select = 2 THEN
+                    Init.Player2 := DumbComp;
+                    WriteString(w,"COMPUTER");
+                ELSE Init.Player2:=SmartComp;
+                     WriteString(w,"SUPER COMP");
+                END;
+         |
+         8:       Init.Play := FALSE;
+         END;
+    UNTIL (MenuItem=7) OR (MenuItem = 8);
+      RETURN Init;
+    END BlastMenu;
+
+END Menu2.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/games/tank/tank.def b/examples/Modula-2_Libraries/PMOS/sources/games/tank/tank.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/games/tank/tank.def
@@ -0,0 +1,7 @@
+DEFINITION MODULE Tank;
+(*****************************************************************************)
+(**  Contains an array and procedure to plot a tank.                        **)
+(*****************************************************************************)
+FROM GWindows IMPORT Window;
+PROCEDURE MainTank(w:Window;x1,y1:INTEGER;colr:SHORTCARD);
+END Tank.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/games/tank/tank.mod b/examples/Modula-2_Libraries/PMOS/sources/games/tank/tank.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/games/tank/tank.mod
@@ -0,0 +1,47 @@
+IMPLEMENTATION MODULE Tank;
+(****************************************************************************
+** Contains an array describing each point to be plotted for a tank        **
+(*									*)
+(*	Last edited:	6 December 1993					*)
+(*									*)
+****************************************************************************)
+
+FROM Graphics IMPORT
+    (* type *)	ColourType;
+
+FROM GWindows IMPORT Window,PutPixel2C;
+
+TYPE a = ARRAY [1..640] OF SHORTCARD;
+
+CONST tanks = a (
+0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,0,1,1,1,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,
+0,0,0,0,0,1,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,
+0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,
+0,0,1,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,1,1,1,0,1,0,1,0,1,0,1,0,1,0,1,1,0,0,0,0,0,0,
+0,1,1,1,1,0,1,0,1,0,1,0,1,0,1,0,1,1,1,1,1,1,0,1,0,1,0,1,0,1,0,1,0,1,1,0,0,0,0,0,
+1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
+1,1,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,1,1,1,0,0,0,0,
+1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,0,0,0,0,
+0,0,1,1,1,1,0,1,1,1,1,0,1,1,1,1,0,1,1,1,1,0,1,1,1,1,0,1,1,1,1,0,1,0,1,0,0,0,0,0,
+0,0,1,1,1,0,0,0,1,1,0,0,0,1,1,0,0,0,1,1,0,0,0,1,1,0,0,0,1,1,0,0,0,1,0,0,0,0,0,0,
+0,0,0,1,1,1,0,1,1,1,1,0,1,1,1,1,0,1,1,1,1,0,1,1,1,1,0,1,1,1,1,0,1,0,0,0,0,0,0,0,
+0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0);
+
+VAR   x,y:INTEGER;
+
+PROCEDURE MainTank(w:Window;x1,y1:INTEGER;colr:SHORTCARD);
+BEGIN
+     FOR y:=0 TO 15 DO
+         FOR x:= 1 TO 40 DO
+
+            IF  tanks[INTEGER(REAL(y)*40.0+REAL(x))] = 1 THEN
+         PutPixel2C(w,x1+x,y1-y,VAL(ColourType,colr));
+         END (*IF*);
+         END (*FOR*);
+     END (*FOR*);
+END MainTank;
+END Tank.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/games/tank/tankhelp.def b/examples/Modula-2_Libraries/PMOS/sources/games/tank/tankhelp.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/games/tank/tankhelp.def
@@ -0,0 +1,7 @@
+DEFINITION MODULE TankHelp;
+(*****************************************************************************)
+(**   Procedure to print out help information.                              **)
+(*****************************************************************************)
+PROCEDURE Help;
+
+END TankHelp.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/games/tank/tankhelp.mod b/examples/Modula-2_Libraries/PMOS/sources/games/tank/tankhelp.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/games/tank/tankhelp.mod
@@ -0,0 +1,81 @@
+IMPLEMENTATION MODULE TankHelp;
+(*****************************************************************************)
+(**  Procedure to print out help messages                                   **)
+(*****************************************************************************)
+
+FROM Windows IMPORT Colour,Window,OpenWindow,FrameType,DividerType,CloseWindow,WriteString,
+             WriteLn,SetCursor,PressAnyKey;
+PROCEDURE Help;
+
+VAR w:Window;
+    c:CHAR;
+BEGIN
+
+    OpenWindow(w,green,black,0,24,0,79,doubleframe,nodivider);
+    WriteLn(w);
+    WriteString(w," HELP FOR TANKBLAST SVGA");
+    WriteLn(w);
+    WriteLn(w);
+    WriteString(w," Use the up and down arrow key to change velocity.");
+    WriteLn(w);
+    WriteString(w," Use the right and left arrow keys to change angle.");
+    WriteLn(w);
+    WriteString(w," Use the Ctrl key with the above keys to make small changes.");
+    WriteLn(w);
+    WriteString(w," Press the space bar or Enter to fire. ");
+    WriteLn(w);
+    WriteLn(w);
+    WriteString(w," Press 'w' or Alt key to change the weapon type. ");
+    WriteLn(w);
+    WriteString(w,"      MISSILES");
+    WriteString(w,              ":  Cause a small explosion. A direct hit will destroy a tank,          and a near hit will cause 20% dammage");
+    WriteLn(w);
+    WriteLn(w);
+    WriteString(w,"      SUPER MISSILES");
+    WriteString(w,                    ":   Cause a large explosion, a direct hit will destroy a         tank, and a near hit will cause 40% dammage.");
+    WriteLn(w);
+    WriteLn(w);
+    WriteString(w,"      Vertical guidance");
+    WriteString(w,                       ":   When directly above a tank, and within a certain          height above the tank, will drop down destroying tank.  The closer            together the two tanks, the smaller the heigt must be.");
+    WriteLn(w);
+    WriteLn(w);
+    WriteString(w,"      Dirt blaster");
+    WriteString(w,                  ":   Will cause a small explosion, and remove dirt without          causing any damage to tanks.");
+    WriteLn(w);
+
+    PressAnyKey(w);
+    CloseWindow(w);
+    OpenWindow(w,green,black,0,24,0,79,doubleframe,nodivider);
+
+    WriteLn(w);
+    WriteString(w," PLAYER 2 OPTIONS:");
+    WriteLn(w);
+    WriteLn(w);
+    WriteString(w,"     HUMAN: 2 player game.");
+    WriteLn(w);
+    WriteLn(w);
+    WriteString(w,"     COMPUTER: Tank 2 is controlled by a computer that will increase power          if the last projectile fell short of its target and will decrease power        otherwise.  It does not take into acount the wind or any other factors.");
+    WriteLn(w);
+    WriteLn(w);
+    WriteString(w,"     SUPER COMPUTR:  Tank 2 is controlled by a 'smarter' computer.  It takes        into account wind, distance and hieght between tanks and if there is a         mountain in between the tanks. ");
+    WriteLn(w);
+
+    PressAnyKey(w);
+    CloseWindow(w);
+    OpenWindow(w,red,black,0,24,0,79,doubleframe,nodivider);
+
+    WriteLn(w);
+    WriteString(w," PROBLEMS WITH THE PROGRAM");
+    WriteLn(w);
+    WriteString(w," The main problem is that for some reason the keys 'lock up' occasionaly.");
+    WriteLn(w);
+    WriteString(w," This can be fixed by pressing the control key or the arrow keys until normal     control is gained again.");
+    WriteLn(w);
+    WriteString(w," Sometimes during an explosion a variable goes out of range. This causes the       program to crash.");
+    WriteLn(w);
+
+    PressAnyKey(w);
+    CloseWindow(w);
+    END Help;
+
+END TankHelp.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/DEMO.DEF b/examples/Modula-2_Libraries/PMOS/sources/general/DEMO.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/DEMO.DEF
@@ -0,0 +1,6 @@
+DEFINITION MODULE demo;
+
+PROCEDURE func;
+
+END demo.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/DEMO2.DEF b/examples/Modula-2_Libraries/PMOS/sources/general/DEMO2.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/DEMO2.DEF
@@ -0,0 +1,6 @@
+DEFINITION MODULE Demo2;
+
+PROCEDURE P(v: CARDINAL): CARDINAL;
+
+END Demo2.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/IKS.DEF b/examples/Modula-2_Libraries/PMOS/sources/general/IKS.DEF
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/IKS.DEF
@@ -0,0 +1,130 @@
+DEFINITION MODULE IKS;
+
+(*# save, call(c_conv => off) *)
+
+        (****************************************************************)
+        (*                                                              *)
+        (*      This is a stripped-down version of the module           *)
+        (*      called InnerKernel, with support for interrupt          *)
+        (*      tasks removed.                                          *)
+        (*                                                              *)
+        (*      By removing the interrupt support, we achieve a         *)
+        (*      large reduction in code complexity.  Note that          *)
+        (*      interrupt handlers can still be written and used,       *)
+        (*      but since the kernel does not know about them           *)
+        (*      they have to be implemented as procedures rather        *)
+        (*      than as tasks.                                          *)
+        (*                                                              *)
+        (*      For the sake of additional readibility, we assume       *)
+        (*      that we are using the TopSpeed Extra Large memory       *)
+        (*      model: multiple code segments, multiple data            *)
+        (*      segments, and separate stack segments.  (That is,       *)
+        (*      all intermodule pointers are long.)  This allows us     *)
+        (*      to delete some of the conditional compilation.          *)
+        (*                                                              *)
+        (*      Note the extensive use of compiler pragmas to specify   *)
+        (*      which registers parameters are passed in.               *)
+        (*                                                              *)
+        (*      Programmer:     P. Moylan                               *)
+        (*      Last edited:    1 April 2004                            *)
+        (*      Status:         OK                                      *)
+        (*                                                              *)
+        (****************************************************************)
+
+FROM Types IMPORT
+    (* type *)  FarPointer;
+
+TYPE
+    (*<TopSpeed3*) Code3 = ARRAY [0..2] OF SHORTCARD; (*>*)
+    TaskSelector = FarPointer;
+    FloatSaveSelector = CARDINAL;
+
+(************************************************************************)
+
+(*# call(reg_saved => (bx,cx,dx,si,di,ds,es,st1,st2)) *)
+
+PROCEDURE EnterKernel (): CARDINAL;
+
+    (* Saves the processor flags word, including the current "interrupt *)
+    (* enable" status, and returns with interrupts disabled.            *)
+    (* NOTE: this procedure and the following one should be used as a   *)
+    (* matched pair.                                                    *)
+
+(*# call(reg_param => (ax), reg_saved => (ax,bx,cx,dx,si,di,ds,es,st1,st2)) *)
+
+PROCEDURE LeaveKernel (PSW: CARDINAL);
+
+    (* Restores the processor flags word, including the "interrupt      *)
+    (* enable" status.  NOTE: this procedure and the one above should   *)
+    (* be used as a matched pair.                                       *)
+
+(*# call(reg_return => (bx,es), reg_saved => (dx,si,di,ds,st1,st2)) *)
+(*# call(reg_param => (ax,bx,cx,dx)) *)
+
+PROCEDURE TaskInit (StackBase: ADDRESS;  StackSize: CARDINAL;
+                        EnableInterrupts: BOOLEAN;
+                        TaskExit, StartAddress: PROC): TaskSelector;
+
+    (* Initialises the stack for a new task.  Parameter StackBase       *)
+    (* points to a block of memory which can be used to hold the stack  *)
+    (* (note that this is a pointer to the start of the memory block,   *)
+    (* not to the bottom of the stack); and StackSize is the size of    *)
+    (* this block.  The next parameter specifies whether processor      *)
+    (* interrupts should be enabled when the task is started.           *)
+    (* StartAddress and TaskExit are the start address of the task code *)
+    (* and the start address of the code to execute when the task       *)
+    (* terminates.  The value returned is a selector for the new task.  *)
+
+(*# call(reg_saved => (ax,cx,dx,si,di,ds,st1,st2)) *)
+
+PROCEDURE InitMainTask (): TaskSelector;
+
+    (* Like TaskInit, but for the special case of the original task     *)
+    (* which is running at program startup.  The function of this       *)
+    (* procedure is simply to ensure that the main stack layout is      *)
+    (* consistent with what we do for all other tasks.                  *)
+
+(*# call(reg_saved => (ax,bx,cx,dx,si,di,ds,es,st1,st2)) *)
+(*# call(reg_param => (si, ds, ax, bx)) *)
+
+PROCEDURE Transfer (VAR (*OUT*) source: TaskSelector;
+                                        destination: TaskSelector);
+
+    (* Performs a task switch to the destination task, at the same time *)
+    (* saving a selector for the outgoing task in variable "source".    *)
+    (* This allows a subsequent call to Transfer to resume the          *)
+    (* original task.  By the time this procedure has returned to the   *)
+    (* caller, then, we are again executing the calling task.           *)
+
+(*# call(reg_param => (ax,bx), reg_return => (bx)) *)
+
+PROCEDURE MakeFloatSaveSelector (selector: TaskSelector): FloatSaveSelector;
+
+    (* Creates the special form of selector which must subsequently be  *)
+    (* used in calls to save and restore the floating point state.      *)
+    (* The parameter supplied must be the value of the task selector    *)
+    (* as created by TaskInit.                                          *)
+
+PROCEDURE NPXsave (selector: FloatSaveSelector);
+
+    (* Saves the state of the Numeric Processor Extension coprocessor.  *)
+
+PROCEDURE NPXrestore (selector: FloatSaveSelector);
+
+    (* The operation complementary to NewNPXsave.  Restores the         *)
+    (* previously saved state of the floating point coprocessor.        *)
+
+(*# restore *)
+
+PROCEDURE PrepareForShutdown;
+
+    (* This procedure is needed just before executing the "exit from    *)
+    (* program" operation, and is provided to get around a problem      *)
+    (* with some memory models in TopSpeed version 3.  (With other      *)
+    (* compilers, this can afford to be a dummy procedure.)             *)
+    (* A (deliberate) side-effect of calling this procedure is that     *)
+    (* the stack is corrupted, so do NOT call it except as the final    *)
+    (* step of termination processing.                                  *)
+
+END IKS.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/analogue.def b/examples/Modula-2_Libraries/PMOS/sources/general/analogue.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/analogue.def
@@ -0,0 +1,159 @@
+DEFINITION MODULE AnalogueIO;
+
+	(********************************************************)
+	(*							*)
+	(*		Analogue Input and Output.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	13 February 1991		*)
+	(*  Status:		Working, more tests desirable.	*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(*									*)
+(* This module supports the RTI-800/815 Multifunction Input/Output	*)
+(* Board.  (RTI is a trademark of Analog Devices).  The board has one	*)
+(* 8-bit digital output port, one 8-bit digital input port, and between	*)
+(* 8 and 32 channels (depending on hardware options) of analogue input.	*)
+(* The RTI-815 version has also two channels of analogue output.  The	*)
+(* A/D and D/A converters are 12-bit devices.				*)
+(*									*)
+(* Details such as whether the analogue signals are unipolar or bipolar	*)
+(* are controlled by hardware jumpers, and not by software, except for	*)
+(* a choice of a 1/10/100/500 gain on analogue input.  It is the user's	*)
+(* responsibility to know what this means in terms of actual voltages;	*)
+(* the software has no way of knowing which hardware options have been	*)
+(* selected.								*)
+(*									*)
+(* The board also contains an AM9513A Counter/Timer chip (a product of	*)
+(* Advanced Micro Devices Inc.) which supplies 5 16-bit counters along	*)
+(* with the support logic to use them in many different ways for	*)
+(* various counting and timing applications.  This module reserves the	*)
+(* use of counters 4 and 5 for its own internal purposes, as a timing	*)
+(* source to control the A/D sampling rate.  (The output of timer 5 is	*)
+(* connected, on the RTI-800/815 board, to the gate input of timer 4,	*)
+(* and the output of timer 4 triggers an A/D conversion).  The first	*)
+(* three timers are not used by this module, and are free to be used	*)
+(* for any other purpose which does not interfere with timers 4 and 5.	*)
+(* (NOTE: the first three timers are called timers 1-3 in the AM9513A	*)
+(* data sheets, but are called timers 0-2 in the RTI-800/815 manual).	*)
+(* Because of the great variety of operating options for the timers,	*)
+(* and the impossibility of predicting what the user will want to do	*)
+(* with them, this module does not attempt to provide any support	*)
+(* software for using timers 1-3.					*)
+(*									*)
+(************************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE, WORD;
+
+TYPE
+    GainCode = [0..3];
+
+    (* The gain code for the A/D converter has the interpretation:	*)
+    (*		0	gain=1		range  -10 V to   +10 V		*)
+    (*		1	gain=10		range   -1 V  to   +1 V		*)
+    (*		2	gain=100	range -100 mV to +100 mV	*)
+    (*		3	gain=500	range  -20 mV to  +20 mV	*)
+    (* The ranges are those applicable when the board is jumpered for	*)
+    (* 10V bipolar operation.  The modifications for the unipolar and	*)
+    (* 5V bipolar cases should be obvious.				*)
+
+    OutputChannelNumber = [0..1];
+    InputChannelNumber = [0..31];
+
+(************************************************************************)
+(*				DIGITAL I/O				*)
+(************************************************************************)
+
+PROCEDURE DigitalOut (value: BYTE);
+
+    (* Sends the given value to the digital output port of the board.	*)
+
+PROCEDURE DigitalInput (): BYTE;
+
+    (* Reads the digital input port of the board.	*)
+
+(************************************************************************)
+(*		      ANALOGUE OUTPUT (RTI-815 ONLY)			*)
+(************************************************************************)
+
+PROCEDURE AnalogueOut (channel: OutputChannelNumber;  value: WORD);
+
+    (* Analogue output.  The channel number should be 0 or 1.  Only the	*)
+    (* least significant 12 bits of the value are used.  The value can	*)
+    (* be treated as either a signed or an unsigned 12-bit number,	*)
+    (* depending on hardware jumper selections.				*)
+
+(************************************************************************)
+(*		      ANALOGUE INPUT - SINGLE SAMPLE			*)
+(************************************************************************)
+
+PROCEDURE AnalogueInput (channel: InputChannelNumber; gain: GainCode): WORD;
+
+    (* Analogue input.  The value returned can be a signed or unsigned	*)
+    (* number, depending on jumper selections on the board.		*)
+    (* This procedure picks up a single sample when called.  It does	*)
+    (* not use interrupts or DMA.  It is recommended for use only in	*)
+    (* those cases (e.g. isolated sample, or aperiodic sampling) where	*)
+    (* the caller takes responsibility for timing.  More commonly, the	*)
+    (* procedures in the following section will be more appropriate.	*)
+    (* This procedure should NOT be called when periodic sampling has	*)
+    (* been activated; the results would be unpredictable.		*)
+
+(************************************************************************)
+(*		    ANALOGUE INPUT - PERIODIC SAMPLING			*)
+(************************************************************************)
+
+PROCEDURE StartPeriodicSampling (first, last: InputChannelNumber;
+					SamplingInterval: LONGCARD;
+					AmplifierGain: GainCode;
+					VAR (*OUT*) Buffer: ARRAY OF BYTE);
+
+    (* Initiates a mode of operation in which channels first..last,	*)
+    (* inclusive, will be sampled every SamplingInterval microseconds,	*)
+    (* with the results stored in array Buffer.  At each sampling time,	*)
+    (* the specified channels are read as nearly simultaneously as the	*)
+    (* hardware will allow.  Procedure WaitForNextSample, below, should	*)
+    (* be called to check when the data are available in array Buffer.	*)
+    (* If WaitForNextSample is not called often enough, there can be a	*)
+    (* data overrun in which data are overwritten.  We do not signal	*)
+    (* this as an error since the only thing which can be done about it	*)
+    (* is to use the new data and ignore whatever data have been lost.	*)
+
+    (* WARNING: Although the sampling interval is specified in		*)
+    (* microseconds, to allow fine tuning of the interval if desired,	*)
+    (* it is in general impractical to specify an interval shorter than	*)
+    (* about one or two milliseconds, because of software overheads.	*)
+    (* The precise limit depends on how much computation is done per	*)
+    (* sample, what other high-priority tasks are in the system, and so	*)
+    (* on.  It is advisable to test the system for evidence of data	*)
+    (* overrun, for example by looking at analogue inputs and outputs	*)
+    (* with a CRO, and to increase the sampling interval if there	*)
+    (* appear to be problems.						*)
+
+PROCEDURE WaitForNextSample;
+
+    (* Pauses until the buffer specified in the preceding procedure has	*)
+    (* been filled with valid data.  Notice that this is essentially a	*)
+    (* synchronization procedure; the caller does not have to do any	*)
+    (* timing operations since a return from this procedure implies	*)
+    (* that the next sample time has arrived.				*)
+    (* WARNINGS:							*)
+    (*  1. This procedure should not be called unless periodic sampling	*)
+    (*     is currently in effect.  Otherwise, it might never return.	*)
+    (*  2. Periodic sampling implies that the data buffer is re-filled	*)
+    (*	   regularly, regardless of whether the user code has finished	*)
+    (*	   with the previous data.  There are no interlocks, and no	*)
+    (*	   protection against data being updated just as one is reading	*)
+    (*	   it.  (Any such protection could interfere with the precision	*)
+    (*	   of the timing of sampling external data).  The caller is	*)
+    (*	   advised to move data out of the buffer promptly, especially	*)
+    (*	   when the sampling rate is high.				*)
+
+PROCEDURE StopPeriodicSampling;
+
+    (* Turns off the periodic sampling mode of A/D conversion.	*)
+
+END AnalogueIO.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/analogue.mod b/examples/Modula-2_Libraries/PMOS/sources/general/analogue.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/analogue.mod
@@ -0,0 +1,673 @@
+IMPLEMENTATION MODULE AnalogueIO;
+
+	(********************************************************)
+	(*							*)
+	(*		Analogue Input and Output.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	24 August 1993			*)
+	(*  Status:						*)
+	(*	Polling method is working.			*)
+	(*	DMA method fails, reason not yet known.		*)
+	(*							*)
+	(********************************************************)
+
+FROM Windows IMPORT	(* for testing *)
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, WriteString, WriteLn;
+
+FROM NumericIO IMPORT	(* for testing *)
+    (* proc *)	WriteHexByte, WriteCard, WriteLongCard;
+
+FROM SYSTEM IMPORT
+    (* type *)	ADDRESS,
+    (* proc *)	ADR;
+
+FROM LowLevel IMPORT
+    (* proc *)	OutByte, InByte,
+		LowByte, HighByte, MakeWord,
+		LS, IANDB, AddOffset;
+
+FROM DMA IMPORT
+    (* proc *)	LoadDMAparameters;
+
+FROM TaskControl IMPORT
+    (* proc *)	WaitForInterrupt, CreateInterruptTask;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, DestroySemaphore, Wait, Signal;
+
+(************************************************************************)
+
+CONST testing = FALSE;
+
+VAR debug: Window;	(* for testing *)
+
+CONST
+
+    (* IOBase is the starting port number for the I/O board.  The	*)
+    (* value is jumper selectable.  The factory setting is 300H.	*)
+
+    IOBase = 300H;
+
+    (* The interrupt number is jumper selectable, with IRQ2 as the	*)
+    (* factory setting.  The interrupt controller normally maps IRQ2 to	*)
+    (* processor interrupt number 10.  The PC/AT is different: IRQ2 is	*)
+    (* reserved as the slave request from interrupt controller 2, so	*)
+    (* the request line which would have been IRQ2 becomes IRQ9, which	*)
+    (* is the second request line of interrupt controller 2 and which	*)
+    (* the interrupt controller maps to processor interrupt number 113	*)
+    (* (=71H).  (Confused yet?  It get worse.)  But then the BIOS maps	*)
+    (* interrupt 113 back to processor interrupt number 10.  Where does	*)
+    (* this leave us?   If we don't mind the slight overhead caused by	*)
+    (* this software mapping, we can just use interrupt number 10 and	*)
+    (* keep compatibility across computer models.  That's what this	*)
+    (* version of this module does.  If, on the other hand, the		*)
+    (* sampling rate is so high that that overhead is intolerable, then	*)
+    (* we would have to deal with the slave interrupt controller.	*)
+
+    InterruptNumber = 10;
+
+    (* The I/O board has 14 addressable ports, of which the last two	*)
+    (* belong to the on-board counter/timer chip.			*)
+
+    CounterDataPort = IOBase+12;
+    CounterControlPort = CounterDataPort+1;
+
+    (* Each of the five counters has a Counter Mode Register.  The bits	*)
+    (* in this register govern the following options:			*)
+    (*	bits 15-13	gating control (000=no gating)			*)
+    (*	bit     12	1 = count on falling clock edge			*)
+    (*	bits  11-8	counter source selection			*)
+    (*	bits   7-5	counter mode					*)
+    (*	bit	 4	0 = binary count, 1 = BCD count			*)
+    (*	bit	 3	0 = count down, 1 = count up			*)
+    (*	bits   2-0	output control					*)
+    (* The following mnemonics define options which we want to use.	*)
+    (* For brevity, the options we never use are omitted.		*)
+
+    ActiveHighGate = 8000H;
+    F1source = 0B00H;
+    ModeQ = 0A0H;
+    ModeJ = 60H;
+    ModeD = 20H;
+    ToggledOutput = 2;
+    PulseOutput = 1;
+
+    (* Some useful commands to the counter/timer chip.	*)
+
+    Select4 = 8;
+    Select5 = 16;
+ 
+    LoadDataPointerRegister = 0;
+    LoadAllCounters = 5FH;
+    LoadAndArm = 060H;
+    Disarm = 0C0H;
+    EnableDataPointerSequencing = 0E0H;
+    ClearToggle = 0E0H;
+    ResetCounters = 0FFH;
+
+    (* Definitions for the DMA controller. *)
+
+    DMAchannel = 1;
+    DMAReadCode = 1;
+
+(************************************************************************)
+
+TYPE
+    SamplingMethod = (DMA, Polling);
+
+VAR
+    (* The following record keeps track of information needed during	*)
+    (* periodic sampling, to save the caller the bother of repeating	*)
+    (* the information at every sample time.				*)
+
+    SamplingInfo:   RECORD
+			method: SamplingMethod;
+			ChannelSelectByte: BYTE;
+			BufferAddress: ADDRESS;
+			ByteCount: CARDINAL;
+		    END (*RECORD*);
+
+    (* The semaphore called tick is used only when analogue input is	*)
+    (* being collected in the periodic sampling mode.			*)
+
+    tick: Semaphore;
+
+(************************************************************************)
+(*				DIGITAL I/O				*)
+(************************************************************************)
+
+PROCEDURE DigitalOut (value: BYTE);
+
+    (* Sends the given value to the digital output port of the board.	*)
+
+    BEGIN
+	OutByte (IOBase+11, value);
+    END DigitalOut;
+
+(************************************************************************)
+
+PROCEDURE DigitalInput (): BYTE;
+
+    (* Reads the digital input port of the board.	*)
+
+    BEGIN
+	RETURN InByte (IOBase+10);
+    END DigitalInput;
+
+(************************************************************************)
+(*		      ANALOGUE OUTPUT (RTI-815 ONLY)			*)
+(************************************************************************)
+
+PROCEDURE AnalogueOut (channel: OutputChannelNumber;  value: WORD);
+
+    (* Analogue output.  The channel number should be 0 or 1.  Only the	*)
+    (* least significant 12 bits of the value are used.  The value can	*)
+    (* be treated as either a signed or an unsigned 12-bit number,	*)
+    (* depending on hardware jumper selections.				*)
+
+    BEGIN
+	OutByte (IOBase+5+2*channel, LowByte(value));
+	OutByte (IOBase+5+2*channel+1, HighByte(value));
+    END AnalogueOut;
+
+(************************************************************************)
+(*		      ANALOGUE INPUT - SINGLE SAMPLE			*)
+(************************************************************************)
+
+PROCEDURE AnalogueInput (channel: InputChannelNumber; gain: GainCode): WORD;
+
+    (* Analogue input.  The value returned can be a signed or unsigned	*)
+    (* number, depending on jumper selections on the board.		*)
+    (* This procedure picks up a single sample when called.  It does	*)
+    (* not use interrupts or DMA.  It is recommended for use only in	*)
+    (* those cases (e.g. isolated sample, or aperiodic sampling) where	*)
+    (* the caller takes responsibility for timing.  More commonly, the	*)
+    (* periodic sampling procedures, given later, will be more		*)
+    (* appropriate.  This procedure should NOT be called when periodic	*)
+    (* sampling has been activated; the results would be unpredictable.	*)
+
+    BEGIN
+	(* Put the A/D converter into non-interrupt, non-DMA mode, and	*)
+	(* clear any flags which might be outstanding.			*)
+
+	OutByte (IOBase, 0);		(* status/control port *)
+	OutByte (IOBase+9, 0);		(* "flags clear" port *)
+
+	(* Start the conversion.  (Function LS is a left shift).	*)
+
+	OutByte (IOBase+1, BYTE(channel + ORD(LS(gain, 5))));
+	OutByte (IOBase+2, 0);		(* "start conversion" port *)
+
+	(* Wait for conversion complete.  The conversion time is in the	*)
+	(* range 8-35 microseconds, depending on things like hardware	*)
+	(* options selected, so there's not enough time to make a task	*)
+	(* switch worthwhile.  This is why this procedure does not use	*)
+	(* an interrupt to sense completion.				*)
+
+	WHILE ORD(IANDB (InByte(IOBase),60H)) = 0 DO
+	    (* busy wait, until either the DONE or	*)
+	    (* OVERRUN ERROR flag is set.		*)
+	END (*WHILE *);
+
+	(* Return the value.  Note that we don't bother telling the	*)
+	(* caller about an overrun error, since that is normally caused	*)
+	(* by trying to drive the A/D converter too fast, and overheads	*)
+	(* like procedure entry time make that impossible with this	*)
+	(* procedure.							*)
+
+	RETURN MakeWord (InByte(IOBase+4),InByte(IOBase+3));
+
+    END AnalogueInput;
+
+(************************************************************************)
+(*		    ANALOGUE INPUT - PERIODIC SAMPLING			*)
+(************************************************************************)
+
+PROCEDURE DumpCounter (w: Window;  counter: SHORTCARD);
+
+    (* For testing: dumps the mode, load, and hold registers of the	*)
+    (* given counter.							*)
+
+    BEGIN
+
+	OutByte (CounterControlPort, EnableDataPointerSequencing);
+	OutByte (CounterControlPort, LoadDataPointerRegister + counter);
+
+	WriteHexByte (w, InByte (CounterDataPort));
+	WriteString (w, "  ");
+	WriteHexByte (w, InByte (CounterDataPort));
+	WriteString (w, "  ");
+	WriteHexByte (w, InByte (CounterDataPort));
+	WriteString (w, "  ");
+	WriteHexByte (w, InByte (CounterDataPort));
+	WriteString (w, "  ");
+	WriteHexByte (w, InByte (CounterDataPort));
+	WriteString (w, "  ");
+	WriteHexByte (w, InByte (CounterDataPort));
+	WriteLn (w);
+
+    END DumpCounter;
+
+(************************************************************************)
+
+PROCEDURE LoadCounter (counter: SHORTCARD;
+			mode, loadvalue, holdvalue: CARDINAL);
+
+    (* Sets the mode, and the values for the Load and Hold Registers,	*)
+    (* for the specified counter.  This does not arm the counter - it	*)
+    (* just sets initial register values.  (Note that the Hold Register	*)
+    (* contents are irrelevant for many modes; but we specify the value	*)
+    (* anyway, in order to have a uniform calling sequence in all cases.*)
+
+    BEGIN
+
+	(* Internal registers of the counter/timer chip are addressed	*)
+	(* by sending a command to load the internal data pointer	*)
+	(* register, which then sequences through the internal register	*)
+	(* file as we send successive bytes to the data port.		*)
+
+	OutByte (CounterControlPort, EnableDataPointerSequencing);
+	OutByte (CounterControlPort, LoadDataPointerRegister + counter);
+
+	OutByte (CounterDataPort, LowByte(mode));
+	OutByte (CounterDataPort, HighByte(mode));
+	OutByte (CounterDataPort, LowByte(loadvalue));
+	OutByte (CounterDataPort, HighByte(loadvalue));
+	OutByte (CounterDataPort, LowByte(holdvalue));
+	OutByte (CounterDataPort, HighByte(holdvalue));
+
+    END LoadCounter;
+
+(************************************************************************)
+
+PROCEDURE PollingMethod (SamplingInterval: LONGCARD);
+
+    (* Sets up periodic sampling by using counter number 4 to trigger	*)
+    (* an A/D conversion at the end of each sampling interval, and	*)
+    (* cause an interrupt on the "conversion complete" condition.  If	*)
+    (* only a single channel is being sampled, then the interrupt task	*)
+    (* can finish the job by reading the converted value.  For multi-	*)
+    (* channel sampling, the interrupt task can use a polling method to	*)
+    (* read the remaining channels.  This approach is suitable for the	*)
+    (* case where the sampling interval is long, or where there is only	*)
+    (* one channel being sampled.  In the multi-channel case, we have	*)
+    (* some processor overhead caused by busy waits in the interrupt	*)
+    (* task, but this is not too serious because we only use this	*)
+    (* method when we are sampling infrequently.			*)
+
+    VAR clock: CARDINAL;  timer4count: LONGCARD;
+
+    BEGIN
+
+	SamplingInfo.method := Polling;
+
+	(* The count for timer 4 is the sampling interval divided by	*)
+	(* the clock frequency.  We have a choice of five clock		*)
+	(* frequencies, namely F1=1MHz, F2=F1/16, F3=F2/16, etc.  The	*)
+	(* choice of which of these to use is dictated by the fact that	*)
+	(* the count must fit into 16 bits.  The clock is specified in	*)
+	(* bits 11-8 of the counter mode register as 1011 for F1, 1100	*)
+	(* for F2, 1101 for F3, etc.					*)
+
+	clock := 11;  timer4count := SamplingInterval;
+	IF testing THEN
+	    WriteString (debug, "clock, count = ");
+	    WriteCard (debug, clock);  WriteLongCard (debug, timer4count);
+	    WriteLn (debug);
+	END (*IF*);
+	WHILE timer4count > 65535 DO
+	    INC (clock);  timer4count := timer4count DIV 16;
+	    IF testing THEN
+		WriteString (debug, "clock, count = ");
+		WriteCard (debug, clock);  WriteLongCard (debug, timer4count);
+		WriteLn (debug);
+	    END (*IF*);
+	END (*WHILE*);
+
+	(* Use mode D for timer 4.  This is a straightforward "rate	*)
+	(* generator" mode, with no gating.				*)
+
+	LoadCounter (4, ORD(LS(clock, 8)) + ModeD + PulseOutput,
+						CARDINAL(timer4count), 0);
+
+	(* Initialise the A/D converter by clearing any flags which	*)
+	(* might be outstanding, specifying the gain and starting	*)
+	(* channel number, and enabling interrupts on end of conversion	*)
+	(* or overrun.							*)
+
+	OutByte (IOBase+1, SamplingInfo.ChannelSelectByte);
+	OutByte (IOBase+9, 0);			(* "flags clear" port *)
+	OutByte (IOBase, 3);			(* enable interrupts  *)
+
+	(* Load and arm counter 4.  This will start the periodic	*)
+	(* sampling operation.						*)
+
+	OutByte (CounterControlPort, LoadAndArm + Select4);
+
+    END PollingMethod;
+
+(************************************************************************)
+
+PROCEDURE DMAMethod (NumberOfChannels, SamplingInterval: CARDINAL;
+					AmplifierGain: GainCode);
+
+    (* Sets up periodic sampling by using counter 4 to trigger the A/D	*)
+    (* converter as fast as possible, once for each channel to be	*)
+    (* sampled, using DMA to put the results into main memory.  Counter	*)
+    (* number 5 is used as a gating source for counter number 4; the	*)
+    (* width of the gating pulse controls the number of channels to be	*)
+    (* sampled, and the time between gating pulses controls the		*)
+    (* sampling interval.  This method can be used only when the	*)
+    (* sampling interval is less than 65536 microseconds, because	*)
+    (* counter 5 is 16 bits wide and will be driven from a 1 MHz clock.	*)
+    (* (We could, with some ingenuity, relax this limit by using a	*)
+    (* lower clock frequency, but then we would lose fine control of	*)
+    (* the width of the gating pulse, possibly to the point where we	*)
+    (* could not correctly control the number of channels to sample.	*)
+    (* One way to solve this problem would be to sample more channels	*)
+    (* than are actually required, but this would give extra software	*)
+    (* complexity, and it is not certain that this is justified).	*)
+    (* Remark: there are hardwired connections from the output of	*)
+    (* counter 5 to the gate of counter 4, from the output of counter 4	*)
+    (* to the A/D converter, and from the output of counter 4 to timer	*)
+    (* source number 5.  The first two connections are useful to us,	*)
+    (* the last is not; but this is not a limitation since we can	*)
+    (* program the counters to ignore the "source" inputs and instead	*)
+    (* take their inputs from a 1MHz crystal oscillator called F1.	*)
+
+    VAR timer4count, GateWidth: CARDINAL;
+
+    BEGIN
+
+	SamplingInfo.method := DMA;
+
+	(* First, calculate a count for timer 4 which will produce a	*)
+	(* train of pulses at a suitable rate, taking into account the	*)
+	(* time needed for an A/D conversion.				*)
+	(* The A/D conversion time is 25 microseconds, but for high	*)
+	(* gains in the input amplifier this must be increased to allow	*)
+	(* for a settling time in the amplifier.			*)
+	(* For future thought: the hardware seems to include an option	*)
+	(* which would allow us to trim this time down, but it's not	*)
+	(* quite clear just how fast we can go.				*)
+
+	IF AmplifierGain = 3 THEN
+	    timer4count := 80;
+	ELSIF AmplifierGain = 2 THEN
+	    timer4count := 40;
+	ELSE
+	    timer4count := 25;
+	END (*IF*);
+
+	GateWidth := NumberOfChannels*timer4count;
+
+	(* Use mode Q for timer 4.  In this mode, the counter does not	*)
+	(* count while the gate is low.  The first clock input after	*)
+	(* the gate goes high loads the counter from its load register,	*)
+	(* and counting starts on the second clock input.  When the	*)
+	(* count hits zero, the A/D converter is triggered, and the	*)
+	(* counter is reloaded from its load register so that counting	*)
+	(* starts again.  This happens repeatedly until the gate goes	*)
+	(* low again.							*)
+
+	LoadCounter (4, ActiveHighGate + F1source + ModeQ + PulseOutput,
+							timer4count, 0);
+
+	(* Use mode J for timer 5.  This makes the counter a free-	*)
+	(* running oscillator where the count is reloaded each time it	*)
+	(* gets to zero, alternately reloading from the Load and Hold	*)
+	(* registers.  (The Load Register is the one which is used when	*)
+	(* we initially load and arm the counter.)			*)
+
+	LoadCounter (5, F1source + ModeJ + ToggledOutput,
+			SamplingInterval - GateWidth, GateWidth);
+
+	(* Set the initial output of counter 5 low.  This operation is	*)
+	(* necessary because counter 5 has a toggled output (unlike	*)
+	(* counter 4, which only puts out a pulse each time its count	*)
+	(* goes to zero), so we must explicitly specify its initial	*)
+	(* condition.							*)
+
+	OutByte (CounterControlPort, ClearToggle + 5);
+
+	(* Arm the A/D converter and the DMA controller.  The A/D	*)
+	(* conversions will not start, however, until triggered by the	*)
+	(* first pulse from timer 4.					*)
+
+	WITH SamplingInfo DO
+	    LoadDMAparameters (DMAchannel, DMAReadCode,
+					BufferAddress, ByteCount);
+	    OutByte (IOBase+1, ChannelSelectByte);
+	END (*WITH*);
+
+	(* Enable DMA mode, with interrupt on DMA completion.	*)
+
+	OutByte (IOBase, 0CH);
+
+	(* Load and arm both counters.  This will start the cycle.	*)
+
+	OutByte (CounterControlPort, LoadAndArm + Select4 + Select5);
+
+    END DMAMethod;
+
+(************************************************************************)
+
+PROCEDURE StartPeriodicSampling (first, last: InputChannelNumber;
+					SamplingInterval: LONGCARD;
+					AmplifierGain: GainCode;
+					VAR (*OUT*) Buffer: ARRAY OF BYTE);
+
+    (* Initiates a mode of operation in which channels first..last,	*)
+    (* inclusive, will be sampled every SamplingInterval microseconds,	*)
+    (* with the results stored in array Buffer.  At each sampling time,	*)
+    (* the specified channels are read as nearly simultaneously as the	*)
+    (* hardware will allow.  Procedure WaitForNextSample, below, should	*)
+    (* be called to check when the data are available in array Buffer.	*)
+    (* If WaitForNextSample is not called often enough, there can be a	*)
+    (* data overrun in which data are overwritten.  We do not signal	*)
+    (* this as an error since the only thing which can be done about it	*)
+    (* is to use the new data and ignore whatever data have been lost.	*)
+
+    BEGIN
+	WITH SamplingInfo DO
+	    ChannelSelectByte := BYTE (first + ORD(LS(AmplifierGain, 5)));
+	    IF last <> first THEN
+		(* Specify that the channel number will auto-increment *)
+		INC (ChannelSelectByte, 80H);
+	    END (*IF*);
+	    BufferAddress := ADR (Buffer);
+	    ByteCount := 2*(last-first+1);
+	END (*WITH*);
+	CreateSemaphore (tick, 0);
+
+	(* Temporary patch: since the DMA method seems to have a bug in	*)
+	(* it (reason so far unknown), use the polling method always.	*)
+
+	PollingMethod (SamplingInterval);
+(*
+	IF (first=last) OR (SamplingInterval>65535) THEN
+	    PollingMethod (SamplingInterval)
+	ELSE
+	    DMAMethod (last-first+1,SHORT(SamplingInterval),AmplifierGain);
+	END (*IF*);
+*)
+	IF testing THEN
+	    DumpCounter (debug, 4);
+	    DumpCounter (debug, 5);
+	END (*IF*);
+
+    END StartPeriodicSampling;
+
+(************************************************************************)
+
+PROCEDURE WaitForNextSample;
+
+    (* Pauses until the buffer specified in the preceding procedure has	*)
+    (* been filled with valid data.  Notice that this is essentially a	*)
+    (* synchronization procedure; the caller does not have to do any	*)
+    (* timing operations since a return from this procedure implies	*)
+    (* that the next sample time has arrived.				*)
+    (* WARNINGS:							*)
+    (*  1. This procedure should not be called unless periodic sampling	*)
+    (*     is currently in effect.  Otherwise, it might never return.	*)
+    (*  2. Periodic sampling implies that the data buffer is re-filled	*)
+    (*	   regularly, regardless of whether the user code has finished	*)
+    (*	   with the previous data.  There are no interlocks, and no	*)
+    (*	   protection against data being updated just as one is reading	*)
+    (*	   it.  (Any such protection could interfere with the precision	*)
+    (*	   of the timing of sampling external data).  The caller is	*)
+    (*	   advised to move data out of the buffer promptly, especially	*)
+    (*	   when the sampling rate is high.				*)
+
+    BEGIN
+
+	(* Wait for the interrupt which indicates operation complete.	*)
+	(* This is all we need to do; the interrupt task looks after	*)
+	(* all the details of re-arming the hardware, etc.		*)
+
+	Wait (tick);
+
+    END WaitForNextSample;
+
+(************************************************************************)
+
+PROCEDURE StopPeriodicSampling;
+
+    (* Turns off the periodic sampling mode of A/D conversion.	*)
+
+    BEGIN
+
+	(* Disarm the A/D converter.	*)
+
+	OutByte (IOBase, 0);
+	OutByte (IOBase+9, 0);
+
+	(* Stop the clocks (counters 4 and 5).	*)
+
+	OutByte (CounterControlPort, Disarm + Select4 + Select5);
+
+	DestroySemaphore (tick);
+
+    END StopPeriodicSampling;
+
+(************************************************************************)
+(*			THE INTERRUPT TASK				*)
+(************************************************************************)
+
+PROCEDURE InterruptTask;
+
+    (* This task has a job to do only during periodic sampling, since	*)
+    (* that is the only time we use interrupts.  Its job depends on	*)
+    (* which method of periodic sampling is in use (see above - we use	*)
+    (* one of two different methods, depending on the sampling interval	*)
+    (* and the number of channels being sampled).  The cases are:	*)
+    (*	1. DMA method: the interrupt occurs on DMA completion, so we	*)
+    (*	   only have to set up the DMA chip to be ready for the next	*)
+    (*	   batch of data, re-arm the A/D converter, and inform the user	*)
+    (*	   that the current data have arrived.				*)
+    (*	2. Polling method: the interrupt occurs on A/D completion for	*)
+    (*	   the first channel to be sampled, and we still have to store	*)
+    (*	   the datum in memory.  If multiple channels are to be sampled	*)
+    (*	   then the interrupt task must finish the job by sampling the	*)
+    (*	   remaining channels.  (This puts a busy wait inside an	*)
+    (*	   interrupt task, which is normally not a good idea; it is	*)
+    (*	   justified in this case because the amount of time to wait is	*)
+    (*	   less than the time it would take to leave and re-enter the	*)
+    (*	   interrupt task).  Finally, the A/D converter must be		*)
+    (*	   re-armed to be ready for the next batch of samples.		*)
+
+    VAR resultptr: POINTER TO BYTE;
+	BytesRemaining: CARDINAL;
+
+    BEGIN
+	LOOP (*FOREVER*)
+	    WaitForInterrupt;
+	    OutByte (IOBase+9, 0);		(* "flags clear" port *)
+
+	    WITH SamplingInfo DO
+		IF method = DMA THEN
+
+		    (* Re-arm the DMA controller for the next sample. *)
+
+		    LoadDMAparameters (DMAchannel, DMAReadCode,
+						BufferAddress, ByteCount);
+
+		ELSE	(* We are using the polling method *)
+
+		    (* Temporarily disable A/D interrupts. *)
+
+		    OutByte (IOBase, 0);	(* status/control port *)
+		    resultptr := BufferAddress;
+		    BytesRemaining := ByteCount;
+
+		    LOOP
+			(* Read in a result.	*)
+
+			resultptr^ := InByte(IOBase+3);	(* low order byte *)
+			resultptr := AddOffset (resultptr, 1);
+			resultptr^ := InByte(IOBase+4);	(* high order byte *)
+			resultptr := AddOffset (resultptr, 1);
+
+			DEC (BytesRemaining, 2);
+			IF BytesRemaining = 0 THEN
+			    EXIT (*LOOP*)
+			END (*IF*);
+
+			(* Perform the next conversion. *)
+
+			OutByte (IOBase+2, 0);	(* "start conversion" port *)
+			WHILE ORD(IANDB (InByte(IOBase),60H)) = 0 DO
+			    (* busy wait, until either the DONE or	*)
+			    (* OVERRUN ERROR flag is set.		*)
+			END (*WHILE *);
+
+		    END (*LOOP*);
+
+		    (* Re-enable interrupts. *)
+
+		    OutByte (IOBase, 3);
+
+		END (*IF*);
+
+		(* Rearm the D/A converter. *)
+
+		OutByte (IOBase+1, ChannelSelectByte);
+
+	    END (*WITH*);
+
+	    Signal (tick);
+
+	END (*LOOP*);
+
+    END InterruptTask;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE InitialSetup;
+
+    (* Resets the A/D board and the counter/timer chip and installs	*)
+    (* the interrupt task.						*)
+
+    BEGIN
+	OutByte (CounterControlPort, ResetCounters);
+	OutByte (CounterControlPort, LoadAllCounters);
+	OutByte (CounterControlPort, LoadDataPointerRegister + 4);
+	OutByte (IOBase, 0);		(* disable interrupts *)
+	OutByte (IOBase+9, 0);		(* clear flags *)
+	CreateInterruptTask(InterruptNumber,InterruptTask,"A/D int handler");
+    END InitialSetup;
+
+(************************************************************************)
+
+BEGIN
+    IF testing THEN
+	OpenWindow (debug,yellow,blue,5,11,0,79,doubleframe,nodivider);
+    END (*IF*);
+    InitialSetup;
+END AnalogueIO.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/bounce.def b/examples/Modula-2_Libraries/PMOS/sources/general/bounce.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/bounce.def
@@ -0,0 +1,27 @@
+DEFINITION MODULE Bounce;
+
+	(********************************************************)
+	(*							*)
+	(*		Bouncing ball demonstration.		*)
+	(*							*)
+	(*  This module is not intended to be of any practical	*)
+	(*  use, but it tests the time delay functions of the	*)
+	(*  kernel and acts as a demonstration that multiple	*)
+	(*  tasks really can coexist.				*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	15 August 1993			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM Windows IMPORT
+    (* type *)	RowRange, ColumnRange;
+
+PROCEDURE Bouncing (top, bottom: RowRange;  left, right: ColumnRange);
+
+    (* Creates a screen window, and runs a bouncing ball demonstration	*)
+    (* inside this window.						*)
+
+END Bounce.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/bounce.mod b/examples/Modula-2_Libraries/PMOS/sources/general/bounce.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/bounce.mod
@@ -0,0 +1,125 @@
+IMPLEMENTATION MODULE Bounce;
+
+	(********************************************************)
+	(*							*)
+	(*		Bouncing ball demonstration.		*)
+	(*							*)
+	(*  This module is not intended to be of any practical	*)
+	(*  use, but it tests the time delay functions of the	*)
+	(*  kernel and acts as a demonstration that multiple	*)
+	(*  tasks really can coexist.				*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	15 February 1994		*)
+	(*  Status:		Working, behaviour not quite	*)
+	(*			ideal.  For now, improvements	*)
+	(*			probably not worth the effort.	*)
+	(*							*)
+	(********************************************************)
+
+FROM TaskControl IMPORT
+    (* proc *)	CreateTask;
+
+FROM Timer IMPORT
+    (* proc *)	Sleep;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, WriteString, WriteChar,
+		SetCursor;
+
+FROM UserInterface IMPORT
+    (* type *)	UIWindow, Capability, CapabilitySet,
+    (* proc *)	AllowMouseControl;
+
+(************************************************************************)
+
+VAR w: Window;
+    debug: Window;
+
+    (* The ball is confined inside window w.  The following four bounds	*)
+    (* define where within the window it can go.			*)
+
+    xmin, xmax, ymin, ymax: REAL;
+
+    (* We must remember where the ball was, so we can delete it.	*)
+
+    oldx, oldy: CARDINAL;
+
+(************************************************************************)
+
+PROCEDURE DisplayBall (x, y: REAL);
+
+    (* Displays the ball at the given screen coordinates.	*)
+
+    BEGIN
+	SetCursor (w, oldy, oldx);  WriteChar (w, " ");
+	oldx := CARDINAL(x+0.5);  oldy := CARDINAL(y+0.5);
+	SetCursor (w, oldy, oldx);  WriteChar (w, CHR(9));
+	WriteString (debug, " .. moved");
+    END DisplayBall;
+
+(************************************************************************)
+
+PROCEDURE BouncingBall;
+
+    (* This procedure runs as a separate task.	*)
+
+    CONST delay = 40;
+	  g = 0.1;  reflection = 0.79;
+
+    VAR xposition, yposition, xspeed, yspeed: REAL;
+
+    BEGIN
+	oldx := 1;  oldy := 1;
+	xposition := 2.0;  yposition := 2.0;
+	xspeed := 1.0;  yspeed := 0.7;
+	LOOP
+	    (* Display current position *)
+	    DisplayBall (xposition, yposition);
+	    Sleep (delay);
+	    (* Update position and speed *)
+	    xposition := xposition + xspeed;
+	    yposition := yposition + yspeed;
+	    yspeed := yspeed + g;
+	    (* Reverse direction if we hit a wall *)
+	    IF xposition < xmin THEN
+		xposition := 2.0*xmin - xposition;
+		xspeed := -xspeed;
+	    ELSIF xposition > xmax THEN
+		xposition :=  2.0*xmax - xposition;
+		xspeed := -xspeed;
+	    END (*IF*);
+	    IF yposition < ymin THEN
+		yposition := 2.0*ymin - yposition;
+		yspeed := -reflection*yspeed;
+	    ELSIF yposition > ymax THEN
+		yposition :=  2.0*ymax - yposition;
+		yspeed := -reflection*yspeed;
+	    END (*IF*);
+	END (*LOOP*);
+    END BouncingBall;
+
+(************************************************************************)
+
+PROCEDURE Bouncing (top, bottom: RowRange;  left, right: ColumnRange);
+
+    (* Creates a screen window, and runs a bouncing ball demonstration	*)
+    (* inside this window.						*)
+
+    VAR UIW1, UIW2: UIWindow;
+
+    BEGIN
+	xmin := 0.5;  xmax := FLOAT(right - left) - 0.5;
+	ymin := 0.5;  ymax := FLOAT(bottom - top) - 0.5;
+	OpenWindow (w,yellow,red,top,bottom,left,right,simpleframe,nodivider);
+	UIW1 := AllowMouseControl (w, "Bouncing ball",
+				CapabilitySet {wmove, wshow, whide});
+	OpenWindow (debug,yellow,red,20,24,0,39,simpleframe,nodivider);
+	UIW2 := AllowMouseControl (debug, "Bounce/debug",
+				CapabilitySet {wmove, wshow, whide});
+	CreateTask (BouncingBall, 2, "Bounce");
+    END Bouncing;
+
+END Bounce.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/calculat.def b/examples/Modula-2_Libraries/PMOS/sources/general/calculat.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/calculat.def
@@ -0,0 +1,21 @@
+DEFINITION MODULE Calculator;
+
+	(****************************************************************)
+	(*								*)
+	(*			Simple calculator			*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	1 September 1993			*)
+	(*  Status:		OK					*)
+	(*								*)
+	(****************************************************************)
+
+PROCEDURE RunCalculator;
+
+    (* Displays a calculator window on the screen; this can be operated	*)
+    (* from the numeric keypad.  On exit, the calculator window is	*)
+    (* closed.  However, calculation results are saved between		*)
+    (* invocations of this procedure.					*)
+
+END Calculator.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/calculat.mod b/examples/Modula-2_Libraries/PMOS/sources/general/calculat.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/calculat.mod
@@ -0,0 +1,1079 @@
+IMPLEMENTATION MODULE Calculator;
+
+	(********************************************************)
+	(*							*)
+	(*	Simple calculator (Algebraic notation version)	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	13 December 1994		*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	Note that this module includes preprocessor	*)
+	(*	  directives for compiler-dependent code.	*)
+	(*							*)
+	(********************************************************)
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey, PutBack, StuffKeyboardBuffer, LockStatus, SetLocks;
+
+FROM KBdriver IMPORT
+    (* const*)	NumLockLED;
+
+FROM SoundEffects IMPORT
+    (* proc *)	Beep;
+
+FROM TextLines IMPORT
+    (* type *)	LineType,
+    (* proc *)	Box;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType, Rectangle,
+		RowRange, ColumnRange,
+    (* proc *)	OpenWindow, CloseWindow, ChangeScrollingRegion,
+		WriteChar, WriteString, WriteLn, SetCursor,
+		ShiftWindowRel, WindowLocation, Hide, PutOnTop,
+		IdentifyTopWindow;
+
+(*<UseMouse*)
+FROM Mouse IMPORT
+    (* type *)	Buttons, ButtonSet,
+    (* proc *)	HideMouseCursor, ShowMouseCursor;
+
+FROM UserInterface IMPORT
+    (* type *)	UIWindow, Capability, CapabilitySet,
+    (* proc *)	AllowMouseControl, AddActiveRegion;
+(*>*)
+
+FROM Menus IMPORT
+    (* type *)	Menu, ItemText,
+    (* proc *)	CreateMenu, PositionMenu, SelectFromMenu, DestroyMenu;
+
+FROM RealIO IMPORT
+    (* proc *)	WriteLongReal;
+
+FROM Str IMPORT
+    (* proc *)	Copy;
+
+FROM LowLevel IMPORT
+    (* proc *)	IAND;
+
+FROM MATHLIB IMPORT
+    (* proc *)	Pow, Sqrt, Exp, Log, Log10, Sin, Cos,
+		Tan, ASin, ACos, ATan, SinH, CosH, TanH;
+
+(************************************************************************)
+(*		    MISCELLANEOUS GLOBAL DEFINITIONS			*)
+(************************************************************************)
+
+TYPE CharSet = SET OF CHAR;
+
+CONST
+    EmptyMarker = CHR(0);  EndMarker = ' ';
+    Enter = CHR(0DH);  Esc = CHR(01BH);
+    UnaryOperatorSet = CharSet {'%', ')', 's', 'S'};
+    UnknownOperatorPriority = 255;
+    numberstart = 8;	(* the x cursor position for displaying numbers	*)
+    numberwidth = 9;	(* The field size for displaying numbers	*)
+
+VAR calc, help: Window;
+    baserow, basecol, helprow, helpcol: CARDINAL;
+
+(************************************************************************)
+(*			THE CALCULATOR STATE				*)
+(************************************************************************)
+
+CONST MaxRegisterNumber = 6;
+      MaxMemoryNumber = 3;
+      DisplayedRegisters = 3;
+
+TYPE RegisterNumber = [0..MaxRegisterNumber];
+     MemoryNumber = [0..MaxMemoryNumber];
+
+VAR
+    (* Array "Register" is a combined operand and operator stack.  It	*)
+    (* would be more conventional to have separate stacks for the	*)
+    (* operators and operands, but we adopt this slightly unusual stack	*)
+    (* format because it makes it easier to maintain a user-friendly	*)
+    (* screen display.							*)
+
+    Register: ARRAY RegisterNumber OF
+		RECORD
+		    operator: CHAR;
+		    ParenCount: CARDINAL;
+		    value: LONGREAL;
+		END (*RECORD*);
+
+    (* NumberPresent = FALSE means that Register[0].value is displayed	*)
+    (* as space characters rather than as a numeric string.		*)
+
+    NumberPresent: BOOLEAN;
+
+    (* In addition to the stack, there is a set of "memory" registers	*)
+    (* in which the user can save calculation results.			*)
+
+    MemoryValue: ARRAY MemoryNumber OF LONGREAL;
+
+(************************************************************************)
+(*			THE PREFIX UNARY FUNCTIONS			*)
+(************************************************************************)
+
+(* To simplify the calculator logic, and to keep the display readable,	*)
+(* all prefix unary functions are stored in the calculator stack in	*)
+(* terms of the all-purpose binary function "f".  The first argument	*)
+(* of f is the function number, and the second argument of f is the	*)
+(* true argument of the original unary function.			*)
+
+CONST
+    MaxFunctionNumber = 13;	(* number of built-in functions		*)
+    functionnamewidth = 5;	(* # of characters in a function name	*)
+
+TYPE
+    FunctionType = [0..MaxFunctionNumber];
+    NameText = ARRAY [0..functionnamewidth-1] OF CHAR;
+    NameArray = ARRAY FunctionType OF NameText;
+    MathProc = PROCEDURE (LONGREAL): LONGREAL;
+    FunctionArray = ARRAY FunctionType OF MathProc;
+
+PROCEDURE Negative (x: LONGREAL): LONGREAL;
+    BEGIN RETURN -x; END Negative;
+
+CONST
+    (* Array FunctionName gives the function names as displayed.	*)
+
+    FunctionName = NameArray ('     ', 'SQRT ', 'EXP  ', 'LN   ', 'LOG10',
+				'SIN  ', 'COS  ', 'TAN  ', 'ASIN ', 'ACOS ',
+				'ATAN ', 'SINH ', 'COSH ', 'TANH ');
+
+    (* Array Function is the set of built-in functions.  This is a	*)
+    (* constant array, but I have to set it up as a variable to mollify	*)
+    (* compilers that can't handle constant arrays of procedures.	*)
+
+    (*<~TopSpeed3
+    VAR Function: FunctionArray;
+    >*)
+
+    (*<TopSpeed3*)
+    CONST Function = FunctionArray (Negative, Sqrt, Exp, Log, Log10,
+			Sin, Cos, Tan, ASin, ACos, ATan, SinH, CosH, TanH);
+    (*>*)
+
+(************************************************************************)
+(*			    DISPLAY ROUTINES				*)
+(************************************************************************)
+
+PROCEDURE MoveWindow (code: CHAR;  w: Window);
+
+    (* Parameter "code" is the second character of a function key	*)
+    (* sequence.  This procedure moves window "w" on the screen if	*)
+    (* the key turns out to be an arrow key (and does nothing if it	*)
+    (* isn't).								*)
+
+    BEGIN
+	IF code = "H" THEN	(* cursor up *)
+	    ShiftWindowRel (w, -1, 0);
+	ELSIF code = "P" THEN	(* cursor down *)
+	    ShiftWindowRel (w, 1, 0);
+	ELSIF code = "M" THEN	(* cursor right *)
+	    ShiftWindowRel (w, 0, 1);
+	ELSIF code = "K" THEN	(* cursor left *)
+	    ShiftWindowRel (w, 0, -1)
+	END (*IF*);
+    END MoveWindow;
+
+(************************************************************************)
+
+PROCEDURE CreateHelpWindow;
+
+    (* Puts a help message on the screen. *)
+
+    (*<UseMouse*)
+    VAR dummy: UIWindow;
+    (*>*)
+
+    BEGIN
+	OpenWindow (help, intensewhite, blue, helprow, helprow+10,
+				helpcol, helpcol+28, simpleframe, nodivider);
+	Hide (help);
+
+	(*<UseMouse*)
+	dummy := AllowMouseControl (help, "Help for calculator",
+				CapabilitySet {wshow, wmove, whide});
+	(*>*)
+
+	WriteString (help, "Operators: + - * / ^ % ( )");
+	WriteLn (help);
+	WriteString (help, "  S   store to memory");
+	WriteLn (help);
+	WriteString (help, "  M   load from memory");
+	WriteLn (help);
+	WriteString (help, "  F   function (from menu)");
+	WriteLn (help);
+	WriteString (help, "  P   3.14159...");
+	WriteLn (help);
+	WriteString (help, "Arrow keys: move calculator");
+	WriteLn (help);
+	WriteString (help, "Backspace: delete last");
+	WriteLn (help);
+	WriteString (help, "= or Enter: evaluate result");
+	WriteLn (help);
+	WriteString (help, "Esc: exit from calculator");
+    END CreateHelpWindow;
+
+(************************************************************************)
+
+PROCEDURE HelpVisible(): BOOLEAN;
+
+    (* Returns TRUE iff some part of the help window is visible on the	*)
+    (* screen.  We have to work this out each time, because the		*)
+    (* visibility of the help window can be affected by things that	*)
+    (* this module doesn't know about.					*)
+
+    VAR R: Rectangle;  w: Window;
+	r, row: RowRange;  c, col: ColumnRange;
+
+    BEGIN
+	R := WindowLocation (help);
+	row := R.top;
+	LOOP
+	    col := R.left;
+	    LOOP
+		r := row;  c := col;
+		IF IdentifyTopWindow(w, r, c) AND (w = help) THEN
+		    RETURN TRUE;
+		ELSIF col = R.right THEN
+		    EXIT (*LOOP*);
+		ELSE
+		    INC (col);
+		END (*IF*);
+	    END (*LOOP*);
+	    IF row = R.bottom THEN
+		RETURN FALSE;
+	    END (*IF*);
+	    INC (row);
+	END (*LOOP*);
+    END HelpVisible;
+
+(************************************************************************)
+
+PROCEDURE LiteralAccumulatorDisplay (VAR (*IN*) Buffer: ARRAY OF CHAR);
+
+    (* Displays "Buffer" as a text string at the screen location	*)
+    (* reserved for the accumulator.					*)
+
+    BEGIN
+	SetCursor (calc, DisplayedRegisters+4, numberstart);
+	WriteString (calc, Buffer);
+    END LiteralAccumulatorDisplay;
+
+(************************************************************************)
+
+PROCEDURE WriteSpaces (N: CARDINAL);
+
+    (* Writes a string of N spaces at the current cursor location.	*)
+
+    VAR k: CARDINAL;
+
+    BEGIN
+	FOR k := 1 TO N DO
+	    WriteChar (calc, " ");
+	END (*FOR*);
+    END WriteSpaces;
+
+(************************************************************************)
+
+PROCEDURE WriteParentheses (count: CARDINAL);
+
+    (* Writes "count" left parentheses on the screen, with an	*)
+    (* abbreviated display if count > 4.			*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	IF count > 4 THEN
+	    WriteString (calc, "(..(");
+	ELSE
+	    FOR j := 1 TO count DO
+		WriteChar (calc, "(");
+	    END (*FOR*);
+	    WriteSpaces (4-count);
+	END (*IF*);
+    END WriteParentheses;
+
+(************************************************************************)
+
+PROCEDURE DisplayRegister (j: RegisterNumber);
+
+    (* Refreshes the display of the left parentheses, the value, and	*)
+    (* the trailing operator for register j.				*)
+
+    VAR row: CARDINAL;  operator: CHAR;
+
+    BEGIN
+	IF j = 0 THEN
+	    row := DisplayedRegisters+4;
+	ELSE
+	    row := DisplayedRegisters+3-j;
+	END (*IF*);
+	SetCursor (calc, row, 2);
+	IF Register[j].operator = EmptyMarker THEN
+	    WriteSpaces (numberwidth+6);
+	ELSE
+	    IF Register[j].operator = "f" THEN
+		IF Register[j+1].value = 0.0 THEN
+		    operator := "-";
+		ELSE
+		    operator := " ";
+		END (*IF*);
+	    ELSE
+		operator := Register[j].operator;
+	    END (*IF*);
+	    WriteChar (calc, operator);
+	    WriteParentheses (Register[j].ParenCount);
+	    SetCursor (calc, row, numberstart);
+	    IF (j > 0) AND (Register[j-1].operator = "f") THEN
+		WriteSpaces (numberwidth - functionnamewidth);
+		WriteString (calc,
+				FunctionName[FunctionType(Register[j].value)]);
+	    ELSIF (j = 0) AND NOT NumberPresent THEN
+		WriteSpaces (numberwidth);
+	    ELSE
+		WriteLongReal (calc, Register[j].value, numberwidth);
+	    END (*IF*);
+	END (*IF*);
+    END DisplayRegister;
+
+(************************************************************************)
+
+PROCEDURE DisplayStack;
+
+    (* Refreshes the display of the stack of registers.	*)
+
+    VAR j: RegisterNumber;
+
+    BEGIN
+	FOR j := 0 TO DisplayedRegisters DO
+	    DisplayRegister (j);
+	END (*FOR*);
+
+	(* If stack is empty, display help message *)
+
+	IF Register[1].operator = EmptyMarker THEN
+	    SetCursor (calc, 3, numberwidth DIV 2 - 1);
+	    WriteString (calc, "Press F1 key");
+	    SetCursor (calc, 4, numberwidth DIV 2 + 1);
+	    WriteString (calc, "for help");
+	END (*IF*);
+
+    END DisplayStack;
+
+(************************************************************************)
+
+PROCEDURE DisplayMemory (j: MemoryNumber);
+
+    (* Refreshes the display of "memory" register j.	*)
+
+    BEGIN
+	SetCursor (calc, DisplayedRegisters+j+6, numberstart);
+	WriteLongReal (calc, MemoryValue[j], numberwidth);
+    END DisplayMemory;
+
+(************************************************************************)
+
+PROCEDURE InitialDisplay;
+
+    (* Assumption: the calculator window calc is already open.  This	*)
+    (* procedure puts the initial picture of the calculator onto the	*)
+    (* screen.								*)
+
+    VAR mem: MemoryNumber;
+
+    BEGIN
+	(* Draw a box for the accumulator.	*)
+
+	Box (calc, DisplayedRegisters+3, numberstart-1,
+					numberwidth+1, 2, single);
+
+	(* Display the register contents.	*)
+
+	DisplayStack;
+
+	(* Display the memory values.	*)
+
+	FOR mem := 0 TO MAX(MemoryNumber) DO
+	    SetCursor (calc, DisplayedRegisters+mem+6, 2);
+	    WriteChar (calc, "M");  WriteChar (calc, CHR(ORD("0")+mem));
+	    DisplayMemory (mem);
+	END (*FOR*);
+
+    END InitialDisplay;
+
+(************************************************************************)
+(*			    NUMERIC INPUT				*)
+(************************************************************************)
+
+PROCEDURE AcceptNumber (nextchar: CHAR);
+
+    (* Reads a number from the keyboard.  On entry, nextchar holds the	*)
+    (* first digit or the decimal point.  On exit, the input value is	*)
+    (* in Register[0].value.						*)
+
+    TYPE BufferSubscript = [1..numberwidth];
+
+    VAR placevalue: LONGREAL;
+	j: BufferSubscript;
+	Buffer: ARRAY BufferSubscript OF CHAR;
+	BufferFull: BOOLEAN;
+
+    (********************************************************************)
+
+    PROCEDURE GetNextChar;
+
+	(* Displays the input so far (as a text string if it will fit,	*)
+	(* otherwise by a call to WriteReal), and then reads nextchar.	*)
+
+	BEGIN
+	    IF BufferFull THEN
+		DisplayRegister(0);
+	    ELSE
+		LiteralAccumulatorDisplay (Buffer);
+	    END (*IF*);
+	    nextchar := InKey();
+	    IF NOT BufferFull THEN
+		IF Buffer[1] <> " " THEN
+		    BufferFull := TRUE;
+		ELSE
+		    FOR j := 1 TO numberwidth-1 DO
+			Buffer[j] := Buffer[j+1];
+		    END (*FOR*);
+		    Buffer[numberwidth] := nextchar;
+		END (*IF*);
+	    END (*IF*);
+	END GetNextChar;
+
+    (********************************************************************)
+
+    BEGIN
+	Register[0].value := 0.0;  BufferFull := FALSE;
+	FOR j := 1 TO numberwidth-1 DO
+	    Buffer[j] := " ";
+	END (*FOR*);
+	NumberPresent := TRUE;
+	Buffer[numberwidth] := nextchar;
+
+	(* Read the part before the decimal point.	*)
+
+	WITH Register[0] DO
+	    WHILE nextchar IN CharSet {"0".."9"} DO
+		value := 10.0*value + LONGREAL(ORD(nextchar) - ORD("0"));
+		GetNextChar;
+	    END (*WHILE*);
+	END (*WITH*);
+
+	(* Now the part after the decimal point, if any.	*)
+
+	IF nextchar = "." THEN
+	    GetNextChar;  placevalue := 0.1;
+	    WHILE nextchar IN CharSet {"0".."9"} DO
+		Register[0].value := Register[0].value
+			+ placevalue*(LONGREAL(ORD(nextchar) - ORD("0")));
+		placevalue := 0.1*placevalue;
+		GetNextChar;
+	    END (*WHILE*);
+	END (*IF*);
+
+	(* Correct for overshoot in input.	*)
+
+	PutBack (nextchar);
+
+    END AcceptNumber;
+
+(************************************************************************)
+
+PROCEDURE priority (operator: CHAR): CARDINAL;
+
+    (* Returns the priority of an operator.	*)
+
+    BEGIN
+	CASE operator OF
+		EndMarker:	RETURN 0;
+	    |
+		Enter,"=":	RETURN 1;
+	    |
+		"+","-":	RETURN 2;
+	    |
+		"*","/":	RETURN 3;
+	    |
+		"f":		IF Register[1].value = 0.0 THEN RETURN 7
+				ELSE RETURN 4;
+				END (*IF*);
+	    |
+		"x":		RETURN 5;
+	    |
+		"^":		RETURN 6;
+	    |
+		ELSE
+				RETURN UnknownOperatorPriority;
+	END (*CASE*);
+    END priority;
+
+(************************************************************************)
+
+PROCEDURE TopOperatorPriority(): CARDINAL;
+
+    (* TopOperatorPriority is normally the priority of the operator in	*)
+    (* Register[0].  However any left parenthesis in Register[0]	*)
+    (* overrides this; in that case we return an answer of 0.		*)
+
+    BEGIN
+	IF Register[0].ParenCount > 0 THEN RETURN 0
+	ELSE RETURN priority (Register[0].operator)
+	END (*IF*);
+    END TopOperatorPriority;
+
+(************************************************************************)
+(*			    STACK MANIPULATION				*)
+(************************************************************************)
+
+PROCEDURE PushStack (LatestOperator: CHAR);
+
+    (* Pushes the register stack, clearing the top one.  The argument	*)
+    (* ends up as the operator in Register[0].  If the stack overflows	*)
+    (* we give an audible alarm, but perform the push anyway.		*)
+
+    VAR j: RegisterNumber;
+
+    BEGIN
+	IF Register[MaxRegisterNumber].operator <> EmptyMarker THEN
+	    Register[MaxRegisterNumber-1].operator := EndMarker;
+	    Beep;
+	END (*IF*);
+	FOR j := MaxRegisterNumber TO 1 BY -1 DO
+	    Register[j] := Register[j-1];
+	END (*FOR*);
+	WITH Register[0] DO
+	    operator := LatestOperator;  value := 0.0;  ParenCount := 0;
+	END (*WITH*);
+	NumberPresent := FALSE;
+	DisplayStack;
+    END PushStack;
+
+(************************************************************************)
+
+PROCEDURE PopStack;
+
+    (* Pops the register stack, clearing the bottom register.	*)
+
+    VAR j: RegisterNumber;
+
+    BEGIN
+	FOR j := 0 TO MaxRegisterNumber-1 DO
+	    Register[j] := Register[j+1];
+	END (*FOR*);
+	WITH Register[MaxRegisterNumber] DO
+	    ParenCount := 0;  value := 0.0;  operator := EmptyMarker;
+	END (*WITH*);
+	DisplayStack;
+    END PopStack;
+
+(************************************************************************)
+(*			OPERATIONS ON THE MEMORIES			*)
+(************************************************************************)
+
+PROCEDURE GetMemoryNumber (): MemoryNumber;
+
+    (* Returns the value of a one-digit memory number typed from the	*)
+    (* keyboard.  Also wipes the "memory number" prompt on the display.	*)
+    (* Assumes memory number 0 (and does not consume the typed key) if	*)
+    (* no valid memory number is specified.				*)
+
+    VAR ch: CHAR;
+
+    BEGIN
+	ch := InKey();
+	SetCursor (calc, DisplayedRegisters+5, 3);
+	WriteString (calc, " ");
+	IF ch IN CharSet{"0"..CHR(ORD("0")+MaxMemoryNumber)} THEN
+	    RETURN ORD(ch) - ORD("0");
+	ELSE
+	    PutBack(ch);  RETURN 0;
+	END (*IF*);
+    END GetMemoryNumber;
+
+(************************************************************************)
+
+PROCEDURE StoreToMemory;
+
+    (* Gets a memory number from the keyboard, stores the accumulator	*)
+    (* value in that memory register.					*)
+
+    VAR mem: MemoryNumber;
+
+    BEGIN
+	SetCursor (calc, DisplayedRegisters+5, 3);
+	WriteChar (calc, CHR(25));
+	mem := GetMemoryNumber();
+	MemoryValue[mem] := Register[0].value;  DisplayMemory(mem);
+    END StoreToMemory;
+
+(************************************************************************)
+(*				OPERATIONS				*)
+(************************************************************************)
+
+PROCEDURE Divide0 (first, second: LONGREAL): LONGREAL;
+
+    (* Computes first/second, except that division by zero gives 0.0.	*)
+
+    BEGIN
+	IF second = 0.0 THEN RETURN 0.0
+	ELSE RETURN first/second;
+	END (*IF*);
+    END Divide0;
+
+(************************************************************************)
+
+PROCEDURE BinaryOperation;
+
+    (* Performs the binary operation requested by Register[0].operator.	*)
+
+    VAR x, y, result: LONGREAL;
+	command: CHAR;
+
+    BEGIN
+	command := Register[0].operator;
+	x := Register[1].value;  y := Register[0].value;
+	result := x;
+	IF command = "+" THEN result := result + y
+	ELSIF command = "-" THEN result := result - y
+	ELSIF (command = "*") OR (command = "x") THEN result := result * y
+	ELSIF command = "/" THEN result := Divide0 (x, y)
+	ELSIF command = "^" THEN result := Pow (x, y)
+	ELSIF command = "f" THEN
+	    result := Function[VAL(FunctionType,x)] (y);
+	ELSE Beep;
+	END (*IF*);
+	Register[1].value := result;
+	PopStack;
+    END BinaryOperation;
+
+(************************************************************************)
+
+PROCEDURE PostfixUnaryOperation (code: CHAR);
+
+    (* Performs the unary operation requested by code.	*)
+
+    BEGIN
+	IF code = "%" THEN
+	    Register[0].value := 0.01*Register[0].value*Register[1].value;
+	ELSIF code = ")" THEN
+	    IF Register[0].ParenCount > 0 THEN
+		DEC (Register[0].ParenCount);
+	    ELSIF Register[0].operator <> EndMarker THEN
+		BinaryOperation;  PutBack (")");
+	    ELSE
+		Beep;
+	    END (*IF*);
+	ELSIF (code="s") OR (code="S") THEN
+	    StoreToMemory;
+	ELSE
+	    Beep;
+	END (*IF*);
+	DisplayRegister(0);
+    END PostfixUnaryOperation;
+
+(************************************************************************)
+(*		GETTING A FUNCTION NAME BY MENU SELECTION		*)
+(************************************************************************)
+
+PROCEDURE ReadBuiltinFunctionName;
+
+    (* Allows the user to select a function name from a menu.  We then	*)
+    (* load the stack with the function number, and the special		*)
+    (* "binary operator" f.						*)
+
+    VAR funcmenu: Menu;  menutext: ARRAY FunctionType OF ItemText;
+	function: FunctionType;
+
+    BEGIN
+	menutext[0] := "    Function";
+	FOR function := 1 TO MaxFunctionNumber DO
+	    Copy (menutext[function], FunctionName[function]);
+	END (*FOR*);
+	CreateMenu (funcmenu, 3, menutext, MaxFunctionNumber);
+	PositionMenu (funcmenu, 14, 22, 60, 78);
+	function := SelectFromMenu (funcmenu);
+	DestroyMenu (funcmenu);
+	IF function <> 0 THEN
+	    Register[0].value := VAL(LONGREAL, function);
+	    PushStack ("f");
+	END (*IF*);
+    END ReadBuiltinFunctionName;
+
+(************************************************************************)
+(*			THE CALCULATOR CONTROL LOGIC			*)
+(************************************************************************)
+
+PROCEDURE HandleFunctionKey;
+
+    (* Looks after the cases where the keyboard input code was CHR(0).	*)
+    (* In the present version, the arrow keys and F1 key are looked	*)
+    (* after, and all other function keys are ignored.			*)
+
+    VAR code: CHAR;
+
+    BEGIN
+	code := InKey();
+	IF (code = ";") OR (code = "T") THEN	(* F1 or Shift/F1 *)
+	    PutOnTop (help);
+	ELSIF HelpVisible() THEN		(* check for arrow key *)
+	    MoveWindow (code, help);
+	ELSE					(* check for arrow key *)
+	    MoveWindow (code, calc);
+	END (*IF*);
+    END HandleFunctionKey;
+
+(************************************************************************)
+
+PROCEDURE LoadAccumulator (VAR (*OUT*) nextchar: CHAR);
+
+    (* Loads the accumulator with a number, also accepting and keeping	*)
+    (* track of any opening parentheses.  Unary operations are also	*)
+    (* dealt with by this procedure; and this could lead to the		*)
+    (* evaluation of entire subexpressions, because we treat a closing	*)
+    (* parenthesis as a unary postfix operator.  On return, nextchar	*)
+    (* holds the following keyboard character (usually an operator, but	*)
+    (* it could also be Esc, Return, or an illegal keystroke).  Most of	*)
+    (* the complexity of this procedure lies in the fact that the user	*)
+    (* can also type Backspace at any time, which has the effect of	*)
+    (* cancelling the latest number, left parenthesis, or unevaluated	*)
+    (* operator, as appropriate.					*)
+
+    (* It is possible that the user will enter no value before the	*)
+    (* operator.  In this case, the previous accumulator contents are	*)
+    (* retained, unless they have been wiped out by a backspace.	*)
+    (* Conversely, the user can override a number which is already	*)
+    (* present.  We try to give a legal meaning, wherever possible, to	*)
+    (* any user input.							*)
+
+    CONST Backspace = CHR(8);
+          Starters = CharSet {"(", ".", "0".."9", "f", "F", "m", "M",
+				"p", "P"};
+	  Misc = CharSet {CHR(0), "e", "E", EndMarker, Backspace};
+	  HandledHere = Starters + Misc + UnaryOperatorSet;
+
+    BEGIN
+	LOOP
+	    nextchar := InKey();
+
+	    (* If the input is such as to imply that a new number is	*)
+	    (* to be entered, discard any number already in the		*)
+	    (* accumulator - i.e. allow the user to override any	*)
+	    (* previous input.						*)
+
+	    IF nextchar IN Starters THEN
+		NumberPresent := FALSE;
+		DisplayRegister(0);
+	    END (*IF*);
+
+	    (* On seeing a "-", we have to decide whether it is a	*)
+	    (* unary minus (if so, handle it here) or a binary minus.	*)
+
+	    IF nextchar = "-" THEN
+		IF NumberPresent THEN EXIT(*LOOP*)
+		ELSE
+		    Register[0].value := 0.0;
+		    PushStack ("f");
+		END (*IF*);
+
+	    ELSIF NOT (nextchar IN HandledHere) THEN
+		EXIT (*LOOP*);
+
+	    (* Any character which, by coincidence, has the	*)
+	    (* same character code as EndMarker is ignored.	*)
+
+	    ELSIF nextchar = EndMarker THEN (* do nothing *)
+
+	    (* Function key? *)
+
+	    ELSIF nextchar = CHR(0) THEN HandleFunctionKey
+
+	    (* Read prefix unary operator.  We don't evaluate it here;	*)
+	    (* it's put on the stack to look like a binary operator.	*)
+
+	    ELSIF CAP(nextchar) = "F" THEN ReadBuiltinFunctionName;
+
+	    (* Handle postfix unary operator.	*)
+
+	    ELSIF nextchar IN UnaryOperatorSet THEN
+		PostfixUnaryOperation (nextchar);
+		NumberPresent := TRUE;
+
+	    (* Handle opening parenthesis.	*)
+
+	    ELSIF nextchar = "(" THEN
+		INC (Register[0].ParenCount);
+		DisplayRegister(0);
+
+	    (* P means the constant PI.	*)
+
+	    ELSIF CAP(nextchar) = "P" THEN
+		Register[0].value := 3.14159265359;
+		NumberPresent := TRUE;
+		DisplayRegister(0);
+
+	    (* Fetch a number.	*)
+
+	    ELSIF nextchar IN CharSet {"0".."9", "."} THEN
+		AcceptNumber (nextchar);
+
+	    (* We use the calculator itself to evaluate "E" notation.	*)
+
+	    ELSIF CAP(nextchar) = "E" THEN
+		IF NOT NumberPresent THEN
+		    Register[0].value := 1.0;
+		    NumberPresent := TRUE;
+		END (*IF*);
+		PushStack ("x");
+		Register[0].value := 10.0;
+		PutBack ("^");
+
+	    (* Or an operand from memory.	*)
+
+	    ELSIF CAP(nextchar) ="M" THEN
+		SetCursor (calc, DisplayedRegisters+5, 3);
+		WriteChar (calc, CHR(24));
+		Register[0].value := MemoryValue[GetMemoryNumber()];
+		NumberPresent := TRUE;
+		DisplayRegister(0);
+
+	    (* Now the hard part: handle Backspace.	*)
+
+	    ELSIF nextchar = Backspace THEN
+
+		(* The effect of a backspace depends on whether the	*)
+		(* accumulator holds a user-supplied number at this	*)
+		(* stage.  This depends on things like whether the	*)
+		(* user has typed several backspaces in a row.		*)
+
+		IF NumberPresent THEN
+
+		    (* Delete the number in the accumulator.	*)
+
+		    Register[0].value := 0.0;  NumberPresent := FALSE;
+
+		ELSIF Register[0].ParenCount > 0 THEN
+
+		    (* Remove one left parenthesis.	*)
+
+		    DEC (Register[0].ParenCount);
+
+		ELSE    (* Delete the last outstanding operator, if any. *)
+
+		    IF Register[0].operator = EndMarker THEN
+			Beep;
+		    ELSIF Register[0].operator = "f" THEN
+			PopStack;
+			Register[0].value := 0.0;
+			NumberPresent := FALSE;
+		    ELSE
+			PopStack;
+			NumberPresent := TRUE;
+		    END (*IF*);
+
+		END (*IF*);
+
+		DisplayRegister(0);
+
+	    END (*IF*);
+
+	END (*LOOP*);
+
+    END LoadAccumulator;
+
+(************************************************************************)
+
+PROCEDURE PerformCalculation;
+
+    (* This procedure consists of a loop which is repeated until an	*)
+    (* Esc character is encountered.  Each time around the loop, we	*)
+    (* pick up an operand followed by an operator.  (Fetching the	*)
+    (* operand, which is done by procedure LoadAccumulator, may itself	*)
+    (* involve some subexpression evaluation, because the operand can	*)
+    (* include things like opening and closing parentheses, prefix and	*)
+    (* postfix functions, and the like.  Procedure LoadAccumulator also	*)
+    (* allows some of the preceding input to be deleted via the		*)
+    (* Backspace key.)  The operator may be a binary operator, or Esc,	*)
+    (* or Enter, or '='.  (These last two are considered to be		*)
+    (* equivalent.)  Anything else is considered to be an unknown	*)
+    (* operator, and results in an audible Beep.			*)
+    (* A calculation step, or possibly a whole sequence of steps, is	*)
+    (* triggered if there are more closing parentheses than opening	*)
+    (* parentheses, or if the operator has lower priority than the last	*)
+    (* stacked operator.						*)
+
+    VAR operator: CHAR;
+
+    BEGIN
+	LOOP
+	    LoadAccumulator (operator);
+
+	    (* The Esc key drops us out of the calculator - unless the	*)
+	    (* help window is on display, in which case Esc simply	*)
+	    (* removes the help window from the display.		*)
+
+	    IF operator = Esc THEN
+		IF HelpVisible() THEN
+		    Hide (help);  operator := Enter;
+		ELSE
+		    EXIT (*LOOP*);
+		END (*IF*);
+	    END (*IF*);
+
+	    (* Perform any pending operations. *)
+
+	    NumberPresent := TRUE;
+	    WHILE TopOperatorPriority() >= priority(operator) DO
+		BinaryOperation;
+	    END (*WHILE*);
+
+	    (* Push the latest operator, unless it marks the end	*)
+	    (* of the calculation.					*)
+
+	    IF priority(operator) = UnknownOperatorPriority THEN
+		Beep;
+	    ELSIF (operator <> Enter) AND (operator <> "=") THEN
+		PushStack (operator);
+	    END(*IF*);
+
+	END (*LOOP*);
+
+    END PerformCalculation;
+
+(************************************************************************)
+
+PROCEDURE ForceExit (w: Window;  row: RowRange;  col: ColumnRange);
+
+    (* This procedure is triggered by a mouse click on the "hide"	*)
+    (* button.  We turn this into a keyboard Esc character, or two Esc	*)
+    (* characters if the help window is visible.			*)
+
+    BEGIN
+	IF HelpVisible() THEN StuffKeyboardBuffer (Esc) END(*IF*);
+	StuffKeyboardBuffer (Esc);
+    END ForceExit;
+
+(************************************************************************)
+
+PROCEDURE ForceF1 (w: Window;  row: RowRange;  col: ColumnRange);
+
+    (* This procedure is triggered by a mouse click on the "F1"		*)
+    (* message.  We turn this into a keyboard F1 keypress.		*)
+
+    BEGIN
+	StuffKeyboardBuffer (CHR(0));
+	StuffKeyboardBuffer (';');
+    END ForceF1;
+
+(************************************************************************)
+(*			INTERFACE TO THE CALLER				*)
+(************************************************************************)
+
+PROCEDURE RunCalculator;
+
+    (* Displays a calculator window on the screen; this can be operated	*)
+    (* from the numeric keypad.  On exit, the screen window is closed,	*)
+    (* but calculation results are saved for the next invocation of	*)
+    (* this procedure.							*)
+
+    VAR KeyboardLocks: CARDINAL;  R: Rectangle;
+	(*<UseMouse*)
+	UIW: UIWindow;
+	(*>*)
+
+    BEGIN
+	(* Set the NumLock state, if not already set.	*)
+
+	KeyboardLocks := LockStatus();
+	IF ORD(IAND (KeyboardLocks, NumLockLED)) = 0 THEN
+	    SetLocks (KeyboardLocks + NumLockLED);
+	END (*IF*);
+
+	OpenWindow (calc, yellow, blue,
+			baserow, baserow+DisplayedRegisters+MaxMemoryNumber+7,
+			    basecol, basecol+numberwidth+9,
+				simpleframe, doubledivider);
+	WriteString (calc, "   Calculator");
+	ChangeScrollingRegion (calc, 3, DisplayedRegisters+MaxMemoryNumber+6);
+
+	(*<UseMouse*)
+	UIW := AllowMouseControl (calc, "Calculator",
+				CapabilitySet {wshow, wmove, whide});
+	AddActiveRegion (UIW, 0, 0, numberwidth+7, numberwidth+7,
+				ButtonSet {LeftButton}, ForceExit);
+	AddActiveRegion (UIW,3,3, numberwidth DIV 2 + 5, numberwidth DIV 2 + 6,
+				ButtonSet {LeftButton}, ForceF1);
+	(*>*)
+
+	CreateHelpWindow;
+	InitialDisplay;
+	PerformCalculation;
+	R := WindowLocation (help);
+	helprow := R.top;  helpcol := R.left;
+	(*<UseMouse*) HideMouseCursor; (*>*)
+	CloseWindow (help);
+	R := WindowLocation (calc);
+	baserow := R.top;  basecol := R.left;
+	CloseWindow (calc);
+	(*<UseMouse*) ShowMouseCursor; (*>*)
+
+	SetLocks (KeyboardLocks);
+
+    END RunCalculator;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE ClearCalculatorState;
+
+    (* Clears all of the working registers of the calculator.	*)
+
+    VAR j: RegisterNumber;  mem: MemoryNumber;
+
+    BEGIN
+	FOR j := 0 TO MaxRegisterNumber DO
+	    WITH Register[j] DO
+		ParenCount := 0;
+		value := 0.0;
+		operator := EmptyMarker;
+	    END (*WITH*);
+	END (*FOR*);
+	Register[0].operator := EndMarker;
+	NumberPresent := FALSE;
+	FOR mem := 0 TO MAX(MemoryNumber) DO
+	    MemoryValue[mem] := 0.0;
+	END (*FOR*);
+    END ClearCalculatorState;
+
+(************************************************************************)
+
+BEGIN
+    baserow := 0;  basecol := 70 - numberwidth;
+    helprow := 7;  helpcol := 26;
+    ClearCalculatorState;
+    (*<~TopSpeed3
+    Function[0] := Negative;
+    Function[1] := Sqrt;
+    Function[2] := Exp;
+    Function[3] := Log;
+    Function[4] := Log10;
+    Function[5] := Sin;
+    Function[6] := Cos;
+    Function[7] := Tan;
+    Function[8] := ASin;
+    Function[9] := ACos;
+    Function[10] := ATan;
+    Function[11] := SinH;
+    Function[12] := CosH;
+    Function[13] := TanH;
+    >*)
+END Calculator.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/circular.def b/examples/Modula-2_Libraries/PMOS/sources/general/circular.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/circular.def
@@ -0,0 +1,43 @@
+DEFINITION MODULE CircularBuffers;
+
+	(****************************************************************)
+	(*								*)
+	(*	Circular Buffer for passing character data		*)
+	(*		between a pair of tasks.			*)
+	(*								*)
+	(*	Author:		P. Moylan				*)
+	(*	Last edited:	7 December 1993				*)
+	(*								*)
+	(*	Status:		OK.					*)
+	(*								*)
+	(****************************************************************)
+
+TYPE CircularBuffer;	(* is private *)
+
+PROCEDURE CreateBuffer (VAR (*OUT*) B: CircularBuffer;  size: CARDINAL);
+
+    (* Allocates space for a circular buffer, and initializes it.  The	*)
+    (* caller specifies how many characters the buffer will hold.	*)
+
+PROCEDURE PutBuffer (B: CircularBuffer; item: CHAR);
+
+    (* Waits for space available, then puts item at the tail of the queue. *)
+
+PROCEDURE PutBufferImpatient (B: CircularBuffer;  item: CHAR;
+						TimeLimit: CARDINAL);
+
+    (* Like PutBuffer, but waits no longer than TimeLimit milliseconds	*)
+    (* for a buffer slot to become available.  If the time limit	*)
+    (* expires, the oldest item in the buffer is overwritten by the	*)
+    (* new data.							*)
+
+PROCEDURE GetBuffer (B: CircularBuffer) : CHAR;
+
+    (* Takes one character from the head of the queue, waiting if necessary. *)
+
+PROCEDURE BufferEmpty (B: CircularBuffer): BOOLEAN;
+
+    (* Returns TRUE iff the buffer is empty. *)
+
+END CircularBuffers.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/circular.mod b/examples/Modula-2_Libraries/PMOS/sources/general/circular.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/circular.mod
@@ -0,0 +1,172 @@
+IMPLEMENTATION MODULE CircularBuffers;
+
+	(********************************************************)
+	(*							*)
+	(*	Circular Buffers for passing character data	*)
+	(*	between a pair of tasks.			*)
+	(*							*)
+	(*	Author:		P. Moylan			*)
+	(*	Last edited:	21 February 1995		*)
+	(*							*)
+	(*	Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE;
+
+FROM Timer IMPORT
+    (* proc *)	TimedWait;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM TaskControl IMPORT
+    (* type *)	Lock,
+    (* proc *)	CreateLock, Obtain, Release;
+
+(************************************************************************)
+
+TYPE
+    BufferTemplate = RECORD
+			SlotAvailable, DataPresent: Semaphore;
+			lastlocation: CARDINAL;
+			mutex: Lock;
+			GetPlace, PutPlace: CARDINAL;
+			data: ARRAY [0..0] OF CHAR
+		     END;
+
+	(* Remark: we do something slightly nonstandard here, because	*)
+	(* we want circular buffers of various sizes and Modula-2 does	*)
+	(* not support variable-length arrays.  The trick is to define	*)
+	(* an array of one element, but then to extend it by calling	*)
+	(* ALLOCATE to give us the array size we really need.  Of	*)
+	(* course, this works only if we suppress "out of range" error	*)
+	(* checking while compiling this module.  This is, admittedly,	*)
+	(* an example of a programming style which probably should be	*)
+	(* outlawed, but I couldn't think of a legal way to achieve the	*)
+	(* desired result.						*)
+
+    CircularBuffer = POINTER TO BufferTemplate;
+
+(************************************************************************)
+
+PROCEDURE CreateBuffer (VAR (*OUT*) B: CircularBuffer;  size: CARDINAL);
+
+    (* Allocates space for a circular buffer, and initializes it.  The	*)
+    (* caller specifies how many characters the buffer will hold.	*)
+
+    BEGIN
+	ALLOCATE (B, SIZE(BufferTemplate) + size - 1);
+	WITH B^ DO
+	    lastlocation := size - 1;
+	    CreateSemaphore (SlotAvailable, size);
+	    CreateSemaphore (DataPresent, 0);
+	    CreateLock (mutex);
+	    GetPlace := 0;  PutPlace := 0;
+	END (*WITH*);
+    END CreateBuffer;
+
+(************************************************************************)
+
+PROCEDURE PutBuffer (B: CircularBuffer; item: CHAR);
+
+    (* Puts item into the circular buffer, waiting for space available	*)
+    (* if necessary.							*)
+
+    BEGIN
+	WITH B^ DO
+	    Wait (SlotAvailable);
+	    (*# save, check(index => off) *)
+	    data[PutPlace] := item;
+	    (*# restore *)
+	    IF PutPlace = lastlocation THEN PutPlace := 0
+	    ELSE INC (PutPlace);
+	    END (*IF*);
+	    Signal (DataPresent);
+	END (*WITH*);
+    END PutBuffer;
+
+(************************************************************************)
+
+PROCEDURE PutBufferImpatient (B: CircularBuffer;  item: CHAR;
+						TimeLimit: CARDINAL);
+
+    (* Like PutBuffer, but waits no longer than TimeLimit milliseconds	*)
+    (* for a buffer slot to become available.  If the time limit	*)
+    (* expires, the oldest item in the buffer is overwritten by the	*)
+    (* new data.							*)
+
+    VAR TimedOut: BOOLEAN;
+
+    BEGIN
+	WITH B^ DO
+	    TimedWait (SlotAvailable, TimeLimit, TimedOut);
+	    IF TimedOut THEN
+		Obtain (mutex);
+		IF GetPlace = lastlocation THEN GetPlace := 0
+		ELSE INC (GetPlace);
+		END (*IF*);
+		Release (mutex);
+	    END (*IF*);
+	    (*# save, check(index => off) *)
+	    data[PutPlace] := item;
+	    (*# restore *)
+	    IF PutPlace = lastlocation THEN PutPlace := 0
+	    ELSE INC (PutPlace);
+	    END (*IF*);
+	    IF NOT TimedOut THEN
+		Signal (DataPresent);
+	    END (*IF*);
+	END (*WITH*);
+    END PutBufferImpatient;
+
+(************************************************************************)
+
+PROCEDURE GetBuffer (B: CircularBuffer) : CHAR;
+
+    (* Gets one character from the circular buffer, waiting when	*)
+    (* necessary for a character to become available.			*)
+
+    VAR result: CHAR;
+
+    BEGIN
+	WITH B^ DO
+	    Wait (DataPresent);
+	    Obtain (mutex);
+	    (*# save, check(index => off) *)
+	    result := data[GetPlace];
+	    (*# restore *)
+	    IF GetPlace = lastlocation THEN GetPlace := 0
+	    ELSE INC (GetPlace);
+	    END (*IF*);
+	    Release (mutex);
+	    Signal (SlotAvailable);
+	END (*WITH*);
+	RETURN result;
+    END GetBuffer;
+
+(************************************************************************)
+
+PROCEDURE BufferEmpty (B: CircularBuffer): BOOLEAN;
+
+    (* Returns TRUE iff the buffer is empty. *)
+
+    VAR TimedOut: BOOLEAN;
+
+    BEGIN
+	WITH B^ DO
+	    TimedWait (DataPresent, 0, TimedOut);
+	    IF TimedOut THEN RETURN TRUE;
+	    ELSE
+		Signal (DataPresent);
+		RETURN FALSE;
+	    END (*IF*);
+	END (*WITH*);
+    END BufferEmpty;
+
+(************************************************************************)
+
+END CircularBuffers.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/configur.def b/examples/Modula-2_Libraries/PMOS/sources/general/configur.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/configur.def
@@ -0,0 +1,59 @@
+DEFINITION MODULE ConfigurationOptions;
+
+	(********************************************************)
+	(*							*)
+	(*	The function of this file is to collect		*)
+	(*	together some key configuration settings	*)
+	(*	which govern things like which PMOS		*)
+	(*	features are to be disabled.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	17 August 1994			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(*	Remark: I'm gradually moving things out of	*)
+	(*	this module, and I might well decide to		*)
+	(*	eliminate this module entirely in a future	*)
+	(*	version of PMOS.				*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(*			KERNEL SETTINGS					*)
+(************************************************************************)
+
+CONST
+    (* The following Boolean constant defines whether the PMOS kernel	*)
+    (* will permit round-robin time-slicing among tasks of equal	*)
+    (* priority.  For hard real-time applications this should typically	*)
+    (* be set to FALSE, since time-slicing interferes with the		*)
+    (* predictability of execution times.  Disabling time-slicing also	*)
+    (* reduces kernel overheads because of the following special	*)
+    (* property: with time-slicing disallowed, the only tasks which	*)
+    (* participate in task switches and in priority inheritance		*)
+    (* calculations are those at the head of each ready queue.  (The	*)
+    (* key theoretical result is that there is at most one "active"	*)
+    (* task per priority level.)  With time-slicing enabled, any ready	*)
+    (* task could be an active task.					*)
+    (* For applications where keyboard/screen interaction is the	*)
+    (* dominant factor, setting TimeSlicingEnabled TRUE sometimes gives	*)
+    (* a better illusion that multiple tasks are running in parallel.	*)
+
+    TimeSlicingEnabled = FALSE;
+
+    (* The next two constants define the maximum number of concurrent	*)
+    (* tasks which are permitted, and the stack size for each task.	*)
+
+    MaxTaskNumber = 31;
+    StackSize = 2048;
+
+(************************************************************************)
+(*				MOUSE					*)
+(************************************************************************)
+
+    (* The mouse options are no longer specified in this module.	*)
+    (* Instead, they are specified in the PP.CFG file which is used	*)
+    (* in the PMOS installation operation.				*)
+
+END ConfigurationOptions.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/configur.mod b/examples/Modula-2_Libraries/PMOS/sources/general/configur.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/configur.mod
@@ -0,0 +1,18 @@
+IMPLEMENTATION MODULE ConfigurationOptions;
+
+	(********************************************************)
+	(*							*)
+	(*	The function of this module is to collect	*)
+	(*	together some key configuration settings	*)
+	(*	which govern things like which PMOS		*)
+	(*	features are to be disabled.  It does not	*)
+	(*	contain any executable code.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	5 February 1994			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+END ConfigurationOptions.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/conversi.def b/examples/Modula-2_Libraries/PMOS/sources/general/conversi.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/conversi.def
@@ -0,0 +1,85 @@
+DEFINITION MODULE Conversions;
+
+	(********************************************************)
+	(*							*)
+	(*		Miscellaneous type conversions		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	25 April 1994			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+TYPE HexDigit = [0..15];
+     EightChar = ARRAY [0..7] OF CHAR;
+
+PROCEDURE atoi (a: LONGREAL;  i: CARDINAL): LONGREAL;
+
+    (* Calculates a**i.  This procedure does not really belong in this	*)
+    (* module, but it's missing from MATHLIB and there's no more	*)
+    (* logical place to put it.						*)
+
+PROCEDURE StringToHex (string: ARRAY OF CHAR): LONGCARD;
+PROCEDURE StringToCardinal (string: ARRAY OF CHAR): CARDINAL;
+PROCEDURE StringToLongCard (string: ARRAY OF CHAR): LONGCARD;
+PROCEDURE StringToReal (string: ARRAY OF CHAR): REAL;
+PROCEDURE StringToLongReal (string: ARRAY OF CHAR): LONGREAL;
+
+    (* Converts a text string to numeric.  Leading blanks are ignored.	*)
+    (* The conversion stops at the end of the array or at the first	*)
+    (* character which cannot be part of the number, and in the		*)
+    (* latter case all subsequent characters are ignored.		*)
+
+PROCEDURE HexToChar (number: HexDigit): CHAR;
+
+    (* Converts a one-digit hexadecimal number to its readable form.	*)
+
+PROCEDURE HexByteToString (value: SHORTCARD;
+			VAR (*OUT*) buffer: ARRAY OF CHAR;  pos: CARDINAL);
+
+    (* Converts a byte value to 2-character hexadecimal, with the	*)
+    (* result stored at buffer[pos] and buffer[pos+1].			*)
+
+PROCEDURE HexToString (value: CARDINAL;  VAR (*OUT*) buffer: ARRAY OF CHAR);
+PROCEDURE LongHexToString (value: LONGCARD;  VAR (*OUT*) buffer: EightChar);
+
+    (* Converts 'value' to a string in hexadecimal notation.	*)
+
+PROCEDURE ShortCardToString (number: SHORTCARD;
+					VAR (*OUT*) buffer: ARRAY OF CHAR;
+					fieldsize: CARDINAL);
+PROCEDURE CardinalToString (number: CARDINAL;
+					VAR (*OUT*) buffer: ARRAY OF CHAR;
+					fieldsize: CARDINAL);
+PROCEDURE LongCardToString (number: LONGCARD;
+					VAR (*OUT*) buffer: ARRAY OF CHAR;
+					fieldsize: CARDINAL);
+PROCEDURE RealToString (number: REAL;  VAR (*OUT*) buffer: ARRAY OF CHAR;
+					fieldsize: CARDINAL);
+PROCEDURE LongRealToString (number: LONGREAL;
+					VAR (*OUT*) buffer: ARRAY OF CHAR;
+					fieldsize: CARDINAL);
+
+    (* Converts the number to a decimal character string in array	*)
+    (* "buffer", right-justified in a field of fieldsize characters.	*)
+    (* In the case of reals the format depends on the size of the	*)
+    (* number relative to the size of the buffer.			*)
+
+PROCEDURE RealToF (number: REAL;  VAR (*INOUT*) fieldsize: CARDINAL;
+			decimalplaces: CARDINAL;  LeftJustified: BOOLEAN;
+			VAR (*OUT*) buffer: ARRAY OF CHAR);
+PROCEDURE LongRealToF (number: LONGREAL;  VAR (*INOUT*) fieldsize: CARDINAL;
+			decimalplaces: CARDINAL;  LeftJustified: BOOLEAN;
+			VAR (*OUT*) buffer: ARRAY OF CHAR);
+
+    (* Converts the number to an F-format string, of up to fieldsize	*)
+    (* characters with decimalplaces digits after the decimal point.	*)
+    (* The result is left justified if LeftJustified = TRUE is		*)
+    (* specified by the caller, and right justified with space fill	*)
+    (* otherwise.  On return fieldsize gives the number of character	*)
+    (* positions actually used.  The result string is terminated with	*)
+    (* at least one CHR(0) (which is not counted in fieldsize), except	*)
+    (* where the result fills the entire buffer.			*)
+
+END Conversions.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/conversi.mod b/examples/Modula-2_Libraries/PMOS/sources/general/conversi.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/conversi.mod
@@ -0,0 +1,796 @@
+IMPLEMENTATION MODULE Conversions;
+
+	(********************************************************)
+	(*							*)
+	(*		Miscellaneous type conversions		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	23 July 1994			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	Have not fully tested the cases where the field	*)
+	(*	 size is too small.				*)
+	(*	Seems to be a loss of accuracy when converting	*)
+	(*	 E-format numbers; for example 123.456E7 is	*)
+	(*	 converted to 1234559999 when passed through	*)
+	(*	 StringToReal and then RealToString.  I'm not	*)
+	(*	 yet sure where this is happening, but suspect	*)
+	(*	 that it requires some deep error analysis.	*)
+	(*							*)
+	(********************************************************)
+
+FROM LowLevel IMPORT
+    (* proc *)	IAND, RS, LowWord, HighWord;
+
+CONST tab = CHR(9);
+
+TYPE CharSet = SET OF CHAR;
+
+(************************************************************************)
+(*			   BUFFER MANIPULATION				*)
+(************************************************************************)
+
+PROCEDURE ShiftRight (VAR (*INOUT*) buffer: ARRAY OF CHAR;
+				first, last, amount: CARDINAL);
+
+    (* Moves the contents of buffer[first..last] right by the specified	*)
+    (* number of characters, space filling at the left and discarding	*)
+    (* characters shifted out at the right.				*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	IF amount > 0 THEN
+	    FOR j := last TO first+amount BY -1 DO
+		buffer[j] := buffer[j-amount];
+	    END (*FOR*);
+	    FOR j := first TO first+amount-1 DO
+		buffer[j] := " ";
+	    END (*FOR*);
+	END (*IF*);
+    END ShiftRight;
+
+(************************************************************************)
+(*			REAL NUMBER TO CARDINAL POWER			*)
+(************************************************************************)
+
+PROCEDURE atoi (a: LONGREAL;  i: CARDINAL): LONGREAL;
+
+    (* Calculates a**i.  This procedure does not really belong in this	*)
+    (* module, but for now it doesn't seem to have any other suitable	*)
+    (* home.								*)
+
+    VAR result: LONGREAL;
+
+    BEGIN
+	result := 1.0;
+
+	(* Desired answer is result*(a)**i.  The loop below keeps this	*)
+	(* quantity invariant while reducing i down to zero.		*)
+
+	LOOP
+	    IF ODD(i) THEN
+		DEC(i);  result := a*result;
+	    END (*IF*);
+	    IF i=0 THEN EXIT(*LOOP*) END(*IF*);
+	    i := i DIV 2;  a := a*a;
+	END (*LOOP*);
+	RETURN result;
+    END atoi;
+
+(************************************************************************)
+
+PROCEDURE TenToPower (N: CARDINAL): LONGREAL;
+
+    (* Calculates 10**N.	*)
+
+    BEGIN
+	RETURN atoi (10.0, N);
+    END TenToPower;
+
+(************************************************************************)
+(*			CARDINAL-TO-STRING CONVERSIONS			*)
+(************************************************************************)
+
+PROCEDURE HexToChar (number: HexDigit): CHAR;
+
+    (* Converts a one-digit hexadecimal number to its readable form.	*)
+
+    BEGIN
+	IF number < 10 THEN
+	    RETURN CHR(ORD("0")+number)
+	ELSE
+	    RETURN CHR(ORD("A")+number-10)
+	END (*IF*);
+    END HexToChar;
+
+(************************************************************************)
+
+PROCEDURE HexByteToString (value: SHORTCARD;
+			VAR (*OUT*) buffer: ARRAY OF CHAR;  pos: CARDINAL);
+
+    (* Converts a byte value to 2-character hexadecimal, with the	*)
+    (* result stored at buffer[pos] and buffer[pos+1].			*)
+
+    BEGIN
+	buffer[pos] := HexToChar (VAL(HexDigit, value DIV 16));
+	buffer[pos+1] := HexToChar (VAL(HexDigit, value MOD 16));
+    END HexByteToString;
+
+(************************************************************************)
+
+PROCEDURE HexToString (value: CARDINAL;  VAR (*OUT*) buffer: ARRAY OF CHAR);
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	FOR j := HIGH(buffer) TO 0 BY -1 DO
+	    buffer[j] := HexToChar (IAND(value,0FH));
+	    value := RS (value, 4);
+	END (*FOR*);
+    END HexToString;
+
+(************************************************************************)
+
+PROCEDURE LongHexToString (value: LONGCARD;  VAR (*OUT*) buffer: EightChar);
+
+    VAR j: [0..3];  highpart: ARRAY [0..3] OF CHAR;
+
+    BEGIN
+	HexToString (LowWord(value), buffer);
+	HexToString (HighWord(value), highpart);
+	FOR j := 0 TO 3 DO
+	    buffer[j] := highpart[j];
+	END (*FOR*);
+    END LongHexToString;
+
+(************************************************************************)
+
+PROCEDURE LongCardToString (number: LONGCARD;
+					VAR (*OUT*) buffer: ARRAY OF CHAR;
+					fieldsize: CARDINAL);
+
+    (* Converts the number to a decimal character string in array	*)
+    (* "buffer", right-justified in a field of fieldsize characters.	*)
+
+    VAR j, remainder: CARDINAL;
+
+    BEGIN
+	IF number < 10 THEN
+	    IF fieldsize > 1 THEN
+		FOR j := 0 TO fieldsize-2 DO
+		    buffer[j] := " ";
+		END (*FOR*);
+	    END (*IF*);
+	    buffer[fieldsize-1] := CHR(ORD(number) + ORD("0"));
+	ELSIF fieldsize = 1 THEN
+	    buffer[0] := "*";
+	ELSE
+	    LongCardToString (number DIV 10, buffer, fieldsize-1);
+	    remainder := CARDINAL (number MOD 10);
+	    buffer[fieldsize-1] := CHR(remainder + ORD("0"));
+	END (*IF*);
+    END LongCardToString;
+
+(*********************************************************************)
+
+PROCEDURE CardinalToString (number: CARDINAL;
+					VAR (*OUT*) buffer: ARRAY OF CHAR;
+					fieldsize: CARDINAL);
+
+    (* Converts the number to a decimal character string in array	*)
+    (* "buffer", right-justified in a field of fieldsize characters.	*)
+
+    BEGIN
+	LongCardToString (LONGCARD(number), buffer, fieldsize);
+    END CardinalToString;
+
+(*********************************************************************)
+
+PROCEDURE ShortCardToString (number: SHORTCARD;
+					VAR (*OUT*) buffer: ARRAY OF CHAR;
+					fieldsize: CARDINAL);
+
+    (* Converts the number to a decimal character string in array	*)
+    (* "buffer", right-justified in a field of fieldsize characters.	*)
+
+    BEGIN
+	LongCardToString (LONGCARD(number), buffer, fieldsize);
+    END ShortCardToString;
+
+(*********************************************************************)
+
+PROCEDURE AssembleLongCardinal (number: LONGCARD;
+				VAR (*OUT*) buffer: ARRAY OF CHAR;
+				VAR (*INOUT*) place: CARDINAL;
+				VAR (*OUT*) error: BOOLEAN);
+
+    (* Converts number to decimal, putting it in buffer starting at	*)
+    (* buffer[place].  On return, place has been updated to be just	*)
+    (* beyond the last digit put in the buffer.				*)
+
+    BEGIN
+	IF number > 9 THEN
+	    AssembleLongCardinal (number DIV 10, buffer, place, error);
+	    IF error THEN RETURN END(*IF*);
+	END (*IF*);
+	error := place > HIGH(buffer);
+	IF NOT error THEN
+	    buffer[place] := CHR (CARDINAL(number MOD 10) + ORD("0"));
+	    INC (place);
+	END (*IF*);
+    END AssembleLongCardinal;
+
+(************************************************************************)
+(*			REAL-TO-STRING CONVERSIONS			*)
+(************************************************************************)
+
+PROCEDURE AssembleExponent (number: INTEGER;
+			VAR (*OUT*) buffer: ARRAY OF CHAR;
+			VAR (*INOUT*) position: CARDINAL;
+			VAR (*OUT*) error: BOOLEAN);
+
+    (* Puts a field of the format Ennn or E-nnn into the buffer,	*)
+    (* starting at buffer[position].  On return, position has been	*)
+    (* updated so that buffer[position] is the first character not	*)
+    (* altered by this procedure.					*)
+
+    BEGIN
+	error := FALSE;
+	IF number <> 0 THEN
+	    error := position > HIGH(buffer);
+	    IF NOT error THEN
+		buffer[position] := "E";  INC(position);
+		IF number < 0 THEN
+		    error := position > HIGH(buffer);
+		    IF NOT error THEN
+			buffer[position] := "-";  INC(position);
+			number := -number;
+		    END (*IF*);
+		END (*IF*);
+	    END (*IF*);
+	    IF NOT error THEN
+		AssembleLongCardinal (LONGCARD(number),
+					buffer, position, error);
+	    END (*IF*);
+	END (*IF*);
+    END AssembleExponent;
+
+(************************************************************************)
+
+PROCEDURE Roundup (VAR (*INOUT*) buffer: ARRAY OF CHAR;
+					first, last: CARDINAL);
+
+    (* Takes the decimal number in buffer[first..last] and increments	*)
+    (* its least significant digit, propagating the carry upwards as	*)
+    (* far as necessary.						*)
+
+    VAR position, pointposition: CARDINAL;
+	code: CHAR;
+
+    BEGIN
+	position := last+1;  pointposition := position;
+	REPEAT
+	    DEC (position);
+	    code := buffer[position];
+	    IF code = "9" THEN buffer[position] := "0"
+	    ELSIF code = "." THEN
+		pointposition := position;  code := "9";
+	    ELSE
+		INC (buffer[position]);
+	    END (*IF*);
+	UNTIL (code <> "9") OR (position = first);
+
+	(* The job is now done, except for one special case.  If we	*)
+	(* have left the above loop after incrementing a "9", the carry	*)
+	(* has propagated off the left end of the number.  In that case	*)
+	(* every digit must have been a "9", so the result is 10000...	*)
+	(* with a decimal point inserted at the appropriate place.	*)
+
+	IF code = "9" THEN
+	    IF pointposition <= last THEN
+		buffer[pointposition] := "0";
+		IF pointposition < last THEN
+		    INC (pointposition);  buffer[pointposition] := ".";
+		END (*IF*);
+	    END (*IF*);
+	    buffer[first] := "1";
+	END (*IF*);
+
+    END Roundup;
+
+(************************************************************************)
+
+PROCEDURE Fformat (number: LONGREAL;  VAR (*OUT*) buffer: ARRAY OF CHAR;
+			start: CARDINAL;  VAR (*INOUT*) finish: CARDINAL;
+			LeftJustified: BOOLEAN;  VAR (*OUT*) error: BOOLEAN);
+
+    (* Formats the second argument as a decimal number, left or right	*)
+    (* justified depending on the value of LeftJustified, in		*)
+    (* buffer[start..finish].  This procedure is known to be called	*)
+    (* only with start=0 or start=1 with a sign in buffer[0]; so we	*)
+    (* perform the justification on all of buffer[0..finish] if right	*)
+    (* justification is specified.  In the case of left justification,	*)
+    (* finish is updated to show the last buffer position actually	*)
+    (* used; and this character position is followed by one or more NUL	*)
+    (* characters, except in the case where we have used the entire	*)
+    (* field to hold the result.					*)
+
+    VAR position: CARDINAL;
+	integerpart: LONGCARD;  nextdigit: [0..9];
+
+    BEGIN
+	position := start;
+	integerpart := VAL (LONGCARD, number);
+	AssembleLongCardinal (integerpart, buffer, position, error);
+	IF error THEN RETURN END(*IF*);
+
+	IF position <= finish THEN
+	    buffer[position] := ".";
+	    INC (position);
+	    number := number - VAL (LONGREAL, integerpart);
+
+	    WHILE (position <= finish) DO
+		number := 10.0*number;
+		nextdigit := VAL (CARDINAL, number);
+		buffer[position] := CHR(ORD("0") + nextdigit);
+		INC (position);
+		number := number - VAL (LONGREAL, nextdigit);
+	    END (*WHILE*);
+
+	    (* If the remainder is 0.5 or more, adjust the result by	*)
+	    (* rounding up.						*)
+
+	    IF number >= 0.5 THEN
+		Roundup (buffer, start, finish);
+	    END (*IF*);
+
+	    (* Strip off the trailing zeros.	*)
+
+	    DEC (position);
+	    WHILE buffer[position] = '0' DO
+		buffer[position] := CHR(0);
+		DEC (position);
+	    END (*WHILE*);
+
+	    (* If we are left with a whole number, strip off the	*)
+	    (* decimal point.						*)
+
+	    IF buffer[position] = '.' THEN
+		buffer[position] := CHR(0);
+		DEC (position);
+	    END (*IF*);
+
+	    (* Right justify the result or modify finish, as specified.	*)
+
+	    IF LeftJustified THEN
+		finish := position;
+	    ELSE
+		ShiftRight (buffer, 0, finish, finish-position);
+	    END (*IF*);
+
+	END (*IF*);
+
+    END Fformat;
+
+(************************************************************************)
+
+PROCEDURE Scale (VAR (*INOUT*) mantissa: LONGREAL;
+			VAR (*INOUT*) exponent: INTEGER;
+			power: CARDINAL;  lower, upper: LONGREAL);
+
+    (* Adjusts mantissa so that lower <= mantissa < upper, while	*)
+    (* keeping the quantity  (mantissa * 10^exponent) invariant.  To	*)
+    (* save us some calculation, the caller must ensure that		*)
+    (* upper = 10^power and lower = 10^(-power).			*)
+
+    BEGIN
+	WHILE mantissa >= upper DO
+	    INC (exponent, power);  mantissa := lower*mantissa;
+	END (*WHILE*);
+
+	WHILE mantissa < lower DO
+	    DEC (exponent, power);  mantissa := upper*mantissa;
+	END (*WHILE*);
+    END Scale;
+
+(************************************************************************)
+
+PROCEDURE Separate (number: LONGREAL;  VAR (*OUT*) mantissa: LONGREAL;
+					VAR (*OUT*) exponent: INTEGER);
+
+    (* Separates the first argument into a mantissa and exponent part,	*)
+    (* so that  number = mantissa * 10^exponent.			*)
+
+    BEGIN
+	mantissa := number;  exponent := 0;
+	Scale (mantissa, exponent, 256, 1.0E-256, 1.0E256);
+	Scale (mantissa, exponent, 64, 1.0E-64, 1.0E64);
+	Scale (mantissa, exponent, 16, 1.0E-16, 1.0E16);
+	Scale (mantissa, exponent, 4, 1.0E-4, 1.0E4);
+	Scale (mantissa, exponent, 1, 1.0E-1, 1.0E1);
+    END Separate;
+
+(************************************************************************)
+
+PROCEDURE Eformat (number: LONGREAL;  VAR (*OUT*) buffer: ARRAY OF CHAR;
+					start, finish: CARDINAL;
+					VAR (*OUT*) error: BOOLEAN);
+
+    (* Puts number into buffer[start..finish] in E format, with the	*)
+    (* whole of buffer[0..finish] right justified.			*)
+
+    VAR mantissa: LONGREAL;  exponent: INTEGER;
+	position: CARDINAL;
+
+    BEGIN
+	Separate (number, mantissa, exponent);
+
+	(* Put the exponent into the buffer first, in order to find out	*)
+	(* how much space will be left for the mantissa.		*)
+
+	position := start;
+	AssembleExponent (exponent, buffer, position, error);
+	error := error OR (position > finish);
+
+	IF error THEN
+	    IF finish < HIGH(buffer) THEN
+		buffer[finish+1] := CHR(0);
+	    END (*IF*);
+	ELSE
+	    ShiftRight (buffer, start, finish, finish-position+1);
+
+	    (* Now assemble the mantissa into the buffer.	*)
+
+	    DEC (finish, position-start);
+	    Fformat (mantissa, buffer, start, finish, FALSE, error);
+	END (*IF*);
+
+    END Eformat;
+
+(************************************************************************)
+(*		CONVERSION OF REAL NUMBER TO CHARACTER STRING		*)
+(************************************************************************)
+
+PROCEDURE LongRealToString (number: LONGREAL;
+					VAR (*OUT*) buffer: ARRAY OF CHAR;
+					fieldsize: CARDINAL);
+
+    (* Converts the number to a decimal character string in array	*)
+    (* "buffer", right-justified in a field of "places" characters.	*)
+
+    VAR start, finish, j: CARDINAL;  small: LONGREAL;  error: BOOLEAN;
+
+    BEGIN
+	IF fieldsize = 0 THEN RETURN END(*IF*);
+
+	start := 0;  finish := start+fieldsize-1;  error := FALSE;
+
+	(* Make sure that the string will fit into the buffer, and that	*)
+	(* it will be properly terminated.				*)
+
+	IF finish > HIGH(buffer) THEN
+	    DEC (fieldsize, finish-HIGH(buffer));
+	    finish := HIGH(buffer);
+	ELSIF finish < HIGH(buffer) THEN
+	    buffer[finish+1] := CHR(0);
+	END (*IF*);
+
+	(* For a negative number, insert a minus sign.	*)
+
+	IF number < 0.0 THEN
+	    IF fieldsize <= 1 THEN
+		error := TRUE;
+	    ELSE
+		buffer[0] := "-";  INC (start);  DEC(fieldsize);
+		number := -number;
+	    END (*IF*);
+	END (*IF*);
+
+	IF NOT error THEN
+
+	    (* Now decide on whether to use E format, based on the	*)
+	    (* value to be converted.					*)
+
+	    small := 100.0 / TenToPower(fieldsize);
+	    IF number = 0.0 THEN
+		Fformat (number, buffer, start, finish, FALSE, error);
+	    ELSIF (number >= TenToPower(fieldsize))
+		    OR (number > VAL(LONGREAL, MAX(LONGCARD)))
+			OR (number < small) THEN
+	        Eformat (number, buffer, start, finish, error);
+	    ELSE
+		Fformat (number, buffer, start, finish, FALSE, error);
+	    END (*IF*);
+
+	END (*IF*);
+
+	IF error THEN
+	    FOR j := 0 TO finish DO
+		buffer[j] := '*';
+	    END (*FOR*);
+	END (*IF*);
+
+    END LongRealToString;
+
+(************************************************************************)
+
+PROCEDURE RealToString (number: REAL;  VAR (*OUT*) buffer: ARRAY OF CHAR;
+					fieldsize: CARDINAL);
+
+    (* Like LongRealToString, except for argument type.	*)
+
+    BEGIN
+	LongRealToString (LONGREAL(number), buffer, fieldsize);
+    END RealToString;
+
+(************************************************************************)
+
+PROCEDURE LongRealToF (number: LONGREAL;  VAR (*INOUT*) fieldsize: CARDINAL;
+			decimalplaces: CARDINAL;  LeftJustified: BOOLEAN;
+			VAR (*OUT*) buffer: ARRAY OF CHAR);
+
+    (* Converts the number to an F-format string, of up to fieldsize	*)
+    (* characters with decimalplaces digits after the decimal point.	*)
+    (* The result is left justified if LeftJustified = TRUE is		*)
+    (* specified by the caller, and right justified with space fill	*)
+    (* otherwise.  On return fieldsize gives the number of character	*)
+    (* positions actually used.  The result string is terminated with	*)
+    (* at least one CHR(0) (which is not counted in fieldsize), except	*)
+    (* where the result fills the entire buffer.			*)
+
+    VAR start, finish, j: CARDINAL;  scalefactor: LONGREAL;  error: BOOLEAN;
+
+    BEGIN
+	IF fieldsize = 0 THEN RETURN END(*IF*);
+
+	start := 0;  finish := start+fieldsize-1;  error := FALSE;
+
+	(* Make sure that the string will fit into the buffer, and that	*)
+	(* it will be properly terminated.				*)
+
+	IF finish > HIGH(buffer) THEN
+	    DEC (fieldsize, finish-HIGH(buffer));
+	    finish := HIGH(buffer);
+	ELSIF finish < HIGH(buffer) THEN
+	    buffer[finish+1] := CHR(0);
+	END (*IF*);
+
+	(* For a negative number, insert a minus sign.	*)
+
+	IF number < 0.0 THEN
+	    IF fieldsize <= 1 THEN
+		error := TRUE;
+	    ELSE
+		buffer[0] := "-";  INC (start);  DEC(fieldsize);
+		number := -number;
+	    END (*IF*);
+	END (*IF*);
+
+	IF NOT error THEN
+
+	    (* Round the number to the desired number of decimal places. *)
+
+	    scalefactor := TenToPower (decimalplaces);
+	    number := scalefactor*number + 0.5;
+	    number := VAL(LONGREAL, VAL(LONGCARD, number)) / scalefactor;
+
+	    (* Perform the conversion.	*)
+
+	    Fformat (number, buffer, start, finish, LeftJustified, error);
+
+	END (*IF*);
+
+	IF error THEN
+	    FOR j := 0 TO finish DO
+		buffer[j] := '*';
+	    END (*FOR*);
+	END (*IF*);
+
+	fieldsize := finish + 1;
+
+    END LongRealToF;
+
+(************************************************************************)
+
+PROCEDURE RealToF (number: REAL;  VAR (*INOUT*) fieldsize: CARDINAL;
+			decimalplaces: CARDINAL;  LeftJustified: BOOLEAN;
+			VAR (*OUT*) buffer: ARRAY OF CHAR);
+
+    (* Like LongRealToF, except for argument type.	*)
+
+    BEGIN
+	LongRealToF (LONGREAL(number), fieldsize, decimalplaces,
+					LeftJustified, buffer);
+    END RealToF;
+
+(************************************************************************)
+(*		    CONVERSION OF STRING TO CARDINAL			*)
+(************************************************************************)
+
+PROCEDURE StringToHex (string: ARRAY OF CHAR): LONGCARD;
+
+    (* Converts a hexadecimal character string to numeric, stopping at	*)
+    (* the first non-digit character.  Leading spaces are permitted.	*)
+
+    CONST HexChars = CharSet {"0".."9", "a".."f", "A".."F"};
+
+    VAR position: CARDINAL;  value: LONGCARD;
+
+    BEGIN
+	position := 0;
+	WHILE (position <= HIGH(string)) AND (string[position] = ' ') DO
+	    INC (position);
+	END (*WHILE*);
+	value := 0;
+	WHILE (position <= HIGH(string)) AND (string[position] IN HexChars) DO
+	    value := 16*value;
+	    IF string[position] IN CharSet{"a".."f"} THEN
+		value := value + 10
+			+ LONGCARD(ORD(string[position]) - ORD('a'));
+	    ELSIF string[position] IN CharSet{"A".."F"} THEN
+		value := value + 10
+			+ LONGCARD(ORD(string[position]) - ORD('A'));
+	    ELSE
+		value := value + LONGCARD(ORD(string[position]) - ORD('0'));
+	    END (*IF*);
+	    INC (position);
+	END (*WHILE*);
+	RETURN value;
+    END StringToHex;
+
+(************************************************************************)
+
+PROCEDURE StringToLongCard (string: ARRAY OF CHAR): LONGCARD;
+
+    (* Converts a character string to decimal, stopping at the first	*)
+    (* non-digit character.  Leading spaces are permitted.		*)
+
+    VAR position: CARDINAL;  value: LONGCARD;
+
+    BEGIN
+	position := 0;
+	WHILE (position <= HIGH(string)) AND (string[position] = ' ') DO
+	    INC (position);
+	END (*WHILE*);
+	value := 0;
+	WHILE (position <= HIGH(string)) AND (string[position] >= '0')
+		AND (string[position] <= '9') DO
+	    value := 10*value + VAL(LONGCARD, ORD(string[position]) - ORD('0'));
+	    INC (position);
+	END (*WHILE*);
+	RETURN value;
+    END StringToLongCard;
+
+(************************************************************************)
+
+PROCEDURE StringToCardinal (string: ARRAY OF CHAR): CARDINAL;
+
+    (* Converts a character string to decimal, stopping at the first	*)
+    (* non-digit character.  Leading spaces are permitted.		*)
+
+    VAR position: CARDINAL;  value: CARDINAL;
+
+    BEGIN
+	RETURN VAL(CARDINAL, StringToLongCard(string));
+    END StringToCardinal;
+
+(************************************************************************)
+(*			CONVERSION OF STRING TO REAL			*)
+(************************************************************************)
+
+PROCEDURE StringToLongReal (string: ARRAY OF CHAR): LONGREAL;
+
+    (* Converts a decimal text string (with optional leading minus	*)
+    (* sign) to real.  Leading blanks are ignored.  The conversion	*)
+    (* stops at the end of the array or at the first character which	*)
+    (* cannot be part of the number, and in the latter case all		*)
+    (* subsequent characters are ignored.				*)
+
+    VAR result, placevalue, temp: LONGREAL;
+	position: CARDINAL;
+	nextchar: CHAR;
+	exponent: CARDINAL;  negative, negativeexp: BOOLEAN;
+
+    (********************************************************************)
+
+    PROCEDURE GetNextChar;
+
+	(* Puts the next character in the input into variable nextchar,	*)
+	(* or sets nextchar := CHR(0) if there is no next character.	*)
+	(* The position in the array is updated.			*)
+
+	CONST EndMarker = CHR(0);
+
+	BEGIN
+	    IF position > HIGH(string) THEN
+		nextchar := EndMarker;
+	    ELSE
+		nextchar := string[position];  INC (position);
+	    END (*IF*);
+	END GetNextChar;
+
+    (********************************************************************)
+
+    BEGIN
+	result := 0.0;  position := 0;  negative := FALSE;
+
+	(* Skip leading spaces and tabs.	*)
+
+	REPEAT
+	    GetNextChar;
+	UNTIL (nextchar <> " ") AND (nextchar <> tab);
+
+	(* Check for a sign.	*)
+
+	IF (nextchar = "-") OR (nextchar = "+") THEN
+	    negative := (nextchar = "-");
+
+	    (* There might be some more spaces to skip.	*)
+
+	    REPEAT
+		GetNextChar;
+	    UNTIL (nextchar <> " ") AND (nextchar <> tab);
+	END (*IF*);
+
+	(* Read the part before the decimal point.	*)
+
+	WHILE nextchar IN CharSet {"0".."9"} DO
+	    result := 10.0*result + VAL(LONGREAL, ORD(nextchar)-ORD("0") );
+	    GetNextChar;
+	END (*WHILE*);
+
+	(* Now the part after the decimal point, if any.	*)
+
+	IF nextchar = "." THEN
+	    GetNextChar;  placevalue := 0.1;
+	    WHILE nextchar IN CharSet {"0".."9"} DO
+		result := result +
+			placevalue * VAL(LONGREAL, ORD(nextchar)-ORD("0") );
+		placevalue := 0.1*placevalue;
+		GetNextChar;
+	    END (*WHILE*);
+	END (*IF*);
+
+	(* Check for Ennn part.	*)
+
+	IF (nextchar = "E") OR (nextchar = "e") THEN
+	    GetNextChar;
+	    exponent := 0;  negativeexp := FALSE;
+	    IF nextchar = "+" THEN
+		GetNextChar;
+	    ELSIF nextchar = "-" THEN
+		negativeexp := TRUE;  GetNextChar;
+	    END (*IF*);
+	    WHILE nextchar IN CharSet {"0".."9"} DO
+		exponent := 10*exponent + ORD(nextchar) - ORD("0");
+		GetNextChar;
+	    END (*WHILE*);
+	    IF negativeexp THEN
+		result := result / TenToPower(exponent);
+	    ELSE
+		result := result * TenToPower(exponent);
+	    END (*IF*);
+	END (*IF*);
+
+	IF negative THEN
+	    result := -result;
+	END (*IF*);
+	RETURN result;
+
+    END StringToLongReal;
+
+(************************************************************************)
+
+PROCEDURE StringToReal (string: ARRAY OF CHAR): REAL;
+
+    (* Like StringToLongReal except for the result type.	*)
+
+    BEGIN
+	RETURN REAL (StringToLongReal(string));
+    END StringToReal;
+
+(************************************************************************)
+
+END Conversions.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/devices.def b/examples/Modula-2_Libraries/PMOS/sources/general/devices.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/devices.def
@@ -0,0 +1,184 @@
+DEFINITION MODULE Devices;
+
+	(********************************************************)
+	(*							*)
+	(*		Support for device drivers.		*)
+	(*							*)
+	(*  The aim of this module is to a measure of device	*)
+	(*  independence in I/O operations.  It provides a	*)
+	(*  uniform I/O interface to all device drivers which	*)
+	(*  choose to make themselves known to module Devices.	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	16 June 1992			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE, ADDRESS;
+
+FROM IOErrorCodes IMPORT
+    (* type *)	ErrorCode;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore;
+
+(************************************************************************)
+
+TYPE
+    BlockNumberType = LONGCARD;
+
+    (* Any I/O device supported by this module is specified by a pair	*)
+    (* of type (device, unit), where the first component has private	*)
+    (* type Device, and the second is a unit number (normally zero, but	*)
+    (* some device drivers support multi-unit devices).			*)
+
+    Device;	(* is private *)
+
+    (* The I/O operations dealt with by this module.  Note that "read"	*)
+    (* and "physicalread" have the same meaning for most devices - and	*)
+    (* similarly for "write" and "physicalwrite" - but the distinction	*)
+    (* is important for hard disks, which can be partitioned into	*)
+    (* one or more logical disks.					*)
+
+    OperationType = (verify, read, write, physicalread, physicalwrite,
+			shutdown);
+
+    (********************************************************************)
+    (*									*)
+    (*  An I/O operation is specified by the details in a request block	*)
+    (*  whose fields have the meaning:					*)
+    (*									*)
+    (*		Status		to show the result of the operation	*)
+    (*				  (Status = OK if there was no error)	*)
+    (*		operation	the desired I/O operation		*)
+    (*		device,unit	the device to be used			*)
+    (*		BlockNumber	the block number on the medium, used	*)
+    (*				only for block-oriented devices		*)
+    (*		ByteCount	the number of bytes to transfer		*)
+    (*		BufferAddress	the address of an array which holds the	*)
+    (*				data to be written, or which will	*)
+    (*				receive the input data			*)
+    (*		DoneSemaphorePointer  the address of a semaphore on	*)
+    (*				which the device will perform a Signal	*)
+    (*				to let the user know that the operation	*)
+    (*				is complete				*)
+    (*									*)
+    (*  The caller must not modify the contents of the request block	*)
+    (*  until completion of the I/O operation.  Device drivers must	*)
+    (*  not modify any field except the Status field.			*)
+    (*									*)
+    (********************************************************************)
+
+TYPE
+    RequestBlock = RECORD
+			Status: ErrorCode;
+			operation: OperationType;
+			device: Device;
+			unit: CARDINAL;
+			BlockNumber: BlockNumberType;
+			ByteCount: CARDINAL;
+			BufferAddress: ADDRESS;
+			DoneSemaphorePointer: POINTER TO Semaphore;
+		   END (*RECORD*);
+
+    RequestBlockPointer = POINTER TO RequestBlock;
+
+(************************************************************************)
+(*		  PROCEDURES CALLED BY THE USER TASKS			*)
+(************************************************************************)
+
+PROCEDURE SameDevice (d1, d2: Device): BOOLEAN;
+
+    (* Tests the condition d1 = d2.	*)
+
+PROCEDURE NullDevice (): Device;
+
+    (* Returns the device code which this module uses internally to	*)
+    (* mean "nonexistent device" or "unknown device".  I/O operations	*)
+    (* on this device are of course impossible (if attempted, they will	*)
+    (* result in the NoSuchDevice error code), but the device code can	*)
+    (* be used by client modules as a marker to indicate that no	*)
+    (* genuine device has yet been specified.				*)
+
+PROCEDURE IdentifyDevice (name: ARRAY OF CHAR;  VAR (*OUT*) device: Device;
+				VAR (*OUT*) unitnumber: CARDINAL);
+
+    (* Given the character string form of a device name, returns the	*)
+    (* device code and unit number.					*)
+
+PROCEDURE GetDefaultDirectory (device: Device;  unit: CARDINAL;
+				VAR (*OUT*) DirectoryString: ARRAY OF CHAR);
+
+    (* Produces a string representing the default directory.  The	*)
+    (* string includes the character form of the device name.		*)
+
+PROCEDURE VolumeSize (device: Device;  unitnumber: CARDINAL): BlockNumberType;
+
+    (* Returns the number of sectors on (device, unitnumber).  Note	*)
+    (* that the result is meaningful only for device drivers which	*)
+    (* supply this information (see DeviceName below).			*)
+
+PROCEDURE IOrequest (VAR (*INOUT*) details: RequestBlock);
+
+    (* Adds the requested I/O operation to the queue of pending		*)
+    (* operations on details.device.  The operation might not be done	*)
+    (* immediately since the device driver might still be working on an	*)
+    (* earlier request.  On I/O completion, the device driver performs	*)
+    (* a Signal(details.DoneSemaphorePointer^).				*)
+
+PROCEDURE BlockRead (d: Device;  unitnumber: CARDINAL;
+			BlockNumber: BlockNumberType;
+			MemoryAddress: ADDRESS;  amount: CARDINAL): ErrorCode;
+
+    (* Reads "amount" bytes into memory, starting at the		*)
+    (* beginning of block number "BlockNumber" on the specified device.	*)
+
+PROCEDURE BlockWrite (d: Device;  unitnumber: CARDINAL;
+			BlockNumber: BlockNumberType;
+			MemoryAddress: ADDRESS;  amount: CARDINAL): ErrorCode;
+
+    (* Writes "amount" bytes from memory, starting at the beginning of	*)
+    (* block number "BlockNumber" on the specified device.		*)
+
+PROCEDURE ReadPhysicalBlock (d: Device;  unitnumber: CARDINAL;
+		BlockNo: BlockNumberType;  MemoryAddress: ADDRESS): ErrorCode;
+
+    (* Reads one sector into memory, starting at the beginning of	*)
+    (* physical block number "BlockNo" on the specified device.		*)
+
+(************************************************************************)
+(*		PROCEDURES CALLED BY THE DEVICE DRIVERS			*)
+(************************************************************************)
+
+PROCEDURE InstallDeviceDriver (MaxUnitNumber: CARDINAL): Device;
+
+    (* Called by the device driver as part of its initialization code,	*)
+    (* to make the driver known to this module.  MaxUnitNumber is the	*)
+    (* maximum unit number which this device driver will support (0 for	*)
+    (* a single-unit device driver).  The value returned is the means	*)
+    (* by which the device driver will henceforth identify itself to	*)
+    (* this module.							*)
+
+PROCEDURE DeviceName (device: Device;  unit: CARDINAL;
+			name: ARRAY OF CHAR;  size: BlockNumberType;
+			DefaultDirString: ARRAY OF CHAR);
+
+    (* Specifies an external name for a given device and unit number.	*)
+    (* Duplicate names are permitted.  The size parameter gives the	*)
+    (* number of sectors in the partition if this "device" is actually	*)
+    (* a partition on a hard disk; but it is not necessarily meaningful	*)
+    (* for other device types.  (This parameter is supplied only for	*)
+    (* the benefit of the file system when it has to deal with the	*)
+    (* special case of a large partition.)  Device drivers which are	*)
+    (* not prepared to specify a meaningful size should supply a value	*)
+    (* of 0 for the size.						*)
+    (* DefaultDirString specifies the initial default directory.	*)
+
+PROCEDURE AcceptRequest (device: Device): RequestBlockPointer;
+
+    (* Returns a pointer to the next request enqueued for this device.	*)
+    (* If there is no next request, we wait until one appears.		*)
+
+END Devices.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/devices.mod b/examples/Modula-2_Libraries/PMOS/sources/general/devices.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/devices.mod
@@ -0,0 +1,549 @@
+IMPLEMENTATION MODULE Devices;
+
+	(********************************************************)
+	(*							*)
+	(*		Support for device drivers.		*)
+	(*							*)
+	(*  The aim of this module is to a measure of device	*)
+	(*  independence in I/O operations.  It provides a	*)
+	(*  uniform I/O interface to all device drivers which	*)
+	(*  choose to make themselves known to module Devices.	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 February 1995		*)
+	(*  Status:		Working.			*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* proc *)	ADR;
+
+FROM Queues IMPORT
+    (* type *)	Queue,
+    (* proc *)	CreateQueue, AddToQueue, TakeFromQueue;
+
+FROM Semaphores IMPORT
+    (* proc *)	CreateSemaphore, DestroySemaphore, Signal, Wait;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM LowLevel IMPORT
+    (* proc *)	Physical;
+
+FROM TerminationControl IMPORT
+    (* proc *)	Crash, SetTerminationProcedure;
+
+IMPORT Str;
+
+(************************************************************************)
+
+CONST CheckCode = 0C5E2H;
+
+TYPE
+
+    (* We allow external device names to be up to eight characters in	*)
+    (* length, and default directory strings to be up to 64 characters	*)
+    (* in length.  (This decision should perhaps be reviewed later.)	*)
+
+    EightChar = ARRAY [0..7] OF CHAR;
+    DirString = ARRAY [0..63] OF CHAR;
+
+    (* The fields in a device descriptor are:				*)
+    (*	  check		a constant, inserted to detect uninitialised	*)
+    (*			pointers					*)
+    (*	  UnitLimit	maximum unit number for this device		*)
+    (*	  RequestQueue	the queue of pending I/O requests		*)
+    (*	  capacity	the number of sectors, as supplied by procedure	*)
+    (*			DeviceName, for each unit of this device	*)
+
+    DeviceRec = RECORD
+		    check: CARDINAL;
+		    UnitLimit: CARDINAL;
+		    RequestQueue: Queue;
+		    capacity: ARRAY [0..0] OF BlockNumberType;
+		END (*RECORD*);
+
+    Device = POINTER TO DeviceRec;
+
+    (* We maintain a binary structure to hold the equivalences between	*)
+    (* external and internal device names.  Note that the information	*)
+    (* kept here is associated with a (device, unit) pair; it cannot	*)
+    (* simply be associated with a device, which is why we can't use	*)
+    (* a DeviceRec record for this purpose.				*)
+
+    TreePointer = POINTER TO NameRecord;
+    NameRecord = RECORD
+		    left, right: TreePointer;
+		    string: EightChar;
+		    devicecode: Device;
+		    unitnumber: CARDINAL;
+		    defaultdir: DirString;
+		 END (*RECORD*);
+
+(************************************************************************)
+
+VAR
+    (* DummyDevice is the device code returned for any unknown device	*)
+    (* name.  Any attempted operation on DummyDevice will return a	*)
+    (* "no such device" error.						*)
+
+    DummyDevice: Device;
+
+    (* Names points to head of the structure which holds device names.	*)
+
+    Names: TreePointer;
+
+(************************************************************************)
+(*			     ERROR HANDLER				*)
+(************************************************************************)
+
+PROCEDURE Error (VAR (*INOUT*) details: RequestBlock;  ErrorNo: ErrorCode);
+
+    (* Fills in the error code in the "details" record, and signals	*)
+    (* that the operation is complete.					*)
+
+    BEGIN
+	WITH details DO
+	    Status := ErrorNo;
+	    Signal (DoneSemaphorePointer^);
+	END (*WITH*);
+    END Error;
+
+(************************************************************************)
+(*	  MAPPING BETWEEN EXTERNAL NAMES AND DEVICE INFORMATION		*)
+(************************************************************************)
+
+PROCEDURE CopyString (src: ARRAY OF CHAR;  VAR (*OUT*) dest: ARRAY OF CHAR;
+					VAR (*INOUT*) place: CARDINAL);
+
+    (* Copies src to dest, starting at dest[place].  On exit place	*)
+    (* has been updated to point to the trailing Nul, or beyond the end	*)
+    (* of dest if there was no room for the trailing Nul.		*)
+
+    CONST Nul = CHR(0);
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	j := 0;
+	WHILE (j<=HIGH(src)) AND (place<=HIGH(dest)) AND (src[j] <> Nul) DO
+	    dest[place] := src[j];  INC (j);  INC (place);
+	END (*WHILE*);
+	IF place <= HIGH(dest) THEN
+	    dest[place] := Nul;
+	END (*IF*);
+    END CopyString;
+
+(************************************************************************)
+
+PROCEDURE CopyAndPad (name: ARRAY OF CHAR): EightChar;
+
+    (* Converts a character string to a fixed-length string with	*)
+    (* trailing space characters.					*)
+
+    VAR result: EightChar;  j: [0..8];
+
+    BEGIN
+	result := "        ";  j := 0;
+	WHILE (j<8) AND (j<=HIGH(name)) AND (name[j] <> CHR(0)) DO
+	    result[j] := name[j];  INC (j);
+	END (*WHILE*);
+	RETURN result;
+    END CopyAndPad;
+
+(************************************************************************)
+
+PROCEDURE Search (name: ARRAY OF CHAR;  VAR (*OUT*) device: Device;
+			VAR (*OUT*) unit: CARDINAL;
+			VAR (*OUT*) found: BOOLEAN);
+
+    (* Searches the Names structure for a match with "name", and	*)
+    (* returns the device and unit codes; or returns found = FALSE if	*)
+    (* the name was not found.						*)
+
+    VAR namestring: EightChar;  current: TreePointer;
+
+    BEGIN
+	namestring := CopyAndPad (name);  current := Names;  found := FALSE;
+	LOOP
+	    IF current = NIL THEN EXIT(*LOOP*) END (*IF*);
+	    IF current^.string = namestring THEN
+		found := TRUE;  EXIT(*LOOP*);
+	    ELSIF Str.Compare (current^.string, namestring) < 0 THEN
+		current := current^.left;
+	    ELSE
+		current := current^.right;
+	    END (*IF*);
+	END (*LOOP*);
+	IF found THEN
+	    device := current^.devicecode;
+	    unit := current^.unitnumber;
+	END (*IF*);
+    END Search;
+
+(************************************************************************)
+
+PROCEDURE SearchTree (T: TreePointer;  dev: Device;  unitno: CARDINAL)
+								: TreePointer;
+
+    (* Searches tree T structure for a match with (dev, unitno), and	*)
+    (* returns a pointer to the record found; or returns NIL if the	*)
+    (* (dev, unitno) pair was not found.				*)
+
+    VAR result: TreePointer;
+
+    BEGIN
+	IF T = NIL THEN RETURN NIL;
+	ELSIF SameDevice(T^.devicecode, dev)
+			AND (T^.unitnumber = unitno) THEN RETURN T;
+	ELSE
+	    result := SearchTree (T^.left, dev, unitno);
+	    IF result <> NIL THEN RETURN result;
+	    ELSE RETURN SearchTree (T^.right, dev, unitno);
+	    END (*IF*);
+	END (*IF*);
+    END SearchTree;
+
+(************************************************************************)
+(*		  PROCEDURES CALLED BY THE USER TASKS			*)
+(************************************************************************)
+
+PROCEDURE SameDevice (d1, d2: Device): BOOLEAN;
+
+    (* Tests the condition d1 = d2.	*)
+
+    BEGIN
+	RETURN Physical(d1) = Physical(d2);
+    END SameDevice;
+
+(************************************************************************)
+
+PROCEDURE NullDevice (): Device;
+
+    (* Returns the device code which this module uses internally to	*)
+    (* mean "nonexistent device" or "unknown device".  I/O operations	*)
+    (* on this device are of course impossible (if attempted, they will	*)
+    (* result in the NoSuchDevice error code), but the device code can	*)
+    (* be used by client modules as a marker to indicate that no	*)
+    (* genuine device has yet been specified.				*)
+
+    BEGIN
+	RETURN DummyDevice;
+    END NullDevice;
+
+(************************************************************************)
+
+PROCEDURE IdentifyDevice (name: ARRAY OF CHAR;  VAR (*OUT*) device: Device;
+				VAR (*OUT*) unitnumber: CARDINAL);
+
+    (* Given the character string form of a device name, returns the	*)
+    (* device code and unit number.					*)
+
+    VAR found: BOOLEAN;
+
+    BEGIN
+	Search (name, device, unitnumber, found);
+	IF NOT found THEN
+	    device := DummyDevice;
+	    unitnumber := 0;
+	END (*IF*);
+    END IdentifyDevice;
+
+(************************************************************************)
+
+PROCEDURE GetDefaultDirectory (device: Device;  unit: CARDINAL;
+				VAR (*OUT*) DirectoryString: ARRAY OF CHAR);
+
+    (* Produces a string representing the default directory.  The	*)
+    (* string includes the character form of the device name.		*)
+
+    VAR T: TreePointer;  j: CARDINAL;
+
+    BEGIN
+	T := SearchTree (Names, device, unit);
+	IF T = NIL THEN
+	    DirectoryString[0] := CHR(0);
+	ELSE
+	    WITH T^ DO
+		j := 0;
+		CopyString (string, DirectoryString, j);
+		WHILE DirectoryString[j-1] = ' ' DO
+		    DEC (j);
+		END (*WHILE*);
+		CopyString (":\", DirectoryString, j);
+		CopyString (defaultdir, DirectoryString, j);
+	    END (*WITH*);
+	END (*IF*);
+    END GetDefaultDirectory;
+
+(************************************************************************)
+
+PROCEDURE VolumeSize (device: Device;  unitnumber: CARDINAL): BlockNumberType;
+
+    (* Returns the number of sectors on (device, unitnumber).  Note	*)
+    (* that the result is meaningful only for device drivers which	*)
+    (* supply this information (see DeviceName below).			*)
+
+    BEGIN
+(*# save, check(index => off) *)
+	RETURN device^.capacity[unitnumber];
+(*# restore *)
+    END VolumeSize;
+
+(************************************************************************)
+
+PROCEDURE IOrequest (VAR (*INOUT*) details: RequestBlock);
+
+    (* Adds the requested I/O operation to the queue of pending		*)
+    (* operations on details.device.  The operation might not be done	*)
+    (* immediately since the device driver might still be working on an	*)
+    (* earlier request.  On I/O completion, the device driver performs	*)
+    (* a Signal(details.DoneSemaphorePointer^).				*)
+
+    BEGIN
+	WITH details DO
+	    IF device^.check <> CheckCode THEN
+		Error (details, NoSuchDevice);
+	    ELSIF unit > device^.UnitLimit THEN
+		Error (details, NoSuchUnit);
+	    ELSE
+		AddToQueue (device^.RequestQueue, ADR(details));
+	    END (*IF*);
+	END (*WITH*);
+    END IOrequest;
+
+(************************************************************************)
+
+PROCEDURE SynchronousIO (op: OperationType;
+			d: Device;  unitnumber: CARDINAL;
+			Block: BlockNumberType;
+			MemoryAddress: ADDRESS;  amount: CARDINAL): ErrorCode;
+
+    (* Like IOrequest, but does not return until the operation is	*)
+    (* complete.  This is for the convenience of callers who do not	*)
+    (* want to deal with the complications of semaphores.		*)
+
+    VAR RequestRecord: RequestBlock;
+	DoneSemaphore: Semaphore;
+	status: ErrorCode;
+
+    BEGIN
+	CreateSemaphore (DoneSemaphore, 0);
+	WITH RequestRecord DO
+	    operation := op;
+	    device := d;
+	    unit := unitnumber;
+	    BlockNumber := Block;
+	    BufferAddress := MemoryAddress;
+	    ByteCount := amount;
+	    DoneSemaphorePointer := ADR (DoneSemaphore);
+	END (*WITH*);
+	IOrequest (RequestRecord);
+	Wait (DoneSemaphore);
+	status := RequestRecord.Status;
+	DestroySemaphore (DoneSemaphore);
+	RETURN status;
+    END SynchronousIO;
+
+(************************************************************************)
+
+PROCEDURE BlockRead (d: Device;  unitnumber: CARDINAL;
+			BlockNumber: BlockNumberType;
+			MemoryAddress: ADDRESS;  amount: CARDINAL): ErrorCode;
+
+    (* Reads "amount" bytes into memory, starting at the beginning of	*)
+    (* block number "BlockNumber" on the specified device.		*)
+
+    BEGIN
+	RETURN SynchronousIO (read, d, unitnumber, BlockNumber,
+					MemoryAddress, amount);
+    END BlockRead;
+
+(************************************************************************)
+
+PROCEDURE ReadPhysicalBlock (d: Device;  unitnumber: CARDINAL;
+		BlockNo: BlockNumberType;  MemoryAddress: ADDRESS): ErrorCode;
+
+    (* Reads one sector into memory, starting at the beginning of	*)
+    (* physical block number "BlockNo" on the specified device.		*)
+
+    BEGIN
+	RETURN SynchronousIO (physicalread, d, unitnumber, BlockNo,
+							MemoryAddress, 0);
+    END ReadPhysicalBlock;
+
+(************************************************************************)
+
+PROCEDURE BlockWrite (d: Device;  unitnumber: CARDINAL;
+			BlockNumber: BlockNumberType;
+			MemoryAddress: ADDRESS;  amount: CARDINAL): ErrorCode;
+
+    (* Writes "amount" bytes from memory to the device, starting at the	*)
+    (* beginning of block number "BlockNumber" on the specified device.	*)
+
+    BEGIN
+	RETURN SynchronousIO (write, d, unitnumber, BlockNumber,
+					MemoryAddress, amount);
+    END BlockWrite;
+
+(************************************************************************)
+(*		PROCEDURES CALLED BY THE DEVICE DRIVERS			*)
+(************************************************************************)
+
+PROCEDURE InstallDeviceDriver (MaxUnitNumber: CARDINAL): Device;
+
+    (* Called by the device driver as part of its initialization code,	*)
+    (* to make the driver known to this module.  MaxUnitNumber is the	*)
+    (* maximum unit number which this device driver will support (0 for	*)
+    (* a single-unit device driver).  The other input parameter is	*)
+    (* the external name of the device.  The value returned is the	*)
+    (* means by which the device driver will henceforth identify itself	*)
+    (* to this module.							*)
+
+    VAR result: Device;  j: CARDINAL;
+
+    BEGIN
+	ALLOCATE (result, SIZE(DeviceRec)+MaxUnitNumber*SIZE(BlockNumberType));
+	WITH result^ DO
+	    check := CheckCode;
+	    UnitLimit := MaxUnitNumber;
+	    CreateQueue (RequestQueue);
+	    FOR j := 0 TO MaxUnitNumber DO
+(*# save, check(index => off) *)
+		capacity[j] := 0;
+(*# restore *)
+	    END (*FOR*);
+	END (*WITH*);
+	RETURN result;
+    END InstallDeviceDriver;
+
+(************************************************************************)
+
+PROCEDURE DeviceName (device: Device;  unit: CARDINAL;
+			name: ARRAY OF CHAR;  size: BlockNumberType;
+			DefaultDirString: ARRAY OF CHAR);
+
+    (* Specifies an external name for a given device and unit number.	*)
+    (* Duplicate names are permitted.  The size parameter gives the	*)
+    (* number of blocks in the partition if this "device" is actually	*)
+    (* a partition on a hard disk; but it is not necessarily meaningful	*)
+    (* for other device types.  (This parameter is supplied only for	*)
+    (* the benefit of the file system when it has to deal with the	*)
+    (* special case of a large partition.)  Device drivers which are	*)
+    (* not prepared to specify a meaningful size should supply a value	*)
+    (* of 0 for the size.						*)
+    (* DefaultDirString specifies the initial default directory.	*)
+
+    VAR namestring: EightChar;  current, newptr: TreePointer;
+	inserted: BOOLEAN;  j: CARDINAL;
+
+    BEGIN
+	(* For a faulty device driver, cause a crash - it's better to	*)
+	(* get the crash at startup time than to let the program run	*)
+	(* with a suspect driver.					*)
+
+	IF (device = NIL) OR (device^.check <> CheckCode) THEN
+	    Crash ("Faulty device driver");
+	END(*IF*);
+
+	(* Insert the size information into the device descriptor. *)
+
+	WITH device^ DO
+	    IF unit < UnitLimit THEN
+(*# save, check(index => off) *)
+		capacity[unit] := size;
+(*# restore *)
+	    END (*IF*);
+	END (*WITH*);
+
+	(* Create a NameRecord to hold the remaining information. *)
+
+	namestring := CopyAndPad (name);
+	NEW (newptr);
+	WITH newptr^ DO
+	    left := NIL;  right := NIL;  string := namestring;
+	    devicecode := device;  unitnumber := unit;
+	    j := 0;  CopyString (DefaultDirString, defaultdir, j);
+	END (*WITH*);
+
+	(* Insert the new record into the Names tree.	*)
+
+	IF Names = NIL THEN
+	    Names := newptr;
+	ELSE
+	    current := Names;  inserted := FALSE;
+	    REPEAT
+		IF Str.Compare (current^.string, namestring) < 0 THEN
+		    IF current^.left = NIL THEN
+			current^.left := newptr;  inserted := TRUE;
+		    ELSE
+			current := current^.left;
+		    END (*IF*);
+		ELSE
+		    IF current^.right = NIL THEN
+			current^.right := newptr;  inserted := TRUE;
+		    ELSE
+			current := current^.right;
+		    END (*IF*);
+		END (*IF*);
+	    UNTIL inserted;
+	END (*IF*);
+    END DeviceName;
+
+(************************************************************************)
+
+PROCEDURE AcceptRequest (device: Device): RequestBlockPointer;
+
+    (* Returns a pointer to the next request enqueued for this device.	*)
+    (* If there is no next request, we wait until one appears.		*)
+
+    BEGIN
+	RETURN TakeFromQueue (device^.RequestQueue);
+    END AcceptRequest;
+
+(************************************************************************)
+(*			TERMINATION HANDLER				*)
+(************************************************************************)
+
+PROCEDURE DeleteTree (VAR (*INOUT*) T: TreePointer);
+
+    (* Destroys tree T.	*)
+
+    BEGIN
+	IF T <> NIL THEN
+	    DeleteTree (T^.left);  DeleteTree (T^.right);
+	    DISPOSE (T);
+	END (*IF*);
+    END DeleteTree;
+
+(************************************************************************)
+
+PROCEDURE CloseDown ();
+
+    (* Cleans up at program termination.  Note that all device drivers	*)
+    (* will have closed down by the time this procedure is called, as	*)
+    (* they are higher-level modules.					*)
+    (* Remark: have not yet made provision for destroying the device	*)
+    (* descriptors.							*)
+
+    BEGIN
+	DeleteTree (Names);
+    END CloseDown;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+BEGIN
+    Names := NIL;
+    SetTerminationProcedure (CloseDown);
+    NEW (DummyDevice);
+    WITH DummyDevice^ DO
+	check := 0;
+	UnitLimit := 0;
+	capacity[0] := 0;
+	CreateQueue (RequestQueue);
+    END (*WITH*);
+END Devices.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/director.def b/examples/Modula-2_Libraries/PMOS/sources/general/director.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/director.def
@@ -0,0 +1,104 @@
+DEFINITION MODULE Directories;
+
+	(********************************************************)
+	(*							*)
+	(*		Disk directory lookup.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	13 June 1992			*)
+	(*  Status:						*)
+	(*	Working, but needs more detailed testing.	*)
+	(*	FindRelativeCluster not tested.			*)
+	(*							*)
+	(********************************************************)
+
+FROM Devices IMPORT
+    (* type *)	Device, BlockNumberType;
+
+FROM IOErrorCodes IMPORT
+    (* type *)	ErrorCode;
+
+(************************************************************************)
+
+TYPE Handle;	(* is private *)
+
+TYPE Cluster = CARDINAL;
+
+CONST
+
+    (* NoSuchBlock is, by convention, returned to indicate a		*)
+    (* nonexistent block.						*)
+
+    NoSuchBlock = 0FFFFFFFFH;
+
+(************************************************************************)
+(*									*)
+(*  Remark: file space is allocated in clusters, where a cluster is	*)
+(*  one or more blocks.  Because the mapping from cluster number to	*)
+(*  block number varies from one disk to another (it depends on the	*)
+(*  disk capacity and format), and because module Devices does not	*)
+(*  know about clusters, it is simplest to keep that mapping private	*)
+(*  to this module, and return information to the caller in terms of	*)
+(*  block numbers.  However, the caller needs to be told the cluster	*)
+(*  size in bytes, in order to know how much data to read or write	*)
+(*  at a time.								*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE SetDefaultDirectory (VAR (*IN*) path: ARRAY OF CHAR): ErrorCode;
+
+    (* Sets the starting point for directory searches in subsequent	*)
+    (* file operations.  Each device has a separate default directory.	*)
+    (* If parameter path includes a device name, the default is set for	*)
+    (* that device; otherwise, the default directory is set for the	*)
+    (* current default device.						*)
+
+PROCEDURE Lookup (newfile: BOOLEAN;  name: ARRAY OF CHAR;
+		VAR (*OUT*) device: Device;
+		VAR (*OUT*) unit: CARDINAL;
+		VAR (*OUT*) fileid: Handle;
+		VAR (*OUT*) StartingBlock: BlockNumberType;
+		VAR (*OUT*) BytesPerCluster: CARDINAL;
+		VAR (*OUT*) BytesInFile: LONGCARD): ErrorCode;
+
+    (* Parses the file name, returns the device code and unit number,	*)
+    (* and looks up the device directory (which might involve some	*)
+    (* subdirectory searches) to find the location of the directory	*)
+    (* entry, the starting block number, cluster size in bytes, and	*)
+    (* file size in bytes, for the file.  If newfile=TRUE, we create a	*)
+    (* new directory entry for this file (or report an error if the	*)
+    (* file already exists).  When creating a new file, we pre-allocate	*)
+    (* the first cluster; this partially avoids the complication of	*)
+    (* having to go back and modify the directory entry when the first	*)
+    (* cluster of data is ready to be written (we will still have to	*)
+    (* modify the file size part of the entry when the file is closed).	*)
+
+PROCEDURE NextBlockNumber (fileid: Handle;
+			   currentblock: BlockNumberType): BlockNumberType;
+
+    (* Given the block number of the current cluster in a file, returns	*)
+    (* the block number of the following cluster.			*)
+
+PROCEDURE FindRelativeCluster (fileid: Handle;  N: CARDINAL)
+							: BlockNumberType;
+
+    (* Returns the block number of the Nth cluster, where N = 0		*)
+    (* corresponds to the starting cluster of the file.			*)
+
+PROCEDURE AllocateBlock (fileid: Handle;
+			currentblock: BlockNumberType): BlockNumberType;
+
+    (* Allocates a new free cluster, and returns its block number.  The	*)
+    (* variable currentblock shows the block number of the last cluster	*)
+    (* used by this file - we need this to update the space allocation	*)
+    (* chain.								*)
+
+PROCEDURE UpdateFileSize (fileid: Handle;  NewSize: LONGCARD);
+
+    (* Updates a directory entry to show a modified file size.	*)
+
+PROCEDURE DiscardHandle (VAR (*INOUT*) fileid: Handle);
+
+    (* To be called when a file is no longer going to be accessed.	*)
+
+END Directories.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/director.mod b/examples/Modula-2_Libraries/PMOS/sources/general/director.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/director.mod
@@ -0,0 +1,1760 @@
+IMPLEMENTATION MODULE Directories;
+
+	(****************************************************************)
+	(*								*)
+	(*			Disk directory lookup.			*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	22 March 1995				*)
+	(*  Status:		Working.				*)
+	(*								*)
+	(*	Method of setting default directories is not very	*)
+	(*	satisfactory, since it relies on assumptions about	*)
+	(*	which drives are present.  Would be better for the	*)
+	(*	device drivers to work out the default directories	*)
+	(*	and add an extra parameter to DeviceName.		*)
+	(*								*)
+	(*	Now working with large partitions.			*)
+	(*								*)
+	(*	FindFreeCluster seems to be a bit slow.			*)
+	(*	FindRelativeCluster not yet tested.			*)
+	(*	Improvements to the cache system desirable.		*)
+	(*	Need procedures for deleting and renaming files.	*)
+	(*								*)
+	(****************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE, ADDRESS,
+    (* proc *)	ADR;
+
+FROM FileNames IMPORT
+    (* type *)	FileName, NameList,
+    (* proc *)	Parse, WriteFileName, DiscardNameList;
+
+FROM Devices IMPORT
+    (* type *)	RequestBlock,
+    (* proc *)	SameDevice, NullDevice, VolumeSize, BlockRead, BlockWrite,
+		GetDefaultDirectory;
+
+FROM IOErrorCodes IMPORT
+    (* proc *)	TranslateErrorCode;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM DMA IMPORT
+    (* proc *)	AllocateDMABuffer;
+
+FROM MaintenancePages IMPORT	(* for testing *)
+    (* type *)	MaintenancePage,
+    (* proc *)	CreateMaintenancePage, Associate;
+
+FROM Windows IMPORT		(* for testing *)
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, ChangeScrollingRegion, SetCursor,
+		WriteString, WriteChar, WriteLn, PressAnyKey;
+
+FROM NumericIO IMPORT		(* for testing *)
+    (* proc *)	WriteHexByte, WriteHexWord, WriteHexLongword,
+		WriteAddress;
+
+FROM LowLevel IMPORT
+    (* proc *)	AddOffset, Copy, BlockFill, Far,
+		LS, RS, IAND, IANDB, IOR;
+
+FROM MiscPMOS IMPORT
+    (* type *)	RegisterPacket,
+    (* proc *)	BIOS;
+
+FROM TimeOfDay IMPORT
+    (* type *)	TimeRecord,
+    (* proc *)	ReadClock;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure;
+
+(************************************************************************)
+
+CONST testing = TRUE;  Prompting = FALSE;
+
+(************************************************************************)
+
+CONST
+    (* In this version, all devices are assumed to have the same block	*)
+    (* size.								*)
+
+    BlockSize = 512;
+
+    (* In a directory, a deleted file is indicated by a special code	*)
+    (* in the first character position of the file name field.		*)
+
+    DeletedFileCode = CHR(0E5H);
+
+    (* In the File Allocation Table, special codes are used to indicate	*)
+    (* an unused cluster, and a cluster which is the end of a space	*)
+    (* allocation chain.						*)
+
+    FreeClusterCode = 0;
+    EndOfChainCode = 0FFFFH;
+
+(************************************************************************)
+(*			    GLOBAL DATA TYPES				*)
+(************************************************************************)
+
+TYPE
+
+    (* The following declaration gives the format of a directory entry	*)
+    (* in the form it actually takes on the disk.  Note: for a deleted	*)
+    (* file, the first byte is DeletedFileCode (=0E5H).			*)
+
+    DirectoryEntry = RECORD
+			Name: FileName;
+			Attribute: BYTE;
+			Reserved: ARRAY [0..9] OF BYTE;
+			Time, Date: CARDINAL;
+			StartingCluster: Cluster;
+			FileSize: LONGCARD;
+		     END (*RECORD*);
+
+    (* The formats for date and time are:				*)
+    (*	Time:	top 5 bits for hour, next 6 bits for minute, bottom	*)
+    (*		5 bits for seconds (DIV 2, presumably).			*)
+    (*	Date:	top 7 bits for year (0=1980), next 4 bits for month,	*)
+    (*		bottom 5 bits for day of month.				*)
+
+    (* We keep some of the recently accessed FAT and directory blocks	*)
+    (* in a cache.  In the present version, we allow for a single	*)
+    (* one-cluster cache per active device.  In a future version, this	*)
+    (* should perhaps be expanded.  There would be a good case for	*)
+    (* having separate caches for FAT and directory buffers.		*)
+
+    CacheDetails =  RECORD
+			modified: BOOLEAN;
+			block: BlockNumberType;
+			address: ADDRESS;
+		    END (*RECORD*);
+
+    (* For each currently active device, we keep track of details such	*)
+    (* as the location of the directory.  The "valid" field is TRUE if	*)
+    (* we believe that the other fields have been filled in correctly.	*)
+    (* The "next" field allows us to string all these records together	*)
+    (* as a linear list.  The other fields are:				*)
+    (*	PackedFAT		indicates that each FAT entry is a	*)
+    (*				packed 12-bit number.  If this field is	*)
+    (*				FALSE, a FAT entry takes 16 bits	*)
+    (*	device, unit		the device to which this record refers	*)
+    (*	ClusterNumberOrigin	the block number which would correspond	*)
+    (*				to a cluster number of zero		*)
+    (*	NumberOfBlocks		the total number of blocks on this unit	*)
+    (*	BlocksPerCluster	sectors in a cluster			*)
+    (*	ClusterSize		bytes in a cluster			*)
+    (*	LowestFreeCluster	cluster number below which it is known	*)
+    (*				that there are no unallocated clusters	*)
+    (*	MaxClusterNumber	maximum possible cluster number		*)
+    (*	FATstart		first FAT block number			*)
+    (*	DirectoryStart		first directory block number		*)
+    (*	DirectoryEnd		last directory block number		*)
+    (*	DirectoryCluster	cluster # of current default directory	*)
+    (*	CachePtr		pointer to the cache record		*)
+
+    MediumInfoPointer = POINTER TO MediumInfo;
+    MediumInfo =    RECORD
+			valid, PackedFAT: BOOLEAN;
+			next: MediumInfoPointer;
+			device: Device;
+			unit: CARDINAL;
+			ClusterNumberOrigin: BlockNumberType;
+			NumberOfBlocks: BlockNumberType;
+			BlocksPerCluster: CARDINAL;
+			ClusterSize: CARDINAL;	(* bytes *)
+			LowestFreeCluster, MaxClusterNumber: CARDINAL;
+			FATstart, DirectoryStart,
+				DirectoryEnd: BlockNumberType;
+			DirectoryCluster: Cluster;
+			CachePtr: POINTER TO CacheDetails;
+		    END (*RECORD*);
+
+    (* A Handle contains the information found by procedure Lookup	*)
+    (* concerning the directory entry for a file.			*)
+
+    Handle = POINTER TO
+		    RECORD
+			M: MediumInfoPointer;
+			dirblock: BlockNumberType;
+			diroffset: CARDINAL;
+		    END (*RECORD*);
+
+(************************************************************************)
+(*			     GLOBAL VARIABLES				*)
+(************************************************************************)
+
+VAR
+    Mpage: MaintenancePage;
+    debug: Window;		(* used only for testing *)
+
+    (* Head of the list of device information records.	*)
+
+    MediumInfoHead: MediumInfoPointer;
+
+    (* Default device and unit number.	*)
+
+    DefaultDevice: Device;
+    DefaultUnit: CARDINAL;
+
+(************************************************************************)
+(*				CACHE I/O				*)
+(************************************************************************)
+(*									*)
+(*  Note: in the current version, there is a single one-cluster cache	*)
+(*  per device; it's mostly used to cache FAT blocks, but sometimes	*)
+(*  used when reading or writing a directory entry.  For		*)
+(*  future versions, we should consider (a) whether we should cache	*)
+(*  multiple clusters per device; (b) whether to have separate caches	*)
+(*  for FATs and directories, or let them share the same cache system;	*)
+(*  (c) whether to reserve cache blocks for a given device (as at	*)
+(*  present) or to have a single pool.					*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE SyncCache (M: MediumInfoPointer): ErrorCode;
+
+    (* Ensures that any changes to the cache are written out to the	*)
+    (* device.								*)
+
+    VAR status: ErrorCode;
+
+    BEGIN
+	status := OK;
+	WITH M^ DO
+	    WITH CachePtr^ DO
+		IF modified THEN
+		    status := BlockWrite (device, unit, block, address,
+								ClusterSize);
+		    modified := FALSE;
+		END (*IF*);
+	    END (*WITH*);
+	END (*WITH*);
+	RETURN status;
+    END SyncCache;
+
+(************************************************************************)
+
+PROCEDURE DumpCache (CacheAddress: ADDRESS);
+
+    (* For debugging: prints out first few bytes of cache.	*)
+
+    VAR p: POINTER TO BYTE;
+	j: CARDINAL;
+
+    BEGIN
+	p := CacheAddress;
+	WriteLn (debug);
+	FOR j := 0 TO 3FH DO
+	    IF j MOD 16 = 0 THEN
+		WriteLn (debug);
+	    END (*IF*);
+	    WriteChar (debug, ' ');  WriteHexByte (debug, p^);
+	    p := AddOffset (p, 1);
+	END (*FOR*);
+	WriteLn (debug);
+    END DumpCache;
+
+(************************************************************************)
+
+PROCEDURE LoadCache (M: MediumInfoPointer;  BlockNumber: BlockNumberType;
+			VAR (*OUT*) CacheAddress: ADDRESS): ErrorCode;
+
+    (* Ensures that a cluster starting with the specified block number	*)
+    (* is in the in-memory cache, and makes CacheAddress point to the	*)
+    (* cache data.							*)
+
+    (* REMARK: BlockNumber must be on a cluster boundary; the rest of	*)
+    (* this module ensures this property at present, but it should be	*)
+    (* re-checked if the module is modified.				*)
+
+    VAR status: ErrorCode;
+
+    BEGIN
+	status := OK;
+	WITH M^ DO
+	    WITH CachePtr^ DO
+		IF address = NIL THEN
+		    AllocateDMABuffer (address, ClusterSize);
+		END (*IF*);
+		IF block <> BlockNumber THEN
+		    status := SyncCache (M);
+		    IF status = OK THEN
+			status := BlockRead (device, unit, BlockNumber,
+						address, ClusterSize);
+			block := BlockNumber;
+		    END (*IF*);
+		END (*IF*);
+		CacheAddress := address;
+	    END (*WITH*);
+	END (*WITH*);
+
+	RETURN status;
+    END LoadCache;
+
+(************************************************************************)
+
+PROCEDURE CachedRead (M: MediumInfoPointer;  block: BlockNumberType;
+			offset, bytecount: CARDINAL;
+			VAR (*OUT*) result: ARRAY OF BYTE): ErrorCode;
+
+    (* Reads bytecount bytes, starting at byte number offset from the	*)
+    (* start of the given block on the device specified by M, into the	*)
+    (* result array.  The function result is an error code.  A cluster	*)
+    (* starting at the given block number is loaded into the cache if	*)
+    (* it isn't already there.  It is permissible to cross block and	*)
+    (* cluster boundaries, but parameter "block" must always be on a	*)
+    (* cluster boundary.						*)
+
+    VAR b1: CARDINAL;  place, CacheAddress: ADDRESS;
+	status: ErrorCode;
+	temp: POINTER TO CARDINAL;	(* for debugging *)
+
+    BEGIN
+	place := ADR (result);
+
+	WITH M^ DO
+	    WHILE offset >= ClusterSize DO
+		block := block + LONGCARD(BlocksPerCluster);
+		DEC (offset, ClusterSize);
+	    END (*WHILE*);
+	END (*WITH*);
+
+	LOOP
+
+	    (* Read a cluster into the cache. *)
+
+	    status := LoadCache (M, block, CacheAddress);
+	    IF status <> OK THEN
+		EXIT (*LOOP*);
+	    END (*IF*);
+
+	    (* Calculate how many bytes to move from this cluster.	*)
+
+	    IF offset+bytecount > M^.ClusterSize THEN
+		b1 := M^.ClusterSize - offset;
+	    ELSE
+		b1 := bytecount;
+	    END (*IF*);
+
+	    Copy (AddOffset(CacheAddress, offset), place, b1);
+
+	    (* Have we finished the job?	*)
+
+	    DEC (bytecount, b1);
+	    IF bytecount = 0 THEN
+		EXIT (*LOOP*);
+	    END (*IF*);
+
+	    (* Still more data to transfer.	*)
+
+	    place := AddOffset (place, b1);
+	    INC (block, LONGCARD(M^.BlocksPerCluster));  offset := 0;
+
+	END (*LOOP*);
+
+	RETURN status;
+
+    END CachedRead;
+
+(************************************************************************)
+
+PROCEDURE CachedWrite (M: MediumInfoPointer;  block: BlockNumberType;
+				offset, bytecount: CARDINAL;
+				VAR (*IN*) value: ARRAY OF BYTE): ErrorCode;
+
+    (* Writes a value of length bytecount bytes to the device specified	*)
+    (* by M, starting at byte number offset from the start of the given	*)
+    (* block number.  The function result is an error code.  The cache	*)
+    (* is reloaded if necessary.  It is permissible to cross block and	*)
+    (* cluster boundaries, but parameter "block" should always be on a	*)
+    (* cluster boundary.						*)
+
+    VAR b1: CARDINAL;  place, CacheAddress: ADDRESS;
+	status: ErrorCode;
+
+    BEGIN
+	place := ADR(value);
+	WHILE offset >= M^.ClusterSize DO
+	    INC (block, LONGCARD(M^.BlocksPerCluster));
+	    DEC (offset, M^.ClusterSize);
+	END (*WHILE*);
+	LOOP
+	    (* Read a block into the cache. *)
+
+	    status := LoadCache (M, block, CacheAddress);
+	    IF status <> OK THEN
+		EXIT (*LOOP*);
+	    END (*IF*);
+
+	    (* Calculate how many bytes to move into the current block.	*)
+
+	    IF offset+bytecount > M^.ClusterSize THEN
+		b1 := M^.ClusterSize - offset;
+	    ELSE
+		b1 := bytecount;
+	    END (*IF*);
+	    Copy (place, AddOffset (CacheAddress, offset), b1);
+
+	    (* Note that we don't write the updated cache block to the	*)
+	    (* device at this stage.  Instead, we simply note that the	*)
+	    (* cache has been modified.  Any attempt to re-load the	*)
+	    (* cache with a different block will trigger the writing	*)
+	    (* out of the current cached block.				*)
+
+	    M^.CachePtr^.modified := TRUE;
+
+	    (* Have we finished the job?	*)
+
+	    DEC (bytecount, b1);
+	    IF bytecount = 0 THEN
+		EXIT (*LOOP*);
+	    END (*IF*);
+
+	    (* Still more data to transfer.	*)
+
+	    place := AddOffset (place, b1);
+	    INC (block, LONGCARD(M^.BlocksPerCluster));  offset := 0;
+
+	END (*LOOP*);
+	RETURN status;
+    END CachedWrite;
+
+(************************************************************************)
+(*		TRANSLATING BLOCK NUMBER TO CLUSTER NUMBER		*)
+(************************************************************************)
+
+PROCEDURE BlockToClusterMap (M: MediumInfoPointer;  block: BlockNumberType)
+							: Cluster;
+
+    (* Translates a block number to a cluster number.	*)
+
+    BEGIN
+	WITH M^ DO
+	    IF block <= ClusterNumberOrigin THEN
+		RETURN 0;
+	    ELSE
+		RETURN Cluster((block-ClusterNumberOrigin)
+					DIV LONGCARD(BlocksPerCluster));
+	    END (*IF*);
+	END (*WITH*);
+    END BlockToClusterMap;
+
+(************************************************************************)
+(*		    LOOKING AFTER THE MEDIA INFORMATION			*)
+(************************************************************************)
+
+PROCEDURE CheckMediumInfo (M: MediumInfoPointer): ErrorCode;
+
+    (* Tries to ensure that the values in M^ are valid.  Returns OK if	*)
+    (* already valid or if we are able to load valid values from the	*)
+    (* device boot block.  In the latter case, we also set the initial	*)
+    (* default directory.  Returns an error code if we fail in the	*)
+    (* attempt to read the boot block.					*)
+
+    VAR status: ErrorCode;
+	DirectoryName: ARRAY [0..63] OF CHAR;
+	BootInfoPtr: POINTER TO RECORD
+			JMPinstruction: ARRAY [0..2] OF BYTE;
+			SystemID: ARRAY [0..7] OF CHAR;
+			BytesPerSector: CARDINAL;
+			SectorsPerCluster: BYTE;
+			ReservedSectors: CARDINAL;
+			CopiesOfFAT: BYTE;
+			DirectoryEntries: CARDINAL;
+			NumberOfSectors: CARDINAL; (* 0 for large partition *)
+			FormatID: BYTE;
+			SectorsPerFAT: CARDINAL;
+			SectorsPerTrack: CARDINAL;
+			NumberOfHeads: CARDINAL;
+			SpecialReservedSectors: CARDINAL;
+		     END (*RECORD*);
+
+	(* This defines the layout of data in the boot record on the	*)
+	(* device.  We use most but not all of this information.	*)
+
+    BEGIN
+	IF M^.valid THEN
+	    IF testing THEN
+		WriteLn (debug);
+		WriteString (debug, "CheckMediumInfo: M^.valid is TRUE");
+	    END (*IF*);
+	    RETURN OK;
+	END (*IF*);
+
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "CheckMediumInfo: about to call AllocateDMABuffer");
+	END (*IF*);
+	AllocateDMABuffer (BootInfoPtr, BlockSize);
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "CheckMediumInfo: return from AllocateDMABuffer");
+	END (*IF*);
+	WITH M^ DO
+	    status := BlockRead (device, unit, 0,
+					BootInfoPtr, BlockSize);
+	    IF status <> OK THEN
+		IF testing THEN
+		    WriteLn (debug);
+		    WriteString (debug, "Can't read boot record.");
+		END (*IF*);
+		DEALLOCATE (BootInfoPtr, BlockSize);
+		RETURN status;
+	    END (*IF*);
+	    IF testing THEN
+		WriteLn (debug);
+		WriteString (debug, "Have successfully read boot record.");
+	    END (*IF*);
+	    WITH BootInfoPtr^ DO
+		BlocksPerCluster := ORD(SectorsPerCluster);
+		ClusterSize := BytesPerSector*BlocksPerCluster;
+		FATstart := BlockNumberType(ReservedSectors);
+		DirectoryStart := FATstart
+			+ BlockNumberType(ORD(CopiesOfFAT)*SectorsPerFAT);
+		DirectoryEnd := DirectoryStart
+			+ BlockNumberType (DirectoryEntries DIV 16 - 1);
+		ClusterNumberOrigin := DirectoryEnd
+			- BlockNumberType (2*BlocksPerCluster) + 1;
+
+		(* Note that the "NumberOfSectors" field is a CARDINAL,	*)
+		(* which is insufficient for a large partition.  A	*)
+		(* large partition is flagged by having NumberOfSectors	*)
+		(* equal to 0, and in this case the true number of	*)
+		(* sectors has been supplied to module Devices by the	*)
+		(* device driver.					*)
+
+		IF NumberOfSectors = 0 THEN
+		    NumberOfBlocks := VolumeSize (device, unit);
+		ELSE
+		    NumberOfBlocks := BlockNumberType(NumberOfSectors);
+		END (*IF*);
+
+		MaxClusterNumber := BlockToClusterMap (M, NumberOfBlocks-1);
+		PackedFAT := MaxClusterNumber < 0FF8H;
+		valid := TRUE;
+	    END (*WITH*);
+
+	    DEALLOCATE (BootInfoPtr, BlockSize);
+
+	    IF testing THEN
+		WriteLn (debug);
+		WriteString (debug, "ClusterNumberOrigin, BlocksPerCluster = ");
+		WriteHexLongword (debug, ClusterNumberOrigin);
+		WriteString (debug, "     ");
+		WriteHexWord (debug, BlocksPerCluster);
+		WriteString (debug, ".  FAT is ");
+		IF NOT PackedFAT THEN WriteString (debug, "not "); END (*IF*);
+		WriteString (debug, "packed.");
+	    END (*IF*);
+
+	    (* Set up the initial default directory.  Note: this causes	*)
+	    (* a recursive call, since SetDefaultDirectory calls	*)
+	    (* CheckMediumInfo, so it's important that we do this only	*)
+	    (* after filling in all the MediumInfo fields.		*)
+
+	    DirectoryCluster := 0;
+
+	    GetDefaultDirectory (device, unit, DirectoryName);
+	    IF testing THEN
+		WriteLn (debug);
+		WriteString (debug, "The directory string is ");
+		WriteString (debug, DirectoryName);
+		IF Prompting THEN PressAnyKey (debug) END(*IF*);
+	    END (*IF*);
+
+	    status := SetDefaultDirectory (DirectoryName);
+
+	END (*WITH*);
+
+	RETURN OK;
+
+    END CheckMediumInfo;
+
+(************************************************************************)
+
+PROCEDURE DumpMediumInfoList;
+
+    (* For testing: dumps the list whose head is MediumInfoHead.	*)
+
+    VAR current: MediumInfoPointer;
+
+    BEGIN
+	current := MediumInfoHead;
+	WriteLn (debug);
+	WriteString (debug, "MediumInfo list: ");
+	IF current = NIL THEN
+	    WriteString (debug, "is empty");
+	ELSE
+	    WHILE current <> NIL DO
+		WriteLn (debug);
+		WITH current^ DO
+		    IF valid THEN WriteString (debug, "T ")
+		    ELSE WriteString (debug, "F ");
+		    END (*IF*);
+		    WriteHexWord (debug, unit);  WriteString (debug, "  ");
+		    WriteHexLongword (debug, ClusterNumberOrigin);
+	 	END (*WITH*);
+		current := current^.next;
+	    END (*WHILE*);
+	END (*IF*);
+    END DumpMediumInfoList;
+
+(************************************************************************)
+
+PROCEDURE FindMediumInfo (devicecode: Device;  unitnumber: CARDINAL)
+							: MediumInfoPointer;
+
+    (* Returns a pointer to the MediumInfo record for the given device	*)
+    (* and unit.  (A new MediumInfo record is created if necessary.)	*)
+
+    VAR current, previous: MediumInfoPointer;
+
+    BEGIN
+	current := MediumInfoHead;  previous := NIL;
+	WHILE current <> NIL DO
+	    IF SameDevice (current^.device, devicecode)
+			AND (current^.unit = unitnumber) THEN
+		RETURN current;
+	    END (*IF*);
+	    previous := current;  current := current^.next;
+	END (*WHILE*);
+
+	(* If we get this far, there is no existing MediumInfo record	*)
+	(* for this device and unit, so we have to create one.		*)
+
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "FindMediumInfo: no match found.");
+	END (*IF*);
+	NEW (current);
+	WITH current^ DO
+	    valid := FALSE;  next := NIL;
+	    device := devicecode;  unit := unitnumber;
+	    LowestFreeCluster := 2;
+	    NEW (CachePtr);
+	    WITH CachePtr^ DO
+		modified := FALSE;
+		block := 0;
+		address := NIL;
+	    END;
+	END (*WITH*);
+	IF previous = NIL THEN
+	    MediumInfoHead := current;
+	ELSE
+	    previous^.next := current;
+	END (*IF*);
+	RETURN current;
+    END FindMediumInfo;
+
+(************************************************************************)
+(*		LOOKING AFTER THE FILE ALLOCATION TABLE			*)
+(************************************************************************)
+
+PROCEDURE ClusterToBlockMap (M: MediumInfoPointer;
+				clusternumber: Cluster): BlockNumberType;
+
+    (* Given a cluster number, translates it to a block number.	*)
+
+    VAR result: BlockNumberType;
+
+    BEGIN
+	WITH M^ DO
+	    IF clusternumber > MaxClusterNumber THEN
+		RETURN NoSuchBlock;
+	    END (*IF*);
+	    IF clusternumber = 0 THEN
+		result := DirectoryStart;
+	    ELSE
+		result := ClusterNumberOrigin
+			+ LONGCARD(clusternumber)*LONGCARD(BlocksPerCluster);
+	    END (*IF*);
+	END (*WITH*);
+	RETURN result;
+    END ClusterToBlockMap;
+
+(************************************************************************)
+
+PROCEDURE DecodeFAT (M: MediumInfoPointer;  entry: Cluster): Cluster;
+
+    (* Returns entry number "entry" of the File Allocation Table (FAT).	*)
+    (* For a packed FAT, each entry of the FAT is 12 bits long, so its	*)
+    (* decoding is mildly messy; in some cases it is even possible for	*)
+    (* an entry to lie partly at the end of one disk sector and partly	*)
+    (* at the beginning of the next.					*)
+
+    VAR FATblock: BlockNumberType;  result: Cluster;
+	place: LONGCARD;  offset: CARDINAL;
+	status: ErrorCode;
+
+    BEGIN
+	place := LONGCARD (entry);
+	WITH M^ DO
+	    IF PackedFAT THEN
+		place := 3*place DIV 2;
+	    ELSE
+		place := 2*place;
+	    END (*IF*);
+	    FATblock := FATstart
+		+ (place DIV LONGCARD(ClusterSize))*LONGCARD(BlocksPerCluster);
+	    offset := CARDINAL(place MOD LONGCARD(ClusterSize));
+	END (*WITH*);
+	status := CachedRead (M, FATblock, offset, 2, result);
+	IF status <> OK THEN
+	    result := 0FFFFH;
+	END (*IF*);
+	IF M^.PackedFAT THEN
+	    IF ODD(entry) THEN
+		result := RS(result, 4);
+	    END (*IF*);
+	    result := IAND (result, 0FFFH);
+	    IF result > 0FF7H THEN
+		result := IOR (result, 0F000H);
+	    END (*IF*);
+	END (*IF*);
+	RETURN result;
+    END DecodeFAT;
+
+(************************************************************************)
+
+PROCEDURE WriteFAT (M: MediumInfoPointer;  entry, value: Cluster): ErrorCode;
+
+    (* Writes the given value into the FAT.  As usual, the returned	*)
+    (* result is an error code.						*)
+
+    VAR FATblock: BlockNumberType;  place: LONGCARD;
+	offset, result: CARDINAL;
+	status: ErrorCode;
+
+    BEGIN
+	place := LONGCARD (entry);
+	WITH M^ DO
+	    IF PackedFAT THEN
+		value := IAND (value, 0FFFH);
+		place := 3*place DIV 2;
+	    ELSE
+		place := 2*place;
+	    END (*IF*);
+
+	    FATblock := FATstart
+		+ LONGCARD(BlocksPerCluster)*(place DIV LONGCARD(ClusterSize));
+	    offset := CARDINAL(place MOD LONGCARD(ClusterSize));
+	END (*WITH*);
+
+	IF M^.PackedFAT THEN
+
+	    (* Read a 2-byte entry through the cache.	*)
+
+	    status := CachedRead (M, FATblock, offset, 2, result);
+	    IF status <> OK THEN
+		RETURN status;
+	    END (*IF*);
+
+	    (* Now we must replace 12 bits of the result, leaving the	*)
+	    (* other 4 bits intact.					*)
+
+	    IF ODD(entry) THEN
+		value := IOR (IAND (result, 0FH), LS(value, 4));
+	    ELSE
+		value := IOR (IAND (result, 0F000H), value);
+	    END (*IF*);
+
+	END (*IF*);
+
+	(* Put the modified value back into the FAT.	*)
+
+	RETURN CachedWrite (M, FATblock, offset, 2, value);
+
+    END WriteFAT;
+
+(************************************************************************)
+
+PROCEDURE NextBlockNumber (fileid: Handle;
+			   currentblock: BlockNumberType): BlockNumberType;
+
+    (* Given the block number of the current cluster in a file, returns	*)
+    (* the block number of the following cluster.			*)
+
+    VAR M: MediumInfoPointer;
+	cluster: Cluster;
+
+    BEGIN
+	M := fileid^.M;
+
+	(* Special case: if we are down in the low block numbers, as	*)
+	(* when reading the main directory, then we just step through	*)
+	(* the clusters sequentially.					*)
+
+	IF currentblock <= M^.DirectoryEnd THEN
+	    currentblock := currentblock + BlockNumberType(M^.BlocksPerCluster);
+	    IF currentblock > M^.DirectoryEnd THEN
+		RETURN NoSuchBlock;
+	    END (*IF*);
+	    RETURN currentblock;
+	END (*IF*);
+
+	(* Normal case: we have to translate the block number into a	*)
+	(* cluster number, and then look up the FAT to get the next	*)
+	(* cluster number.						*)
+
+	WITH M^ DO
+	    cluster := BlockToClusterMap (M, currentblock);
+	END (*WITH*);
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "Current cluster is ");
+	    WriteHexWord (debug, cluster);
+	END (*IF*);
+	cluster := DecodeFAT (M, cluster);
+	IF testing THEN
+	    WriteString (debug, ", next cluster is ");
+	    WriteHexWord (debug, cluster);
+	END (*IF*);
+	RETURN ClusterToBlockMap (M, cluster);
+    END NextBlockNumber;
+
+(************************************************************************)
+
+PROCEDURE DeallocateCluster (M: MediumInfoPointer;
+					cluster: Cluster): ErrorCode;
+
+    (* Marks the given cluster as being no longer in use.	*)
+
+    BEGIN
+	IF cluster < M^.LowestFreeCluster THEN
+	    M^.LowestFreeCluster := cluster;
+	END (*IF*);
+	RETURN WriteFAT (M, cluster, FreeClusterCode);
+    END DeallocateCluster;
+
+(************************************************************************)
+
+PROCEDURE FindFreeCluster (M: MediumInfoPointer;
+			VAR (*OUT*) ClusterNumber: Cluster): ErrorCode;
+
+    (* Searches the FAT for a free cluster, returns its cluster number	*)
+    (* and allocates the cluster by marking it as the end of a space	*)
+    (* allocation chain.  The returned value is an error code.		*)
+
+    VAR result: Cluster;
+
+    BEGIN
+	ClusterNumber := M^.LowestFreeCluster;
+	LOOP
+	    result := DecodeFAT (M, ClusterNumber);
+	    IF result = FreeClusterCode THEN
+		IF testing THEN
+		    WriteLn (debug);
+		    WriteString (debug, "FindFreeCluster: allocating cluster #");
+		    WriteHexWord (debug, ClusterNumber);
+		END (*IF*);
+		M^.LowestFreeCluster := ClusterNumber + 1;
+		RETURN WriteFAT (M, ClusterNumber, EndOfChainCode);
+	    ELSIF ClusterNumber = M^.MaxClusterNumber THEN
+		RETURN DeviceFull;
+	    ELSE
+		INC (ClusterNumber);
+	    END (*IF*);
+	END (*LOOP*);
+    END FindFreeCluster;
+
+(************************************************************************)
+
+PROCEDURE AllocateCluster (M: MediumInfoPointer;  cluster: Cluster;
+				VAR (*OUT*) result: Cluster): ErrorCode;
+
+    (* Allocates a new free cluster, returns its cluster number as	*)
+    (* result.  Parameter cluster shows the existing last cluster on	*)
+    (* this space allocation chain.					*)
+
+    VAR status: ErrorCode;
+
+    BEGIN
+	status := FindFreeCluster (M, result);
+	IF status = OK THEN
+	    status := WriteFAT (M, cluster, result);
+	END (*IF*);
+	RETURN status;
+    END AllocateCluster;
+
+(************************************************************************)
+
+PROCEDURE AllocateBlock (fileid: Handle;
+			currentblock: BlockNumberType): BlockNumberType;
+
+    (* Allocates a new free cluster, and returns its block number.  The	*)
+    (* variable currentblock shows the last block used by this file -	*)
+    (* we need this to update the space allocation chain.		*)
+
+    VAR M: MediumInfoPointer;  NewClusterNumber: Cluster;
+
+    BEGIN
+	WITH fileid^ DO
+	    WITH M^ DO
+		IF AllocateCluster (M, BlockToClusterMap(M, currentblock),
+			NewClusterNumber) <> OK THEN RETURN NoSuchBlock;
+		END (*IF*);
+	    END (*WITH*);
+	    RETURN ClusterToBlockMap (M, NewClusterNumber);
+	END (*WITH*);
+    END AllocateBlock;
+
+(************************************************************************)
+
+PROCEDURE AllocateEmptyCluster (M: MediumInfoPointer;
+			current: BlockNumberType;
+			VAR (*OUT*) newblock: BlockNumberType): ErrorCode;
+
+    (* Similar to AllocateBlock, but ensures that the new cluster is	*)
+    (* filled with zeros.						*)
+
+    VAR p: POINTER TO ARRAY[0..0] OF BYTE;
+	newcluster: Cluster;
+	status: ErrorCode;
+
+    BEGIN
+	newblock := NoSuchBlock;
+	WITH M^ DO
+	    status := AllocateCluster (M, BlockToClusterMap (M, current),
+							newcluster);
+	    IF status <> OK THEN RETURN status END(*IF*);
+	    newblock := ClusterToBlockMap (M, newcluster);
+	    AllocateDMABuffer (p, ClusterSize);
+	    BlockFill (Far(p), ClusterSize, 0);
+	    status := BlockWrite (device, unit, newblock, p, ClusterSize);
+	    DEALLOCATE (p, ClusterSize);
+	END (*WITH*);
+	RETURN status;
+    END AllocateEmptyCluster;
+
+(************************************************************************)
+
+PROCEDURE FindRelativeCluster (fileid: Handle;  N: CARDINAL)
+							: BlockNumberType;
+
+    (* Returns the block number of the Nth cluster, where N = 0		*)
+    (* corresponds to the starting cluster of the file.			*)
+
+    CONST ClusterFieldOffset
+		= SIZE(DirectoryEntry) - SIZE(LONGCARD) - SIZE(CARDINAL);
+
+    VAR status: ErrorCode;
+	oldcluster, cluster: Cluster;
+
+    BEGIN
+
+	WITH fileid^ DO
+
+	    (* Find the starting cluster by looking up the directory.	*)
+	    (* We could make this more efficient by storing the		*)
+	    (* starting cluster in fileid^, but so far there has been	*)
+	    (* no great motivation for making this operation efficient;	*)
+	    (* this decision could be reviewed if we wanted to support	*)
+	    (* faster random access.					*)
+
+	    IF CachedRead (M, dirblock, diroffset + ClusterFieldOffset,
+				2, cluster) <> OK THEN RETURN NoSuchBlock;
+	    END (*IF*);
+
+	    (* Now follow the space allocation chain - which is not as	*)
+	    (* slow as it looks because of the high probability that	*)
+	    (* entire chain will stay in the cache.			*)
+
+	    WHILE N > 0 DO
+		oldcluster := cluster;
+		cluster := DecodeFAT (M, oldcluster);
+		IF cluster = EndOfChainCode THEN
+		    IF AllocateCluster (M, oldcluster, cluster) <> OK THEN
+			RETURN NoSuchBlock;
+		    END (*IF*);
+		END (*IF*);
+		DEC(N);
+	    END (*WHILE*);
+
+	    RETURN ClusterToBlockMap (M, cluster);
+
+	END (*WITH*);
+
+    END FindRelativeCluster;
+
+(************************************************************************)
+(*			SEARCHING A DIRECTORY				*)
+(************************************************************************)
+
+PROCEDURE NameMatch (name: FileName;  details: DirectoryEntry): BOOLEAN;
+
+    (* Returns TRUE iff "name" matches the file name in "details".	*)
+
+    BEGIN
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "Comparing name with ");
+	    WriteFileName (debug, details.Name);
+	END (*IF*);
+
+	(* Special case: if name.fname[0] = CHR(0) then we consider	*)
+	(* any "deleted file name" to be a match.			*)
+
+	IF name.fname[0] = CHR(0) THEN
+	    RETURN (details.Name.fname[0] = CHR(0))
+			OR (details.Name.fname[0] = DeletedFileCode);
+	END (*IF*);
+
+	(* Normal case: require a complete match.	*)
+
+	RETURN (name.fname = details.Name.fname)
+			AND (name.fext = details.Name.fext);
+    END NameMatch;
+
+(************************************************************************)
+
+PROCEDURE SearchBuffer (VAR (*IN*) Array: ARRAY OF DirectoryEntry;
+			entries: CARDINAL;
+			name: FileName;
+			VAR (*OUT*) details: DirectoryEntry;
+			VAR (*OUT*) offset: CARDINAL): ErrorCode;
+
+    (* Searches an array of "entries" directory entries for the		*)
+    (* specified file name.  If the search succeeds, the value returned	*)
+    (* is OK, the directory entry is returned in details, and offset	*)
+    (* gives the offset within the array.  If the search fails, the	*)
+    (* details record is left unmodified.				*)
+    (* Special case 1: if name.fname[0] = CHR(0) then we are searching	*)
+    (* for an unused directory entry.  In this case, a successful	*)
+    (* search returns the location of an unused entry in offset.	*)
+    (* Special case 2: a return with result NameNotFound and offset=0	*)
+    (* means that we came across a directory entry whose filename	*)
+    (* started with CHR(0) (and special case 1 did not apply, i.e. we	*)
+    (* weren't wanting an unused entry).  This implies that there is no	*)
+    (* point in searching the rest of the directory, since this case	*)
+    (* marks the first directory slot which has never been used.	*)
+
+    VAR entry: CARDINAL;
+	status: ErrorCode;
+
+    BEGIN
+	(*# save, check(index=>off) *)
+	entry := 0;  offset := 0;
+	LOOP
+	    IF NameMatch (name, Array[entry]) THEN
+		details := Array[entry];  status := OK;
+		EXIT (*LOOP*);
+	    END (*IF*);
+	    IF Array[entry].Name.fname[0] = CHR(0) THEN
+		offset := 0;  status := NameNotFound;  EXIT (*LOOP*);
+	    END (*IF*);
+	    INC (entry);  INC (offset, SIZE(DirectoryEntry));
+	    IF entry >= entries THEN
+		status := NameNotFound;  EXIT (*LOOP*);
+	    END (*IF*);
+	END (*LOOP*);
+	(*# restore *)
+	RETURN status;
+    END SearchBuffer;
+
+(************************************************************************)
+
+PROCEDURE SearchCluster (name: FileName;
+			VAR (*INOUT*) fileid: Handle;
+			VAR (*OUT*) details: DirectoryEntry): ErrorCode;
+
+    (* Searches the disk cluster starting at block fileid^.dirblock for	*)
+    (* the specified file name.  If the search succeeds, the value	*)
+    (* returned is OK, the directory entry is returned in details, and	*)
+    (* fileid^.diroffset gives the byte offset from the start of the	*)
+    (* cluster.  If the search fails, the details record is unaltered.	*)
+    (* Special case 1: if name.fname[0] = CHR(0) then we are searching	*)
+    (* for an unused directory entry.  In this case, a successful	*)
+    (* search returns the location of an unused entry in offset.	*)
+    (* Special case 2: a return with result NameNotFound and offset=0	*)
+    (* means that we came across a directory entry whose filename	*)
+    (* started with CHR(0) (and special case 1 did not apply, i.e. we	*)
+    (* weren't wanting an unused entry).  This implies that there is no	*)
+    (* point in searching the rest of the directory, since this case	*)
+    (* marks the first directory slot which has never been used.	*)
+
+    TYPE DirectoryBlock = ARRAY [0..0] OF DirectoryEntry;
+
+    VAR BufferPointer: POINTER TO DirectoryBlock;
+	BufferSize: CARDINAL;
+	status: ErrorCode;
+
+    BEGIN
+	WITH fileid^ DO
+	    BufferSize := M^.ClusterSize;
+	    AllocateDMABuffer (BufferPointer, BufferSize);
+	    status := BlockRead (M^.device, M^.unit, dirblock,
+				BufferPointer, BufferSize);
+	END (*WITH*);
+	IF status = OK THEN
+	    status := SearchBuffer (BufferPointer^,
+					BufferSize DIV SIZE(DirectoryEntry),
+					name, details, fileid^.diroffset);
+	END (*IF*);
+	DEALLOCATE (BufferPointer, BufferSize);
+	RETURN status;
+    END SearchCluster;
+
+(************************************************************************)
+
+PROCEDURE SearchDirectory (name: FileName;
+			VAR (*INOUT*) fileid: Handle;
+			VAR (*OUT*) details: DirectoryEntry): ErrorCode;
+
+    (* Searches a directory for file "name".  On entry, fileid^ shows	*)
+    (* the starting block of the directory.  (The fileid^.diroffset	*)
+    (* component is ignored.)  On successful return, details holds the	*)
+    (* directory entry for the file being searched for, and fileid^	*)
+    (* holds the block number and byte offset within the cluster of	*)
+    (* that directory entry.  If the search fails, fileid^.dirblock is	*)
+    (* restored to its original value, and the contents of details are	*)
+    (* meaningless.  Special case: if name.fname[0] is CHR(0) then we	*)
+    (* are searching for an unused directory entry.  In this case, a	*)
+    (* successful search returns the location of an unused entry in	*)
+    (* fileid^.  (If necessary, we expand the directory to create the	*)
+    (* unused entry.)							*)
+
+    VAR status: ErrorCode;  start, previousblock: BlockNumberType;
+	SearchingRootDirectory: BOOLEAN;
+
+    BEGIN
+	WITH fileid^ DO
+	    start := dirblock;
+	    SearchingRootDirectory := dirblock <= M^.DirectoryEnd;
+	END (*WITH*);
+
+	LOOP
+	    status := SearchCluster (name, fileid, details);
+	    IF status <> NameNotFound THEN
+		EXIT (*LOOP*);
+	    END (*IF*);
+
+	    (* No luck in the current cluster.  Is there any point in	*)
+	    (* searching further?					*)
+
+	    IF fileid^.diroffset = 0 THEN
+		EXIT (*LOOP*);
+	    END (*IF*);
+
+	    (* Move to next cluster in this directory. *)
+
+	    previousblock := fileid^.dirblock;
+	    fileid^.dirblock := NextBlockNumber (fileid, previousblock);
+
+	    IF fileid^.dirblock = NoSuchBlock THEN
+
+		(* Have reached the end of the directory.  If searching	*)
+		(* for an empty slot, and this is not the root		*)
+		(* directory, extend the directory.			*)
+
+		IF name.fname[0] = CHR(0) THEN
+		    IF SearchingRootDirectory THEN
+			status := DirectoryFull;
+		    ELSE
+			fileid^.diroffset := 0;
+			status := AllocateEmptyCluster (fileid^.M,
+					previousblock, fileid^.dirblock);
+		    END (*IF*);
+		END (*IF*);
+
+		EXIT (*LOOP*);
+
+	    END (*IF*);
+
+	END (*LOOP*);
+
+	IF status <> OK THEN
+	    fileid^.dirblock := start;
+	END (*IF*);
+	RETURN status;
+
+    END SearchDirectory;
+
+(************************************************************************)
+(*		    CREATING A NEW DIRECTORY ENTRY			*)
+(************************************************************************)
+
+PROCEDURE SetTimeAndDate (VAR (*OUT*) time, date: CARDINAL);
+
+    (* Sets the two output parameters to the current time and date.	*)
+    (* For formats, see the comments near the beginning of this module.	*)
+
+    VAR CurrentTime: TimeRecord;
+
+    (********************************************************************)
+
+    PROCEDURE bin (val: SHORTCARD): CARDINAL;
+
+	(* Converts a two-digit BCD value to binary.	*)
+
+	BEGIN
+	    RETURN CARDINAL(10*(val DIV 16) + (val MOD 16));
+	END bin;
+
+    (********************************************************************)
+
+    BEGIN
+	ReadClock (CurrentTime);
+	WITH CurrentTime DO
+	    IF year < 128 THEN year := 128 END(*IF*);
+	    time := ORD(LS(bin(hours),11)) + ORD(LS(bin(minutes),5))
+						+ (bin(seconds) DIV 2);
+	    date := ORD(LS(bin(year)-80,9)) + ORD(LS(bin(month),5))
+						+ bin(dayofmonth);
+	END (*WITH*);
+    END SetTimeAndDate;
+
+(************************************************************************)
+
+PROCEDURE CreateDirectoryEntry (name: FileName;
+				VAR (*INOUT*) fileid: Handle;
+				FirstCluster: Cluster): ErrorCode;
+
+    (* Creates a new directory entry.  On entry, fileid^ identifies	*)
+    (* the starting block of the directory (the diroffset component is	*)
+    (* ignored).  On return, fileid^ gives the location of the newly	*)
+    (* created entry.  A starting cluster has already been allocated	*)
+    (* for the new file, and parameter FirstCluster gives its number.	*)
+
+    VAR tempname: FileName;  status: ErrorCode;
+	details: DirectoryEntry;  j: [0..9];
+
+    BEGIN
+
+	(* Search for an unused directory entry.  In this phase, the	*)
+	(* details record is a dummy; we are interested only in the	*)
+	(* status and updated fileid^.					*)
+
+	tempname.fname[0] := CHR(0);
+	status := SearchDirectory (tempname, fileid, details);
+	IF status <> OK THEN
+	    RETURN status;
+	END (*IF*);
+
+	WITH details DO
+
+	    (* Fill in the details of the desired new entry.	*)
+
+	    Name := name;  Attribute := 20H;
+	    FOR j := 0 TO 9 DO
+		Reserved[j] := 0;
+	    END (*FOR*);
+	    SetTimeAndDate (Time, Date);
+	    StartingCluster := FirstCluster;  FileSize := 0;
+
+	END (*WITH*);
+
+	(* Write the new entry out to the device.	*)
+
+	WITH fileid^ DO
+	    RETURN CachedWrite (M, dirblock, diroffset,
+					SIZE(DirectoryEntry), details);
+	END (*WITH*);
+
+    END CreateDirectoryEntry;
+
+(************************************************************************)
+(*			   CREATING A NEW FILE				*)
+(************************************************************************)
+
+PROCEDURE CreateNewFile (name: FileName;
+			VAR (*INOUT*) fileid: Handle;
+			VAR (*OUT*) BlockNumber: BlockNumberType): ErrorCode;
+
+    (* Creates a new file with its starting block pre-allocated.  On	*)
+    (* entry fileid^.M identifies the device, name is the file name,	*)
+    (* and fileid^.dirblock is the starting block of the directory.	*)
+    (* On exit, if the file has been successfully created, fileid^	*)
+    (* points to the newly created directory entry and BlockNumber	*)
+    (* gives the starting block of the new file.			*)
+
+    VAR status, dummy: ErrorCode;
+	M: MediumInfoPointer;
+	DataCluster: Cluster;
+	string: ARRAY [0..31] OF CHAR;
+
+    BEGIN
+	M := fileid^.M;  DataCluster := EndOfChainCode;
+
+	(* Pre-allocate the first cluster of the new file.	*)
+
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "About to call FindFreeCluster.");
+	    IF Prompting THEN PressAnyKey (debug) END(*IF*);
+	END (*IF*);
+	status := FindFreeCluster (M, DataCluster);
+
+	IF status = OK THEN
+	    status := CreateDirectoryEntry (name, fileid, DataCluster);
+	    IF status <> OK THEN
+		dummy := DeallocateCluster (M, DataCluster);
+	    END (*IF*);
+	    IF testing THEN
+		WriteLn (debug);
+		WriteString (debug, "Created new directory entry, status = ");
+		TranslateErrorCode (status, string);
+		WriteString (debug, string);
+		IF Prompting THEN PressAnyKey (debug) END(*IF*);
+	    END (*IF*);
+	END (*IF*);
+
+	BlockNumber := ClusterToBlockMap (M, DataCluster);
+	RETURN status;
+
+    END CreateNewFile;
+
+(************************************************************************)
+(*			SEARCHING A DIRECTORY PATH			*)
+(************************************************************************)
+
+PROCEDURE SearchPath (	VAR (*INOUT*) path: NameList;
+			VAR (*INOUT*) fileid: Handle;
+			VAR (*OUT*) details: DirectoryEntry): ErrorCode;
+
+    (* Searches for the file whose name (which might be a full path	*)
+    (* name involving further subdirectories) is given in path.  On	*)
+    (* entry, fileid^.dirblock shows which directory to search.  On	*)
+    (* return with status = OK, details holds the directory entry for	*)
+    (* the file being searched for, fileid^ gives the physical location	*)
+    (* of its directory entry, and "path" has been fully discarded.  On	*)
+    (* return with status <> OK, details and fileid^ reflect the result	*)
+    (* of the partial search (i.e. details identifies the directory	*)
+    (* found so far, and fileid^ points to the parent directory), and	*)
+    (* "path" contains that part of the path which was not found.	*)
+
+    VAR result: ErrorCode;
+	current: NameList;
+
+    BEGIN
+	(* Set up a "details" record for the current directory, in	*)
+	(* case the search fails at the first step.			*)
+
+	WITH details DO
+	    Attribute := 10H;
+	    WITH fileid^ DO
+		StartingCluster := BlockToClusterMap (M, dirblock);
+	    END (*WITH*);
+	END (*WITH*);
+
+	IF path = NIL THEN RETURN NameNotFound END(*IF*);
+
+	(* Each pass through the following loop steps one level down	*)
+	(* in the directory tree.					*)
+
+	LOOP
+	    (* Search for "path" in the directory file.	    *)
+
+	    result := SearchDirectory (path^.string, fileid, details);
+
+	    (* If not found, return with path intact.	*)
+
+	    IF result <> OK THEN EXIT (*LOOP*) END (*IF*);
+
+	    (* If found, dispose of that part of the path already	*)
+	    (* found, and move to the next name to find if any.		*)
+
+	    current := path;
+	    path := current^.child;
+	    DISPOSE (current);
+	    IF path = NIL THEN EXIT (*LOOP*) END (*IF*);
+
+	    (* If there is still more of the path to search, what we	*)
+	    (* have found so far should be a subdirectory.		*)
+
+	    WITH details DO
+		IF ORD(IANDB(Attribute, 10H)) = 0 THEN
+		    RETURN NotADirectory;
+		END (*IF*);
+		WITH fileid^ DO
+		    dirblock := ClusterToBlockMap (M, StartingCluster);
+		END (*WITH*);
+	    END (*WITH*);
+
+	END (*LOOP*);
+
+	(* The error code is a little more informative for the user if	*)
+	(* we distinguish between two different kinds of "not found"	*)
+	(* errors.							*)
+
+	IF (result = NameNotFound) AND (path^.child <> NIL) THEN
+	    result := DirectoryNotFound;
+	END (*IF*);
+
+	RETURN result;
+
+    END SearchPath;
+
+(************************************************************************)
+
+PROCEDURE DirectoryLookup (newfile: BOOLEAN;  path: NameList;
+		VAR (*INOUT*) fileid: Handle;
+		VAR (*OUT*) BlockNumber: BlockNumberType;
+		VAR (*OUT*) BytesInFile: LONGCARD)
+							: ErrorCode;
+
+    (* Returns the directory information for a file, whose name is in	*)
+    (* path, on the device identified by fileid^.M, starting the search	*)
+    (* at directory block fileid^.dirblock.  On successful return	*)
+    (* fileid^ identifies the directory entry, and the remaining output	*)
+    (* parameters give the file information.				*)
+    (* Input parameter newfile is TRUE if the intention is to create a	*)
+    (* new file.  The value returned is an error code (OK if no error).	*)
+
+    VAR details: DirectoryEntry;
+	M: MediumInfoPointer;  status: ErrorCode;
+
+    BEGIN
+	M := fileid^.M;
+
+	status := SearchPath (path, fileid, details);
+
+	(* What we do next depends on whether we are to create a new	*)
+	(* file.  For a supposedly existing file, SearchPath should	*)
+	(* have found the directory entry.  For a new file, SearchPath	*)
+	(* should NOT have found an existing directory entry, and it	*)
+	(* should return with the details record indicating the		*)
+	(* directory rather than the file.				*)
+
+	IF newfile THEN
+
+	    BytesInFile := 0;
+	    IF status = OK THEN
+		status := DuplicateFileName;
+	    ELSIF status = NameNotFound THEN
+		IF ORD(IANDB(details.Attribute, 10H)) = 0 THEN
+		    status := NotADirectory;
+		ELSE
+		    fileid^.dirblock := ClusterToBlockMap (
+						M, details.StartingCluster);
+		    status := CreateNewFile(path^.string, fileid, BlockNumber);
+		END (*IF*);
+	    END (*IF*);
+
+	ELSIF status = OK THEN
+
+	    (* We were looking for an existing file.  The information	*)
+	    (* we want should by now be in the "details" record.	*)
+
+	    WITH details DO
+		BlockNumber := ClusterToBlockMap (M, StartingCluster);
+		BytesInFile := FileSize;
+	    END (*WITH*);
+
+	ELSE
+	    IF testing THEN
+		WriteLn (debug);
+		WriteString (debug, "DirectoryLookup: name not found.");
+	    END (*IF*);
+	END (*IF*);
+
+	DiscardNameList (path);
+	RETURN status;
+
+    END DirectoryLookup;
+
+(************************************************************************)
+(*			SETTING THE DEFAULT DIRECTORY			*)
+(************************************************************************)
+
+PROCEDURE SetDefaultDirectory (VAR (*IN*) pathstring: ARRAY OF CHAR):ErrorCode;
+
+    (* Sets the starting point for directory searches in subsequent	*)
+    (* file operations.  Each device has a separate default directory.	*)
+    (* If parameter path includes a device name, the default is set for	*)
+    (* that device; otherwise, the default directory is set for the	*)
+    (* current default device.						*)
+
+    VAR device: Device;  unit: CARDINAL;
+	pathlist: NameList;  fileid: Handle;
+	MediumInfo: MediumInfoPointer;
+	StartAtRoot: BOOLEAN;
+	details: DirectoryEntry;
+	status: ErrorCode;
+
+    BEGIN
+	(* Note that most of the following code duplicates what is in	*)
+	(* procedure Lookup.  When I get time I should clean this up.	*)
+
+	Parse (pathstring, device, unit, pathlist, StartAtRoot);
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "Device code is ");
+	    WriteAddress (debug, ADDRESS(device));
+	END (*IF*);
+
+	(* Obtain a MediumInfo record for the device.  (This could	*)
+	(* trigger a recursive call to SetDefaultDirectory, but that	*)
+	(* should not be a problem for us.)				*)
+
+	IF SameDevice (device, NullDevice()) THEN
+	    device := DefaultDevice;  unit := DefaultUnit;
+	END (*IF*);
+
+	MediumInfo := FindMediumInfo (device, unit);
+	status := CheckMediumInfo (MediumInfo);
+
+	IF status <> OK THEN
+	    RETURN status;
+	END (*IF*);
+
+	(* Create a directory locator for SearchPath to use.	*)
+
+	NEW (fileid);
+	WITH fileid^ DO
+	    M := MediumInfo;
+	    IF StartAtRoot THEN
+		dirblock := M^.DirectoryStart;
+	    ELSE
+		dirblock := ClusterToBlockMap (M, M^.DirectoryCluster);
+	    END (*IF*);
+	    diroffset := 0;
+	END (*WITH*);
+
+	(* Find the directory entry.	*)
+
+	status := SearchPath (pathlist, fileid, details);
+
+	IF status = OK THEN
+
+	    WITH details DO
+
+		IF ORD(IANDB(Attribute, 10H)) = 0 THEN
+		    status := NotADirectory;
+		ELSE
+		    MediumInfo^.DirectoryCluster := StartingCluster;
+		END (*IF*);
+	    END (*WITH*);
+
+	END (*IF*);
+
+	DiscardNameList (pathlist);
+	RETURN status;
+
+    END SetDefaultDirectory;
+
+(************************************************************************)
+(*	    DIRECTORY LOOKUP - THE EXTERNALLY CALLABLE VERSION		*)
+(************************************************************************)
+
+PROCEDURE Lookup (newfile: BOOLEAN;  name: ARRAY OF CHAR;
+		VAR (*OUT*) device: Device;
+		VAR (*OUT*) unit: CARDINAL;
+		VAR (*OUT*) fileid: Handle;
+		VAR (*OUT*) StartingBlock: BlockNumberType;
+		VAR (*OUT*) BytesPerCluster: CARDINAL;
+		VAR (*OUT*) BytesInFile: LONGCARD): ErrorCode;
+
+    (* Parses the file name, returns the device code and unit number,	*)
+    (* and looks up the device directory (which might involve some	*)
+    (* subdirectory searches) to find the location of the directory	*)
+    (* entry, the starting block number, cluster size in bytes, and	*)
+    (* file size in bytes, for the file.  If newfile=TRUE, we create a	*)
+    (* new directory entry for this file (or report an error if the	*)
+    (* file already exists).  When creating a new file, we pre-allocate	*)
+    (* the first block; this partially avoids the complication of	*)
+    (* having to go back and modify the directory entry when the first	*)
+    (* block of data is ready to be written (but we will still have to	*)
+    (* modify the file size part of the entry when the file is closed).	*)
+
+    VAR status: ErrorCode;
+	path: NameList;
+	MediumInfo: MediumInfoPointer;
+	StartAtRoot: BOOLEAN;
+	string: ARRAY [0..31] OF CHAR;
+
+    BEGIN
+	(* Decode the filename string.	*)
+
+	Parse (name, device, unit, path, StartAtRoot);
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "Device code is ");
+	    WriteAddress (debug, ADDRESS(device));
+	END (*IF*);
+
+	(* Obtain a MediumInfo record for the device.	*)
+
+	IF SameDevice (device, NullDevice()) THEN
+	    IF testing THEN
+		WriteLn (debug);
+		WriteString (debug, "Assuming the default device.");
+	    END (*IF*);
+	    device := DefaultDevice;  unit := DefaultUnit;
+	END (*IF*);
+
+	MediumInfo := FindMediumInfo (device, unit);
+	status := CheckMediumInfo (MediumInfo);
+
+	IF status <> OK THEN
+	    IF testing THEN
+		WriteLn (debug);
+		WriteString (debug, "Can't check medium info, status is ");
+		TranslateErrorCode (status, string);
+		WriteString (debug, string);
+		IF Prompting THEN PressAnyKey (debug) END(*IF*);
+	    END (*IF*);
+	    RETURN status;
+	END (*IF*);
+
+	BytesPerCluster := MediumInfo^.ClusterSize;
+
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "CheckMediumInfo succeeded.");
+	    WriteString (debug, "  Cluster size is ");
+	    WriteHexWord (debug, BytesPerCluster);
+	END (*IF*);
+
+	(* Create a directory locator for this file.	*)
+
+	NEW (fileid);
+	WITH fileid^ DO
+	    M := MediumInfo;
+	    IF StartAtRoot THEN
+		dirblock := M^.DirectoryStart;
+	    ELSE
+		dirblock := ClusterToBlockMap (M, M^.DirectoryCluster);
+	    END (*IF*);
+	    diroffset := 0;
+	END (*WITH*);
+
+	(* Find the directory entry.	*)
+
+	status := DirectoryLookup (newfile, path, fileid,
+						StartingBlock, BytesInFile);
+
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteHexWord (debug, BytesPerCluster);
+	    WriteString (debug, " bytes per cluster, ");
+	    WriteHexLongword (debug, BytesInFile);
+	    WriteString (debug, " bytes in file.");
+	    WriteLn (debug);
+	    WriteString (debug, "The starting block is ");
+	    WriteHexLongword (debug, StartingBlock);  WriteLn (debug);
+	    WriteString (debug, "  and the status code is ");
+	    TranslateErrorCode (status, string);
+	    WriteString (debug, string);
+	    IF Prompting THEN PressAnyKey (debug) END(*IF*);
+	END (*IF*);
+
+	RETURN status;
+
+    END Lookup;
+
+(************************************************************************)
+(*		UPDATING THE FILE SIZE IN THE DIRECTORY			*)
+(************************************************************************)
+
+PROCEDURE UpdateFileSize (fileid: Handle;  NewSize: LONGCARD);
+
+    (* Updates a directory entry to show a modified file size.	*)
+
+    VAR entry: DirectoryEntry;
+	status: ErrorCode;
+
+    BEGIN
+
+	WITH fileid^ DO
+	    status := CachedRead (M, dirblock, diroffset,
+					SIZE(DirectoryEntry), entry);
+	    IF status = OK THEN
+		entry.FileSize := NewSize;
+		status := CachedWrite (M, dirblock, diroffset,
+					SIZE(DirectoryEntry), entry);
+	    END (*IF*);
+	    status := SyncCache (M);
+	END (*WITH*);
+
+    END UpdateFileSize;
+
+(************************************************************************)
+
+PROCEDURE DiscardHandle (VAR (*INOUT*) fileid: Handle);
+
+    (* To be called when a file is no longer going to be accessed.	*)
+
+    BEGIN
+	IF fileid <> NIL THEN
+	    DISPOSE (fileid);
+	END (*IF*);
+    END DiscardHandle;
+
+(************************************************************************)
+(*				FINAL CLEANUP				*)
+(************************************************************************)
+
+PROCEDURE Cleanup;
+
+    (* Releases the medium descriptors.  It would be nice to flush the	*)
+    (* caches as well, but we can't do that without the risk of a	*)
+    (* deadlock, because the device drivers might already have shut	*)
+    (* themselves down by this stage.  This is not too disastrous: the	*)
+    (* only cases where there would still be unflushed caches at this	*)
+    (* stage would be where a file has not been closed, or when a	*)
+    (* newly created file has length 0.					*)
+
+    VAR current: MediumInfoPointer;
+
+    BEGIN
+	WHILE MediumInfoHead <> NIL DO
+	    current := MediumInfoHead;
+	    MediumInfoHead := current^.next;
+	    DISPOSE (current^.CachePtr);
+	    DISPOSE (current);
+	END (*WHILE*);
+    END Cleanup;
+
+(************************************************************************)
+(*			   MODULE INITIALISATION			*)
+(************************************************************************)
+
+PROCEDURE SetupDefaults ();
+
+    (* Sets up the default device and unit	*)
+
+    VAR dummy1: NameList;  dummy2: BOOLEAN;
+	devname: ARRAY [0..2] OF CHAR;
+	Registers: RegisterPacket;
+
+    BEGIN
+
+	(* Get the current default DOS device, and call this our	*)
+	(* default device.						*)
+
+	Registers.AH := 25;
+	BIOS (33, Registers);
+	devname[0] := CHR (ORD('A') + ORD(Registers.AL));
+	devname[1] := ':';  devname[2] := CHR(0);
+
+	Parse (devname, DefaultDevice, DefaultUnit, dummy1, dummy2);
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "Default device code is ");
+	    WriteAddress (debug, ADDRESS(DefaultDevice));
+	END (*IF*);
+
+    END SetupDefaults;
+
+(************************************************************************)
+
+BEGIN
+    IF testing THEN
+	CreateMaintenancePage (Mpage);
+	OpenWindow (debug, yellow, blue, 0, 23, 0, 79,
+					simpleframe, doubledivider);
+	Associate (debug, Mpage);
+	SetCursor (debug, 1, 18);
+	WriteString (debug, "Diagnostic output from Directories module");
+	ChangeScrollingRegion (debug, 3, 22);
+    END (*IF*);
+    MediumInfoHead := NIL;
+    SetTerminationProcedure (Cleanup);
+    SetupDefaults ();
+END Directories.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/dma.def b/examples/Modula-2_Libraries/PMOS/sources/general/dma.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/dma.def
@@ -0,0 +1,49 @@
+DEFINITION MODULE DMA;
+
+	(********************************************************)
+	(*							*)
+	(*	Procedures to deal with Direct Memory Access	*)
+	(*		    input and output.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	19 August 1994			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	ADDRESS;
+
+PROCEDURE CheckDMAAddress (Address: ADDRESS;  count: CARDINAL): BOOLEAN;
+
+    (* Returns TRUE iff the given address and count values are		*)
+    (* suitable for a DMA transfer.  An unsuitable pair is one where	*)
+    (* the transfer would cross a 64K boundary in memory - a case which	*)
+    (* the DMA hardware cannot handle.					*)
+
+PROCEDURE AllocateDMABuffer (VAR (*OUT*) Address: ADDRESS;  size: CARDINAL);
+
+    (* Like the standard ALLOCATE procedure, but ensures that the	*)
+    (* allocated memory does not straddle a 64K boundary.  The memory	*)
+    (* can be deallocated with DEALLOCATE when you are finished with it.*)
+
+PROCEDURE LoadDMAparameters (channel, operation: CARDINAL;
+				Address: ADDRESS;  count: CARDINAL);
+
+    (* Loads the DMA controller with the address and count values	*)
+    (* as a preliminary to starting a DMA transfer.			*)
+    (* The code for "operation" is 0 for verify, 1 for read (transfer	*)
+    (* from external device to memory), and 2 for write (from memory to	*)
+    (* external device).  Other values are illegal.			*)
+
+    (* It is the caller's responsibility to know that the specified DMA	*)
+    (* channel is not already in use.  This is normally not a problem,	*)
+    (* since each channel is permanently dedicated to a single use.	*)
+
+    (* It is also the caller's responsibility to know that the given	*)
+    (* address and count do not cause the transfer to cross a 64 Kbyte	*)
+    (* boundary in main memory - a case which the DMA hardware cannot	*)
+    (* handle.  Use the above procedures to get around this problem.	*)
+
+END DMA.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/dma.mod b/examples/Modula-2_Libraries/PMOS/sources/general/dma.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/dma.mod
@@ -0,0 +1,195 @@
+IMPLEMENTATION MODULE DMA;
+
+	(********************************************************)
+	(*							*)
+	(*	Procedures to deal with Direct Memory Access	*)
+	(*		    input and output.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 February 1995		*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(*									*)
+(* HARDWARE ASSUMPTIONS:						*)
+(*  DMA transfers to/from main memory are performed by the 8237A DMA	*)
+(*  controller.  The DMA controller is at ports 000H-01FH.		*)
+(*									*)
+(*  A complicating factor is that the DMA controller expects physical	*)
+(*  addresses (i.e. it knows nothing about memory segmentation), and	*)
+(*  furthermore it can only handle 16-bit addresses.  To get around	*)
+(*  this limitation, port 081H is a latch for the higher-order bits of	*)
+(*  the address.  Unfortunately, this arrangement means that, when the	*)
+(*  DMA controller increments the address during a transfer, any carry	*)
+(*  from the low-order 16 bits is not propagated upwards.  The		*)
+(*  practical consequence is that the user's data buffer must not cross	*)
+(*  a 64 Kbyte boundary in main memory.					*)
+(*									*)
+(*  Added later: according to information I have just received, each	*)
+(*  DMA channel has its own port for holding the high-order part of the	*)
+(*  address.  This information has been incorporated into the current	*)
+(*  version of the software, but has not been tested (14/2/91).		*)
+(*									*)
+(************************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE;
+
+FROM LowLevel IMPORT
+    (* proc *)	OutByte, Physical, LowByte, HighByte, LowWord, HighWord;
+
+FROM MiscPMOS IMPORT
+    (* proc *)	EnterCriticalSection, LeaveCriticalSection;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+(************************************************************************)
+
+TYPE CARD9 = ARRAY [0..8] OF CARDINAL;
+
+CONST
+    DMAchip = 0;
+    LatchPort = CARD9 (87H, 83H, 81H, 82H, 00H, 8BH, 89H, 8AH, 8FH);
+
+    (* Remark: note that channel 4 does not appear to have a latch	*)
+    (* port.  Note also that I've added a latch port for "channel 8",	*)
+    (* which is not in fact a DMA channel so far as I know but has been	*)
+    (* given to me as the "refresh" port, and I've put it into this	*)
+    (* list so that I won't forget the number in case I ever need it.	*)
+    (* Note in any case that the present version of this module only	*)
+    (* covers channels 0..3, so that the other numbers are here only as	*)
+    (* a reminder for future enhancements to the module.		*)
+
+(************************************************************************)
+(*		      DEALING WITH THE 64K LIMITATION			*)
+(************************************************************************)
+
+PROCEDURE CheckDMAAddress (Address: ADDRESS;  count: CARDINAL): BOOLEAN;
+
+    (* Returns TRUE iff the given address and count values are		*)
+    (* suitable for a DMA transfer.  An unsuitable pair is one where	*)
+    (* the transfer would cross a 64K boundary in memory - a case which	*)
+    (* the DMA hardware cannot handle.					*)
+
+    VAR first: LONGCARD;
+
+    BEGIN
+	first := Physical (Address);
+	RETURN HighWord(first) = HighWord(first+LONGCARD(count-1));
+    END CheckDMAAddress;
+
+(************************************************************************)
+
+PROCEDURE AllocateDMABuffer (VAR (*OUT*) Address: ADDRESS;  size: CARDINAL);
+
+    (* Like the standard ALLOCATE procedure, but ensures that the	*)
+    (* allocated memory does not straddle a 64K boundary.		*)
+
+    VAR NotOK, temp: POINTER TO ADDRESS;
+
+    BEGIN
+	NotOK := NIL;  ALLOCATE (Address, size);
+	WHILE (Address <> NIL) AND NOT CheckDMAAddress(Address, size) DO
+
+	    (* This one didn't work out, put it on a list of buffers	*)
+	    (* to be discarded later, and try again.			*)
+
+	    temp := Address;  temp^ := NotOK;  NotOK := temp;
+	    ALLOCATE (Address, size);
+
+	END (*LOOP*);
+
+	(* Deallocate all the buffers that didn't work out. *);
+
+	WHILE NotOK <> NIL DO
+	    temp := NotOK;  DEALLOCATE (NotOK, size);
+	    NotOK := temp;
+	END (*WHILE*);
+
+    END AllocateDMABuffer;
+
+(************************************************************************)
+(*			SETTING UP THE DMA CONTROLLER			*)
+(************************************************************************)
+
+PROCEDURE LoadDMAparameters (channel, operation: CARDINAL;
+				Address: ADDRESS; count: CARDINAL);
+
+    (* Loads the DMA controller with the address and count values	*)
+    (* as a preliminary to starting a disk transfer.			*)
+    (* The code for "operation" is 0 for verify, 1 for read (i.e. from	*)
+    (* device to memory), and 2 for write (from main memory to device).	*)
+    (* Other values are illegal.					*)
+
+    (* Note that this procedure requires critical section protection	*)
+    (* because, even though the four DMA channels can operate in	*)
+    (* parallel, there is only a single mode register and a single	*)
+    (* "byte pointer" flipflop.  Semaphores are inappropriate for this	*)
+    (* application because the procedure is sometimes called from	*)
+    (* inside an interrupt handler.					*)
+
+    CONST
+	ChannelEnable = DMAchip + 0AH;
+	ModeRegister = DMAchip + 0BH;
+	ClearByteFlipFlop = DMAchip + 0CH;
+
+    VAR PhysicalAddress: LONGCARD;
+	bottom16bits: CARDINAL;
+	AddressRegister, CountRegister: CARDINAL;
+	savedPSW: WORD;
+	
+    BEGIN
+	AddressRegister := DMAchip + 2*channel;
+	CountRegister := AddressRegister + 1;
+
+	savedPSW := EnterCriticalSection();
+
+	(* Specify the operation to be performed.  The constant 40H	*)
+	(* encodes the options: single transfer mode, autoincrementing	*)
+	(* address, and no autoinitialisation.				*)
+
+	OutByte (ModeRegister, BYTE(40H + 4*operation + channel));
+
+	(* Clear the "byte pointer" flipflop in the DMA chip, to ensure	*)
+	(* that the subsequent writes to the address and count ports	*)
+	(* can be sent in a known order.  The actual value written to	*)
+	(* this port is irrelevant.					*)
+
+	OutByte (ClearByteFlipFlop, 0);
+
+	(* Load the starting address as a physical address.  Only 16	*)
+	(* bits of the physical address will fit in the DMA controller.	*)
+	(* The high-order 4 bits must be loaded into a separate latch.	*)
+	(* Error to watch out for: can't cross a 64KB boundary.  In the	*)
+	(* present version we treat that as the caller's problem.	*)
+
+	PhysicalAddress := Physical (Address);
+	bottom16bits := LowWord (PhysicalAddress);
+
+	OutByte (AddressRegister, LowByte (bottom16bits));
+	OutByte (AddressRegister, HighByte (bottom16bits));
+	OutByte (LatchPort[channel], LowByte (HighWord(PhysicalAddress)));
+
+	(* Load the count register.  The value loaded is one less than	*)
+	(* the actual desired count.					*)
+
+	DEC (count);
+	OutByte (CountRegister, LowByte(count));
+	OutByte (CountRegister, HighByte(count));
+
+	(* Ensure that this DMA channel is enabled, by clearing a bit	*)
+	(* in the mask register.					*)
+
+	OutByte (ChannelEnable, BYTE(channel));
+
+	LeaveCriticalSection (savedPSW);
+
+    END LoadDMAparameters;
+
+(************************************************************************)
+
+END DMA.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/dummymou.def b/examples/Modula-2_Libraries/PMOS/sources/general/dummymou.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/dummymou.def
@@ -0,0 +1,80 @@
+DEFINITION MODULE DummyMouse;
+
+	(********************************************************)
+	(*							*)
+	(*		  Dummy mouse driver			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	17 August 1994			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(*	This module acts as the "mouse driver" for	*)
+	(*	the case in which we don't want mouse support.	*)
+	(*	It consists entirely of dummy procedures.	*)
+	(*							*)
+	(********************************************************)
+
+FROM Mouse0 IMPORT
+    (* type *)	ButtonSet, EventSet, EventHandler;
+
+PROCEDURE InitialiseMouseDriver(): BOOLEAN;
+
+    (* Does all initialisation needed for this module.  We make this a	*)
+    (* procedure rather than an initialisation section because module	*)
+    (* Mouse has to decide which mouse driver to use.  The function	*)
+    (* result indicates success; if it is FALSE, none of the following	*)
+    (* procedures will work.  Note: this is not an end-user procedure,	*)
+    (* it's intended to be called only by module Mouse.			*)
+
+PROCEDURE Reset (VAR (*OUT*) MousePresent: BOOLEAN;
+			VAR (*OUT*) NumberOfButtons: CARDINAL);
+
+    (* Resets the mouse, returning MousePresent as FALSE if no mouse	*)
+    (* available and as TRUE if it is, and NumberOfButtons as the	*)
+    (* number of buttons for the mouse if installed.			*)
+
+PROCEDURE SetCursorPos (X, Y : CARDINAL);
+
+    (* Sets the mouse cursor position. *)
+
+PROCEDURE GetPosBut (VAR (*OUT*) buttons: ButtonSet;
+				VAR (*OUT*) Xposition, Yposition: CARDINAL);
+
+    (* Returns the current mouse position and the state of the buttons.	*)
+    (* Note: the units here are not the same as for procedure		*)
+    (* GetTextMousePosition.  In both this procedure and in the event	*)
+    (* handlers the position is presented in units of 1/8th of a	*)
+    (* character width or height.					*)
+
+PROCEDURE SetPage (page: CARDINAL);
+
+    (* Sets the hardware screen page where the mouse is visible. *)
+
+PROCEDURE SetHorizontalLimits (MinX, MaxX : CARDINAL);
+PROCEDURE SetVerticalLimits (MinY, MaxY : CARDINAL);
+
+    (* Sets the cursor limits. *)
+
+PROCEDURE ShowCursor;
+
+    (* Makes the mouse cursor visible on the screen.  Note: we allow	*)
+    (* nesting in ShowCursor/HideCursor calls, so that for example if	*)
+    (* you've called HideCursor twice then you need to call ShowCursor	*)
+    (* twice to make the cursor reappear.				*)
+
+PROCEDURE HideCursor;
+
+    (* Makes the mouse cursor invisible. *)
+
+PROCEDURE SetEventHandler (DetectedEvents: EventSet;
+					Handler: EventHandler);
+
+    (* Nominates the procedure to be called whenever an event in the	*)
+    (* set DetectedEvents occurs.  Note: the Handler is like an		*)
+    (* interrupt procedure, in that it is executing in the context of	*)
+    (* an unknown task; typically it should probably restrict its	*)
+    (* actions to fairly elementary things, like a Signal to wake up	*)
+    (* the task that really wants to know about the event.		*)
+
+END DummyMouse.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/dummymou.mod b/examples/Modula-2_Libraries/PMOS/sources/general/dummymou.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/dummymou.mod
@@ -0,0 +1,135 @@
+IMPLEMENTATION MODULE DummyMouse;
+
+	(********************************************************)
+	(*							*)
+	(*		  Dummy mouse driver			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	17 August 1994			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(*	This module acts as the "mouse driver" for	*)
+	(*	the case in which we don't want mouse support.	*)
+	(*	It consists entirely of dummy procedures.	*)
+	(*							*)
+	(********************************************************)
+
+FROM Mouse0 IMPORT
+    (* type *)	ButtonSet, EventSet, EventHandler;
+
+(************************************************************************)
+
+PROCEDURE InitialiseMouseDriver(): BOOLEAN;
+
+    (* Does all initialisation needed for this module.  We make this a	*)
+    (* procedure rather than an initialisation section because module	*)
+    (* Mouse has to decide which mouse driver to use.  The function	*)
+    (* result indicates success; if it is FALSE, none of the following	*)
+    (* procedures will work.  Note: this is not an end-user procedure,	*)
+    (* it's intended to be called only by module Mouse.			*)
+
+    BEGIN
+	RETURN FALSE;
+    END InitialiseMouseDriver;
+
+(************************************************************************)
+
+PROCEDURE Reset (VAR (*OUT*) MousePresent: BOOLEAN;
+			VAR (*OUT*) NumberOfButtons: CARDINAL);
+
+    (* Resets the mouse, returning MousePresent as FALSE if no mouse	*)
+    (* available and as TRUE if it is, and NumberOfButtons as the	*)
+    (* number of buttons for the mouse if installed.			*)
+
+    BEGIN
+	MousePresent := FALSE;  NumberOfButtons := 0;
+    END Reset;
+
+(************************************************************************)
+
+PROCEDURE SetCursorPos (X, Y : CARDINAL);
+
+    (* Sets the mouse cursor position. *)
+
+    BEGIN
+    END SetCursorPos;
+
+(************************************************************************)
+
+PROCEDURE GetPosBut (VAR (*OUT*) buttons: ButtonSet;
+				VAR (*OUT*) Xposition, Yposition: CARDINAL);
+
+    (* Returns the current mouse position and the state of the buttons.	*)
+    (* Note: the units here are not the same as for procedure		*)
+    (* GetTextMousePosition.  In both this procedure and in the event	*)
+    (* handlers the position is presented in units of 1/8th of a	*)
+    (* character width or height.					*)
+
+    BEGIN
+	buttons := ButtonSet{};
+	Xposition := 0;  Yposition := 0;
+    END GetPosBut;
+
+(************************************************************************)
+
+PROCEDURE SetPage (page: CARDINAL);
+
+    (* Sets the hardware screen page where the mouse is visible. *)
+
+    BEGIN
+    END SetPage;
+
+(************************************************************************)
+
+PROCEDURE SetHorizontalLimits (MinX, MaxX : CARDINAL);
+
+    BEGIN
+    END SetHorizontalLimits;
+
+(************************************************************************)
+
+PROCEDURE SetVerticalLimits (MinY, MaxY : CARDINAL);
+
+    BEGIN
+    END SetVerticalLimits;
+
+(************************************************************************)
+
+PROCEDURE ShowCursor;
+
+    (* Makes the mouse cursor visible on the screen.  Note: we allow	*)
+    (* nesting in ShowCursor/HideCursor calls, so that for example if	*)
+    (* you've called HideCursor twice then you need to call ShowCursor	*)
+    (* twice to make the cursor reappear.				*)
+
+    BEGIN
+    END ShowCursor;
+
+(************************************************************************)
+
+PROCEDURE HideCursor;
+
+    (* Makes the mouse cursor invisible. *)
+
+    BEGIN
+    END HideCursor;
+
+(************************************************************************)
+
+PROCEDURE SetEventHandler (DetectedEvents: EventSet;
+					Handler: EventHandler);
+
+    (* Nominates the procedure to be called whenever an event in the	*)
+    (* set DetectedEvents occurs.  Note: the Handler is like an		*)
+    (* interrupt procedure, in that it is executing in the context of	*)
+    (* an unknown task; typically it should probably restrict its	*)
+    (* actions to fairly elementary things, like a Signal to wake up	*)
+    (* the task that really wants to know about the event.		*)
+
+    BEGIN
+    END SetEventHandler;
+
+(************************************************************************)
+
+END DummyMouse.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/fieldedi.def b/examples/Modula-2_Libraries/PMOS/sources/general/fieldedi.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/fieldedi.def
@@ -0,0 +1,130 @@
+DEFINITION MODULE FieldEditor;
+
+	(********************************************************)
+	(*							*)
+	(*		Screen editing utilities		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	15 May 1991			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	ADDRESS;
+
+FROM Windows IMPORT
+    (* type *)	Window;
+
+(************************************************************************)
+(*									*)
+(*  The editor in this module is "generic" in a limited sense.  It	*)
+(*  performs screen editing of variables of arbitrary types, provided	*)
+(*  that those types have been declared by calls to DefineFieldType.	*)
+(*									*)
+(*  The caller is required, when calling DefineFieldType, to supply	*)
+(*  procedures which write and edit variables of that type.  Each of	*)
+(*  the user-supplied procedures has three parameters: a window, a	*)
+(*  pointer to the variable to be written or edited, and the number of	*)
+(*  character positions to use.  For field types where the number of	*)
+(*  character positions cannot be determined in advance, the caller is	*)
+(*  expected to supply 0 as the value of the third parameter, and the	*)
+(*  user-supplied procedures are expected to be able to work out the	*)
+(*  actual width required.  The user-supplied procedures are expected,	*)
+(*  in all cases, to leave the screen cursor at the character position	*)
+(*  just beyond the written form of the field.  They must be prepared	*)
+(*  to deal with NIL addresses.  The user-supplied editor must handle	*)
+(*  all keystrokes which belong to it, but leave intact (via		*)
+(*  Keyboard.Putback, for example) the keystroke which causes it to	*)
+(*  return.  Note that it will be very common for the editor to receive	*)
+(*  a cursor movement key implying that the user does not want to	*)
+(*  modify this field but is simply skipping over it.  In such cases	*)
+(*  the editor still has the responsibility for showing the user where	*)
+(*  the cursor is, by using blinking, reverse video, etc.		*)
+(*									*)
+(*  Given all of these rules, and the fact that all the hard work is to	*)
+(*  be done by user-supplied procedures, you might by now be wondering	*)
+(*  whether there is any point in having this module.  The main point	*)
+(*  is that the rules impose some uniform standards which make it	*)
+(*  easier to develop readable software for applications which need a	*)
+(*  lot of screen editing.  They also help, in some applications, to	*)
+(*  avoid duplication of effort.  These properties are used to		*)
+(*  advantage in modules ListEditor and ScreenEditor.			*)
+(*									*)
+(*  As an added bonus, this module exports some pre-defined field types	*)
+(*  for commonly encountered cases.  For those cases, the user does not	*)
+(*  need to call DefineFieldType, and therefore does not need to supply	*)
+(*  the procedures for writing and editing variables of those types.	*)
+(*									*)
+(************************************************************************)
+
+TYPE
+    FieldType;		(* is private *)
+    WriteProc = PROCEDURE (Window, ADDRESS, CARDINAL);
+    EditProc = PROCEDURE (Window, VAR (*INOUT*) ADDRESS, CARDINAL);
+
+(************************************************************************)
+(*			THE PREDEFINED TYPES				*)
+(************************************************************************)
+
+VAR Byte, Cardinal, Real: FieldType;
+
+(************************************************************************)
+(*			DEFINING A NEW TYPE				*)
+(************************************************************************)
+
+PROCEDURE DefineFieldType (Writer: WriteProc;  Editor: EditProc): FieldType;
+
+    (* Introduces a new field type into the system.  Writer is a	*)
+    (* user-supplied procedure to write a variable of the new type.	*)
+    (* Editor is the user-supplied procedure for editing a variable of	*)
+    (* that type.							*)
+
+PROCEDURE DiscardFieldType (type: FieldType);
+
+    (* A notification from the user that this type will not be used	*)
+    (* again (unless it is redefined by another call to procedure	*)
+    (* DefineFieldType).  Use of this procedure is optional, but is	*)
+    (* recommended for the sake of "clean" memory management.		*)
+
+(************************************************************************)
+(*			   COMPARING TYPES				*)
+(************************************************************************)
+
+PROCEDURE SameType (t1, t2: FieldType): BOOLEAN;
+
+    (* Returns TRUE iff t1 = t2.	*)
+
+(************************************************************************)
+(*			    SCREEN OUTPUT				*)
+(************************************************************************)
+
+PROCEDURE WriteField (w: Window;  address: ADDRESS;  type: FieldType;
+							width: CARDINAL);
+
+    (* Writes address^ on the screen at the current cursor position in	*)
+    (* window w.  The width parameter specifies how many character	*)
+    (* positions to use.  Use width=0 for variable-width fields for	*)
+    (* which the write procedure for that type must work out the width.	*)
+
+(************************************************************************)
+(*			     THE EDITOR					*)
+(************************************************************************)
+
+PROCEDURE EditField (w: Window;  VAR (*INOUT*) address: ADDRESS;
+				type: FieldType;  width: CARDINAL);
+
+    (* Edits the variable at the given address, and of the given type,	*)
+    (* at the current cursor position in window w.  The width parameter	*)
+    (* specifies how many character positions are to be used on the	*)
+    (* screen.  Set width=0 for variable-width fields where the editor	*)
+    (* must determine the width.  We leave this procedure on seeing a	*)
+    (* keyboard character which does not belong to us.  The cursor is	*)
+    (* left just beyond the last character of the field as it is	*)
+    (* displayed.  The terminating keystroke is returned to the		*)
+    (* keyboard driver so that it can still be read by the caller.	*)
+    (* Note that the address is an inout parameter because there are	*)
+    (* cases where we allow the user to create and delete fields, i.e.	*)
+    (* address could be NIL on entry but not on exit, or vice versa.	*)
+
+END FieldEditor.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/fieldedi.mod b/examples/Modula-2_Libraries/PMOS/sources/general/fieldedi.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/fieldedi.mod
@@ -0,0 +1,202 @@
+IMPLEMENTATION MODULE FieldEditor;
+
+	(********************************************************)
+	(*							*)
+	(*		Screen editing utilities		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 February 1995		*)
+	(*  Status:		Seems to be OK			*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure;
+
+FROM NumericIO IMPORT
+    (* proc *)	WriteHexByte, EditHexByte, WriteRJCard, EditCardinal;
+
+FROM RealIO IMPORT
+    (* proc *)	WriteReal, EditReal;
+
+(************************************************************************)
+
+TYPE
+    BytePtr = POINTER TO BYTE;
+    CardPtr = POINTER TO CARDINAL;
+    RealPtr = POINTER TO REAL;
+
+    FieldType =  POINTER TO RECORD
+				FieldWriter: WriteProc;
+				FieldEditor: EditProc;
+			    END (*RECORD*);
+
+(************************************************************************)
+(*		SCREEN OUTPUT FOR THE PREDEFINED TYPES			*)
+(************************************************************************)
+
+PROCEDURE WriteCardinalField (w: Window;  address: CardPtr;  width: CARDINAL);
+
+    BEGIN
+	WriteRJCard (w, address^, width);
+    END WriteCardinalField;
+
+(************************************************************************)
+
+PROCEDURE WriteByteField (w: Window;  address: BytePtr;  width: CARDINAL);
+
+    BEGIN
+	WriteHexByte (w, address^);
+    END WriteByteField;
+
+(************************************************************************)
+
+PROCEDURE WriteRealField (w: Window;  address: RealPtr;  width: CARDINAL);
+
+    BEGIN
+	WriteReal (w, address^, width);
+    END WriteRealField;
+
+(************************************************************************)
+(*		    EDITORS FOR THE PREDEFINED TYPES			*)
+(************************************************************************)
+
+PROCEDURE EditByteField (w: Window;  VAR (*INOUT*) address: BytePtr;
+						width: CARDINAL);
+
+    BEGIN
+	EditHexByte (w, address^);
+    END EditByteField;
+
+(************************************************************************)
+
+PROCEDURE EditCardinalField (w: Window;  VAR (*INOUT*) address: CardPtr;
+						width: CARDINAL);
+
+    BEGIN
+	EditCardinal (w, address^, width);
+    END EditCardinalField;
+
+(************************************************************************)
+
+PROCEDURE EditRealField (w: Window;  VAR (*INOUT*) address: RealPtr;
+							width: CARDINAL);
+
+    BEGIN
+	EditReal (w, address^, width);
+    END EditRealField;
+
+(************************************************************************)
+(*			   COMPARING TYPES				*)
+(************************************************************************)
+
+PROCEDURE SameType (t1, t2: FieldType): BOOLEAN;
+
+    (* Returns TRUE iff t1 = t2.	*)
+
+    BEGIN
+	RETURN t1 = t2;
+    END SameType;
+
+(************************************************************************)
+(*			DEFINING A NEW TYPE				*)
+(************************************************************************)
+
+PROCEDURE DefineFieldType (Writer: WriteProc;  Editor: EditProc): FieldType;
+
+    (* Introduces a new field type into the system.  Writer is a	*)
+    (* user-supplied procedure to write a variable of the new type.	*)
+    (* Editor is the user-supplied procedure for editing a variable of	*)
+    (* that type.							*)
+
+    VAR result: FieldType;
+
+    BEGIN
+	NEW (result);
+	WITH result^ DO
+	    FieldWriter := Writer;
+	    FieldEditor := Editor;
+	END (*WITH*);
+	RETURN result;
+    END DefineFieldType;
+
+(************************************************************************)
+
+PROCEDURE DiscardFieldType (type: FieldType);
+
+    (* A notification from the user that this type will not be used	*)
+    (* again (unless it is redefined by another call to procedure	*)
+    (* DefineFieldType).  Use of this procedure is optional, but is	*)
+    (* recommended for the sake of "clean" memory management.		*)
+
+    BEGIN
+	DISPOSE (type);
+    END DiscardFieldType;
+
+(************************************************************************)
+(*			    SCREEN OUTPUT				*)
+(************************************************************************)
+
+PROCEDURE WriteField (w: Window;  address: ADDRESS;  type: FieldType;
+							width: CARDINAL);
+
+    (* Writes address^ on the screen at the current cursor position in	*)
+    (* window w.  The width parameter specifies how many character	*)
+    (* positions to use.  Use width=0 for variable-width fields for	*)
+    (* which the write procedure for that type must work out the width.	*)
+
+    BEGIN
+	WITH type^ DO
+	    FieldWriter (w, address, width);
+	END (*WITH*);
+    END WriteField;
+
+(************************************************************************)
+(*			     THE EDITOR					*)
+(************************************************************************)
+
+PROCEDURE EditField (w: Window;  VAR (*INOUT*) address: ADDRESS;
+				type: FieldType;  width: CARDINAL);
+
+    (* Edits the variable at the given address, and of the given type,	*)
+    (* at the current cursor position in window w.  The width parameter	*)
+    (* specifies how many character positions are to be used on the	*)
+    (* screen.  Set width=0 for variable-width fields where the editor	*)
+    (* must determine the width.  We leave this procedure on seeing a	*)
+    (* keyboard character which does not belong to us.  The cursor is	*)
+    (* left just beyond the last character of the field as it is	*)
+    (* displayed.  The terminating keystroke is returned to the		*)
+    (* keyboard driver so that it can still be read by the caller.	*)
+
+    BEGIN
+	WITH type^ DO
+	    FieldEditor (w, address, width);
+	END (*WITH*);
+    END EditField;
+
+(************************************************************************)
+(*			SETTING UP THE PREDEFINED TYPES			*)
+(************************************************************************)
+
+PROCEDURE FinalCleanup;
+
+    BEGIN
+	DiscardFieldType (Byte);
+	DiscardFieldType (Cardinal);  DiscardFieldType (Real);
+    END FinalCleanup;
+
+(************************************************************************)
+
+BEGIN
+    Byte := DefineFieldType (WriteByteField, EditByteField);
+    Cardinal := DefineFieldType (WriteCardinalField, EditCardinalField);
+    Real := DefineFieldType (WriteRealField, EditRealField);
+    SetTerminationProcedure (FinalCleanup);
+END FieldEditor.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/filename.def b/examples/Modula-2_Libraries/PMOS/sources/general/filename.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/filename.def
@@ -0,0 +1,77 @@
+DEFINITION MODULE FileNames;
+
+	(********************************************************)
+	(*							*)
+	(*		File name parsing			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	19 January 1993			*)
+	(*  Status:		Just started			*)
+	(*							*)
+	(*	This module, which is part of the file system	*)
+	(*	and is not intended for end-user use, looks	*)
+	(*	after translating file name strings into a	*)
+	(*	more convenient internal form.			*)
+	(*							*)
+	(********************************************************)
+
+FROM Windows IMPORT
+    (* type *)	Window;
+
+FROM Devices IMPORT
+    (* type *)	Device;
+
+(************************************************************************)
+
+TYPE
+
+    (* File names (and directory names) are at most eight characters	*)
+    (* long.  This archaic restriction is regretted, but we have no	*)
+    (* choice if we want to remain compatible with the MS-DOS directory	*)
+    (* formats.  Actually, longer names are accepted (see procedure	*)
+    (* Scan), but all but the first eight characters are skipped.	*)
+    (* FileNameExtension refers to the three characters which may	*)
+    (* appear after a period in the complete file name.			*)
+
+    EightChar = ARRAY [0..7] OF CHAR;		(* not exported *)
+    FileNameString = EightChar;
+    FileNameExtension = ARRAY [0..2] OF CHAR;
+    FileName =	RECORD
+		    fname: FileNameString;
+		    fext: FileNameExtension;
+		END (*RECORD*);
+
+    (* The NameList form of a file name is a linked list where the	*)
+    (* first entry gives the device name, following entries give the	*)
+    (* directory names in order, and the last entry is the name of the	*)
+    (* file within its own directory.					*)
+
+    NameList = POINTER TO NameListRecord;
+    NameListRecord= RECORD
+			string: FileName;
+			child: NameList;
+		    END (*RECORD*);
+
+(************************************************************************)
+
+PROCEDURE WriteFileName (w: Window;  name: FileName);
+
+    (* For testing: writes name in window w.	*)
+    (* Probably won't need to export this in final version.	*)
+
+PROCEDURE Parse (name: ARRAY OF CHAR;  VAR (*OUT*) device: Device;
+		VAR (*OUT*) unit: CARDINAL;  VAR (*OUT*) result: NameList;
+		VAR (*OUT*) StartAtRoot: BOOLEAN);
+
+    (* Translates a text string "name" into NameList form.  If the	*)
+    (* string includes a device specification this is returned as	*)
+    (* (device, unit); otherwise we return with device = NullDevice.	*)
+    (* Output parameter StartAtRoot is TRUE iff the filename string	*)
+    (* started with a '\'.						*)
+
+PROCEDURE DiscardNameList (VAR (*INOUT*) path: NameList);
+
+    (* Disposes of the storage occupied by a NameList.  Returns NIL.	*)
+
+END FileNames.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/filename.mod b/examples/Modula-2_Libraries/PMOS/sources/general/filename.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/filename.mod
@@ -0,0 +1,216 @@
+IMPLEMENTATION MODULE FileNames;
+
+	(********************************************************)
+	(*							*)
+	(*		File name parsing			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 February 1995		*)
+	(*  Status:		Just started			*)
+	(*	Apparently complete but untested.		*)
+	(*							*)
+	(*	This module, which is part of the file system	*)
+	(*	and is not intended for end-user use, looks	*)
+	(*	after translating file name strings into a	*)
+	(*	more convenient internal form.			*)
+	(*							*)
+	(*	It is still questionable whether the syntax	*)
+	(*	imposed by this module is the best one.		*)
+	(*	Need to check the rules for DOS file names	*)
+	(*	more carefully.  Should perhaps also report	*)
+	(*	an incompletely consumed name string as an	*)
+	(*	error.						*)
+	(*							*)
+	(********************************************************)
+
+FROM Windows IMPORT	(* for testing	*)
+    (* type *)	Window,
+    (* proc *)	OpenSimpleWindow, WriteString, WriteChar, WriteLn;
+
+FROM Devices IMPORT
+    (* proc *)	NullDevice, IdentifyDevice;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+(************************************************************************)
+
+TYPE CharSet = SET OF CHAR;
+
+CONST Nul = CHR(0);
+
+(************************************************************************)
+(*				FOR TESTING				*)
+(************************************************************************)
+
+CONST testing = FALSE;
+
+VAR debug: Window;		(* used only for testing *)
+
+(************************************************************************)
+(*			   PARSING A FILE NAME				*)
+(************************************************************************)
+
+PROCEDURE WriteFileName (w: Window;  name: FileName);
+
+    (* For testing: writes name in window w.	*)
+
+    BEGIN
+	WriteString (w, name.fname);  WriteChar (w, ".");
+	WriteString (w, name.fext);
+    END WriteFileName;
+
+(************************************************************************)
+
+PROCEDURE SimpleScan (VAR (*IN*) string: ARRAY OF CHAR;
+		VAR (*OUT*) substring: ARRAY OF CHAR;
+		VAR (*OUT*) separator: CHAR;
+		VAR (*INOUT*) point: CARDINAL);
+
+    (* Extracts a substring of "string", starting at string[point]	*)
+    (* and continuing until one of the characters ".", ":", "\", " ",	*)
+    (* or Nul is found.  The terminating character is returned as	*)
+    (* "separator".  (If we reach the end of the string, Nul is		*)
+    (* returned as the separator.)  On return, point is updated so that	*)
+    (* string[point] is the first character after the separator, except	*)
+    (* in the end-of-string case where the value of point is irrelevant.*)
+    (* Alphabetic characters are converted to upper case in substring.	*)
+    (* If array substring is longer than the substring extracted by	*)
+    (* this procedure, the trailing character positions are not		*)
+    (* disturbed - it is up to the caller to supply defaults.		*)
+
+    CONST SeparatorSet = CharSet {Nul, " ", ".", ":", "\"};
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	j := 0;
+	LOOP
+	    IF point > HIGH(string) THEN EXIT (*LOOP*)
+	    ELSIF string[point] IN SeparatorSet THEN EXIT(*LOOP*)
+	    ELSIF j <= HIGH(substring) THEN
+		substring[j] := CAP(string[point]);  INC(j);
+	    END (*IF*);
+	    INC (point);
+	END (*LOOP*);
+	IF point <= HIGH(string) THEN
+	    separator := string[point];  INC(point);
+	ELSE
+	    separator := Nul;
+	END (*IF*);
+    END SimpleScan;
+
+(************************************************************************)
+
+PROCEDURE Scan (VAR (*IN*) string: ARRAY OF CHAR;
+		VAR (*OUT*) name: FileName;
+		VAR (*OUT*) separator: CHAR;
+		VAR (*INOUT*) point: CARDINAL);
+
+    (* Extracts a file name from "string", starting at string[point].	*)
+    (* The terminating character is returned as "separator".  (If we	*)
+    (* reach the end of the string, Nul is returned as the separator).	*)
+    (* On return, point is updated so that string[point] is the first	*)
+    (* character after the separator, except in the end-of-string case	*)
+    (* where the value of point is irrelevant.				*)
+
+    BEGIN
+	name.fname := "        ";  name.fext := "   ";
+	SimpleScan (string, name.fname, separator, point);
+	IF separator = "." THEN
+	    SimpleScan (string, name.fext, separator, point);
+	END (*IF*);
+    END Scan;
+
+(************************************************************************)
+(*		   THE EXTERNALLY CALLABLE PROCEDURES			*)
+(************************************************************************)
+
+PROCEDURE Parse (name: ARRAY OF CHAR;  VAR (*OUT*) device: Device;
+		VAR (*OUT*) unit: CARDINAL;  VAR (*OUT*) result: NameList;
+		VAR (*OUT*) StartAtRoot: BOOLEAN);
+
+    (* Translates a text string "name" into NameList form.  If the	*)
+    (* string includes a device specification this is returned as	*)
+    (* (device, unit); otherwise we return with device = NullDevice.	*)
+    (* Output parameter StartAtRoot is TRUE iff the filename string	*)
+    (* started with a '\'.						*)
+
+    CONST Terminators = CharSet {Nul, " ", ".", ":"};
+
+    VAR separator: CHAR;
+	place: CARDINAL;
+	devicestring: EightChar;
+	previous, current: NameList;
+
+    BEGIN
+	place := 0;  devicestring := "        ";  result := NIL;
+
+	(* Extract the device name, if present.	*)
+
+	SimpleScan (name, devicestring, separator, place);
+	IF separator = ":" THEN
+	    IdentifyDevice (devicestring, device, unit);
+	ELSE
+	    devicestring := "        ";
+	    device := NullDevice();  place := 0;
+	END (*IF*);
+
+	IF testing THEN
+	    WriteString (debug, "The device name is ");
+	    WriteString (debug, devicestring);  WriteLn (debug);
+	END (*IF*);
+
+	(* A leading "\" indicates the root directory.	*)
+
+	StartAtRoot := name[place] = "\";
+	IF StartAtRoot THEN
+	    INC (place);
+	END (*IF*);
+
+	(* Check whether this is all that was supplied.	*)
+
+	IF (place > HIGH(name)) OR (name[place] IN Terminators) THEN
+	    RETURN;
+	END (*IF*);
+
+	(* Now fill in all the details of the path.	*)
+
+	current := NIL;
+	REPEAT
+	    previous := current;
+	    NEW (current);
+	    IF previous = NIL THEN result := current;
+	    ELSE previous^.child := current;
+	    END (*IF*);
+	    WITH current^ DO
+		Scan (name, string, separator, place);
+		child := NIL;
+	    END (*WITH*);
+	UNTIL separator <> '\';
+
+    END Parse;
+
+(************************************************************************)
+
+PROCEDURE DiscardNameList (VAR (*INOUT*) path: NameList);
+
+    (* Disposes of the storage occupied by a NameList.  Returns NIL.	*)
+
+    VAR current: NameList;
+
+    BEGIN
+	WHILE path <> NIL DO
+	    current := path;  path := current^.child;
+	    DISPOSE (current);
+	END (*WHILE*);
+    END DiscardNameList;
+
+(************************************************************************)
+
+BEGIN
+    IF testing THEN
+	OpenSimpleWindow (debug, 0, 4, 0, 79);
+    END (*IF*);
+END FileNames.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/files.def b/examples/Modula-2_Libraries/PMOS/sources/general/files.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/files.def
@@ -0,0 +1,88 @@
+DEFINITION MODULE Files;
+
+	(********************************************************)
+	(*							*)
+	(*		    File operations.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	16 September 1991		*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	IMPORTANT NOTE: The file system starts with	*)
+	(*	no pre-conceived idea of what devices are	*)
+	(*	present; it's up to the device drivers		*)
+	(*	themselves to "install" themselves at program	*)
+	(*	initialisation time.  To make this work, the	*)
+	(*	user of this module should import whatever	*)
+	(*	device drivers are needed.  Furthermore, this	*)
+	(*	IMPORT declaration must come before the		*)
+	(*	IMPORT of module Files, to ensure that device	*)
+	(*	driver initialisation is complete before the	*)
+	(*	file system starts its own initialisation.	*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE, ADDRESS;
+
+FROM IOErrorCodes IMPORT
+    (* type *)	ErrorCode;
+
+TYPE
+    File;	(* is private *)
+
+PROCEDURE OpenFile (VAR (*OUT*) f: File;  name: ARRAY OF CHAR;
+					newfile: BOOLEAN): ErrorCode;
+
+    (* Opens the file named by the given character string, and returns	*)
+    (* f as the identification to be used when specifying this file in	*)
+    (* future.  The caller must specify newfile = TRUE to create a new	*)
+    (* file, or newfile = FALSE if the intention is to open an existing	*)
+    (* file.  It is illegal to open a new file with the same name as an	*)
+    (* existing file; this is to protect against accidental deletions.	*)
+    (* The value returned is an error code (OK if no error).		*)
+
+PROCEDURE CloseFile (VAR (*INOUT*) f: File);
+
+    (* Closes file f.	*)
+
+PROCEDURE EOF (f: File): BOOLEAN;
+
+    (* Returns TRUE iff we are currently at the end of file f.	*)
+
+PROCEDURE ReadByte (f: File): BYTE;
+
+    (* Returns the next byte from the file.	*)
+
+PROCEDURE ReadRecord (f: File;  buffaddr: ADDRESS;  desired: CARDINAL;
+				VAR (*OUT*) actual: CARDINAL): ErrorCode;
+
+    (* Reads up to "desired" bytes from file f to memory location	*)
+    (* "buffaddr".  On return, "actual" gives the number of bytes read.	*)
+
+PROCEDURE WriteByte (f: File;  value: BYTE): ErrorCode;
+
+    (* Writes one byte to the file.	*)
+
+PROCEDURE WriteRecord (f: File;  buffaddr: ADDRESS;
+					count: CARDINAL): ErrorCode;
+
+    (* Writes count bytes from memory location buffaddr.	*)
+
+PROCEDURE SetPosition (f: File;  position: LONGCARD): ErrorCode;
+
+    (* Ensures that the next read or write on this file will be at	*)
+    (* byte number position in the file.  (The first byte in the file	*)
+    (* is byte number 0.)  If a position greater than the file size	*)
+    (* is specified, the length of the file will increase.		*)
+
+PROCEDURE SavePosition (f: File): LONGCARD;
+
+    (* Returns the current byte number in file f.	*)
+
+PROCEDURE FileSize (f: File): LONGCARD;
+
+    (* Returns the length of the file in bytes.	*)
+
+END Files.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/files.mod b/examples/Modula-2_Libraries/PMOS/sources/general/files.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/files.mod
@@ -0,0 +1,806 @@
+IMPLEMENTATION MODULE Files;
+
+	(****************************************************************)
+	(*								*)
+	(*			File operations.			*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	27 February 1995			*)
+	(*  Status:		OK					*)
+	(*								*)
+	(*	SetPosition not yet tested.				*)
+	(*								*)
+	(*	To avoid complications in FAT updating, the first	*)
+	(*	cluster of a new file is pre-allocated.  Should we	*)
+	(*	de-allocate it again (probably in module Directories)	*)
+	(*	if the file size is 0 when the file is closed?		*)
+	(*	A related question: what should we do about opening	*)
+	(*	an existing file whose file size is 0?  Possibly we	*)
+	(*	should be pre-allocating a block in that case too,	*)
+	(*	but that could cause problems if the disk is full	*)
+	(*	or write-protected.					*)
+	(*								*)
+	(*	A DeleteFile operation will no doubt be needed		*)
+	(*	at some stage.						*)
+	(*								*)
+	(*	Writing is double-buffered, but so far reading is	*)
+	(*	not.  At the present stage of the design, I lean	*)
+	(*	towards keeping the current scheme, on the grounds	*)
+	(*	that reading ahead is worthwhile only if one can be	*)
+	(*	certain that access will be strictly sequential.	*)
+	(*	Unlike many operating systems, PMOS does not have a	*)
+	(*	bias towards serial streams.				*)
+	(*								*)
+	(****************************************************************)
+
+FROM SYSTEM IMPORT
+    (* proc *)	ADR;
+
+FROM Devices IMPORT
+    (* type *)	Device, BlockNumberType, RequestBlock, OperationType,
+    (* proc *)	IOrequest;
+
+FROM Directories IMPORT
+    (* type *)	Cluster, Handle,
+    (* const*)	NoSuchBlock,
+    (* proc *)	Lookup, NextBlockNumber, AllocateBlock, UpdateFileSize,
+		FindRelativeCluster, DiscardHandle;
+
+FROM Semaphores IMPORT
+    (* proc *)	CreateSemaphore, DestroySemaphore, Wait, Signal;
+
+FROM LowLevel IMPORT
+    (* proc *)	Copy, AddOffset;
+
+FROM MaintenancePages IMPORT	(* for testing *)
+    (* type *)	MaintenancePage,
+    (* proc *)	CreateMaintenancePage, Associate;
+
+FROM Windows IMPORT		(* for testing *)
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, ChangeScrollingRegion, SetCursor,
+		WriteString, WriteChar, WriteLn;
+
+FROM NumericIO IMPORT
+    (* proc *)	WriteLongCard;
+
+FROM IOErrorCodes IMPORT
+    (* proc *)	TranslateErrorCode;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM DMA IMPORT
+    (* proc *)	AllocateDMABuffer;
+
+(************************************************************************)
+(* General remark: a potential cause for confusion in reading this code	*)
+(* is the distinction between disk blocks and clusters.  A cluster is	*)
+(* some integral number of adjacent blocks, the exact number being held	*)
+(* in the boot block of the disk.  Module Directories works internally	*)
+(* in terms of clusters, but module Devices (which does not know about	*)
+(* the boot block) works in terms of block numbers.  The present module	*)
+(* buffers data a cluster at a time, but must talk to module Devices in	*)
+(* terms of blocks.  We resolve this conflict by using block numbers	*)
+(* to identify the clusters.  Every reference to a block number in this	*)
+(* module is in fact a reference to the block number of the first block	*)
+(* in a cluster.							*)
+(************************************************************************)
+
+CONST testing = TRUE;
+
+CONST GuardConst = 9999H;
+
+TYPE
+
+    (* The size of a data buffer has to be determined when the file is	*)
+    (* opened, because different disks have different numbers of bytes	*)
+    (* per cluster, and we read or write one cluster at a time.		*)
+
+    DataBufferPointer = POINTER TO ARRAY [0..MAX(CARDINAL)-1] OF BYTE;
+
+    (* A file is identified by pointing to its FileData record.		*)
+
+    File = POINTER TO FileData;
+
+    (********************************************************************)
+    (* We keep a FileData record for each open file.  The information	*)
+    (* stored is:							*)
+    (*									*)
+    (*	  guard		a constant, to let us detect dangling pointers	*)
+    (*	  locator	information needed by module Directories to	*)
+    (*			 identify the file				*)
+    (*	  EndBlock	block number of the last cluster in the file;	*)
+    (*			 not necessarily accurate at all times, but	*)
+    (*			 must be accurate at the time we extend the	*)
+    (*			 file.						*)
+    (*	  current	byte number within the current buffer		*)
+    (*	  ByteNumber	byte number within the file as a whole		*)
+    (*	  FileSize	number of bytes in the file			*)
+    (*	  BufferSize	number of bytes in the buffer			*)
+    (*	  ReadInProgress TRUE if the current data buffer is busy	*)
+    (*			 with a read operation				*)
+    (*	  AtEOF		TRUE iff we are now at the end of the file	*)
+    (*	  BufferModified TRUE if the current contents of the data	*)
+    (*			buffer are different from the disk copy		*)
+    (*	  LengthChanged	TRUE iff the file size has been altered since	*)
+    (*			the file was opened				*)
+    (*	  BufferNumber	identifies which I/O request block, and		*)
+    (*			therefore which data buffer, is currently active*)
+    (*	  BufferHeader	a pair of I/O request blocks; we have two to	*)
+    (*			permit double buffering on output (at present	*)
+    (*			there is no provision for read-ahead on input)	*)
+    (*	  Bufptr	pointer to currently active data buffer		*)
+    (*									*)
+    (* When writing to a file, a block number is normally not allocated	*)
+    (* until the buffer has been filled and we are about to write out	*)
+    (* the buffer, so usually Block = NoSuchBlock.  There are in fact	*)
+    (* several different cases to consider:				*)
+    (*	 (a)	Rewriting an existing cluster, i.e. writing to a	*)
+    (*		cluster after reading it.  (This includes the case	*)
+    (*		where some data have been appended to the end of the	*)
+    (*		file, but not yet enough to require a new cluster to be	*)
+    (*		allocated.)  Here Block is the block number of the	*)
+    (*		first block in the cluster.				*)
+    (*	 (b)	Appending a new cluster at the tail of the file, when	*)
+    (*		the file already contains one or more clusters.  In	*)
+    (*		this case Block = NoSuchBlock.				*)
+    (*	 (c)	Writing the first cluster of a new file.  This case	*)
+    (*		could cause complications in terms of updating the	*)
+    (*		directory.  To avoid those complications, we arrange	*)
+    (*		for the first cluster to be pre-allocated when the file	*)
+    (*		is opened, so that this case is actually the same as	*)
+    (*		case (a).						*)
+    (*									*)
+    (* The value of EndBlock is not always up-to-date, since we cannot	*)
+    (* know the value until we have read the last cluster of the file.	*)
+    (* Fortunately, we need it only when writing to a cluster which has	*)
+    (* not yet been allocated (see procedure WriteCurrentBuffer), and	*)
+    (* that can happen only during sequential file operations.  In such	*)
+    (* cases, EndBlock is correctly updated as we reach the end of the	*)
+    (* file.  If we jump to or beyond the current end of the file via	*)
+    (* procedure SetPosition, module Directories looks after allocating	*)
+    (* the clusters.							*)
+    (*									*)
+    (********************************************************************)
+
+    FileData =	RECORD
+		    guard: CARDINAL;
+		    locator: Handle;
+		    EndBlock: BlockNumberType;
+		    current: CARDINAL;
+		    ByteNumber, FileSize: LONGCARD;
+		    BufferSize: CARDINAL;
+		    ReadInProgress, AtEOF,
+			BufferModified, LengthChanged: BOOLEAN;
+		    BufferNumber: [0..1];
+		    BufferHeader: ARRAY [0..1] OF RequestBlock;
+		    Bufptr: DataBufferPointer;
+		END (*RECORD*);
+
+(************************************************************************)
+(*			MAINTENANCE PAGE VARIABLES			*)
+(************************************************************************)
+
+VAR Mpage: MaintenancePage;
+    debug: Window;
+
+(************************************************************************)
+(*			BLOCK READ/WRITE OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE WriteCurrentBuffer (f: File): BlockNumberType;
+
+    (* Writes out the contents of the file's data buffer.  If this is a	*)
+    (* write to an existing block, we simply overwrite the old block.	*)
+    (* Otherwise, a new block is allocated.  We can tell the difference	*)
+    (* between the two cases by testing whether NoSuchBlock is recorded	*)
+    (* as the block number for this buffer.				*)
+    (* Note that this is an asynchronous procedure, in that it returns	*)
+    (* without waiting for the device driver to complete the write.	*)
+    (* The function result is the block number of the following block.	*)
+
+    VAR	Block, following: BlockNumberType;
+
+    BEGIN
+	WITH f^ DO
+	    Block := BufferHeader[BufferNumber].BlockNumber;
+	    IF Block = NoSuchBlock THEN
+
+		(* We have run off the end of the file (which is normal	*)
+		(* for a file being written), so allocate a new block.	*)
+
+		Block := AllocateBlock (locator, EndBlock);
+		EndBlock := Block;
+		following := NoSuchBlock;
+
+	    ELSE
+
+		following := NextBlockNumber (locator, Block);
+		IF following = NoSuchBlock THEN
+		    EndBlock := Block;
+		END (*IF*);
+
+	    END (*IF*);
+
+	    IF testing THEN
+		WriteString (debug, "Writing block number ");
+		WriteLongCard (debug, Block);  WriteLn (debug);
+	    END (*IF*);
+
+	    (* Write out the current block. *)
+
+	    WITH BufferHeader[BufferNumber] DO
+		IF Block = NoSuchBlock THEN
+		    Status := DeviceFull;  Signal (DoneSemaphorePointer^);
+		ELSE
+		    operation := write;
+		    BlockNumber := Block;
+		    IOrequest (BufferHeader[BufferNumber]);
+		END (*IF*);
+	    END (*WITH*);
+
+	END (*WITH*);
+	RETURN following;
+    END WriteCurrentBuffer;
+
+(************************************************************************)
+
+PROCEDURE AllocateBuffer (f: File;  B: BlockNumberType): ErrorCode;
+
+    (* Waits until an I/O buffer is available, returns with		*)
+    (* f^.BufferHeader[f^.BufferNumber] set up ready for a read of	*)
+    (* block B.  As a side-effect, we return the status of the most	*)
+    (* recent I/O operation on this buffer.  This version uses double	*)
+    (* buffering.							*)
+
+    BEGIN
+	WITH f^ DO
+	    BufferNumber := 1 - BufferNumber;
+	    BufferModified := FALSE;
+	    WITH BufferHeader[BufferNumber] DO
+		Wait (DoneSemaphorePointer^);
+		Bufptr := BufferAddress;
+		operation := read;
+		BlockNumber := B;
+		RETURN Status;
+	    END (*WITH*);
+	END (*WITH*);
+    END AllocateBuffer;
+
+(************************************************************************)
+
+PROCEDURE WaitForReadComplete (f: File): ErrorCode;
+
+    (* Waits for completion of the most recent I/O operation on the	*)
+    (* current buffer.  Updates AtEOF, ReadInProgress.			*)
+
+    VAR status: ErrorCode;
+
+    BEGIN
+	WITH f^ DO
+	    WITH BufferHeader[BufferNumber] DO
+		Wait (DoneSemaphorePointer^);
+		status := Status;
+		AtEOF := BlockNumber = NoSuchBlock;
+	    END (*WITH*);
+	    ReadInProgress := FALSE;
+	END (*WITH*);
+	RETURN status;
+    END WaitForReadComplete;
+
+(************************************************************************)
+
+PROCEDURE ReleaseCurrentBuffer (f: File): BlockNumberType;
+
+    (* Flushes out the current buffer, writing out the contents if	*)
+    (* necessary.  As a side-effect, we return the block number of the	*)
+    (* next sequential cluster in the file.  EndBlock is updated if we	*)
+    (* discover that we are at the last block in the file.		*)
+    (* If the buffer does not need to be written out, and there is no	*)
+    (* read in progress, the buffer immediately becomes available to be	*)
+    (* grabbed by AllocateBuffer.  Otherwise, the buffer will become	*)
+    (* available when the device driver signals that the current I/O	*)
+    (* operation on this buffer is complete.				*)
+
+    VAR NextBlock: BlockNumberType;
+
+    BEGIN
+	WITH f^ DO
+	    IF BufferModified THEN
+		NextBlock := WriteCurrentBuffer(f);
+	    ELSE
+		WITH BufferHeader[BufferNumber] DO
+		    NextBlock := NextBlockNumber (locator, BlockNumber);
+		    IF NextBlock = NoSuchBlock THEN
+			EndBlock := BlockNumber;
+		    END (*IF*);
+		    IF NOT ReadInProgress THEN
+			Signal (DoneSemaphorePointer^);
+		    END (*IF*);
+		END (*WITH*);
+	    END (*IF*);
+	END (*WITH*);
+	RETURN NextBlock;
+    END ReleaseCurrentBuffer;
+
+(************************************************************************)
+
+PROCEDURE StartRead (f: File;  B: BlockNumberType): ErrorCode;
+
+    (* Allocates a buffer for input, and starts a read operation.  We	*)
+    (* always allocate a fresh buffer so that we can overlap with the	*)
+    (* last write if any, or with any read already in progress.  (If we	*)
+    (* are starting a read when a read is already in progress it means	*)
+    (* that we no longer care about the outcome of the previous read;	*)
+    (* even so, it continues to lock up the buffer until it is done.)	*)
+
+    VAR status: ErrorCode;
+
+    BEGIN
+	WITH f^ DO
+	    status := AllocateBuffer (f, B);
+	    IF status <> OK THEN
+		RETURN status;
+	    END (*IF*);
+
+	    ReadInProgress := TRUE;
+	    IF B = NoSuchBlock THEN
+		Signal (BufferHeader[BufferNumber].DoneSemaphorePointer^);
+	    ELSE
+		IOrequest (BufferHeader[BufferNumber]);
+	    END (*IF*);
+	END (*WITH*);
+	RETURN OK;
+
+    END StartRead;
+
+(************************************************************************)
+
+PROCEDURE StartNextRead (f: File): ErrorCode;
+
+    (* Writes out the current block if necessary, then initiates a read	*)
+    (* of the following block in the file.  If we have already reached	*)
+    (* the last block in the file, a Signal is immediately performed	*)
+    (* to indicate that the operation is complete.			*)
+    (* Otherwise, this procedures returns after the read operation has	*)
+    (* been initiated, but before the read is complete.			*)
+
+    BEGIN
+	RETURN StartRead (f, ReleaseCurrentBuffer(f));
+    END StartNextRead;
+
+(************************************************************************)
+(*			     OPENING A FILE				*)
+(************************************************************************)
+
+PROCEDURE OpenFile (VAR (*OUT*) f: File;  name: ARRAY OF CHAR;
+					newfile: BOOLEAN): ErrorCode;
+
+    (* Opens the file named by the given character string, and returns	*)
+    (* f as the identification to be used when specifying this file in	*)
+    (* future.  If newfile is TRUE, a new file is created.  If newfile	*)
+    (* is FALSE, the file must already exist.				*)
+
+    VAR dev: Device;  unitno: CARDINAL;  j: [0..1];
+	fileid: Handle;
+	BytesPerCluster: CARDINAL;
+	StartingBlock: BlockNumberType;
+	status: ErrorCode;
+	BytesInFile: LONGCARD;
+	string: ARRAY [0..31] OF CHAR;
+
+    BEGIN
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "OpenFile: about to call Lookup");
+	END (*IF*);
+	status := Lookup (newfile, name, dev, unitno, fileid,
+				StartingBlock, BytesPerCluster, BytesInFile);
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "Returned from Lookup, status is ");
+	    TranslateErrorCode (status, string);
+	    WriteString (debug, string);
+	END (*IF*);
+	IF status = OK THEN
+	    NEW (f);
+	    WITH f^ DO
+		guard := GuardConst;
+		locator := fileid;
+		EndBlock := StartingBlock;
+		current := 0;  ByteNumber := 0;
+		FileSize := BytesInFile;
+		BufferSize := BytesPerCluster;
+		ReadInProgress := FALSE;
+		AtEOF := FileSize = 0;
+		BufferModified := FALSE;  LengthChanged := newfile;
+		FOR j := 0 TO 1 DO
+		    WITH BufferHeader[j] DO
+			Status := OK;
+			device := dev;
+			unit := unitno;
+			BlockNumber := NoSuchBlock;
+			IF testing THEN
+			    WriteLn (debug);
+			    WriteString (debug, "About to allocate DMA buffer.");
+			END (*IF*);
+			AllocateDMABuffer (BufferAddress, BufferSize);
+			IF testing THEN
+			    WriteLn (debug);
+			    WriteString (debug, "Have allocated DMA buffer.");
+			END (*IF*);
+			ByteCount := BufferSize;
+			NEW (DoneSemaphorePointer);
+			CreateSemaphore (DoneSemaphorePointer^, 1);
+		    END (*WITH*);
+		END (*FOR*);
+		BufferNumber := 0;
+		status := AllocateBuffer (f, StartingBlock);
+		IF NOT newfile THEN
+		    ReadInProgress := TRUE;
+		    IOrequest (BufferHeader[BufferNumber]);
+		END (*IF*);
+	    END (*WITH*);
+	ELSE	(* status <> OK *)
+	    f := NIL;
+	END (*IF*);
+
+	IF testing THEN
+	    IF status <> OK THEN
+		WriteLn (debug);
+		WriteString (debug, "OpenFile failure, status = ");
+		TranslateErrorCode (status, string);
+		WriteString (debug, string);
+	    END (*IF*);
+	END (*IF*);
+
+	RETURN status;
+    END OpenFile;
+
+(************************************************************************)
+(*			     CLOSING A FILE				*)
+(************************************************************************)
+
+PROCEDURE CloseFile (VAR (*INOUT*) f: File);
+
+    (* Closes file f. *)
+
+    VAR j: [0..1];  status: ErrorCode;
+	dummy: BlockNumberType;
+
+    BEGIN
+
+	(* Note: we have to check for f = NIL, and also check the guard	*)
+	(* field, because it is possible that this is a file which was	*)
+	(* never successfully opened.					*)
+
+	IF f <> NIL THEN
+	    WITH f^ DO
+		IF guard <> GuardConst THEN RETURN END (*IF*);
+
+		(* If we have been writing to the file, then there may	*)
+		(* be some data in the buffer which have not yet been	*)
+		(* written.  It is also possible that the directory has	*)
+		(* to be updated to show a revised file size.		*)
+
+		dummy := ReleaseCurrentBuffer (f);
+		IF LengthChanged THEN
+		    UpdateFileSize (locator, FileSize);
+		END (*IF*);
+		DiscardHandle (locator);
+		FOR j := 0 TO 1 DO
+		    WITH BufferHeader[j] DO
+			Wait (DoneSemaphorePointer^);
+			DestroySemaphore (DoneSemaphorePointer^);
+			DISPOSE (DoneSemaphorePointer);
+			DEALLOCATE (BufferAddress, BufferSize);
+		    END (*WITH*);
+		END (*FOR*);
+		guard := 0;
+		DISPOSE (f);
+	    END (*WITH*);
+	END (*IF*);
+
+    END CloseFile;
+
+(************************************************************************)
+(*			    END-OF-FILE TEST				*)
+(************************************************************************)
+
+PROCEDURE EOF (f: File): BOOLEAN;
+
+    (* Returns TRUE iff we are currently at the end of file f.	*)
+
+    BEGIN
+	RETURN f^.AtEOF;
+    END EOF;
+
+(************************************************************************)
+(*				WRITING					*)
+(************************************************************************)
+
+PROCEDURE SendToCurrentBuffer (f: File;  buffaddr: ADDRESS;
+				VAR (*INOUT*) count: CARDINAL): ErrorCode;
+
+    (* Writes up to count bytes from memory location buffaddr.		*)
+    (* On return, count has been decremented by the number of bytes	*)
+    (* actually written.  Unlike WriteRecord (below), this procedure	*)
+    (* transfers at most one buffer-full of data.			*)
+
+    VAR status: ErrorCode;  amount: CARDINAL;
+
+    BEGIN
+	status := OK;
+	WITH f^ DO
+
+	    (* Check whether we are still waiting for the	*)
+	    (* buffer to become available.			*)
+
+	    IF ReadInProgress THEN
+		status := WaitForReadComplete (f);
+		IF status <> OK THEN
+		    RETURN status;
+		END (*IF*);
+	    END (*IF*);
+
+	    (* Work out how much data to transfer.	*)
+
+	    amount := BufferSize - current;
+	    IF amount > count THEN
+		amount := count;
+	    END (*IF*);
+	    Copy (buffaddr, ADR(Bufptr^[current]), amount);
+
+	    (* Update counts, etc.	*)
+
+	    BufferModified := TRUE;
+	    DEC (count, amount);
+	    INC (ByteNumber, LONGCARD(amount));  INC (current, amount);
+	    AtEOF := ByteNumber >= FileSize;
+	    IF ByteNumber > FileSize THEN
+		FileSize := ByteNumber;
+		LengthChanged := TRUE;
+	    END (*IF*);
+
+	    (* If we have just filled the buffer, write it out and read	*)
+	    (* a new buffer-full.  Note that procedure StartNextRead	*)
+	    (* writes out the current buffer if necessary, before	*)
+	    (* reading the next block.  It is possible that there is no	*)
+	    (* next block, but in the present situation that is not an	*)
+	    (* error.							*)
+
+	    IF current = BufferSize THEN
+		status := StartNextRead (f);
+		current := 0;
+	    END (*IF*);
+
+	END (*WITH*);
+	RETURN status;
+    END SendToCurrentBuffer;
+
+(************************************************************************)
+
+PROCEDURE WriteByte (f: File;  value: BYTE): ErrorCode;
+
+    (* Writes one byte to the file.  The returned value is an error	*)
+    (* code (OK if no error).						*)
+
+    VAR count: CARDINAL;
+
+    BEGIN
+	IF (f = NIL) OR (f^.guard <> GuardConst) THEN
+	    RETURN FileNotOpen;
+	END (*IF*);
+	count := 1;
+	RETURN SendToCurrentBuffer (f, ADR(value), count);
+    END WriteByte;
+
+(************************************************************************)
+
+PROCEDURE WriteRecord (f: File;  buffaddr: ADDRESS;
+					count: CARDINAL): ErrorCode;
+
+    (* Writes count bytes from memory location buffaddr.	*)
+
+    VAR oldcount: CARDINAL;  status: ErrorCode;
+
+    BEGIN
+	status := OK;
+	IF (f = NIL) OR (f^.guard <> GuardConst) THEN
+	    status := FileNotOpen;
+	END (*IF*);
+	WHILE (status = OK) AND (count > 0) DO
+	    oldcount := count;
+	    status := SendToCurrentBuffer (f, buffaddr, count);
+	    buffaddr := AddOffset (buffaddr, oldcount-count);
+	END (*WHILE*);
+	RETURN status;
+    END WriteRecord;
+
+(************************************************************************)
+(*				READING					*)
+(************************************************************************)
+
+PROCEDURE FetchFromCurrentBuffer (f: File;  buffaddr: ADDRESS;
+				VAR (*INOUT*) count: CARDINAL): ErrorCode;
+
+    (* Reads up to count bytes from file f to memory location buffaddr.	*)
+    (* On return, count has been decremented by the number of bytes	*)
+    (* actually read.  Unlike ReadRecord (below), this procedure will	*)
+    (* not read beyond the end of the current data buffer.		*)
+
+    VAR amount: CARDINAL;  status: ErrorCode;
+
+    BEGIN
+	WITH f^ DO
+	    IF AtEOF THEN
+		RETURN OK;
+	    ELSE
+		(* Wait for any pending read. *)
+
+		IF ReadInProgress THEN
+		    status := WaitForReadComplete (f);
+		    IF status <> OK THEN
+			AtEOF := TRUE;
+			RETURN status;
+		    END (*IF*);
+		END (*IF*);
+
+		(* Work out how much data to transfer. *)
+
+		amount := count;
+		IF amount > BufferSize - current THEN
+		    amount := BufferSize - current;
+		END (*IF*);
+		IF LONGCARD(amount) >= FileSize-ByteNumber THEN
+		    amount := CARDINAL (FileSize - ByteNumber);
+		    AtEOF := TRUE;
+		END (*IF*);
+
+		(* Perform the transfer. *)
+
+		Copy (ADR(Bufptr^[current]), buffaddr, amount);
+		INC (ByteNumber, LONGCARD(amount));  INC (current, amount);
+		DEC (count, amount);
+
+		(* If we have come to the end of the buffer, initiate	*)
+		(* a new read operation.				*)
+
+		IF current = BufferSize THEN
+		    current := 0;
+		    RETURN StartNextRead (f);
+		ELSE
+		    RETURN OK;
+		END (*IF*);
+
+	    END (*IF*);
+	END (*WITH*);
+
+    END FetchFromCurrentBuffer;
+
+(************************************************************************)
+
+PROCEDURE ReadByte (f: File): BYTE;
+
+    (* Returns the next byte from the file.	*)
+
+    VAR result: BYTE;  status: ErrorCode;  count: CARDINAL;
+
+    BEGIN
+	result := 0;
+	IF (f <> NIL) AND (f^.guard = GuardConst) THEN
+	    count := 1;
+	    status := FetchFromCurrentBuffer (f, ADR(result), count);
+	END (*IF*);
+	RETURN result;
+    END ReadByte;
+
+(************************************************************************)
+
+PROCEDURE ReadRecord (f: File;  buffaddr: ADDRESS;  desired: CARDINAL;
+				VAR (*OUT*) actual: CARDINAL): ErrorCode;
+
+    (* Reads up to "desired" bytes from file f to memory location	*)
+    (* "buffaddr".  On return, "actual" gives the number of bytes read.	*)
+
+    VAR status: ErrorCode;  count, oldcount: CARDINAL;
+
+    BEGIN
+	status := OK;  count := desired;
+	IF (f = NIL) OR (f^.guard <> GuardConst) THEN
+	    status := FileNotOpen;
+	END (*IF*);
+	WHILE (status = OK) AND (count > 0) AND NOT f^.AtEOF DO
+	    oldcount := count;
+	    status := FetchFromCurrentBuffer (f, buffaddr, count);
+	    buffaddr := AddOffset (buffaddr, oldcount-count);
+	END (*WHILE*);
+	actual := desired-count;
+	RETURN status;
+    END ReadRecord;
+
+(************************************************************************)
+(*				RANDOM ACCESS				*)
+(************************************************************************)
+
+PROCEDURE SetPosition (f: File;  position: LONGCARD): ErrorCode;
+
+    (* Ensures that the next read or write on this file will be at	*)
+    (* byte number position in the file.  (The first byte in the file	*)
+    (* is byte number 0.)  If a position greater than the file size	*)
+    (* is specified, the length of the file will increase.		*)
+
+    VAR NewBlock, dummy: BlockNumberType;
+	status: ErrorCode;
+
+    BEGIN
+	IF f = NIL THEN RETURN FileNotOpen END(*IF*);
+	WITH f^ DO
+	    IF guard <> GuardConst THEN RETURN FileNotOpen END(*IF*);
+
+	    (* Find the desired block number. *)
+
+	    NewBlock := FindRelativeCluster (locator,
+				CARDINAL(position DIV LONGCARD(BufferSize)));
+
+	    IF NewBlock <> BufferHeader[BufferNumber].BlockNumber THEN
+
+		(* Flush the current buffer, and read a new cluster. *)
+
+		dummy := ReleaseCurrentBuffer (f);
+		status := StartRead (f, NewBlock);
+		IF status <> OK THEN RETURN status END (*IF*);
+
+	    END (*IF*);
+
+	    (* Set the position within the buffer. *)
+
+	    current := CARDINAL (position MOD LONGCARD(BufferSize));
+	    ByteNumber := position;
+	    AtEOF := position >= FileSize;
+	    IF position > FileSize THEN
+		FileSize := position;
+		LengthChanged := TRUE;
+	    END (*IF*);
+
+	END (*WITH*);
+
+	RETURN OK;
+
+    END SetPosition;
+
+(************************************************************************)
+
+PROCEDURE SavePosition (f: File): LONGCARD;
+
+    (* Returns the current byte number in file f.	*)
+
+    BEGIN
+	RETURN f^.ByteNumber;
+    END SavePosition;
+
+(************************************************************************)
+
+PROCEDURE FileSize (f: File): LONGCARD;
+
+    (* Returns the length of the file in bytes.	*)
+
+    BEGIN
+	RETURN f^.FileSize;
+    END FileSize;
+
+(************************************************************************)
+
+BEGIN
+    IF testing THEN
+	CreateMaintenancePage (Mpage);
+	OpenWindow (debug, yellow, blue, 0, 23, 0, 79,
+					simpleframe, doubledivider);
+	Associate (debug, Mpage);
+	SetCursor (debug, 1, 21);
+	WriteString (debug, "Diagnostic output from Files module");
+	ChangeScrollingRegion (debug, 3, 22);
+    END (*IF*);
+END Files.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/filesort.def b/examples/Modula-2_Libraries/PMOS/sources/general/filesort.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/filesort.def
@@ -0,0 +1,35 @@
+DEFINITION MODULE FileSort;
+
+	(********************************************************)
+	(*							*)
+	(*	In-place file sort using the QuickSort method	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	4 August 1993			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	ADDRESS;
+
+FROM QuickSortModule IMPORT
+    (* type *)	CompareProc;
+
+FROM FileSys IMPORT
+    (* type *)	File;
+
+TYPE
+    RecordNumber = LONGCARD;
+
+PROCEDURE InplaceSort (f: File;  from, to: RecordNumber;
+			EltSize, offset: CARDINAL;  GE: CompareProc);
+
+    (* In-place sort of part of a file.  We sort record numbers		*)
+    (* from..to inclusive.  EltSize is the element size; offset is the	*)
+    (* number of bytes (zero, in most cases) before record number 0 in	*)
+    (* the file; and GE is a user-supplied function to compare elements	*)
+    (* at two specified addresses.					*)
+
+END FileSort.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/filesort.mod b/examples/Modula-2_Libraries/PMOS/sources/general/filesort.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/filesort.mod
@@ -0,0 +1,415 @@
+IMPLEMENTATION MODULE FileSort;
+
+	(********************************************************)
+	(*							*)
+	(*	In-place file sort using the QuickSort method	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	27 February 1995		*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM FileSys IMPORT
+    (* proc *)	SetPosition, ReadRecord, WriteRecord;
+
+FROM IOErrorCodes IMPORT
+    (* type *)	ErrorCode;
+
+FROM QuickSortModule IMPORT
+    (* proc *)	QuickSort;
+
+FROM LowLevel IMPORT
+    (* proc *)	AddOffset, Copy;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+(************************************************************************)
+
+CONST CacheSize = 2048;
+
+TYPE
+    Cache = RECORD
+		first, last, dirty1, dirty2: RecordNumber;
+		dp: ADDRESS;
+	    END (*RECORD*);
+
+    FileDescriptor = RECORD
+			file: File;
+			eltsize, offset: CARDINAL;
+			greaterorequal: CompareProc;
+			cache: Cache;
+		     END (*RECORD*);
+
+    EltPointer = ADDRESS;
+
+(************************************************************************)
+(*			BASIC I/O OPERATIONS				*)
+(************************************************************************)
+
+PROCEDURE ReadBlock (VAR (*IN*) FD: FileDescriptor;  N1, N2: RecordNumber;
+							dest: EltPointer);
+
+    (* Reads record numbers N1..N2, inclusive, into a buffer starting	*)
+    (* at location 'dest'.						*)
+
+    VAR status: ErrorCode;  actual: CARDINAL;
+
+    BEGIN
+	WITH FD DO
+	    status := SetPosition (file, VAL(LONGCARD,offset)
+					+ VAL(LONGCARD,eltsize)*N1);
+	    status := ReadRecord (file, dest,
+				eltsize*VAL(CARDINAL,N2-N1+1), actual);
+	END (*WITH*);
+    END ReadBlock;
+
+(************************************************************************)
+
+PROCEDURE WriteBlock (VAR (*IN*) FD: FileDescriptor; src: EltPointer;
+						N1, N2: RecordNumber);
+
+    (* Writes from a buffer starting at location 'src' to records	*)
+    (* number N1 to N2 inclusive.					*)
+
+    VAR status: ErrorCode;
+
+    BEGIN
+	WITH FD DO
+	    status := SetPosition (file, VAL(LONGCARD,offset)
+					+ VAL(LONGCARD,eltsize)*N1);
+	    status := WriteRecord (file, src, eltsize*VAL(CARDINAL,N2-N1+1));
+	END (*WITH*);
+    END WriteBlock;
+
+(************************************************************************)
+(*			     CACHE MANAGEMENT				*)
+(* The cache here is a "load on demand" cache rather than the more	*)
+(* conventional cache which holds recently read records.  Our approach	*)
+(* is to cache the low-numbered records of the subfile currently	*)
+(* being sorted, which is consistent with an algorithm which, roughly	*)
+(* speaking, sorts the bottom half of a range before starting work on	*)
+(* the top half.							*)
+(************************************************************************)
+
+PROCEDURE FlushCache (VAR (*IN*) FD: FileDescriptor;  N: RecordNumber);
+
+    (* Writes back any unwritten records, up to and including record	*)
+    (* number N, back to disk.						*)
+
+    BEGIN
+	WITH FD DO
+	    WITH cache DO
+		IF N > dirty2 THEN
+		    N := dirty2;
+		END (*IF*);
+		IF N >= dirty1 THEN
+		    (* We must flush out records dirty1..N *)
+		    WriteBlock (FD, AddOffset(dp,
+			eltsize*VAL(CARDINAL,dirty1-first)), dirty1, N);
+		    dirty1 := N+1;
+		END (*IF*);
+	    END (*WITH*);
+	END (*WITH*);
+    END FlushCache;
+
+(************************************************************************)
+
+PROCEDURE LoadCache (VAR (*IN*) FD: FileDescriptor;
+					low, high: RecordNumber): BOOLEAN;
+
+    (* Puts records low..high inclusive into the cache, if they will	*)
+    (* fit.  If they don't fit, loads as many as possible starting from	*)
+    (* record number low.  Returns TRUE iff everything fitted.		*)
+
+    VAR result: BOOLEAN;
+
+    BEGIN
+	WITH FD DO
+
+	    (* Work out whether everything will fit.  If not, adjust	*)
+	    (* high downwards.						*)
+
+	    IF VAL(LONGCARD,eltsize)*(high-low+1) <= CacheSize THEN
+		result := TRUE;
+	    ELSE
+		result := FALSE;
+		high := VAL(LONGCARD, CacheSize DIV eltsize) + low - 1;
+	    END (*IF*);
+
+	    (* Clean out everything below 'low' from the cache *)
+
+	    IF low > 0 THEN
+		FlushCache (FD, low-1);
+	    END (*IF*);
+	    WITH cache DO
+
+		(* If the leading part of what we want is already in	*)
+		(* the cache, move it to the beginning.			*)
+
+		IF (first <= last) AND (low >= first) AND (low <= last) THEN
+		    IF low > first THEN
+			Copy (AddOffset(dp, eltsize*VAL(CARDINAL,low-first)),
+				 dp, eltsize*VAL(CARDINAL,last-low+1));
+			first := low;
+		    END (*IF*);
+		    low := last + 1;
+
+		ELSE
+
+		    (* In all other cases, empty the cache completely	*)
+		    (* and make a fresh beginning.  Note that we don't	*)
+		    (* bother to check for cases like low<first and	*)
+		    (* high>first, because we know that data will flow	*)
+		    (* through the cache only in one direction.		*)
+
+		    FlushCache (FD, last);
+		    last := 0;  first := 1;
+
+		END (*IF*);
+
+		(* At this stage, either the cache is empty or it	*)
+		(* contains a part of what we want.  In either case,	*)
+		(* the remainder is sure to fit.			*)
+
+		IF first > last THEN
+		    ReadBlock (FD, low, high, dp);
+		    first := low;
+		    last := high;
+		ELSE
+		    IF high >= low THEN
+			ReadBlock (FD, low, high,
+				AddOffset(dp,eltsize*VAL(CARDINAL,low-first)));
+		    END (*IF*);
+		    IF high > last THEN
+			last := high;
+		    END (*IF*);
+		END (*IF*);
+	    END (*WITH*);
+	END (*WITH*);
+	RETURN result;
+    END LoadCache;
+
+(************************************************************************)
+
+PROCEDURE MarkDirty (VAR (*IN*) FD: FileDescriptor;  N: RecordNumber);
+
+    (* Notes that record number N needs to be written back to disk	*)
+    (* from the cache.							*)
+
+    BEGIN
+	WITH FD.cache DO
+	    IF dirty2 < dirty1 THEN
+		dirty1 := N;  dirty2 := N;
+	    ELSIF N < dirty1 THEN dirty1 := N;
+	    ELSIF N > dirty2 THEN dirty2 := N;
+	    END (*IF*);
+	END (*WITH*);
+    END MarkDirty;
+
+(************************************************************************)
+
+PROCEDURE AddressInCache (VAR (*IN*) FD: FileDescriptor;
+					index: RecordNumber): EltPointer;
+
+    (* Returns the address in memory of element 'index', if it is in	*)
+    (* the cache; otherwise returns NIL.				*)
+
+    BEGIN
+	WITH FD DO
+	    WITH cache DO
+		IF (first > last) OR (index < first) OR (index > last) THEN
+		    RETURN NIL;
+		ELSE
+		    RETURN AddOffset (dp, eltsize*VAL(CARDINAL,index-first));
+		END (*IF*);
+	    END (*WITH*);
+	END (*WITH*);
+    END AddressInCache;
+
+(************************************************************************)
+(*			I/O THROUGH CACHE WHERE POSSIBLE		*)
+(************************************************************************)
+
+PROCEDURE GetRecord (VAR (*IN*) FD: FileDescriptor; index: RecordNumber;
+							dest: EltPointer);
+
+    (* Reads record number 'index' of the file into a buffer starting	*)
+    (* at location 'dest'.						*)
+
+    VAR p: EltPointer;
+
+    BEGIN
+	p := AddressInCache (FD, index);
+	IF p <> NIL THEN
+	    Copy (p, dest, FD.eltsize);
+	ELSE
+	    ReadBlock (FD, index, index, dest);
+	END (*IF*);
+    END GetRecord;
+
+(************************************************************************)
+
+PROCEDURE PutRecord (VAR (*IN*) FD: FileDescriptor; src: EltPointer;
+						index: RecordNumber);
+
+    (* Writes from a buffer starting at location 'src' to record	*)
+    (* number 'index' of the file.					*)
+
+    VAR p: EltPointer;
+
+    BEGIN
+	p := AddressInCache (FD, index);
+	IF p <> NIL THEN
+	    Copy (src, p, FD.eltsize);
+	    MarkDirty (FD, index);
+	ELSE
+	    WriteBlock (FD, src, index, index);
+	END (*IF*);
+    END PutRecord;
+
+(************************************************************************)
+(*			THE OVERALL SORTING ALGORITHM			*)
+(************************************************************************)
+
+PROCEDURE Partition ( VAR (*IN*) FD: FileDescriptor;
+				low: RecordNumber;
+				VAR (*OUT*) mid: RecordNumber;
+				high: RecordNumber);
+
+    (* By shuffling elements as necessary, ensures the property		*)
+    (*		R[j] <= v	for low <= j < mid			*)
+    (*		R[mid] = v						*)
+    (*		R[j] >= v	for mid < j <= high			*)
+    (* where R[j] represents record number j of the file, mid is the	*)
+    (* function result, and v is some unspecified value chosen by the	*)
+    (* procedure.							*)
+
+    VAR up, down: RecordNumber;
+	ptemp, pmid: EltPointer;
+
+    BEGIN
+	down := low;  up := high;  mid := (down + up) DIV 2;
+
+	ALLOCATE (ptemp, FD.eltsize);
+	ALLOCATE (pmid, FD.eltsize);
+	GetRecord (FD, mid, pmid);
+
+	(* v is pmid^.  The following loop maintains the invariants:	*)
+	(*	R[j] <= v	for low <= j < down			*)
+	(*	R[j] >= v	for up < j <= high			*)
+	(* We exit the outer loop when down >= mid and up <= mid.	*)
+	(* Note that v=pmid^ is the value that should be stored as	*)
+	(* R[mid], but to avoid redundant store and load operations as	*)
+	(* mid changes we don't actually store this value back until	*)
+	(* the final exit from the loop.  During loop execution, mid	*)
+	(* refers to a "hole" in which a value has not yet been stored.	*)
+	(* Note also that ptemp^ holds either R[down] or R[up],		*)
+	(* depending on whether we're adjusting down or up at the time.	*)
+
+	LOOP
+	    GetRecord (FD, down, ptemp);
+	    WHILE (down < mid) AND FD.greaterorequal (pmid, ptemp) DO
+		INC (down);
+		GetRecord (FD, down, ptemp);
+	    END (*WHILE*);
+
+	    IF down < mid THEN
+		PutRecord (FD, ptemp, mid);
+		mid := down;
+		INC (down);
+	    END (*IF*);
+
+	    (* Note that down >= mid at this point.	*)
+
+	    GetRecord (FD, up, ptemp);
+	    WHILE (up > mid) AND FD.greaterorequal (ptemp, pmid) DO
+		DEC (up);
+		GetRecord (FD, up, ptemp);
+	    END (*WHILE*);
+
+	    IF up <= mid THEN EXIT(*LOOP*) END(*IF*);
+
+	    PutRecord (FD, ptemp, mid);
+	    mid := up;
+	    DEC (up);
+
+	END (*LOOP*);
+
+	PutRecord (FD, pmid, mid);
+	DEALLOCATE (pmid, FD.eltsize);
+	DEALLOCATE (ptemp, FD.eltsize);
+
+    END Partition;
+
+(************************************************************************)
+
+PROCEDURE SmallSort (VAR (*IN*) FD: FileDescriptor;  low, high: RecordNumber);
+
+    (* Sorts the subfile of records low..high inclusive, where we are	*)
+    (* guaranteed that the entire range is in the cache.		*)
+
+    VAR p: EltPointer;
+
+    BEGIN
+	p := AddressInCache (FD, low);
+	QuickSort (p^, VAL(CARDINAL,high-low), FD.eltsize, FD.greaterorequal);
+	MarkDirty (FD, low);
+	MarkDirty (FD, high);
+    END SmallSort;
+
+(************************************************************************)
+
+PROCEDURE Sort ( VAR (*IN*) FD: FileDescriptor;  low, high: RecordNumber);
+
+    (* Sorts the subfile of records low..high inclusive.	*)
+
+    VAR mid: RecordNumber;
+
+    BEGIN
+	IF LoadCache (FD, low, high) THEN
+	    SmallSort (FD, low, high);
+	ELSE
+	    Partition (FD, low, mid, high);
+	    IF mid > low+1 THEN Sort (FD, low, mid-1) END(*IF*);
+	    IF high > mid+1 THEN Sort (FD, mid+1, high) END(*IF*);
+	END (*IF*);
+	FlushCache (FD, high);
+    END Sort;
+
+(************************************************************************)
+(*			   THE END-USER VERSION				*)
+(************************************************************************)
+
+PROCEDURE InplaceSort (f: File;  from, to: RecordNumber;
+			EltSize, Offset: CARDINAL;  GE: CompareProc);
+
+    (* In-place sort of part of a file.  We sort record numbers		*)
+    (* from..to inclusive.  EltSize is the element size; Offset is the	*)
+    (* number of bytes (zero, in most cases) before record number 0 in	*)
+    (* the file; and GE is a user-supplied function to compare elements	*)
+    (* at two specified addresses.					*)
+
+    VAR FD: FileDescriptor;
+
+    BEGIN
+	WITH FD DO
+	    file := f;
+	    eltsize := EltSize;
+	    offset := Offset;
+	    greaterorequal := GE;
+	    WITH cache DO
+		first := MAX(RecordNumber);  last := 0;
+		dirty1 := 1;  dirty2 := 0;
+		ALLOCATE (dp, CacheSize);
+	    END (*WITH*);
+	END (*WITH*);
+	Sort (FD, from, to);
+	DEALLOCATE (FD.cache.dp, CacheSize);
+    END InplaceSort;
+
+(************************************************************************)
+
+END FileSort.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/filesys.def b/examples/Modula-2_Libraries/PMOS/sources/general/filesys.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/filesys.def
@@ -0,0 +1,97 @@
+DEFINITION MODULE FileSys;
+
+	(****************************************************************)
+	(*								*)
+	(*			File operations				*)
+	(*								*)
+	(*	This version is functionally equivalent to module	*)
+	(*	Files, but it uses standard library calls rather than	*)
+	(*	working through the PMOS device drivers.  It is		*)
+	(*	recommended for use in cases where the Files module	*)
+	(*	is unsuitable for reasons such as (a) I/O on a device	*)
+	(*	for which a PMOS device driver does not exist, or	*)
+	(*	(b) conflicts caused by a cache system which does not	*)
+	(*	recognise changes to directories.			*)
+	(*								*)
+	(*	Note, however, that use of this module rather than	*)
+	(*	module Files can limit the real-time response and	*)
+	(*	cause difficulties in effective multitasking.  In	*)
+	(*	particular, if the underlying operating system is	*)
+	(*	MS-DOS then multiple tasks should not attempt to	*)
+	(*	perform file operations in parallel.			*)
+	(*								*)
+	(*	Note too that the error code returned on an I/O		*)
+	(*	error is a rough guess, because of the lack of		*)
+	(*	correspondence between the library error codes and	*)
+	(*	the standard PMOS error codes.				*)
+	(*								*)
+	(*	Programmer:	P. Moylan				*)
+	(*	Last edited:	14 April 1993				*)
+	(*	Status:		OK					*)
+	(*								*)
+	(****************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE, ADDRESS;
+
+FROM FIO IMPORT
+    (* type *)	File;
+
+FROM IOErrorCodes IMPORT
+    (* type *)	ErrorCode;
+
+PROCEDURE OpenFile (VAR (*OUT*) f: File;  name: ARRAY OF CHAR;
+					newfile: BOOLEAN): ErrorCode;
+
+    (* Opens the file named by the given character string, and returns	*)
+    (* f as the identification to be used when specifying this file in	*)
+    (* future.  The caller must specify newfile = TRUE to create a new	*)
+    (* file, or newfile = FALSE if the intention is to open an existing	*)
+    (* file.  It is illegal to open a new file with the same name as an	*)
+    (* existing file; this is to protect against accidental deletions.	*)
+    (* The value returned is an error code (OK if no error).		*)
+
+PROCEDURE CloseFile (VAR (*INOUT*) f: File);
+
+    (* Closes file f.	*)
+
+PROCEDURE EOF (f: File): BOOLEAN;
+
+    (* Returns TRUE iff we are currently at the end of file f.	*)
+
+PROCEDURE ReadByte (f: File): BYTE;
+
+    (* Returns the next byte from the file.	*)
+
+PROCEDURE ReadRecord (f: File;  buffaddr: ADDRESS;  desired: CARDINAL;
+				VAR (*OUT*) actual: CARDINAL): ErrorCode;
+
+    (* Reads up to "desired" bytes from file f to memory location	*)
+    (* "buffaddr".  On return, "actual" gives the number of bytes read.	*)
+
+PROCEDURE WriteByte (f: File;  value: BYTE): ErrorCode;
+
+    (* Writes one byte to the file.	*)
+
+PROCEDURE WriteRecord (f: File;  buffaddr: ADDRESS;
+					count: CARDINAL): ErrorCode;
+
+    (* Writes count bytes from memory location buffaddr.	*)
+
+PROCEDURE SetPosition (f: File;  position: LONGCARD): ErrorCode;
+
+    (* Ensures that the next read or write on this file will be at	*)
+    (* byte number position in the file.  (The first byte in the file	*)
+    (* is byte number 0.)  If a position greater than the file size	*)
+    (* is specified, the length of the file will increase.		*)
+
+PROCEDURE SavePosition (f: File): LONGCARD;
+
+    (* Returns the current byte number in file f.	*)
+
+PROCEDURE FileSize (f: File): LONGCARD;
+
+    (* Returns the length of the file in bytes.	*)
+
+END FileSys.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/filesys.mod b/examples/Modula-2_Libraries/PMOS/sources/general/filesys.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/filesys.mod
@@ -0,0 +1,217 @@
+IMPLEMENTATION MODULE FileSys;
+
+   (****************************************************************)
+   (*                      *)
+   (*       File operations.        *)
+   (*                      *)
+   (*  Programmer:      P. Moylan            *)
+   (*  Last edited:  6 September 1993        *)
+   (*  Status:    Working              *)
+   (*                      *)
+   (****************************************************************)
+
+IMPORT FIO;
+
+FROM Str IMPORT Caps, Compare;
+
+(************************************************************************)
+(*        TRANSLATING THE LIBRARY ERROR CODES         *)
+(************************************************************************)
+
+PROCEDURE IOstatus(): ErrorCode;
+
+    (* Returns the status of the last I/O operation.  We do a "best  *)
+    (* guess" approximation to the error code.           *)
+
+    BEGIN
+   CASE FIO.IOresult() OF
+     0:  RETURN OK;
+    |
+     0A0H:  RETURN FileNotOpen;
+    |
+     0A2H:  RETURN NameNotFound;
+    |
+     0A5H:  RETURN DeviceFull;
+    |
+    ELSE
+		RETURN UndiagnosedFailure;
+	END (*CASE*);
+    END IOstatus;
+
+(************************************************************************)
+(*			     OPENING A FILE				*)
+(************************************************************************)
+
+PROCEDURE OpenFile (VAR (*OUT*) f: File;  name: ARRAY OF CHAR;
+					newfile: BOOLEAN): ErrorCode;
+
+    (* Opens the file named by the given character string, and returns	*)
+    (* f as the identification to be used when specifying this file in	*)
+    (* future.  If newfile is TRUE, a new file is created.  If newfile	*)
+    (* is FALSE, the file must already exist.				*)
+
+    VAR FileExists: BOOLEAN;
+
+    BEGIN
+	Caps (name);
+	IF Compare (name, "PRN") = 0 THEN
+	    f := FIO.PrinterDevice;
+	    RETURN OK;
+	END (*IF*);
+	FileExists := FIO.Exists(name);
+	IF newfile THEN
+	    IF FileExists THEN RETURN DuplicateFileName;
+	    ELSE
+		f := FIO.Create(name);
+		RETURN IOstatus();
+	    END (*IF*);
+	ELSIF FileExists THEN
+	    f := FIO.Open(name);
+	    IF f = MAX(CARDINAL) THEN RETURN NameNotFound
+	    ELSE RETURN IOstatus();
+	    END (*IF*);
+	ELSE
+	    RETURN NameNotFound;
+	END (*IF*);
+    END OpenFile;
+
+(************************************************************************)
+(*			     CLOSING A FILE				*)
+(************************************************************************)
+
+PROCEDURE CloseFile (VAR (*INOUT*) f: File);
+
+    (* Closes file f. *)
+
+    VAR dummy: CARDINAL;
+
+    BEGIN
+	FIO.Close(f);
+	dummy := FIO.IOresult();
+    END CloseFile;
+
+(************************************************************************)
+(*			    END-OF-FILE TEST				*)
+(************************************************************************)
+
+PROCEDURE EOF (f: File): BOOLEAN;
+
+    (* Returns TRUE iff we are currently at the end of file f.		*)
+    (* Remark: the library procedure FIO.EOF is inadequate for this	*)
+    (* purpose, because (a) it is only updated after a read, and	*)
+    (* (b) there is no feedback about WHICH file has reached its end.	*)
+
+    BEGIN
+	RETURN FIO.GetPos(f) >= FIO.Size(f);
+    END EOF;
+
+(************************************************************************)
+(*				WRITING					*)
+(************************************************************************)
+
+PROCEDURE WriteByte (f: File;  value: BYTE): ErrorCode;
+
+    (* Writes one byte to the file.  The returned value is an error	*)
+    (* code (OK if no error).						*)
+
+    BEGIN
+	FIO.WrChar (f, value);
+	RETURN IOstatus();
+    END WriteByte;
+
+(************************************************************************)
+
+PROCEDURE WriteRecord (f: File;  buffaddr: ADDRESS;
+					count: CARDINAL): ErrorCode;
+
+    (* Writes count bytes from memory location buffaddr.	*)
+
+    BEGIN
+	FIO.WrBin (f, buffaddr^, count);
+	RETURN IOstatus();
+    END WriteRecord;
+
+(************************************************************************)
+(*				READING					*)
+(************************************************************************)
+
+PROCEDURE ReadByte (f: File): BYTE;
+
+    (* Returns the next byte from the file.	*)
+
+    BEGIN
+	RETURN FIO.RdChar(f);
+    END ReadByte;
+
+(************************************************************************)
+
+PROCEDURE ReadRecord (f: File;  buffaddr: ADDRESS;  desired: CARDINAL;
+				VAR (*OUT*) actual: CARDINAL): ErrorCode;
+
+    (* Reads up to "desired" bytes from file f to memory location	*)
+    (* "buffaddr".  On return, "actual" gives the number of bytes read.	*)
+
+    BEGIN
+	actual := FIO.RdBin (f, buffaddr^, desired);
+	RETURN IOstatus();
+    END ReadRecord;
+
+(************************************************************************)
+(*				RANDOM ACCESS				*)
+(************************************************************************)
+
+PROCEDURE SetPosition (f: File;  position: LONGCARD): ErrorCode;
+
+    (* Ensures that the next read or write on this file will be at	*)
+    (* byte number position in the file.  (The first byte in the file	*)
+    (* is byte number 0.)  If a position greater than the file size	*)
+    (* is specified, the length of the file will increase.		*)
+
+    VAR size, amount: LONGCARD;
+
+    BEGIN
+	size := FIO.Size(f);
+	IF position > size THEN
+	    FIO.Seek (f, size);
+	    IF IOstatus() <> OK THEN
+		RETURN SeekFailure;
+	    END (*IF*);
+	    amount := position - size;
+	    WHILE amount > MAX(CARDINAL) DO
+		FIO.WrCharRep (f, CHR(0), MAX(CARDINAL));
+		DEC (amount, VAL(LONGCARD, MAX(CARDINAL)));	
+	    END (*WHILE*);
+	    FIO.WrCharRep (f, CHR(0), VAL(CARDINAL,amount));	
+	END (*IF*);
+	FIO.Seek (f, position);
+	IF IOstatus() <> OK THEN RETURN SeekFailure;
+	ELSE RETURN OK;
+	END (*IF*);
+    END SetPosition;
+
+(************************************************************************)
+
+PROCEDURE SavePosition (f: File): LONGCARD;
+
+    (* Returns the current byte number in file f.	*)
+
+    BEGIN
+	RETURN FIO.GetPos(f);
+    END SavePosition;
+
+(************************************************************************)
+
+PROCEDURE FileSize (f: File): LONGCARD;
+
+    (* Returns the length of the file in bytes.	*)
+
+    BEGIN
+	RETURN FIO.Size(f);
+    END FileSize;
+
+(************************************************************************)
+
+BEGIN
+    FIO.IOcheck := FALSE;
+END FileSys.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/floppy.def b/examples/Modula-2_Libraries/PMOS/sources/general/floppy.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/floppy.def
@@ -0,0 +1,30 @@
+DEFINITION MODULE Floppy;
+
+	(********************************************************)
+	(*							*)
+	(*	    Device driver for floppy disk.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	15 June 1992			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	Note that there are no explicit entry		*)
+	(*	points to this module.  To use it, put an	*)
+	(*	"IMPORT Floppy" declaration somewhere in	*)
+	(*	your program, and do all I/O through module	*)
+	(*	Files (for file-structured I/O), or module	*)
+	(*	Devices (for low-level operations).		*)
+	(*							*)
+	(*  Remark: This version supports only two drives, even	*)
+	(*  though the controller hardware is capable of	*)
+	(*  dealing with four drives.  I have actually tested	*)
+	(*  the software with four drives, and there would be	*)
+	(*  a negligible amount of work involved in modifying	*)
+	(*  the module to handle the four-drive case; but I've	*)
+	(*  never heard of any installation which has the four	*)
+	(*  drives, so there seemed to be little point in	*)
+	(*  retaining that feature.				*)
+	(*							*)
+	(********************************************************)
+
+END Floppy.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/floppy.mod b/examples/Modula-2_Libraries/PMOS/sources/general/floppy.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/floppy.mod
@@ -0,0 +1,1492 @@
+IMPLEMENTATION MODULE Floppy;
+
+	(****************************************************************)
+	(*								*)
+	(*		Device driver for floppy disk.			*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	25 November 1994			*)
+	(*  Status:		Working					*)
+	(*								*)
+	(*	Working with 360KB, 1.2MB, and 1.44MB disks, but not	*)
+	(*	completely reliably, and more fiddling with delays	*)
+	(*	while reading from controller will be needed.		*)
+	(*								*)
+	(*	The busy waits are inelegant and unreliable, and I	*)
+	(*	should look for a better method.			*)
+	(*								*)
+	(*	There are intermittent failures of the controller,	*)
+	(*	i.e. the controller is not always listening when it	*)
+	(*	should be, and does not always send a reply when it	*)
+	(*	should, which suggests that there might be some time	*)
+	(*	delays which should be lengthened; but my tests have	*)
+	(*	failed to track down the cause.  Luckily, the problem	*)
+	(*	usually disappears on a retry.				*)
+	(*								*)
+	(*	Still need to do something about:			*)
+	(*	    Implementation of verify, format			*)
+	(*	    Handling case of 360K disk in 1.2M or 1.44M drive	*)
+	(*	    Detection of disk change				*)
+	(*								*)
+	(****************************************************************)
+
+(************************************************************************)
+(*									*)
+(* HARDWARE ASSUMPTIONS:						*)
+(*									*)
+(*  This module is set up to handle the 765 diskette controller, with	*)
+(*  DMA transfers to/from main memory using channel 2 of the 8237A DMA	*)
+(*  controller.  Up to four disk drives can be handled, but the present	*)
+(*  version of the software assumes two drives.  (I dropped support for	*)
+(*  the other two because I doubt that anyone will ever need it).	*)
+(*									*)
+(*  Ports 3F0H-3F7H are reserved for the diskette controller.  Only	*)
+(*  four of these ports are actually used: 3F2H for some motor control	*)
+(*  bits, 3F4H for the 765 status register, 3F5H for the 765 data	*)
+(*  register, and 3F7H for setting the data rate.  Commands to the 765	*)
+(*  controller are sent as byte strings to its data register, and	*)
+(*  status information comes back through the same port.  Essentially	*)
+(*  the only function of the 765 status register is to indicate whether	*)
+(*  the data register is ready to send or receive information.		*)
+(*									*)
+(*  Interrupts from the diskette controller come through request line 6	*)
+(*  of the master 8259 interrupt controller (which lives at ports	*)
+(*  020H-03FH), which maps them to processor interrupt number 14.	*)
+(*									*)
+(*  The disks are formatted with 8, 9, 15, or 18 sectors per track, and	*)
+(*  there are two heads per cylinder, i.e. both sides of the disk are	*)
+(*  used.								*)
+(*									*)
+(*  All of that information is no doubt confusing to those unfamiliar	*)
+(*  with the hardware.  From a software viewpoint, the following	*)
+(*  sequence of operations is needed to perform a disk read or write:	*)
+(*									*)
+(*   1.	Tell the diskette controller to start the motor, if it is not	*)
+(*	already running from an earlier operation.  A time delay is	*)
+(*	then necessary to let the motor run up to its correct operating	*)
+(*	speed.								*)
+(*   2.	Load the DMA controller with the memory address to be used for	*)
+(*	the data transfer.  (In most computers, the disk controller has	*)
+(*	its own built-in DMA hardware.  In this computer, the DMA	*)
+(*	controller is physically separate from the disk controller; but	*)
+(*	the principle is the same, since we permanently dedicate	*)
+(*	channel 2 of the DMA controller to floppy disk operations).	*)
+(*   3.	Send the appropriate command bytes to the diskette controller	*)
+(*	to seek (i.e. move the read-write head) to the desired track.	*)
+(*   4.	Wait for the interrupt which announces that the seek operation	*)
+(*	is done.							*)
+(*   5.	Send the appropriate command bytes to the diskette controller	*)
+(*	ports to start the read or write operation.  The data transfer	*)
+(*	between the diskette controller and main memory occurs via the	*)
+(*	DMA controller, and does not require any further software	*)
+(*	intervention.							*)
+(*   6.	When the operation is complete, the diskette controller sends	*)
+(*	an interrupt request to the processor.  The interrupt routine	*)
+(*	can then send a "stop motor" command to the diskette.		*)
+(*									*)
+(*  This description is oversimplified in that it ignores error		*)
+(*  handling.  In fact a large part of the software in this module is	*)
+(*  the code needed to deal with various types of error.		*)
+(*									*)
+(************************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE, ADDRESS,
+    (* proc *)	ADR;
+
+FROM IOErrorCodes IMPORT
+    (* type *)	ErrorCode,
+    (* proc *)	TranslateErrorCode;
+
+FROM Devices IMPORT
+    (* type *)	Device, RequestBlock, RequestBlockPointer, OperationType,
+    (* proc *)	InstallDeviceDriver, DeviceName, AcceptRequest, IOrequest;
+
+FROM MaintenancePages IMPORT
+    (* type *)	MaintenancePage,
+    (* proc *)	CreateMaintenancePage, Associate;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, WriteChar, WriteString, WriteLn,
+		ChangeScrollingRegion, OpenSimpleWindow;
+
+FROM NumericIO IMPORT
+    (* proc *)	WriteCard, WriteHexByte, WriteHexWord, WriteAddress;
+
+FROM LowLevel IMPORT
+    (* proc *)	IANDB, IORB, INOTB, RS, OutByte, InByte;
+
+FROM DMA IMPORT
+    (* proc *)	LoadDMAparameters, CheckDMAAddress;
+
+FROM MiscPMOS IMPORT
+    (* proc *)	ShortDelay, ReadCMOS;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, DestroySemaphore, Wait, Signal;
+
+FROM Timer IMPORT
+    (* proc *)	Sleep, TimedWait;
+
+FROM TaskControl IMPORT
+    (* type *)	Lock,
+    (* proc *)	CreateTask, CreateInterruptTask, WaitForInterrupt,
+		CreateLock, DestroyLock, Obtain, Release;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure;
+
+(************************************************************************)
+(*			MISCELLANEOUS GLOBAL DATA			*)
+(************************************************************************)
+
+CONST testing = TRUE;		(* debugging control *)
+
+VAR Mpage: MaintenancePage;
+    log: Window;
+
+(************************************************************************)
+(*			LOTS OF USEFUL CONSTANTS			*)
+(************************************************************************)
+
+CONST
+
+    (************************************)
+    (* Formatting, etc., parameters.	*)
+    (************************************)
+
+    NumberOfHeads = 2;
+    DataLengthCode = 0FFH;
+
+    (*********************)
+    (* Interrupt number. *)
+    (*********************)
+
+    DiskInterrupt = 14;
+
+    (*****************)
+    (* Port numbers. *)
+    (*****************)
+
+    BasePort = 03F0H;
+    MotorControlPort = BasePort + 2;
+    StatusPort = BasePort + 4;
+    DataPort = BasePort + 5;
+    DataRatePort = BasePort + 7;
+
+    (********************************************************************)
+    (* Flags in controller status register.  The high-order bit is set	*)
+    (* if the controller is ready to communicate with the processor, 	*)
+    (* and the next bit indicates the direction.  The low-order six	*)
+    (* bits, which this software does not use, give more precise	*)
+    (* information about why the controller is not ready.		*)
+    (********************************************************************)
+
+    StatusMask = 0C0H;
+    ReadyToSend = BYTE(0C0H);
+    ReadyToListen = BYTE(080H);
+
+    (********************************************************************)
+    (* Flags in internal controller status registers SR0, SR1, SR2, and	*)
+    (* SR3.  (Note that these are distinct from the main status		*)
+    (* register mentioned above).  We list here only those flags	*)
+    (* checked by more than one procedure.  Some further flags are	*)
+    (* defined locally in some procedures.				*)
+    (********************************************************************)
+
+    SeekEnd = 20H;	(* in SR0 *)
+
+(************************************************************************)
+(*			    DRIVE INFORMATION				*)
+(************************************************************************)
+
+VAR
+    (* The variable "floppy" is the means by which this device driver	*)
+    (* makes itself known to module Devices.				*)
+
+    floppy: Device;
+
+TYPE DriveNumber = SHORTCARD [0..1];
+
+    (* In this version, we support only two drives.  See comments in	*)
+    (* source about how to support four drives if required.		*)
+
+TYPE DriveType = [0..5];
+
+    (* The drive types which the software currently recognises are:	*)
+    (*		0	no drive present				*)
+    (*		1	double sided, 48 TPI, capacity 360KB		*)
+    (*		2	high capacity, 96 TPI, capacity 1.2MB		*)
+    (*		3	unknown type					*)
+    (*		4	3.5", capacity 1.44MB				*)
+    (*		5	unknown type					*)
+
+CONST UnknownDriveType = MAX(DriveType);
+
+    (* The "unknown" category does not mean that all is lost.  The	*)
+    (* present version of the software has no provision for handling	*)
+    (* unknown types; but in principle such provision could be added.	*)
+    (* For example, one could work out how many tracks there were on	*)
+    (* an unknown disk by checking which Seek operations work.		*)
+
+TYPE DataRateCode = SHORTCARD [0..2];
+
+    (* The data rate code is 0 for 500KBS, 1 for 300KBS, 2 for 250KBS.	*)
+    (* Information in the DriveInfo array is partly an attribute of the	*)
+    (* drive, and partly of the medium in the drive.  In this version	*)
+    (* of the software, we allow for 360KB and 1.2MB drives, but have	*)
+    (* not yet allowed for the case of a 360KB disk in a 1.2MB drive.	*)
+    (* The hardware will support that case, but the software is not yet	*)
+    (* set up to work out what size disk is present.			*)
+
+VAR DriveInfo: ARRAY DriveNumber OF
+		    RECORD
+			drivetype: DriveType;
+			SectorsPerTrack: CARDINAL;
+			NumberOfCylinders: CARDINAL;
+			SectorGap: BYTE;
+			DataRate: DataRateCode;
+			HeadSettlingTime: BYTE;	(* milliseconds *)
+		    END (*RECORD*);
+
+(************************************************************************)
+(*		INFORMATION ABOUT THE DRIVE MOTORS			*)
+(************************************************************************)
+(*									*)
+(*  The bits in the motor control port register are:			*)
+(*	   bit	7	turn on drive motor 3				*)
+(*		6	turn on drive motor 2				*)
+(*		5	turn on drive motor 1				*)
+(*		4	turn on drive motor 0				*)
+(*		3	interrupt enable				*)
+(*		2	reset (0=reset, 1=no reset)			*)
+(*	      1-0	number of drive to select			*)
+(*									*)
+(*  Note that any number of motors may be running but only one drive	*)
+(*  can be selected at any given time.  Because of this, and because	*)
+(*  of controller limitations, we can only do I/O on one disk at a	*)
+(*  time, but we do have the option of keeping the other motors running	*)
+(*  in anticipation of future operations on the other drives.		*)
+(*									*)
+(************************************************************************)
+
+VAR
+
+    (* The following array is in fact an array of constants, giving the	*)
+    (* motor control bits for the four drives.  We set up the values	*)
+    (* 10H, 20H, 40H, 80H in the initialisation code.			*)
+
+    MotorControlBit: ARRAY DriveNumber OF BYTE;
+
+    (* SharedMotorData holds data which may be modified by more than	*)
+    (* one task.  The lock field is for critical section protection.	*)
+    (* The count field is used only during module initialisation, to	*)
+    (* count how many motor control tasks are running.  MotorStatus	*)
+    (* is the byte we will put out to the motor control port.		*)
+
+    SharedMotorData:	RECORD
+			    lock: Lock;
+			    count: SHORTCARD;
+			    MotorStatus: BYTE;
+			END (*RECORD*);
+
+    (* Interaction between the user task and the drive control task is	*)
+    (* via several semaphores: MotorStartRequest is for requests to	*)
+    (* start the motor, MotorUpToSpeed is for saying when the drive is	*)
+    (* at operating speed, and MotorMayBeStopped is for telling the	*)
+    (* motor control task that the drive is no longer needed.  There is	*)
+    (* a separate motor control task for each motor.			*)
+
+    MotorStartRequest, MotorUpToSpeed, MotorMayBeStopped:
+					ARRAY DriveNumber OF Semaphore;
+
+(************************************************************************)
+(*		INFORMATION ABOUT THE CONTROLLER STATE			*)
+(************************************************************************)
+
+TYPE
+    HeadNumber = SHORTCARD [0..1];
+
+VAR
+    ShutDownDesired: BOOLEAN;
+    OperationDone: Semaphore;
+    ResetNeeded: BOOLEAN;
+    CalibrationNeeded: ARRAY DriveNumber OF BOOLEAN;
+    CurrentCylinder: ARRAY DriveNumber OF CARDINAL;
+
+    (* The controller status record is updated after every interrupt	*)
+    (* from the disk controller.  We choose to make it global to the	*)
+    (* module, at least in this version, because it is accessed by	*)
+    (* several different procedures.					*)
+
+    (* The amount of meaningful information stored here varies with the	*)
+    (* operation performed.  The procedure which collects the		*)
+    (* information interrogates the disk controller, and accepts as	*)
+    (* many status bytes as the controller is prepared to deliver.	*)
+    (* If the "valid" field in this record is FALSE, something has gone	*)
+    (* wrong with collecting the status information itself.		*)
+
+    (* Most commands produce seven bytes of reply: three bytes of	*)
+    (* status information, mostly consisting of error flags, then three	*)
+    (* bytes giving the cylinder, head, and sector which was reached at	*)
+    (* the end of command execution, and finally a number giving sector	*)
+    (* size (the code is log2(#bytes/128).  The Sense Interrupt Status	*)
+    (* command produces only two bytes of reply (and these are given	*)
+    (* immediately, without producing any interrupt); the first is the	*)
+    (* contents of Status Register 0 of the controller, and the second	*)
+    (* is the current cylinder number.  The Sense Drive Status command	*)
+    (* produces only one byte of reply, as does any invalid command.	*)
+    (* The Recalibrate, Specify, and Seek commands do not produce any	*)
+    (* reply, but in those cases we can send a Sense Interrupt Status	*)
+    (* command to force some status information to be sent.		*)
+
+    (* Incidentally, it often turns out that some of the reply bytes	*)
+    (* are worthless, since the controller has the bad habit of just	*)
+    (* bouncing back the information about cylinder, etc., which it was	*)
+    (* sent, rather than sending data actually read from the disk.	*)
+    (* For example, a Seek operation can succeed even if there is no	*)
+    (* disk in the drive, which means that it can be a little tricky	*)
+    (* working out just why a command failed.  Even the "ready" flags	*)
+    (* are useless; contrary to what the controller documentation says,	*)
+    (* a drive can appear to be ready even when the door is open and	*)
+    (* there is no disk present.					*)
+
+    ControllerStatus:	RECORD
+			    valid: BOOLEAN;
+			    info: ARRAY [0..6] OF BYTE
+			END (*RECORD*);
+
+(************************************************************************)
+(*			    DISK MOTOR CONTROL				*)
+(************************************************************************)
+
+PROCEDURE MotorControlTask;
+
+    (* Several tasks execute this procedure, one for each drive.  The	*)
+    (* client task is expected to perform the operations:		*)
+    (*		Signal (MotorStartRequest[drive]);			*)
+    (*		Wait (MotorUpToSpeed[drive]);				*)
+    (*		do the desired disk operation;				*)
+    (*		Signal (MotorMayBeStopped[drive]);			*)
+    (* This task responds to the Signal operations by starting and	*)
+    (* stopping the drive motor.  The reason for having a separate task	*)
+    (* is that we leave the motor running between operations - thereby	*)
+    (* avoiding a motor startup delay - as long as new start requests	*)
+    (* are coming along frequently enough.  Thus, this task has a job	*)
+    (* to do even after the disk operations for the client task have	*)
+    (* been completed.							*)
+
+    CONST
+	UpToSpeedDelay = 250;  MotorStopDelay = 2000;
+	TimeoutCheckInterval = 500;
+
+    VAR drive: DriveNumber;
+	TimedOut: BOOLEAN;
+	motorlog: Window;
+
+    BEGIN
+	(* Preamble: since several tasks are executing this procedure,	*)
+	(* we need to work out which drive the current invocation is	*)
+	(* supposed to be looking after.				*)
+
+	WITH SharedMotorData DO
+	    Obtain (lock);
+	    drive := count;  INC (count);
+	    Release (lock);
+	END (*WITH*);
+
+	IF testing THEN
+	    OpenWindow (motorlog, red, white, 4*CARDINAL(drive),
+	    		4*CARDINAL(drive)+3, 61, 79, simpleframe, nodivider);
+	    Associate (motorlog, Mpage);
+	    WriteString (motorlog, "Drive number ");
+	    WriteHexByte (motorlog, drive);
+	    ChangeScrollingRegion (motorlog, 2, 2);
+	END (*IF*);
+
+	(* Each time around the main loop of this procedure, we start	*)
+	(* and stop the motor once.  There is an inner loop which keeps	*)
+	(* the motor running over several disk operations, as long as	*)
+	(* motor start requests arrive sufficiently frequently.		*)
+
+	LOOP	(* until ShutDownDesired *)
+
+	    IF testing THEN
+		WriteLn (motorlog);  WriteString (motorlog, "stopped");
+	    END (*IF*);
+
+	    (* Wait for a motor start request, periodically checking	*)
+	    (* the ShutDownDesired flag.				*)
+
+	    REPEAT
+		IF ShutDownDesired THEN EXIT(*LOOP*) END(*IF*);
+		TimedWait (MotorStartRequest[drive],
+					TimeoutCheckInterval, TimedOut);
+	    UNTIL NOT TimedOut;
+
+	    (* A request has arrived.  Start the motor.	*)
+
+	    WITH SharedMotorData DO
+		Obtain (lock);
+		MotorStatus := IORB(drive, IANDB (0FCH,
+			IORB (MotorStatus, MotorControlBit[drive])));
+		OutByte (MotorControlPort, MotorStatus);
+		Release (lock);
+	    END (*WITH*);
+	    IF testing THEN
+		WriteLn (motorlog);  WriteString (motorlog, "starting");
+	    END (*IF*);
+
+	    (* Give the motor time to reach its operating speed.	*)
+
+	    Sleep (UpToSpeedDelay);
+
+	    (* We remain in the following inner loop for as long as	*)
+	    (* there is sufficient demand for keeping the motor going.	*)
+
+	    REPEAT	(* until TimedOut *)
+
+		(* Ensure that the drive is selected, and then inform	*)
+		(* the client that it is ready to use.			*)
+
+		WITH SharedMotorData DO
+		    Obtain (lock);
+		    IF IANDB (MotorStatus, 3) <> BYTE(drive) THEN
+			MotorStatus := IORB(drive, IANDB (MotorStatus, 0FCH));
+			OutByte (MotorControlPort, MotorStatus);
+		    END (*IF*);
+		    Release (lock);
+		END (*WITH*);
+		Signal (MotorUpToSpeed[drive]);
+
+		IF testing THEN
+		    WriteLn (motorlog);  WriteString (motorlog, "in use");
+		END (*IF*);
+
+		(* Wait until the client has finished using the drive.	*)
+
+		Wait (MotorMayBeStopped[drive]);
+
+		IF ShutDownDesired THEN
+		    TimedOut := TRUE;
+		ELSE
+
+		    (* Here is where we must decide whether to stop the	*)
+		    (* motor.  Wait - but not forever - for a new start	*)
+		    (* request to arrive.				*)
+
+		    IF testing THEN
+			WriteLn(motorlog);WriteString(motorlog, "timing out");
+		    END (*IF*);
+
+		    TimedWait (MotorStartRequest[drive], MotorStopDelay,
+								TimedOut);
+
+		END (*IF*);
+
+	    UNTIL TimedOut;
+
+	    (* Stop the motor.  At this stage there might well be an	*)
+	    (* operation in progress on some other drive, so we must be	*)
+	    (* careful not to interfere with the "selected" field of	*)
+	    (* the MotorStatus byte.					*)
+
+	    WITH SharedMotorData DO
+		Obtain (lock);
+		MotorStatus := IANDB (MotorStatus,
+				INOTB(MotorControlBit[drive]));
+		OutByte (MotorControlPort, MotorStatus);
+		Release (lock);
+	    END (*WITH*);
+
+	    IF testing THEN
+		WriteLn (motorlog);  WriteString (motorlog, "stopped");
+	    END (*IF*);
+
+	END (* main LOOP *);
+
+	IF testing THEN
+	    CloseWindow (motorlog);
+	END (*IF*);
+
+	WITH SharedMotorData DO
+	    Obtain (lock);
+	    DEC (count);
+	    Release (lock);
+	END (*WITH*);
+
+    END MotorControlTask;
+
+(************************************************************************)
+
+PROCEDURE CreateMotorControlTasks;
+
+    (* Initialisation procedure: Sets up the motor control tasks, and	*)
+    (* the global variables which they use.				*)
+
+    CONST AllowInterrupts = 0CH;
+
+    VAR drive: DriveNumber;
+
+    BEGIN
+	ShutDownDesired := FALSE;
+	MotorControlBit[0] := 10H;
+	MotorControlBit[1] := 20H;
+
+	(* To support four drives, include the statements:
+		MotorControlBit[2] := 40H;
+		MotorControlBit[3] := 80H;
+	*)
+
+	WITH SharedMotorData DO
+	    CreateLock (lock);
+	    count := 0;
+	    MotorStatus := AllowInterrupts;
+	END (*WITH*);
+	FOR drive := 0 TO MAX(DriveNumber) DO
+	    CreateSemaphore (MotorStartRequest[drive], 0);
+	    CreateSemaphore (MotorUpToSpeed[drive], 0);
+	    CreateSemaphore (MotorMayBeStopped[drive], 0);
+	    CreateTask (MotorControlTask, 13, "Floppy motor");
+	END (*FOR*);
+    END CreateMotorControlTasks;
+
+(************************************************************************)
+
+PROCEDURE ShutDownMotors;
+
+    VAR drive, MotorsRunning: SHORTCARD;
+
+    BEGIN
+	ShutDownDesired := TRUE;
+	REPEAT
+	    Sleep (400);
+	    WITH SharedMotorData DO
+		Obtain (lock);
+		MotorsRunning := count;
+		Release (lock);
+	    END (*WITH*);
+	UNTIL MotorsRunning = 0;
+	DestroyLock (SharedMotorData.lock);
+	FOR drive := 0 TO MAX(DriveNumber) DO
+	    DestroySemaphore (MotorStartRequest[drive]);
+	    DestroySemaphore (MotorUpToSpeed[drive]);
+	    DestroySemaphore (MotorMayBeStopped[drive]);
+	END (*FOR*);
+    END ShutDownMotors;
+
+(************************************************************************)
+(*			THE BASIC DISK OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE SendCommand (command: BYTE): BOOLEAN;
+
+    (* The basic output operation to the disk controller command port.	*)
+    (* It is complicated by the fact that the controller is not always	*)
+    (* ready to receive a command, so we might have to busy wait for	*)
+    (* the controller's being willing to listen to us.			*)
+    (* The function result indicates success; it is FALSE if we were	*)
+    (* unable to get the controller to listen.  In that case, this	*)
+    (* procedure sets the global flag ResetNeeded.  This procedure also	*)
+    (* returns FALSE, without sending anything, if ResetNeeded has	*)
+    (* already been set by an earlier entry.				*)
+
+    CONST MaxNumberOfRetries = 10;
+	  pauselength = 300;
+
+    VAR patience: [0..MaxNumberOfRetries];
+
+    BEGIN
+
+	(* Exit immediately if a reset is needed.  This can happen if a	*)
+	(* command is more than one byte long; if something goes wrong	*)
+	(* while sending such a command, we would only make matters	*)
+	(* worse by sending the later bytes of that command.		*)
+
+	IF ResetNeeded THEN
+	    RETURN FALSE;
+	END (*IF*);
+
+	(* There needs to be a brief delay between reading and writing	*)
+	(* the controller's data register and a read of its status	*)
+	(* register.							*)
+
+	ShortDelay (pauselength);
+
+	(* We see whether the disk controller is idle by reading the	*)
+	(* top two bits from its status port.  The idle state is shown	*)
+	(* by binary 10 in those bits; the other bits are irrelevant to	*)
+	(* us in this case.						*)
+
+	patience := MaxNumberOfRetries;
+	WHILE (patience > 0) AND
+		(IANDB(InByte(StatusPort), StatusMask) <> ReadyToListen) DO
+	    DEC (patience);
+	END (*WHILE*);
+
+	(* If the controller is still not idle, give up.	*)
+
+	IF patience = 0 THEN
+	    IF testing THEN
+		WriteString (log, "SendCommand failure.  Status byte is ");
+		WriteHexByte (log, InByte (StatusPort));  WriteLn (log);
+	    END (*IF*);
+	    ResetNeeded := TRUE;
+	    RETURN FALSE;
+	END (*IF*);
+
+	(* All OK.  Send the desired command.	*)
+
+	OutByte (DataPort, command);
+	RETURN TRUE;
+
+    END SendCommand;
+
+(************************************************************************)
+
+PROCEDURE WaitForCompletion;
+
+    (* This procedure is called after every nontrivial command - that	*)
+    (* is, every command which takes some time to complete, as distinct	*)
+    (* from the commands which simply request status and which give an	*)
+    (* immediate reply - to the disk controller.  We wait for the	*)
+    (* interrupt which indicates completion of the operation, and then	*)
+    (* if necessary issue a "sense" command to the controller, to make	*)
+    (* it return some information about the status of the operation	*)
+    (* just completed.  (In some cases, no sense command is needed,	*)
+    (* because the controller spontaneously returns the information).	*)
+    (* The returned information is left in the global variable called	*)
+    (* ControllerStatus.						*)
+
+    CONST SenseInterruptStatus = 8;  BusyBit = 10H;
+	TimeoutPeriod = 500;	(* milliseconds *)
+	pause1 = 20000;  pause2 = 20000;	(* arbitrary units *)
+
+	(* PAUSELENGTH TESTS WITH 33 MHz PROCESSOR:		*)
+	(*	8000 is big enough				*)
+	(*	5000 produces intermittent failures		*)
+	(*	1000 is too small				*)
+	(* Earlier results on a slower processor:		*)
+	(*	100 is certainly big enough			*)
+	(*	60 failed on some tests				*)
+	(*	50 works most of the time			*)
+	(*	25 is too small					*)
+	(* Have not yet tested the case pause1 <> pause2	*)
+	(* The above figures are for the 1.2MB drive.  For my	*)
+	(* drive B it seems that a longer pause is needed, so	*)
+	(* I've arbitrarily increased the time.			*)
+
+	(* ORIGINAL PAUSELENGTH TESTS WITH 286 PROCESSOR:	*)
+	(*	1 was big enough				*)
+	(*	0 was far too large!! - error in compiler?	*)
+
+    VAR count: CARDINAL;  TimedOut: BOOLEAN;
+	j: CARDINAL;	(* needed only for testing code *)
+
+    BEGIN
+
+	(* Wait for the interrupt.  If the interrupt does not happen	*)
+	(* within a reasonable time, return with a "not ready"		*)
+	(* indication in the controller status record (since the most	*)
+	(* probable reason is that there is no disk in the drive).	*)
+	(* If the interrupt occurs, issue a "sense" command if needed.	*)
+
+	TimedWait (OperationDone, TimeoutPeriod, TimedOut);
+
+	IF TimedOut THEN
+	    IF testing THEN
+		WriteString (log, "WaitForCompletion: timed out.");
+		WriteLn (log);
+		WriteString (log, "Interrupt masks:   master ");
+		WriteHexByte (log, InByte(21H));
+		WriteString (log, "   slave ");
+		WriteHexByte (log, InByte (0A1H));
+		WriteLn (log);
+	    END (*IF*);
+	    ResetNeeded := TRUE;
+	    WITH ControllerStatus DO
+		valid := TRUE;  info[0] := 48H;
+		info[1] := 0;  info[2] := 0;
+	    END (*WITH*);
+	    RETURN;
+	END (*IF*);
+
+	(* Send a Sense command if needed.  Note that many operations	*)
+	(* imply an automatic Sense, in which case it would be wrong to	*)
+	(* send the explicit Sense command.  We make the distinction by	*)
+	(* checking whether the controller is currently waiting for a	*)
+	(* command.							*)
+
+	IF IANDB (InByte(StatusPort),StatusMask) = ReadyToListen THEN
+	    IF testing THEN
+		WriteString (log, "WaitForCompletion: sending Sense command.");
+		WriteLn (log);
+	    END (*IF*);
+	    IF NOT SendCommand(SenseInterruptStatus) THEN
+		IF testing THEN
+		    WriteString (log, "WaitForCompletion: Sense command not accepted.");
+		    WriteLn (log);
+		END (*IF*);
+		ControllerStatus.valid := FALSE;
+		RETURN;
+	    END (*IF*);
+
+	    (* A small delay is needed between writing a command and	*)
+	    (* reading the status port.					*)
+
+	    ShortDelay (pause1);
+
+	END (*IF*);
+
+	(* Each time around this loop, we pick up one byte of reply.	*)
+
+	count := 0;
+	LOOP
+
+	    (* Read the controller status port to check whether the	*)
+	    (* controller is willing to give us some information.	*)
+
+	    IF IANDB (InByte(StatusPort),StatusMask) <> ReadyToSend THEN
+		IF testing THEN
+		    WriteString (log, "WaitForCompletion: controller not replying.");
+		    WriteLn (log);
+		    WriteCard (log, count);
+		    WriteString (log, " bytes received so far.");
+		    WriteLn (log);
+		END (*IF*);
+		ControllerStatus.valid := FALSE;
+		RETURN;
+	    END (*IF*);
+
+	    (* OK, the controller is ready, read a byte.	*)
+
+	    ControllerStatus.info[count] := InByte (DataPort);
+
+	    (* A brief pause here, to let the controller get its breath.*)
+
+	    ShortDelay (pause2);
+
+	    (* Check the controller status port again, to see whether	*)
+	    (* there is still more information to come.  If not, this	*)
+	    (* operation is done and we can return.			*)
+
+	    IF IANDB(InByte(StatusPort),BusyBit) = BYTE(0) THEN
+		ControllerStatus.valid := TRUE;
+		IF testing THEN
+		    WriteString (log, "WaitForCompletion: data bytes are ");
+		    FOR j := 0 TO count DO
+			WriteChar (log, " ");
+			WriteHexByte (log, ControllerStatus.info[j]);
+		    END (*FOR*);
+		    WriteLn (log);
+		END (*IF*);
+		RETURN;
+	    END (*IF*);
+
+	    (* Yes, more to come.  Go around the loop again, unless	*)
+	    (* the controller is putting out more information than it	*)
+	    (* should, in which case something is going wrong and the	*)
+	    (* controller must be reset.				*)
+
+	    IF count = 6 THEN
+		ResetNeeded := TRUE;  ControllerStatus.valid := FALSE;
+		RETURN;
+	    END (*IF*);
+
+	    INC (count);
+
+	END (*LOOP*);
+
+    END WaitForCompletion;
+
+(************************************************************************)
+
+PROCEDURE ResetController;
+
+    (* This operation is performed when the software and controller	*)
+    (* somehow got out of synchronism, so that we need to set the	*)
+    (* controller back to a known state.				*)
+
+    CONST TimingParameterSpecification = 3;
+
+    VAR dummy: BOOLEAN;  drive: DriveNumber;
+
+    BEGIN
+
+	(* Pulse the reset bit low, and then let it go high again.	*)
+
+	WITH SharedMotorData DO
+	    Obtain (lock);
+	    OutByte (MotorControlPort, IANDB(MotorStatus, 0FBH));
+	    OutByte (MotorControlPort, MotorStatus);
+	    Release (lock);
+	END (*WITH*);
+	FOR drive := 0 TO MAX(DriveNumber) DO
+	    CalibrationNeeded[drive] := TRUE;
+	END (*FOR*);
+	ResetNeeded := FALSE;
+	IF testing THEN
+	    WriteString (log, "Reset performed, now waiting for completion.");
+	    WriteLn (log);
+	END (*IF*);
+
+	(* Wait until the controller has done the operation, and then	*)
+	(* check that the reset succeeded.				*)
+
+	WaitForCompletion;
+	IF NOT ControllerStatus.valid THEN
+	    IF testing THEN
+		WriteString (log, "Disk reset failed.");  WriteLn (log);
+	    END (*IF*);
+	    ResetNeeded := TRUE;
+
+	ELSIF ControllerStatus.info[0] <> BYTE(0C0H) THEN
+	    IF testing THEN
+		WriteString (log, "Disk reset has failed.  SR0 = ");
+		WriteHexByte (log, ControllerStatus.info[0]);  WriteLn (log);
+	    END (*IF*);
+	    ResetNeeded := TRUE;
+
+	ELSE
+
+	    (* Reset has succeeded.  Now send the controller a command	*)
+	    (* which tells it the step rate, head unload time, and head	*)
+	    (* load time.						*)
+
+	    dummy := SendCommand (TimingParameterSpecification)
+			AND SendCommand (0DFH) AND SendCommand (2);
+
+	END (*IF*);
+
+    END ResetController;
+
+(************************************************************************)
+
+PROCEDURE Recalibrate (drive: DriveNumber): ErrorCode;
+
+    (* Puts the disk head back into a known state, by driving the head	*)
+    (* to its outermost position.  This operation is needed whenever	*)
+    (* the controller loses track of the head position, which can	*)
+    (* happen now and then through cumulative positioning errors.	*)
+    (* As usual, the returned value is an error code.			*)
+    (* Remark: for an 80-track disk, recalibration can fail because the	*)
+    (* hardware doesn't realise that a disk can have that many tracks,	*)
+    (* and gives up before stepping the head across the whole 80	*)
+    (* tracks.  Rather than check for this special case, which will not	*)
+    (* arise very often, we allow the operation to fail.  On a retry,	*)
+    (* the operation will succeed because by then the head has already	*)
+    (* been moved most of the way to track 0.				*)
+
+    CONST RecalibrateCode = 7;
+
+    VAR success: BOOLEAN;
+
+    BEGIN
+	IF testing THEN
+	    WriteString (log, "Recalibrating the drive.");  WriteLn (log);
+	END (*IF*);
+
+	success := SendCommand (RecalibrateCode) AND SendCommand (drive);
+	IF ResetNeeded OR NOT success THEN
+	    RETURN ControllerNotListening;
+	END (*IF*);
+
+	(* Check the status reply, to see whether the recalibration	*)
+	(* has succeeded.  If not, a reset is needed.			*)
+
+	WaitForCompletion;
+
+	IF ControllerStatus.valid
+		AND (ControllerStatus.info[0] = BYTE(SeekEnd + drive))
+		AND (ControllerStatus.info[1] = BYTE(0))
+	  THEN
+	    CurrentCylinder[drive] := 0;  CalibrationNeeded[drive] := FALSE;
+	    RETURN OK;
+	ELSE
+	    ResetNeeded := TRUE;
+	    RETURN CalibrationFailure;
+	END (*IF*);
+    END Recalibrate;
+
+(************************************************************************)
+
+PROCEDURE Seek (drive: DriveNumber; cylinder: CARDINAL): ErrorCode;
+
+    (* Drives the disk read/write head to the desired cylinder.  The	*)
+    (* value returned is an error code (OK if no errors).		*)
+
+    CONST SeekCode = 0FH;
+	StepsPerCylinder = 1;
+
+    VAR success: BOOLEAN;  result: ErrorCode;  position: BYTE;
+
+    BEGIN
+
+	(* Check for some special cases: illegal cylinder number,	*)
+	(* recalibration needed, or position already OK.		*)
+
+	IF cylinder >= DriveInfo[drive].NumberOfCylinders THEN
+	    RETURN IllegalBlockNumber;
+	END (*IF*);
+	IF CalibrationNeeded[drive] THEN
+	    result := Recalibrate (drive);
+	    IF result <> OK THEN
+		RETURN result;
+	    END (*IF*);
+	END (*IF*);
+	IF cylinder = CurrentCylinder[drive] THEN
+	    IF testing THEN
+		WriteString (log, "Seek: already on desired cylinder.");
+		WriteLn (log);
+	    END (*IF*);
+	    RETURN OK;
+	END (*IF*);
+
+	position := BYTE(cylinder*StepsPerCylinder);
+
+	(* The command to the disk controller is a sequence of three	*)
+	(* bytes, whose meaning is, I hope, obvious from the parameters	*)
+	(* mentioned in the next statement.				*)
+	(* NOTE: according to the documentation, the second byte of the	*)
+	(* command should specify which head as well as which drive,	*)
+	(* and the same for the SR0 value when we read back the		*)
+	(* interrupt status.  From tests, it appears that we should not	*)
+	(* specify the head, and that the "head" bit in SR0 is never	*)
+	(* set after a seek.						*)
+
+	success := SendCommand (SeekCode) AND SendCommand (drive)
+			AND SendCommand (position);
+	IF NOT success THEN
+	    RETURN ControllerNotListening;
+	END (*IF*);
+
+	WaitForCompletion;
+	IF NOT ControllerStatus.valid THEN
+	    RETURN ControllerOutOfSync;
+	ELSIF (ControllerStatus.info[0] <> BYTE(SeekEnd + drive))
+			OR (ControllerStatus.info[1] <> position) THEN
+	    IF testing THEN
+		WriteString (log, "Seek error, needed reply ");
+		WriteHexByte (log, SeekEnd+drive);
+		WriteString(log, " ");
+		WriteHexByte (log, position);
+		WriteString (log, ", obtained reply ");
+		WriteHexByte (log, ControllerStatus.info[0]);
+		WriteString(log, " ");
+		WriteHexByte (log, ControllerStatus.info[1]);
+		WriteLn(log);
+	    END (*IF*);
+	    CalibrationNeeded[drive] := TRUE;
+	    RETURN SeekFailure;
+	ELSE
+	    CurrentCylinder[drive] := cylinder;
+	    RETURN OK;
+	END (*IF*);
+
+    END Seek;
+
+(************************************************************************)
+
+PROCEDURE DumpIDinformation (drive: DriveNumber;  head: HeadNumber);
+
+    (* Reads current sector information from the disk, which might help	*)
+    (* us determine more about the cause of an error.			*)
+
+    (* Remark: my tests so far suggest that we don't get any error	*)
+    (* information this way, but we do seem to get back information	*)
+    (* about the current track and sector.				*)
+
+    CONST ReadIDCommand = 4AH;
+
+    VAR success: BOOLEAN;
+
+    BEGIN
+
+	success := SendCommand(ReadIDCommand)
+			AND SendCommand(BYTE(4*head + drive));
+
+	IF NOT success THEN
+	    IF testing THEN
+		WriteString (log, "Can't read ID information.");
+		WriteLn (log);
+	    END (*IF*);
+	END (*IF*);
+
+	WaitForCompletion;
+
+	(* The information which we want is dumped to the screen by	*)
+	(* procedure WaitForCompletion.					*)
+
+    END DumpIDinformation;
+
+(************************************************************************)
+
+PROCEDURE DoTheOperation (operation: CARDINAL;  drive: DriveNumber;
+				head: HeadNumber;
+				cylinder, sector: CARDINAL): ErrorCode;
+
+    (* Performs a disk operation (read=1, write=2) assuming that the	*)
+    (* motor is running, the read/write head has been driven to the	*)
+    (* correct cylinder, and the DMA controller is ready to go.		*)
+    (* Notice that there is no specification of how much data to	*)
+    (* transfer.  That detail is handled by the DMA controller, which	*)
+    (* has already been set up before this procedure was called.	*)
+
+    CONST ReadCommand = 0E6H;  WriteCommand = 0C5H;
+
+    VAR opcode: BYTE;  success: BOOLEAN;
+	SectorsTransferred: CARDINAL;
+
+    BEGIN
+	OutByte (DataRatePort, DriveInfo[drive].DataRate);
+	CASE operation OF
+	    1:	opcode := ReadCommand;
+	  |
+	    2:	opcode := WriteCommand;
+	END (*CASE*);
+
+	(* The operation is performed by sending the disk controller a	*)
+	(* command string starting with "opcode".  The significance of	*)
+	(* the remaining bytes will, I believe, be obvious from the	*)
+	(* statement below.						*)
+
+	success := SendCommand(opcode) AND SendCommand(4*head + drive)
+			AND SendCommand(BYTE(cylinder)) AND SendCommand(head)
+			AND SendCommand(BYTE(sector))
+			AND SendCommand(2)	(* sector size code *)
+			AND SendCommand(BYTE(DriveInfo[drive].SectorsPerTrack))
+			AND SendCommand(DriveInfo[drive].SectorGap)
+			AND SendCommand(DataLengthCode);
+
+	IF NOT success THEN
+	    RETURN ControllerNotListening;
+	END (*IF*);
+
+	WaitForCompletion;
+	WITH ControllerStatus DO
+
+	    IF NOT valid THEN
+		RETURN ControllerOutOfSync;
+	    END(*IF*);
+
+	    IF ORD(IANDB(info[1], 2)) <> 0 THEN
+		RETURN WriteProtected;
+	    END (*IF*);
+
+	    IF (ORD(IANDB(info[1], 5)) <> 0)
+			OR (ORD(IANDB(info[2], 12H)) <> 0) THEN
+		CalibrationNeeded[drive] := TRUE;
+		RETURN SectorNotFound;
+	    END (*IF*);
+
+	    IF (ORD(IANDB(info[1], 20H)) <> 0)
+			OR (ORD(IANDB(info[2], 21H)) <> 0) THEN
+		RETURN BadData;
+	    END (*IF*);
+
+	    IF (info[1] <> BYTE(0)) OR (info[2] <> BYTE(0)) THEN
+		RETURN UndiagnosedFailure;
+	    END (*IF*);
+
+	    (* In the following test, we mask out the "head" bit of	*)
+	    (* status register 0, because it does confusing things at	*)
+	    (* the end of a multi-sector read.				*)
+
+	    IF IANDB(info[0], 0FBH) <> BYTE(drive) THEN
+		RETURN DriveNotReady;
+	    END (*IF*);
+
+	    (* The next little calculation works out how much data was	*)
+	    (* actually transferred.  Entries 3,4,5 of the "info" field	*)
+	    (* give the ending cylinder, head, and sector respectively.	*)
+	    (* Remark: we never use this information except when testing*)
+
+	    SectorsTransferred := DriveInfo[drive].SectorsPerTrack*
+				((ORD(info[3])-cylinder)*NumberOfHeads
+						+CARDINAL(info[4])-ORD(head))
+			+ ORD(info[5]) - sector;
+	    IF testing THEN
+		WriteCard (log, SectorsTransferred);
+		WriteString (log, " sectors were transferred.");
+		WriteLn (log);
+	    END (*IF*);
+
+	    RETURN OK;
+
+	END (*WITH*);
+
+    END DoTheOperation;
+
+(************************************************************************)
+(*			THE DISK INTERRUPT TASK				*)
+(************************************************************************)
+
+PROCEDURE DiskInterruptTask;
+
+    (* Responds to the disk interrupts.  The interrupt could occur for	*)
+    (* a variety of reasons, depending on what operation was in		*)
+    (* progress.  Rather than sort that out here, we simply perform a	*)
+    (* semaphore Signal to wake up whichever task was waiting for the	*)
+    (* interrupt.							*)
+
+    VAR status: BYTE;
+
+    BEGIN
+	LOOP (*FOREVER*)
+	    WaitForInterrupt;
+	    status := InByte(StatusPort);
+
+	    (* We occasionally get an interrupt with 0 in the status	*)
+	    (* port, and I can find nothing in the data sheets to	*)
+	    (* explain this - it is perhaps a power-on interrupt.  In	*)
+	    (* any case, it is certainly not a "command done" signal,	*)
+	    (* therefore we can afford to ignore it.			*)
+
+	    IF status <> BYTE(0) THEN
+		Signal (OperationDone);
+	    END (*IF*);
+	END (*LOOP*);
+    END DiskInterruptTask;
+
+(************************************************************************)
+(*			DATA TRANSFER PROCEDURES			*)
+(************************************************************************)
+
+PROCEDURE DiskOperation (VAR (*INOUT*) details: RequestBlock);
+
+    (* Performs a disk transfer as specified in the request block.	*)
+
+    CONST DMAchannel = 2;  DefaultSectorSize = 512;
+
+    VAR command: CARDINAL;  drive: DriveNumber;  BlockNumber: CARDINAL;
+	head: HeadNumber;  cylinder, sector: CARDINAL;
+	result: ErrorCode;
+
+    BEGIN
+	WITH details DO
+	    CASE operation OF
+		verify:		command := 0;
+		|
+		read:		command := 1;
+		|
+		write:		command := 2;
+		|
+		physicalread:	ByteCount := DefaultSectorSize;
+				command := 1;
+		|
+		physicalwrite:	ByteCount := DefaultSectorSize;
+				command := 2;
+		|
+		ELSE
+			Status := FeatureNotImplemented;
+			RETURN;
+	    END (*CASE*);
+	    drive := SHORTCARD(unit);
+	END (*WITH*);
+
+	Signal (MotorStartRequest [drive]);
+
+	(* Convert the block number to the head/cylinder/sector form	*)
+	(* which the hardware expects.  The relationship is		*)
+	(*  BlockNumber = SectorsPerTrack*(NumberOfHeads*cylinder+head)	*)
+	(*				+ sector - 1			*)
+	(* Note that sector number starts from 1, while the numbering	*)
+	(* of blocks, heads, and cylinders all start from 0.		*)
+
+	BlockNumber := CARDINAL (details.BlockNumber);
+	WITH DriveInfo[drive] DO
+	    sector := BlockNumber MOD SectorsPerTrack + 1;
+	    cylinder := BlockNumber DIV SectorsPerTrack;
+	END (*WITH*);
+	head := SHORTCARD(cylinder MOD CARDINAL(NumberOfHeads));
+	cylinder := cylinder DIV NumberOfHeads;
+
+	Wait (MotorUpToSpeed [drive]);
+	result := Seek (drive, cylinder);
+	IF testing THEN
+	    WriteString (log, "Return from procedure Seek");
+	    WriteLn (log);
+	END (*IF*);
+	IF result = OK THEN
+	    IF testing THEN
+		WriteString (log, "Successful completion of seek operation");
+		WriteLn (log);
+	    END (*IF*);
+
+	    (* The seek has apparently been successful.  Set up the	*)
+	    (* DMA controller.						*)
+
+	    IF testing THEN
+		WriteString (log, "Setting up DMA, buffer address is ");
+		WriteAddress (log, details.BufferAddress);
+		WriteLn (log);
+	    END (*IF*);
+
+	    WITH details DO
+		IF NOT CheckDMAAddress (BufferAddress, ByteCount) THEN
+		    Signal (MotorMayBeStopped [drive] );
+		    Status := BadDMAAddress;
+		    RETURN;
+		END (*IF*);
+		LoadDMAparameters (DMAchannel, command, BufferAddress,
+							ByteCount);
+	    END (*WITH*);
+
+	    (* For a write operation, wait for the head settling time.	*)
+	    (* For a read we do not bother, since there is a chance	*)
+	    (* that the head will have settled anyway by the time the	*)
+	    (* desired sector comes around, and the rare problems will	*)
+	    (* be solved when we re-try the operation.			*)
+
+	    IF command = 2 THEN
+		Sleep (CARDINAL(DriveInfo[drive].HeadSettlingTime));
+	    END (*IF*);
+
+	    (* All OK so far, perform the actual transfer.	*)
+
+	    result := DoTheOperation (command, drive, head, cylinder, sector);
+	    IF result <> OK THEN
+		DumpIDinformation (drive, head);
+	    END (*IF*);
+	ELSE
+	    IF testing THEN
+		WriteString (log, "Seek failed");
+		WriteLn (log);
+	    END (*IF*);
+	END (*IF*);
+
+	Signal (MotorMayBeStopped [drive] );
+	IF ResetNeeded THEN
+	    ResetController;
+	END (*IF*);
+	details.Status := result;
+
+    END DiskOperation;
+
+(************************************************************************)
+(*			INTERFACE TO THE FILE SYSTEM			*)
+(************************************************************************)
+
+PROCEDURE DiskRequestHandler;
+
+    (* This procedure runs as an independent task.  Each time around	*)
+    (* its main loop, it picks up one enqueued I/O request and executes	*)
+    (* the request.  The requests are placed on the queue by calls to	*)
+    (* module Devices.  On completion of an operation, we inform the	*)
+    (* caller by performing a Signal on a user-specified semaphore.	*)
+
+    CONST MaxNumberOfRetries = 3;  StopCode = 0FFFFH;
+
+    VAR reply: ErrorCode;  retries: CARDINAL;
+	RequestPointer: RequestBlockPointer;
+	string: ARRAY [0..31] OF CHAR;
+
+    BEGIN
+	LOOP
+	    RequestPointer := AcceptRequest (floppy);
+	    WITH RequestPointer^ DO
+		IF operation = shutdown THEN
+		    Signal (DoneSemaphorePointer^);
+		    EXIT (*LOOP*);
+		END (*IF*);
+	    END (*WITH*);
+	    retries := 0;
+	    REPEAT
+		DiskOperation (RequestPointer^);
+		reply := RequestPointer^.Status;
+		IF testing AND (reply <> OK) THEN
+			WriteString (log, "DISK ERROR: error code ");
+			TranslateErrorCode (reply, string);
+			WriteString (log, string);  WriteLn (log);
+		END (*IF*);
+		INC (retries);
+	    UNTIL (reply = OK) OR (retries>MaxNumberOfRetries);
+	    Signal (RequestPointer^.DoneSemaphorePointer^);
+	END (*LOOP*);
+    END DiskRequestHandler;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE InitialiseDriveParameters (drive: DriveNumber;  type: DriveType);
+
+    (* Sets up the information we need about the given drive.		*)
+    (* Notes:								*)
+    (*    1.	The Sector Gap values shown are for read/write/verify.	*)
+    (*		When formatting a disk, use 054H for a 1.2MB disk, and	*)
+    (*		050H for a 360KB disk.					*)
+    (*    2.	I have not yet allowed for the possibility of a 360K	*)
+    (*		disk in a 1.2M drive.  In that case, use 023H for the	*)
+    (*		sector gap, and a data rate code of 1.			*)
+
+    BEGIN
+	WITH DriveInfo[drive] DO
+	    drivetype := type;
+	    CASE type OF
+	 	    0:		(* no drive present *)
+			SectorsPerTrack := 9;
+			NumberOfCylinders := 0;
+			SectorGap := 02AH;  DataRate := 2;
+			HeadSettlingTime := 20;
+		|
+		    1:		(* 360KB drive *)
+			SectorsPerTrack := 9;
+			NumberOfCylinders := 40;
+			SectorGap := 02AH;  DataRate := 2;
+			HeadSettlingTime := 20;
+		|
+		    2:		(* 1.2MB drive *)
+			SectorsPerTrack := 15;
+			NumberOfCylinders := 80;
+			SectorGap := 01BH;  DataRate := 0;
+			HeadSettlingTime := 15;
+		|
+		    4:		(* 1.44MB drive - still have to fix details *)
+				(* Note: for a disk formatted at low	*)
+				(* density, the parameters for case 1	*)
+				(* seem to work.			*)
+			SectorsPerTrack := 18;
+			NumberOfCylinders := 80;
+			SectorGap := 01BH;  DataRate := 0;
+			HeadSettlingTime := 15;
+		|
+		    ELSE	(* unknown type *)
+			SectorsPerTrack := 9;
+			NumberOfCylinders := 0;
+			SectorGap := 02AH;  DataRate := 2;
+			HeadSettlingTime := 20;
+	    END (*CASE*);
+	END (*WITH*);
+    END InitialiseDriveParameters;
+
+(************************************************************************)
+
+PROCEDURE SetupDriveInformation;
+
+    (* Sets up the information we need about each drive.  In this	*)
+    (* version, we get information from CMOS about the type of the	*)
+    (* first two drives, but we can't say much about the other two.	*)
+
+    VAR DriveTypeCode: BYTE;
+
+    BEGIN
+	DriveTypeCode := ReadCMOS (10H);
+
+	IF testing THEN
+	    WriteString (log, "DriveTypeCode from CMOS is ");
+	    WriteHexByte (log, DriveTypeCode);
+	    WriteString (log, " hexadecimal.");
+	    WriteLn (log);
+	END (*IF*);
+
+	InitialiseDriveParameters (0, RS(CARDINAL(DriveTypeCode), 4));
+	InitialiseDriveParameters (1, DriveType(IANDB(DriveTypeCode, 0FH)));
+
+	(* The following two calls should be included only if four	*)
+	(* drives are to be supported.					*)
+(*
+	InitialiseDriveParameters (2, UnknownDriveType);
+	InitialiseDriveParameters (3, UnknownDriveType);
+*)
+
+    END SetupDriveInformation;
+
+(************************************************************************)
+(*				SHUTDOWN				*)
+(************************************************************************)
+
+PROCEDURE ShutDown;
+
+    (* Brings the tasks in this module to an orderly halt.  This is to	*)
+    (* guard against the possibly catastrophic consequences of program	*)
+    (* termination while a disk operation is still in progress.		*)
+
+    VAR Sync: Semaphore;  RequestRecord: RequestBlock;
+	DontPanic: Window;
+
+    BEGIN
+	OpenSimpleWindow (DontPanic, 11, 13, 33, 45);
+	WriteString (DontPanic, "DON'T PANIC");
+	IF testing THEN
+	    WriteString (log, "Starting the shutdown operation.");
+	    WriteLn (log);
+	END (*IF*);
+
+	(* Send a shutdown request to the task which deals with the	*)
+	(* queue of floppy disk operation requests.			*)
+
+	CreateSemaphore (Sync, 0);
+	WITH RequestRecord DO
+	    operation := shutdown;
+	    device := floppy;
+	    unit := 0;
+	    DoneSemaphorePointer := ADR (Sync);
+	END (*WITH*);
+	IOrequest (RequestRecord);
+	Wait (Sync);
+	DestroySemaphore (Sync);
+
+	IF testing THEN
+	    WriteString (log, "About to close down the motor control tasks.");
+	    WriteLn (log);
+	END (*IF*);
+
+	(* Close down the motor control tasks, and destroy the		*)
+	(* semaphores belonging to them.				*)
+
+	ShutDownMotors;
+
+	IF testing THEN
+	    WriteString (log, "Motor control tasks are now stopped.");
+	    WriteLn (log);
+	END (*IF*);
+
+	(* Dispose of miscellaneous global variables.	*)
+
+	DestroySemaphore (OperationDone);
+	CloseWindow (DontPanic);
+
+    END ShutDown;
+
+(************************************************************************)
+(*			MODULE INITIALISATION				*)
+(************************************************************************)
+
+BEGIN
+    IF testing THEN
+	CreateMaintenancePage (Mpage);
+	OpenWindow (log, black, green, 0,23, 0,60, simpleframe, doubledivider);
+	Associate (log, Mpage);
+	WriteString (log,"         Diagnostic output from floppy disk driver");
+	ChangeScrollingRegion (log, 3, 22);
+    END (*IF*);
+
+    SetupDriveInformation;
+
+    (* Create the motor control tasks, and the information they need.	*)
+
+    CreateMotorControlTasks;
+
+    CreateSemaphore (OperationDone, 0);
+    CreateInterruptTask (DiskInterrupt, DiskInterruptTask, "Floppy int");
+    IF testing THEN
+	WriteString (log, "Have now installed the interrupt task.");
+	WriteLn (log);
+	WriteString (log, "Interrupt masks:   master ");
+	WriteHexByte (log, InByte(21H));
+	WriteString (log, "   slave ");
+	WriteHexByte (log, InByte (0A1H));
+	WriteLn (log);
+    END (*IF*);
+    ResetController;
+    floppy := InstallDeviceDriver (1);
+    DeviceName (floppy, 0, "A", 0, "");
+    DeviceName (floppy, 1, "B", 0, "");
+    CreateTask (DiskRequestHandler, 14, "Floppy request");
+    SetTerminationProcedure (ShutDown);
+
+END Floppy.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/glasstty.def b/examples/Modula-2_Libraries/PMOS/sources/general/glasstty.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/glasstty.def
@@ -0,0 +1,71 @@
+DEFINITION MODULE GlassTTY;
+
+	(********************************************************)
+	(*							*)
+	(*	     Simple screen output routines.		*)
+	(*							*)
+	(*  This module handles screen output at a very low	*)
+	(*  level, without supplying the advanced features	*)
+	(*  which may be found in, for example, module Windows.	*)
+	(*  It is intended for things like error message	*)
+	(*  output, and is designed for compactness rather	*)
+	(*  than comprehensiveness.				*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	13 December 1993		*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE, ADDRESS;
+
+PROCEDURE WriteChar (ch: CHAR);
+
+    (* Writes one character. *)
+
+PROCEDURE WriteString (text: ARRAY OF CHAR);
+
+    (* Writes a string of characters.	*)
+
+PROCEDURE WriteLn;
+
+    (* Moves the screen cursor to the beginning of the next line,	*)
+    (* scrolling if necessary.						*)
+
+PROCEDURE SetCursor (row, column: CARDINAL);
+
+    (* Moves the screen cursor to the specified row and column.		*)
+
+PROCEDURE SaveCursor;
+
+    (* Remembers the current cursor position, for use by a subsequent	*)
+    (* call to RestoreCursor.  Note that nesting is not supported, i.e.	*)
+    (* a call to SaveCursor destroys the information saved by any	*)
+    (* earlier call to SaveCursor.					*)
+
+PROCEDURE RestoreCursor;
+
+    (* Sets the cursor back to where it was at the time of the last	*)
+    (* call to SaveCursor.						*)
+
+PROCEDURE WriteHexByte (number: BYTE);
+
+    (* Writes its argument as a two-digit hexadecimal number.		*)
+
+PROCEDURE WriteHexWord (number: CARDINAL);
+
+    (* Writes its argument as a four-digit hexadecimal number.		*)
+
+PROCEDURE WriteInt (number: INTEGER);
+PROCEDURE WriteCard (number: CARDINAL);
+PROCEDURE WriteLongCard (number: LONGCARD);
+
+    (* Writes a number to the screen.	*)
+
+PROCEDURE WriteAddress (addr: ADDRESS);
+
+    (* Writes a segmented address to the screen.	*)
+
+END GlassTTY.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/glasstty.mod b/examples/Modula-2_Libraries/PMOS/sources/general/glasstty.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/glasstty.mod
@@ -0,0 +1,312 @@
+IMPLEMENTATION MODULE GlassTTY;
+
+	(********************************************************)
+	(*							*)
+	(*	     Simple screen output routines.		*)
+	(*							*)
+	(*  This module handles screen output at a very low	*)
+	(*  level, without supplying the advanced features	*)
+	(*  which may be found in, for example, module Windows.	*)
+	(*  It is intended for things like error message	*)
+	(*  output, and is designed for compactness rather	*)
+	(*  than comprehensiveness.				*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	27 February 1995		*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* proc *)	ADR;
+
+FROM Types IMPORT
+    (* proc *)	FarPointer, FarCharPointer;
+
+FROM TextVideo IMPORT
+    (* proc *)	VideoKind, PositionCursor;
+
+FROM LowLevel IMPORT
+    (* proc *)	LowByte, HighByte, RSB, IANDB,
+		Far, MakePointer, SEGMENT, OFFSET, FarCopy;
+
+(************************************************************************)
+
+CONST
+    BytesPerChar = 2;			(* # bytes/char in video buffer	*)
+    NoOfColumns = 80;
+    BytesPerRow = NoOfColumns*BytesPerChar;  (* bytes per screen row	*)
+    bottomrow = 24;			(* row # of last screen row	*)
+
+TYPE
+    RowRange = [0..bottomrow];
+    HexDigit = SHORTCARD [0..15];
+
+(*************************************************************************)
+
+VAR
+    (* BlankRow is set up by the initialisation code as a row of space	*)
+    (* characters.							*)
+
+    BlankRow: ARRAY [0..BytesPerRow-1] OF CHAR;
+
+    (* 16*ScreenSeg is the physical address of the video buffer.  The	*)
+    (* value depends on whether we are using black-and-white or colour.	*)
+
+    ScreenSeg: CARDINAL;
+
+    (* ScreenPosition is the current cursor location, relative to the	*)
+    (* start of the screen.  SavedScreenPosition is a copy made by	*)
+    (* procedure SaveCursor.						*)
+
+    ScreenPosition, SavedScreenPosition: CARDINAL;
+
+    (* CurrentRow is the number of the current screen line.		*)
+
+    CurrentRow: RowRange;
+
+    (* CurrentColumn is the number of the current screen column.  The	*)
+    (* special case CurrentColumn = NoOfColumns means that we have run	*)
+    (* off the end of the current row, and must do a WriteLn or		*)
+    (* SetCursor before writing a new character.			*)
+
+    CurrentColumn: [0..NoOfColumns];
+
+(************************************************************************)
+(*			SCROLLING AND CURSOR MOVEMENTS			*)
+(************************************************************************)
+
+PROCEDURE SetCursor (row, column: CARDINAL);
+
+    (* Moves the screen cursor to the specified row and column.		*)
+
+    BEGIN
+	CurrentRow := row;  CurrentColumn := column;
+	ScreenPosition := BytesPerRow*row + BytesPerChar*column;
+	PositionCursor (TRUE, ScreenPosition, FALSE);
+    END SetCursor;
+
+(************************************************************************)
+
+PROCEDURE SaveCursor;
+
+    (* Remembers the current cursor position, for use by a subsequent	*)
+    (* call to RestoreCursor.  Note that nesting is not supported, i.e.	*)
+    (* a call to SaveCursor destroys the information saved by any	*)
+    (* earlier call to SaveCursor.					*)
+
+    BEGIN
+	SavedScreenPosition := ScreenPosition;
+    END SaveCursor;
+
+(************************************************************************)
+
+PROCEDURE RestoreCursor;
+
+    (* Sets the cursor back to where it was at the time of the last	*)
+    (* call to SaveCursor.						*)
+
+    BEGIN
+	ScreenPosition := SavedScreenPosition;
+	CurrentRow := ScreenPosition DIV BytesPerRow;
+	CurrentColumn := (ScreenPosition MOD BytesPerRow) DIV BytesPerChar;
+	PositionCursor (TRUE, ScreenPosition, FALSE);
+    END RestoreCursor;
+
+(************************************************************************)
+
+PROCEDURE ScrollUp;
+
+    (* Scrolls the screen contents up by one line.  The last row is	*)
+    (* filled with spaces.						*)
+
+    VAR screenloc: FarPointer;
+
+    BEGIN
+	FarCopy (MakePointer (ScreenSeg, BytesPerRow),
+			MakePointer (ScreenSeg, 0),
+				BytesPerRow*bottomrow);
+	ScreenPosition := BytesPerRow*bottomrow;
+	screenloc := MakePointer (ScreenSeg, ScreenPosition);
+	FarCopy (Far(ADR(BlankRow)), screenloc, BytesPerRow);
+    END ScrollUp;
+
+(************************************************************************)
+
+PROCEDURE WriteLn;
+
+    (* Moves the screen cursor to the beginning of the next line,	*)
+    (* scrolling if necessary.						*)
+
+    BEGIN
+	IF CurrentRow = bottomrow THEN ScrollUp
+	ELSE INC (CurrentRow);
+	END (*IF*);
+	CurrentColumn := 0;
+	ScreenPosition := BytesPerRow*CurrentRow;
+	PositionCursor (TRUE, ScreenPosition, FALSE);
+    END WriteLn;
+
+(************************************************************************)
+(*			CHARACTER AND STRING OUTPUT			*)
+(************************************************************************)
+
+PROCEDURE WriteChar (ch: CHAR);
+
+    (* Writes one character, and updates the cursor.  This procedure	*)
+    (* does not recognise the concept of a control character.  Every	*)
+    (* possible value of ch produces something readable on the screen.	*)
+    (* If we have run off the end of the current row, wraps to a	*)
+    (* new line.							*)
+
+    VAR screenloc: FarCharPointer;
+
+    BEGIN
+	IF CurrentColumn = NoOfColumns THEN
+	    WriteLn;
+	END (*IF*);
+	screenloc := MakePointer (ScreenSeg, ScreenPosition);
+	screenloc^ := ch;
+	INC (ScreenPosition, BytesPerChar);
+	INC (CurrentColumn);
+	PositionCursor (TRUE, ScreenPosition, FALSE);
+    END WriteChar;
+
+(************************************************************************)
+
+PROCEDURE WriteString (text: ARRAY OF CHAR);
+
+    (* Writes a sequence of characters, terminated either by NUL or by	*)
+    (* the end of the array.						*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	j := 0;
+	LOOP
+	    IF ORD (text[j]) = 0 THEN EXIT(*LOOP*)  END (*IF*);
+	    WriteChar (text[j]);  INC (j);
+	    IF j > HIGH (text) THEN EXIT(*LOOP*)  END (*IF*);
+	END (*LOOP*);
+    END WriteString;
+
+(************************************************************************)
+(*			NUMERIC OUTPUT (HEXADECIMAL)			*)
+(************************************************************************)
+
+PROCEDURE WriteHexDigit (number: HexDigit);
+
+    (* Writes a one-digit hexadecimal number.	*)
+
+    BEGIN
+	IF number < 10 THEN
+	    WriteChar (CHR(ORD("0")+ORD(number)))
+	ELSE
+	    WriteChar (CHR(ORD("A")+ORD(number)-10))
+	END (*IF*);
+    END WriteHexDigit;
+
+(*************************************************************************)
+
+PROCEDURE WriteHexByte (number: BYTE);
+
+    (* Writes its argument as a two-digit hexadecimal number.	*)
+
+    BEGIN
+
+	(* The obscure function names from LowLevel are:	*)
+	(*	RSB = right shift	IANDB = logical AND	*)
+
+	WriteHexDigit (RSB(number,4));
+	WriteHexDigit (IANDB(number,15));
+    END WriteHexByte;
+
+(*************************************************************************)
+
+PROCEDURE WriteHexWord (number: CARDINAL);
+
+    (* Writes its argument as a four-digit hexadecimal number.	*)
+
+    BEGIN
+	WriteHexByte (HighByte(number));
+	WriteHexByte (LowByte(number));
+    END WriteHexWord;
+
+(************************************************************************)
+
+PROCEDURE WriteAddress (addr: ADDRESS);
+
+    (* Writes a segmented address to the screen.	*)
+
+    BEGIN
+	WriteHexWord (SEGMENT(addr));  WriteChar (":");
+	WriteHexWord (OFFSET(addr));
+    END WriteAddress;
+
+(************************************************************************)
+(*			NUMERIC OUTPUT (DECIMAL)			*)
+(************************************************************************)
+
+PROCEDURE WriteLongCard (number: LONGCARD);
+
+    (* Writes a number to the screen.	*)
+
+    VAR remainder: CARDINAL;
+
+    BEGIN
+	IF number > 9 THEN
+	    WriteLongCard (number DIV 10);
+	END (*IF*);
+	remainder := CARDINAL (number MOD 10);
+	WriteChar (CHR(remainder + ORD("0")));
+    END WriteLongCard;
+
+(************************************************************************)
+
+PROCEDURE WriteCard (number: CARDINAL);
+
+    (* Writes a number to the screen.	*)
+
+    BEGIN
+	WriteLongCard (VAL(LONGCARD,number));
+    END WriteCard;
+
+(************************************************************************)
+
+PROCEDURE WriteInt (number: INTEGER);
+
+    (* Writes a number to the screen.	*)
+
+    BEGIN
+	IF number < 0 THEN
+	    WriteChar ('-');  number := -number;
+	END (*IF*);
+	WriteCard (VAL(CARDINAL,number));
+    END WriteInt;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE Initialise;
+
+    VAR j: CARDINAL;  dummy: BOOLEAN;
+
+    BEGIN
+	VideoKind (ScreenSeg, dummy);
+
+	FOR j := 0 TO HIGH(BlankRow)-1 BY 2 DO
+	    BlankRow[j] := " ";  BlankRow[j+1] := CHR(07H);
+	END (*FOR*);
+
+	ScreenPosition := 0;  SavedScreenPosition := 0;
+	CurrentRow := 0;  CurrentColumn := 0;
+
+    END Initialise;
+
+(************************************************************************)
+
+BEGIN
+    Initialise;
+END GlassTTY.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/graphics.def b/examples/Modula-2_Libraries/PMOS/sources/general/graphics.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/graphics.def
@@ -0,0 +1,281 @@
+DEFINITION MODULE Graphics;
+
+	(****************************************************************)
+	(*								*)
+	(*		     Screen graphics output			*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	10 February 1995			*)
+	(*  Status:		OK					*)
+	(*								*)
+	(*	The procedures in this module assume that the caller	*)
+	(*	has control of the entire screen.			*)
+	(*	For multi-window graphics, see module GWindows.		*)
+	(*								*)
+	(* The support status for the various graphics modes is listed	*)
+	(* below.  Text modes are listed for information only; this	*)
+	(* module allows you to select a text mode, but does not supply	*)
+	(* any support beyond that point.				*)
+	(*								*)
+	(*	-	720x348x1 (Hercules only)	working		*)
+	(*	0	40x25 BW text			text		*)
+	(*	1	40x25 colour text		text		*)
+	(*	2	80x25 BW text			text		*)
+	(*	3	80x25 colour text		text		*)
+	(*	4	320x200x4 (CGA)			working		*)
+	(*	5	320x200 BW (CGA)		working		*)
+	(*	6	640x200	BW (CGA)		working		*)
+	(*	7	80x25 mono text (MDA/Hercules)	text		*)
+	(*	8-12	unsure, but not graphics	not supported	*)
+	(*	13	320x200x16 (EGA)		working		*)
+	(*	14	640x200x16 (EGA)		working		*)
+	(*	15	640x350x1  (EGA)		working		*)
+	(*	16	640x350x16 (EGA)		working		*)
+	(*	17	640x480x1  (VGA)		working		*)
+	(*	18	640x480x16 (VGA)		working		*)
+	(*	19	320x200x256 (VGA)		working		*)
+	(*								*)
+	(*  ATI SVGA modes:						*)
+	(*	83	800x600x16			working		*)
+	(*	84	800x600x16			working		*)
+	(*	85	1024x768x16			working		*)
+	(*	97	640x400x256			working		*)
+	(*	98	640x480x256			working		*)
+	(*	99	800x600x256			working*	*)
+	(*	100	1024x768x256			untested	*)
+	(*	101	1024x768x16 packed		BIOS problem?	*)
+	(*								*)
+	(*  S3 modes:							*)
+	(*	The S3 supports only VESA SVGA modes.  Of these,	*)
+	(*	mode 257 works (after a correction in SCREEN.MOD for a	*)
+	(*	bug in the BIOS), but for some reason I can't succeed	*)
+	(*	in setting any other VESA mode.				*)
+	(*								*)
+	(*  Trident SVGA modes:						*)
+	(*	17 extra modes defined, all untested so far.		*)
+	(*								*)
+	(*  VESA modes:							*)
+	(*	106	800x600x16			working		*)
+	(*	256	640x400x256			working		*)
+	(*	257	640x480x256			working		*)
+	(*	258	800x600x16			working*	*)
+	(*	259	800x600x256			working*	*)
+	(*	260	1024x768x16			working*	*)
+	(*	261	1024x768x256			untested	*)
+	(*	262	1280x1024x16			untested	*)
+	(*	263	1280x1024x256			untested	*)
+	(*	264	80x60 text			text		*)
+	(*	265	132x25 text			text		*)
+	(*	266	132x43 text			text		*)
+	(*	267	132x50 text			text		*)
+	(*	268	132x60 text			text		*)
+	(*	269	300x200x32K			untested	*)
+	(*	270	320x200x64K			untested	*)
+	(*	271	320x200x16.8M			not supported	*)
+	(*	272	640x480x32K			working		*)
+	(*	273	640x480x64K			working		*)
+	(*	274	640x480x16.8M			not supported	*)
+	(*	275	800x600x32K			working		*)
+	(*	276	800x600x64K			working		*)
+	(*	277	800x600x16.8M			not supported	*)
+	(*	278	1024x768x32K			untested	*)
+	(*	279	1024x768x64K			untested	*)
+	(*	280	1024x768x16.8M			not supported	*)
+	(*	281	1280x1024x32K			untested	*)
+	(*	282	1280x1024x64K			untested	*)
+	(*	283	1280x1024x16.8M			not supported	*)
+	(* Modes 271,274,277,280, and 283, which use 24-bit colours,	*)
+	(* are not supported by the current version of module Graphics.	*)
+	(*								*)
+	(* The notation "working*" means that the modes are working on	*)
+	(* some hardware but failing on others.  Since this is due to	*)
+	(* BIOS errors the only remedy is to disable or avoid the modes	*)
+	(* that don't work on your hardware (or upgrade your BIOS).	*)
+	(*								*)
+	(* I now have partial support on the Trident for the		*)
+	(* following "VESA" modes:					*)
+	(*	368	512x480x32K			working?	*)
+	(*	369	512x480x64K			working?	*)
+	(* These have poor horizontal position on my monitor, but this	*)
+	(* is possibly just a monitor limitation; otherwise they	*)
+	(* work well.							*)
+	(*								*)
+	(* Comments on modes which are "almost" working:		*)
+	(*	106,258,260						*)
+	(*		Sync problem on Trident				*)
+	(*	99,259	Fails on some but not all ATI adaptors.		*)
+	(*	261..263,269..283					*)
+	(*		The hardware I'm using so far doesn't support	*)
+	(*		these modes, so I can't yet test them.		*)
+	(*	348..351, 354, 362, 372..375 (plus some text modes)	*)
+	(*		these are in some sense "supported" on the	*)
+	(*		Trident; most of them turn out to be duplicates,*)
+	(*		so I've eliminated them from the list of	*)
+	(*		supported modes.  The only genuine extras are	*)
+	(*		272,273,275,276 (which are not listed as	*)
+	(*		supported, but are available anyway); and	*)
+	(*		368,369 (which are listed as supported,		*)
+	(*		although I'm not sure that the Vesa standard	*)
+	(*		includes them).					*)
+	(*								*)
+	(* Note that on the Trident:					*)
+	(*   - all the 16-colour modes using bank switching show the	*)
+	(*     same symptom: a triple image apparently caused by a	*)
+	(*     clock synch problem;					*)
+	(*   - the 32K and 64K colour modes are working to some		*)
+	(*     extent, but the colours are not what one would expect.	*)
+	(*								*)
+	(****************************************************************)
+
+FROM ScreenGeometry IMPORT
+    (* type *)	Rectangle;
+
+FROM Screen IMPORT
+    (* const*)	HercGraphics;	(* 720x348 monochrome Hercules graphics *)
+
+(************************************************************************)
+(*									*)
+(*  The constant BLorigin defined below is to support two different	*)
+(*  origin conventions.  When a reference is made to (x,y) coordinates	*)
+(*  in this module, the x value is the horizontal coordinate, with 0	*)
+(*  at the left of the the screen, and the y value is the vertical	*)
+(*  coordinate.  If BLorigin is TRUE then y=0 is at the bottom of the	*)
+(*  screen and y values increase upwards.  If BLorigin is FALSE then	*)
+(*  y=0 is at the top of the screen and y values increase downwards.	*)
+(*  You can choose whichever convention suits you best; the effect on	*)
+(*  execution speed is negligible.  Some other PMOS modules assume	*)
+(*  that you have selected the TRUE option.				*)
+(*									*)
+(*  NOTE: The case BLorigin=FALSE has not yet been fully tested.	*)
+(*									*)
+(*  You might think that the inclusion of this choice will increase	*)
+(*  software overheads, but in fact any reasonable compiler will do	*)
+(*  the constant testing at compile time rather than at execution time,	*)
+(*  eliminating the unreachable code.					*)
+(*									*)
+(************************************************************************)
+
+CONST BLorigin = TRUE;
+
+(************************************************************************)
+
+TYPE ColourType = CARDINAL;
+
+PROCEDURE SetMode (newmode: CARDINAL;  ClearScreen: BOOLEAN);
+
+    (* Sets the video mode. *)
+
+    (* Warning: the option ClearScreen=FALSE sometimes produces some	*)
+    (* strange effects, apparently because of some aspect of the BIOS	*)
+    (* that I don't yet understand.					*)
+
+PROCEDURE SetDefaultMode;
+
+    (* Sets the video mode to (our opinion of) the "best" graphics mode	*)
+    (* supported by the hardware.					*)
+
+PROCEDURE GraphicsOff (ClearScreen: BOOLEAN);
+
+    (* Sets the video mode to a default text mode. *)
+
+PROCEDURE GetScreenShape (VAR (*OUT*) xmax, ymax: CARDINAL;
+				VAR (*OUT*) maxcolour: ColourType;
+				VAR (*OUT*) CharHeight: CARDINAL);
+
+    (* Returns the maximum values permitted by the current mode for	*)
+    (* x, y, and colour; and the number of rows in a character.		*)
+
+PROCEDURE SetPaletteColour (Palette_Index, Red, Green, Blue: SHORTCARD);
+
+    (* Sets the colour for one palette register.  Applicable only to	*)
+    (* VGA or better.  The three colour codes are 6-bit numbers.	*)
+
+PROCEDURE PlotDot (x, y: CARDINAL;  colour: ColourType);
+
+    (* Writes a dot at screen position (x, y).	*)
+
+PROCEDURE PlotMark (x, y: CARDINAL;
+			colour: ColourType;  pointtype: SHORTCARD);
+
+    (* Writes a mark at screen position (x, y).  Currently, the options	*)
+    (* for pointtype are:						*)
+    (*		0	dot						*)
+    (*		1	X						*)
+    (*		2	box						*)
+
+PROCEDURE PlotLine (x0, y0, x1, y1: CARDINAL;  colour: ColourType);
+
+    (* Plots a straight line from (x0,y0) to (x1,y1).  It is the	*)
+    (* caller's responsibility to ensure that the coordinates are in	*)
+    (* range for the current video mode.				*)
+
+PROCEDURE PlotRectangle (R: Rectangle;  colour: ColourType);
+
+    (* Plots a rectangle, with clipping if necessary to keep the	*)
+    (* points within the screen boundary.				*)
+
+PROCEDURE ClippedLine (x0, y0, x1, y1: CARDINAL;  colour: ColourType;
+			left, right, ymin, ymax: CARDINAL);
+
+    (* Like PlotLine, but plots only that part of the line which lies	*)
+    (* in the rectangle (left <= x <= right), (ymin <= y <= ymax).	*)
+    (* The caller is expected to ensure, by appropriate definition of	*)
+    (* the rectangle, that all plotted points are in range for the	*)
+    (* current video mode.						*)
+
+PROCEDURE Fill (x0, y0, x1, y1: CARDINAL;  colour: ColourType);
+
+    (* Fills a rectangle with the indicated colour.  The rectangle is	*)
+    (* specified by giving two opposite corners (x0,y0) and (x1,y1).	*)
+
+PROCEDURE ACopy (xs, ys, width, height: CARDINAL;  dx, dy: INTEGER);
+
+    (* Copies a rectangular region by an offset (dx, dy).  The pair	*)
+    (* (xs,ys) gives the coordinates of the top left of the source	*)
+    (* rectangle.  Restrictions: this procedure is restricted to the	*)
+    (* case where distance to move the data is an integral number of	*)
+    (* bytes (i.e. if you want it to work for all modes then dx should	*)
+    (* be a multiple of 8); and in the case where the source and	*)
+    (* destination rectangles overlap then the move has to be upwards	*)
+    (* on the screen.  Thus we do not have a completely general "block	*)
+    (* copy" operation, but we do have something sufficient to support	*)
+    (* "scroll up" and similar operations.				*)
+
+    (* Further restriction: for multibank modes, will work only on	*)
+    (* hardware that permits separate "read" and "write" banks.  A fix	*)
+    (* for this would be sufficiently troublesome that I don't plan	*)
+    (* to fix the problem unless/until I discover that someone needs	*)
+    (* the software for that kind of hardware.				*)
+
+PROCEDURE DrawChar (ch: CHAR;  x, y: CARDINAL;  colour: ColourType);
+
+    (* Draws the single character ch.  The coordinates (x,y) are the	*)
+    (* location of the bottom left of the character.			*)
+
+PROCEDURE PlotString (VAR (*IN*) text: ARRAY OF CHAR;
+			x, y, length: CARDINAL;  colour: ColourType);
+
+    (* Draws a string of "length" characters starting at location (x,y)	*)
+    (* It is the caller's responsibility to ensure that the string will	*)
+    (* not run off the screen edges.					*)
+
+PROCEDURE ClippedString (VAR (*IN*) text: ARRAY OF CHAR;
+			x, y, length: CARDINAL;  colour: ColourType;
+			left, right, ymin, ymax: CARDINAL);
+
+    (* Like PlotString, but excludes any points which fall outside the	*)
+    (* clip rectangle defined by (left,right,ymin,ymax).		*)
+
+PROCEDURE PlotStringUp (VAR (*IN*) text: ARRAY OF CHAR;
+			x, y, length: CARDINAL;  colour: ColourType);
+
+    (* Like PlotString, but with text written in the +Y direction	*)
+
+PROCEDURE ClippedUpString (VAR (*IN*) text: ARRAY OF CHAR;
+			x, y, length: CARDINAL;  colour: ColourType;
+			left, right, ymin, ymax: CARDINAL);
+
+    (* Like ClippedString, but with text written in the +Y direction.	*)
+
+END Graphics.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/graphics.mod b/examples/Modula-2_Libraries/PMOS/sources/general/graphics.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/graphics.mod
@@ -0,0 +1,2857 @@
+IMPLEMENTATION MODULE Graphics;
+
+	(********************************************************)
+	(*							*)
+	(*		Screen graphics output.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*	VGA and VESA graphics support based on code	*)
+	(*	developed by Luke Plaizier and Warren Reynolds.	*)
+	(*  Last edited:	27 February 1995		*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	ATI mode 85 has suddenly gone buggy: the	*)
+	(*	vertical resolution is out by a factor of 2.	*)
+	(*	I can't see why - it was working until quite	*)
+	(*	recently.  (Noticed later: it works on one of	*)
+	(*	my machines but not on the other.)		*)
+	(*							*)
+	(*	Next big job: graphics accelerator support.	*)
+	(*							*)
+	(*	Hercules, CGA, EGA, and VGA modes working.	*)
+	(*	SVGA seems to be working now.  Still need to	*)
+	(*	add graphics accelerator features.		*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(*									*)
+(*  A particular problem in supporting screen operations on PC or AT	*)
+(*  compatibles is that there are enormous differences between models	*)
+(*  in what sort of graphics interface is provided.  Some of the	*)
+(*  lowest-level part of this problem is handled by module Screen.	*)
+(*									*)
+(*  Remark: There is a considerable amount of code duplication in this	*)
+(*  module.  This is deliberate.  Things need to be done slightly	*)
+(*  differently in different modes, and we can gain some time by using	*)
+(*  separate procedures for the different modes rather than putting	*)
+(*  the decision logic inside a single general-purpose procedure.	*)
+(*  Since graphics is expensive in computer time, this space/time	*)
+(*  tradeoff can be worthwhile.  We haven't gone all the way in this	*)
+(*  direction - that would make the module enormous - but the		*)
+(*  separation has been done for those cases where the decision logic	*)
+(*  was becoming unreasonably long.					*)
+(*									*)
+(*  For special applications, especially where it is known a priori	*)
+(*  that certain modes will never be used, there is still some scope	*)
+(*  for tuning this code.  If you decide to support only a subset of	*)
+(*  modes (e.g. only the planar 16-colour modes) then certain variables	*)
+(*  become constants, which then allows some unreachable code to be	*)
+(*  stripped out.  This may allow some IF decisions to be removed,	*)
+(*  thereby speeding up the code.					*)
+(*									*)
+(************************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE;
+
+FROM Types IMPORT
+    (* type *)	FarPointerPointer, FarBytePointer, FarWordPointer;
+
+FROM LowLevel IMPORT
+    (* proc *)	MakePointer, Virtual, FarAddOffset, OutByte,
+		IANDB, IORB, INOTB, RS, RSB, LS, LSB, Mul, BlockFill,
+		BlockFillWord, FarCopy, OFFSET, INCV, DECV;
+
+FROM Screen IMPORT
+    (* type *)	VideoAdaptorType, ModeInfoType,
+    (* proc *)	VideoKind, SetVideoMode, GetAddresses, GetModeInfo,
+		SelectReadBank, SelectWriteBank;
+
+(************************************************************************)
+
+TYPE
+
+    (* A ScreenLocation consists of a bank number and a pointer to a	*)
+    (* byte within the bank.  The first field of this record type does	*)
+    (* double duty: it's a "long offset" during the initial calculation	*)
+    (* and a pointer thereafter.					*)
+
+    SLvariant = [0..3];
+    ScreenLocation = RECORD
+			CASE :SLvariant OF
+			  | 0:	L: LONGCARD;
+			  | 1:	pb: FarBytePointer;
+			  | 2:	pw: FarWordPointer;
+			  | 3:	offset, high: CARDINAL;
+			END (*IF*);
+			bank: CARDINAL;
+		    END (*RECORD*);
+
+VAR
+
+    (* The type of video adaptor which is installed.	*)
+
+    AdaptorKind: VideoAdaptorType;
+
+    (* Our opinion of the "best" modes this adaptor supports.	*)
+
+    DefaultTextMode, DefaultGraphicsMode: CARDINAL;
+
+    (* Segment for the memory-mapped screen, and the starting port	*)
+    (* number for the video I/O ports.  Defined as variables because	*)
+    (* they depend on the adaptor type and current video mode.		*)
+    (* NOTE: IObase not used so far in this module.  It's here solely	*)
+    (* because it is obtained as a side-effect of getting ScreenSeg.	*)
+
+    ScreenSeg, IObase: CARDINAL;
+
+    (* Pointers to the currently active font table, for drawing text.	*)
+    (* Because of a quirky design flaw, we need two tables: one for	*)
+    (* each of two sets of first 128 characters.			*)
+
+    FontAddress0, FontAddress1: FarBytePointer;
+
+    (* Information about the current graphics mode.	*)
+
+    ModeData: ModeInfoType;
+
+    (* Information about the "current position" on the screen.  This	*)
+    (* record is here for the sake of some operations where we want to	*)
+    (* set the position and location once just before a repetitious	*)
+    (* sequence.  The data are not expected to be up-to-date at all	*)
+    (* times; only when in use by a few special procedures.		*)
+
+    CurrentPos: RECORD
+		    loc: ScreenLocation;
+		    DotsPerByte: [1..8];
+		    fill: BYTE;
+		END (*RECORD*);
+
+    (* Table of screen addresses for the beginning of each screen line.	*)
+    (* We precompute this information to speed up address calculations.	*)
+
+    LineStart: ARRAY [0..1023] OF
+			    RECORD
+				CASE :BOOLEAN OF
+				  | FALSE:	L: LONGCARD;
+				  | TRUE:	offset, bank: CARDINAL;
+				END (*IF*);
+			    END (*RECORD*);
+
+TYPE
+    FillProcType = PROCEDURE (CARDINAL,CARDINAL,CARDINAL,CARDINAL,ColourType);
+    LineProcType = PROCEDURE (CARDINAL, CARDINAL, INTEGER,
+			CARDINAL, CARDINAL, CARDINAL, CARDINAL,
+			BOOLEAN, ColourType);
+    CopyRectangleProcType = PROCEDURE (CARDINAL, CARDINAL, CARDINAL, CARDINAL,
+						INTEGER, INTEGER);
+    CopyPartByteProcType = PROCEDURE (VAR ScreenLocation,
+					VAR ScreenLocation, BYTE);
+    CopyStringProcType = PROCEDURE (VAR ScreenLocation,
+					VAR ScreenLocation, CARDINAL);
+
+VAR
+    (* Procedure to perform the "Fill" operation. *)
+
+    FillProc: FillProcType;
+
+    (* Procedure to plot a straight line. *)
+
+    VisibleLine: LineProcType;
+
+    (* Procedures to copy screen data. *)
+
+    CopyRectangle: CopyRectangleProcType;
+    CopyPartByte: CopyPartByteProcType;
+    CopyString: CopyStringProcType;
+
+(************************************************************************)
+(*			  SPECIAL COLOUR MODES				*)
+(************************************************************************)
+
+TYPE
+    BlackOrWhite = ColourType [0..1];
+    CGAColour = ColourType [0..3];
+    EGAColour = ColourType [0..15];
+
+(************************************************************************)
+(*		 	MASKS FOR BIT OPERATIONS			*)
+(************************************************************************)
+
+    (* A Mask value is used for stripping out a pixel from a byte, and	*)
+    (* a Fill value is for filling a byte with one colour.		*)
+    (* A Mask array is indexed by the pixel position (left to right)	*)
+    (* within the byte, and a Fill array is indexed by colour.		*)
+    (* A Keep value is similar to a Mask, but selects all pixels from	*)
+    (* a given position onwards: KeepL selects the given pixel and all	*)
+    (* pixels to the left, and KeepR selects the given pixel and all	*)
+    (* pixels to its right.						*)
+
+TYPE
+    B2M = ARRAY [0..1] OF BYTE;
+    B4M = ARRAY [0..3] OF BYTE;
+    B8M = ARRAY [0..7] OF BYTE;
+
+    B4C = ARRAY CGAColour OF BYTE;
+    B2C = ARRAY BlackOrWhite OF BYTE;
+    B16 = ARRAY EGAColour OF BYTE;
+
+CONST
+    (* Monochrome	*)
+
+    Mask2 = B8M (80H, 40H, 20H, 10H, 8, 4, 2, 1);
+    KeepL2 = B8M (80H, 0C0H, 0E0H, 0F0H, 0F8H, 0FCH, 0FEH, 0FFH);
+    KeepR2 = B8M (0FFH, 7FH, 3FH, 1FH, 0FH, 7, 3, 1);
+    Fill2 = B2C (0, 0FFH);
+
+    (* Four-colour palette: CGA colour	*)
+
+    Mask4 = B4M (0C0H,30H,0CH,03H);
+    KeepL4 = B4M (0C0H,0F0H,0FCH,0FFH);
+    KeepR4 = B4M (0FFH,3FH,0FH,03H);
+    Fill4 = B4C (0, 55H, 0AAH, 0FFH);
+
+    (* Two pixels per byte: used only by one special ATI mode.	*)
+
+    Mask16 = B2M (0F0H, 0FH);
+    KeepL16 = B2M (0F0H, 0FFH);
+    KeepR16 = B2M (0FFH, 0FH);
+    Fill16 = B16 (0, 11H, 22H, 33H, 44H, 55H, 66H, 77H, 88H, 99H,
+			0AAH, 0BBH, 0CCH, 0DDH, 0EEH, 0FFH);
+
+VAR
+    Mask, KeepL, KeepR: B8M;
+    FillArray: B16;
+
+(************************************************************************)
+(*			MANIPULATING A SCREEN POINTER			*)
+(************************************************************************)
+
+PROCEDURE StepForwardSrc (VAR (*INOUT*) loc: ScreenLocation;  K: CARDINAL);
+
+    (* Steps a source screen location K bytes forward. *)
+
+    BEGIN
+	WITH loc DO
+	    IF INCV (offset, K) THEN
+		INC (bank);
+		SelectReadBank (bank);
+	    END (*IF*);
+	END (*WITH*);
+    END StepForwardSrc;
+
+(************************************************************************)
+
+PROCEDURE StepForwardDst (VAR (*INOUT*) loc: ScreenLocation;  K: CARDINAL);
+
+    (* Like StepForwardSrc, but for a destination location. *)
+
+    BEGIN
+	WITH loc DO
+	    IF INCV (offset, K) THEN
+		INC (bank);
+		SelectWriteBank (bank);
+	    END (*IF*);
+	END (*WITH*);
+    END StepForwardDst;
+
+(************************************************************************)
+
+PROCEDURE StepForwardTrans (VAR (*INOUT*) loc: ScreenLocation;  K: CARDINAL);
+
+    (* Steps a screen location loc to K bytes beyond its current point.	*)
+    (* This is the appropriate "step forward" procedure to use for	*)
+    (* transparent write operations (plotting dots, etc.).		*)
+
+    BEGIN
+	WITH loc DO
+	    IF INCV (offset, K) THEN
+		INC (bank);
+		SelectWriteBank (bank);
+		IF ModeData.BitsPerPixel < 8 THEN
+		    SelectReadBank (bank);
+		END (*IF*);
+	    END (*IF*);
+	END (*WITH*);
+    END StepForwardTrans;
+
+(************************************************************************)
+(*		THE BASIC GRAPHICS OPERATION - PLOTTING A DOT		*)
+(************************************************************************)
+
+PROCEDURE PlotDot64K (x, y: CARDINAL;  colour: ColourType);
+
+    (* Writes a dot at screen position (x, y).  This procedure is for	*)
+    (* the direct colour modes, i.e. those which use a full word per	*)
+    (* pixel.								*)
+
+    VAR PixelLocation: ScreenLocation;
+
+    BEGIN
+	WITH ModeData DO
+	    IF colour > MaxColour THEN colour := MaxColour END(*IF*);
+	    IF BLorigin THEN y := MaxY - y; END (*IF*);
+	END (*WITH*);
+
+	WITH PixelLocation DO
+	    L := LineStart[y].L + Mul(2,x);
+	    bank := high;
+	    high := ScreenSeg;
+	    SelectWriteBank (bank);
+	    pw^ := colour;
+	END (*WITH*);
+
+    END PlotDot64K;
+
+(************************************************************************)
+
+PROCEDURE PlotDot (x, y: CARDINAL;  colour: ColourType);
+
+    (* Writes a dot at screen position (x, y).  Handles all modes.	*)
+
+    VAR mask, fill: BYTE;
+	DotsPerByte: CARDINAL;
+	PixelLocation: ScreenLocation;
+
+    BEGIN
+	WITH ModeData DO
+	    IF BitsPerPixel > 8 THEN
+		PlotDot64K (x, y, colour);
+		RETURN;
+	    END (*IF*);
+	    DotsPerByte := 8 DIV BitsPerPixel;
+	    IF colour > MaxColour THEN colour := MaxColour END(*IF*);
+	    mask := Mask [x MOD DotsPerByte];
+	    IF BLorigin THEN y := MaxY - y END (*IF*);
+	END (*WITH*);
+	fill := FillArray [colour];
+
+	(* Turn the (x,y) coordinates into a video memory address.	*)
+
+	WITH PixelLocation DO
+	    IF ModeData.MultiBank THEN
+		L := LineStart[y].L + LONGCARD(x DIV DotsPerByte);
+		bank := high;
+		SelectWriteBank (bank);
+		IF DotsPerByte > 1 THEN
+		    SelectReadBank (bank);
+		END (*IF*);
+	    ELSE
+		offset := LineStart[y].offset + x DIV DotsPerByte;
+		bank := 0;
+	    END (*IF*);
+	    high := ScreenSeg;
+	END (*WITH*);
+
+	(* Clear out the old pixel value and set a new value.  For the	*)
+	(* planar modes, we do this by loading the colour code into	*)
+	(* the set/reset register, the mask into the bit mask register,	*)
+	(* and reading then writing the video memory location.  (The	*)
+	(* actual data read and written are irrelevant, since the	*)
+	(* actual data are taken from the graphics controller's		*)
+	(* internal 32-bit latch.)  For the 256-colour modes, an 8-bit	*)
+	(* colour code is written directly and no masking is needed.	*)
+	(* For other modes, we have to do the masking ourselves.	*)
+
+	IF ModeData.Planar THEN
+	    OutByte (3CEH, 0);  OutByte (3CFH, BYTE(colour));
+	    OutByte (3CEH, 8);  OutByte (3CFH, mask);
+	    PixelLocation.pb^ := PixelLocation.pb^;
+	ELSIF ModeData.MaxColour = 255 THEN
+	    PixelLocation.pb^ := VAL(BYTE,colour);
+	ELSE
+	    PixelLocation.pb^ := IANDB (PixelLocation.pb^, INOTB(mask))
+						+ IANDB (mask, fill);
+	END (*IF*);
+
+    END PlotDot;
+
+(************************************************************************)
+(*			PLOTTING A SHORT STRING OF DOTS			*)
+(************************************************************************)
+
+PROCEDURE SetScreenLocation (x, y: CARDINAL);
+
+    (* Turns the (x,y) coordinates into a video memory address, storing	*)
+    (* the answer in global variable CurrentPos.  The processing	*)
+    (* includes setting the memory bank for the multi-bank modes.	*)
+    (* This procedure is designed for situations where we are about to	*)
+    (* do some repetitive operations starting at location (x,y), i.e.	*)
+    (* situations where we don't want to have to re-do this operation	*)
+    (* for each pixel.							*)
+
+    (* At present this procedure handles only those modes with at most	*)
+    (* 8 bits per pixel.  For the other modes it is never called.	*)
+
+    BEGIN
+	IF BLorigin THEN y := ModeData.MaxY - y END (*IF*);
+	WITH CurrentPos DO
+	    DotsPerByte := 8 DIV ModeData.BitsPerPixel;
+	    WITH loc DO
+		IF ModeData.MultiBank THEN
+		    L := LineStart[y].L + LONGCARD(x DIV DotsPerByte);
+		    bank := high;
+		    SelectWriteBank (bank);
+		    IF DotsPerByte > 1 THEN
+			SelectReadBank (bank);
+		    END (*IF*);
+		ELSE
+		    bank := 0;
+		    offset := LineStart[y].offset + x DIV DotsPerByte;
+		END (*IF*);
+		high := ScreenSeg;
+	    END (*WITH*);
+	END (*WITH*);
+    END SetScreenLocation;
+
+(************************************************************************)
+
+PROCEDURE SetColour (colour: ColourType);
+
+    (* Processes the colour, storing the answer in global variable	*)
+    (* CurrentPos.  The colour processing involves calculating a "fill"	*)
+    (* variable appropriate to the current mode, or loading the		*)
+    (* set/reset register in the case of a planar mode.  This procedure	*)
+    (* is designed for situations where we are about to do some		*)
+    (* repetitive operations in a fixed colour, i.e. situations where	*)
+    (* we don't want to have to re-do this operation for each pixel.	*)
+
+    (* At present this procedure handles only those modes with up to	*)
+    (* 16 colours.  For the other modes it is never called.		*)
+
+    BEGIN
+	WITH ModeData DO
+	    IF colour > MaxColour THEN colour := MaxColour END(*IF*);
+	    IF Planar THEN
+		OutByte (3CEH, 0);  OutByte (3CFH, BYTE(colour));
+	    ELSIF MaxColour < 16 THEN
+		CurrentPos.fill := FillArray[colour];
+	    END (*IF*);
+	END (*WITH*);
+    END SetColour;
+
+(************************************************************************)
+
+PROCEDURE AlignedPattern (pattern: BYTE);
+
+    (* Plots up to eight pixels starting at location (x,y) and		*)
+    (* continuing horizontally.  This is a specialised version where	*)
+    (* the caller must guarantee that x is aligned so that the pattern	*)
+    (* in graphics memory starts at a byte boundary.  We don't use the	*)
+    (* whole of "pattern", only the leftmost bits: as many bits as	*)
+    (* would fill up one byte of graphics memory.			*)
+
+    (* This procedure does NOT handle all modes; only those for which	*)
+    (* ModeData.BitsPerPixel < 8.					*)
+
+    (* The caller is expected to have set up CurrentPos.  On return,	*)
+    (* CurrentPos.loc has been incremented.				*)
+
+    VAR j: [0..3];
+	DotsPerByte: [1..8];
+	mask: BYTE;
+
+    BEGIN
+	DotsPerByte := CurrentPos.DotsPerByte;
+
+	WITH ModeData DO
+
+	    (* Note that the caller was required to guarantee that	*)
+	    (* BitsPerPixel < 8, hence DotsPerByte > 1; and that	*)
+	    (* x MOD DotsPerByte = 0.					*)
+
+	    IF DotsPerByte = 8 THEN
+		mask := pattern;
+	    ELSE
+		mask := 0;
+		FOR j := 0 TO DotsPerByte-1 DO
+		    IF IANDB(pattern,80H) <> BYTE(0) THEN
+			INC (mask, Mask[j]);
+		    END (*IF*);
+		    pattern := LSB(pattern,1);
+		END (*FOR*);
+	    END (*IF*);
+
+	END (*WITH*);
+
+	(* Clear out the old pixel values and set new values.  For the	*)
+	(* planar modes, the set/reset register has already been loaded	*)
+	(* with the colour code; next we load the mask into the bit	*)
+	(* mask register, and read and then write the video memory	*)
+	(* location.  (The actual data read and written are irrelevant,	*)
+	(* since the actual data are taken from the graphics		*)
+	(* controller's internal 32-bit latch.)  For other modes, we	*)
+	(* have to do the masking ourselves.				*)
+
+	IF ModeData.Planar THEN
+	    OutByte (3CEH, 8);  OutByte (3CFH, mask);
+	    CurrentPos.loc.pb^ := CurrentPos.loc.pb^;
+	ELSE
+	    CurrentPos.loc.pb^ := IANDB (CurrentPos.loc.pb^, INOTB(mask))
+					+ IANDB (mask, CurrentPos.fill);
+	END (*IF*);
+	StepForwardTrans (CurrentPos.loc, 1);
+
+    END AlignedPattern;
+
+(************************************************************************)
+
+PROCEDURE PlotPattern (pattern: BYTE;  x, y: CARDINAL;  colour: ColourType);
+
+    (* Plots up to eight pixels starting at location (x,y) and		*)
+    (* continuing horizontally.						*)
+
+    VAR j, PixelsPerByte: [0..8];
+
+    BEGIN
+	IF ModeData.BitsPerPixel >= 8 THEN
+
+	    (* The best we can do is to plot the dots one by one. *)
+
+	    INC (x,7);
+	    FOR j := 0 TO 7 DO
+		IF ODD(pattern) THEN
+		    PlotDot (x, y, colour);
+		END (*IF*);
+		DEC (x);
+		pattern := SHORTCARD(pattern) DIV 2;
+	    END (*FOR*);
+
+	ELSE
+
+	    SetScreenLocation (x, y);
+	    SetColour (colour);
+	    PixelsPerByte := 8 DIV ModeData.BitsPerPixel;
+	    j := x MOD PixelsPerByte;
+
+	    IF j <> 0 THEN
+		AlignedPattern (RSB(pattern, j));
+		pattern := LSB (pattern, PixelsPerByte - j);
+	    END (*IF*);
+	    WHILE pattern <> BYTE(0) DO
+		AlignedPattern (pattern);
+		pattern := LSB (pattern, PixelsPerByte);
+	    END (*WHILE*);
+
+	END (*IF*);
+    END PlotPattern;
+
+(************************************************************************)
+(*				BLOCK MOVES				*)
+(*									*)
+(*  Restriction: all of these procedures are restricted to the case	*)
+(*  where distance to move the data is an integral number of bytes;	*)
+(*  and in the case where the source and destination rectangles overlap	*)
+(*  then the move has to be upwards on the screen.  Thus we do not	*)
+(*  have a completely general "block copy" operation, but we do have	*)
+(*  something sufficient to support "scroll up" and similar operations.	*)
+(*									*)
+(*  For all procedures in this group except ACopy, the y values are in	*)
+(*  hardware-dependent form, i.e. y=0 is at the top of the screen.	*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE CopyPartByte0 (VAR (*INOUT*) src, dst: ScreenLocation;  mask: BYTE);
+
+    (* Copies a partial byte, namely the bits selected by mask, from	*)
+    (* src to dst.  This procedure is for packed modes with no		*)
+    (* bank switching.  On return src and dst have been updated.	*)
+
+    BEGIN
+	dst.pb^ := IORB(IANDB(dst.pb^, INOTB(mask)), IANDB (src.pb^, mask));
+	INC (src.offset);  INC (dst.offset);
+    END CopyPartByte0;
+
+(************************************************************************)
+
+PROCEDURE CopyPartByteMultibank (VAR (*INOUT*) src, dst: ScreenLocation;
+							mask: BYTE);
+
+    (* Copies a partial byte, namely the bits selected by mask, from	*)
+    (* src to dst.  On return src and dst have been updated.		*)
+    (* This version is for packed modes which require bank switching.	*)
+
+    VAR srcval: BYTE;
+
+    BEGIN
+	WITH src DO
+	    SelectReadBank (bank);
+	    srcval := IANDB (pb^, mask);
+	    IF INCV (offset, 1) THEN INC(bank) END(*IF*);
+	END (*WITH*);
+	WITH dst DO
+	    SelectReadBank (bank);
+	    SelectWriteBank (bank);
+	    pb^ := IORB(IANDB(pb^, INOTB(mask)), srcval);
+	    IF INCV (offset, 1) THEN INC(bank) END(*IF*);
+	END (*WITH*);
+    END CopyPartByteMultibank;
+
+(************************************************************************)
+
+PROCEDURE CopyPartBytePlanar (VAR (*INOUT*) src, dst: ScreenLocation;
+							mask: BYTE);
+
+    (* Copies a partial byte, namely the bits selected by mask, from	*)
+    (* src to dst.  This procedure is for all planar modes.  On return	*)
+    (* src and dst have been updated.					*)
+
+    (* The gross inefficiency is regretted, but I couldn't find a	*)
+    (* better way of doing the job within the limitations of the	*)
+    (* EGA/VGA hardware.  The basic problem is that, through some	*)
+    (* inexplicable hardware design oversight, the Bit Mask Register	*)
+    (* is ignored in Write Mode 1.  If anyone knows of a better way to	*)
+    (* do this operation, I'd love to hear about it.			*)
+
+    VAR value0, value1, value2, value3, dummy: BYTE;
+
+    BEGIN
+	(* Read four source bytes, one from each bit plane.  After	*)
+	(* that we must prime the internal 32-bit buffer with the	*)
+	(* original destination value.					*)
+
+	OutByte (3CEH, 4);	(* select "read map select" register *)
+	WITH src DO
+	    IF ModeData.MultiBank THEN SelectReadBank (bank) END (*IF*);
+	    OutByte (3CFH, 0);  value0 := pb^;
+	    OutByte (3CFH, 1);  value1 := pb^;
+	    OutByte (3CFH, 2);  value2 := pb^;
+	    OutByte (3CFH, 3);  value3 := pb^;
+	    IF INCV (offset, 1) THEN INC(bank) END(*IF*);
+	END (*WITH*);
+
+	(* Set the bit mask, and disable set/reset mode, before writing	*)
+	(* the new data.						*)
+
+	OutByte (3CEH, 1);  OutByte (3CFH, 0);
+	OutByte (3CEH, 8);  OutByte (3CFH, mask);
+
+	(* Write the source values for the four planes. *)
+
+	OutByte (3C4H, 2);	(* select map mask register *)
+	WITH dst DO
+	    IF ModeData.MultiBank THEN
+		SelectReadBank (bank);
+		SelectWriteBank (bank);
+	    END (*IF*);
+	    dummy := pb^;
+	    OutByte (3C5H, 1);  pb^ := value0;
+	    OutByte (3C5H, 2);  pb^ := value1;
+	    OutByte (3C5H, 4);  pb^ := value2;
+	    OutByte (3C5H, 8);  pb^ := value3;
+	    IF INCV (offset, 1) THEN INC(bank) END(*IF*);
+	END (*WITH*);
+
+	(* Re-enable all planes, and set/reset mode, before returning. *)
+
+	OutByte (3C5H, 0FH);  OutByte (3CEH, 1);  OutByte (3CFH, 0FH);
+
+    END CopyPartBytePlanar;
+
+(************************************************************************)
+
+PROCEDURE StringCopy0 (VAR (*INOUT*) src, dst: ScreenLocation;
+						count: CARDINAL);
+
+    (* Copies a string of bytes from src to dst.  On return src and dst	*)
+    (* have been updated.						*)
+    (* This is the version for all modes without bank switching.	*)
+
+    BEGIN
+	IF ModeData.Planar THEN
+
+	    (* Do the copy using Write Mode 1.  The Mode Register	*)
+	    (* contains several subfields, but fortunately for us the	*)
+	    (* other fields are all 0 for the planar modes.		*)
+
+	    OutByte (3CEH, 5);  OutByte (3CFH, 1);
+	END (*IF*);
+
+	FarCopy (src.pb, dst.pb, count);
+	INC (src.offset, count);  INC (dst.offset, count);
+
+	IF ModeData.Planar THEN
+
+	    (* Switch back to the default Write Mode 0.	*)
+
+	    OutByte (3CEH, 5);  OutByte (3CFH, 0);
+
+	END (*IF*);
+
+    END StringCopy0;
+
+(************************************************************************)
+
+PROCEDURE StringCopyMultibank (VAR (*INOUT*) src, dst: ScreenLocation;
+						count: CARDINAL);
+
+    (* Copies a string of bytes from src to dst.  On return src and dst	*)
+    (* have been updated.  This version is for all bank-switching modes.*)
+
+    VAR amount: CARDINAL;
+
+    BEGIN
+	IF ModeData.Planar THEN
+
+	    (* Do the copy using Write Mode 1.  The Mode Register	*)
+	    (* contains several subfields, but fortunately for us the	*)
+	    (* other fields are all 0 for the planar modes.		*)
+
+	    OutByte (3CEH, 5);  OutByte (3CFH, 1);
+	END (*IF*);
+
+	WHILE count > 0 DO
+	    amount := count;
+	    IF src.offset > MAX(CARDINAL) - amount + 1 THEN
+		amount := MAX(CARDINAL) - src.offset + 1;
+	    END (*IF*);
+	    IF dst.offset > MAX(CARDINAL) - amount + 1 THEN
+		amount := MAX(CARDINAL) - dst.offset + 1;
+	    END (*IF*);
+	    SelectReadBank (src.bank);
+	    SelectWriteBank (dst.bank);
+	    FarCopy (src.pb, dst.pb, amount);
+	    DEC (count, amount);
+	    WITH src DO
+		IF INCV (offset, amount) THEN INC(bank) END(*IF*);
+	    END (*WITH*);
+	    WITH dst DO
+		IF INCV (offset, amount) THEN INC(bank) END(*IF*);
+	    END (*WITH*);
+	END (*WHILE*);
+
+	IF ModeData.Planar THEN
+
+	    (* Switch back to the default Write Mode 0.	*)
+
+	    OutByte (3CEH, 5);  OutByte (3CFH, 0);
+
+	END (*IF*);
+
+    END StringCopyMultibank;
+
+(************************************************************************)
+
+PROCEDURE RowCopy (VAR (*INOUT*) src, dst: ScreenLocation;
+				Lmask, Rmask: BYTE;  middlecount: CARDINAL);
+
+    (* Copies a row of data from srcloc to dstloc.  Lmask and Rmask	*)
+    (* are masks for the first and last partial bytes, and middlecount	*)
+    (* is the number of complete bytes in the middle.  If everything	*)
+    (* is neatly byte-aligned then Lmask = 0FFH, Rmask = 0FFH.		*)
+    (* On return src and dst have been updated.				*)
+
+    (* This version works for all modes, although in fact it is never	*)
+    (* called for modes with an integral number of bytes per pixel.	*)
+
+    BEGIN
+
+	(* Perform a masked copy in the first partial byte, if any. *)
+
+	IF Lmask <> BYTE(0FFH) THEN
+	    CopyPartByte (src, dst, Lmask);
+	END (*IF*);
+
+	(* Copy the middle section.	*)
+
+	IF middlecount > 0 THEN
+	    CopyString (src, dst, middlecount);
+	END (*IF*);
+
+	(* Masked copy in the last partial byte, if any.	*)
+
+	IF Rmask <> BYTE(0FFH) THEN
+	    CopyPartByte (src, dst, Rmask);
+	END (*IF*);
+
+    END RowCopy;
+
+(************************************************************************)
+
+PROCEDURE ACopy0 (x0, y0, x1, y1: CARDINAL;  dx, dy: INTEGER);
+
+    (* This is the version of the Copy operation used for modes		*)
+    (* with no bank switching.  We assume that dx is an integral	*)
+    (* multiple of the number of pixels per byte for the current mode.	*)
+
+    VAR Lmask, Rmask: BYTE;
+	firstcol, dstcol, middlecount, y: CARDINAL;
+	DotsPerByte: [1..8];
+	src, dst: ScreenLocation;
+
+    BEGIN
+	DotsPerByte := 8 DIV ModeData.BitsPerPixel;
+
+	(* Work out the horizontal column range.  For our present	*)
+	(* purposes, a "column" is a group of pixels which fit into one	*)
+	(* byte.							*)
+
+	firstcol := x0 DIV DotsPerByte;
+	middlecount := x1 DIV DotsPerByte - firstcol;
+
+	(* Work out the mask values for the left and right edges.	*)
+
+	Lmask := KeepR[x0 MOD DotsPerByte];
+	Rmask := KeepL[x1 MOD DotsPerByte];
+
+	IF middlecount = 0 THEN
+	    Lmask := IANDB(Lmask,Rmask);  Rmask := 0FFH;
+	END (*IF*);
+
+	IF Lmask = BYTE(0FFH) THEN
+	    INC (middlecount);
+	END (*IF*);
+
+	IF Rmask <> BYTE(0FFH) THEN
+	    DEC (middlecount);
+	END (*IF*);
+
+	dstcol := INTEGER(firstcol) + dx DIV INTEGER(DotsPerByte);
+
+	WITH src DO
+	    bank := 0;
+	    high := ScreenSeg;
+	END (*WITH*);
+	dst := src;
+	FOR y := y0 TO y1 DO
+	    src.offset := LineStart[y].offset+firstcol;
+	    dst.offset := LineStart[INTEGER(y) + dy].offset + dstcol;
+	    RowCopy (src, dst, Lmask, Rmask, middlecount);
+	END (*FOR*);
+
+    END ACopy0;
+
+(************************************************************************)
+
+PROCEDURE ACopyMultibank (x0, y0, x1, y1: CARDINAL;  dx, dy: INTEGER);
+
+    (* This is the version of the Copy operation used for multibank	*)
+    (* modes with up to one byte per pixel.  We assume that dx is an	*)
+    (* integral multiple of the number of pixels per byte.		*)
+
+    VAR Lmask, Rmask: BYTE;
+	firstcol, middlecount, y, linestep: CARDINAL;
+	DotsPerByte: [1..8];
+	src, dst: ScreenLocation;
+
+    BEGIN
+	WITH ModeData DO
+	    DotsPerByte := 8 DIV ModeData.BitsPerPixel;
+	    linestep := BytesPerRow - 1;
+	END (*WITH*);
+
+	(* Work out the horizontal column range.  For our present	*)
+	(* purposes, a "column" is a group of pixels which fit into one	*)
+	(* byte.							*)
+
+	firstcol := x0 DIV DotsPerByte;
+	middlecount := x1 DIV DotsPerByte - firstcol;
+	DEC (linestep, middlecount);
+
+	(* Work out the mask values for the left and right edges.	*)
+
+	Lmask := KeepR[x0 MOD DotsPerByte];
+	Rmask := KeepL[x1 MOD DotsPerByte];
+
+	IF middlecount = 0 THEN
+	    Lmask := IANDB(Lmask,Rmask);  Rmask := 0FFH;
+	END (*IF*);
+
+	IF Lmask = BYTE(0FFH) THEN
+	    INC (middlecount);
+	END (*IF*);
+
+	IF Rmask <> BYTE(0FFH) THEN
+	    DEC (middlecount);
+	END (*IF*);
+
+	WITH src DO
+	    L := LineStart[y0].L + LONGCARD(firstcol);
+	    bank := high;  high := ScreenSeg;
+	END (*WITH*);
+	WITH dst DO
+	    L := LineStart[INTEGER(y0) + dy].L
+		+ LONGCARD(INTEGER(firstcol) + dx DIV INTEGER(DotsPerByte));
+	    bank := high;  high := ScreenSeg;
+	END (*WITH*);
+
+	FOR y := y0 TO y1 DO
+	    RowCopy (src, dst, Lmask, Rmask, middlecount);
+	    WITH src DO
+		IF INCV(offset, linestep) THEN INC (bank) END(*IF*);
+	    END (*WITH*);
+	    WITH dst DO
+		IF INCV(offset, linestep) THEN INC (bank) END(*IF*);
+	    END (*WITH*);
+	END (*FOR*);
+
+    END ACopyMultibank;
+
+(************************************************************************)
+
+PROCEDURE ACopy1 (x0, y0, x1, y1: CARDINAL;  dx, dy: INTEGER);
+
+    (* This is the version of the Copy operation used for modes with an	*)
+    (* integral number of bytes per pixel.				*)
+
+    VAR BytesPerDot, count, y, linestep: CARDINAL;
+	src, dst: ScreenLocation;
+
+    BEGIN
+	WITH ModeData DO
+	    BytesPerDot := BitsPerPixel DIV 8;
+	    count := BytesPerDot * (x1 - x0 + 1);
+	    linestep := BytesPerRow - count;
+	END (*WITH*);
+
+	WITH src DO
+	    L := LineStart[y0].L + Mul(BytesPerDot, x0);
+	    bank := high;  high := ScreenSeg;
+	END (*WITH*);
+	WITH dst DO
+	    L := LineStart[INTEGER(y0) + dy].L
+			+ Mul(BytesPerDot, INTEGER(x0)+dx);
+	    bank := high;  high := ScreenSeg;
+	END (*WITH*);
+
+	FOR y := y0 TO y1 DO
+	    CopyString (src, dst, count);
+	    WITH src DO
+		IF INCV(offset, linestep) THEN INC(bank) END(*IF*);
+	    END (*WITH*);
+	    WITH dst DO
+		IF INCV(offset, linestep) THEN INC(bank) END(*IF*);
+	    END (*WITH*);
+	END (*FOR*);
+
+    END ACopy1;
+
+(************************************************************************)
+
+PROCEDURE ACopy (xs, ys, width, height: CARDINAL;  dx, dy: INTEGER);
+
+    (* Copies a rectangular region by an offset (dx, dy).  The pair	*)
+    (* (xs,ys) gives the coordinates of the top left of the source	*)
+    (* rectangle.  For packed or planar modes, we assume that dx is an	*)
+    (* integral multiple of the number of pixels per byte.		*)
+
+    BEGIN
+	IF BLorigin THEN
+	    ys := ModeData.MaxY - ys;
+	    dy := -dy;
+	END (*IF*);
+	CopyRectangle (xs, ys, xs+width-1, ys+height-1, dx, dy);
+    END ACopy;
+
+(************************************************************************)
+(*			FILLING A RECTANGULAR REGION			*)
+(*									*)
+(*  The following "fill" procedures fill a rectangular region with the	*)
+(*  indicated colour.  The rectangle is specified by two opposite	*)
+(*  corners (x0,y0) and (x1,y1), where x0<=x1 and y0<=y1.  Unlike most	*)
+(*  of the other procedures in this module, the y values are in		*)
+(*  hardware-dependent form, i.e. y=0 is at the top of the screen.	*)
+(*  The master procedure "Fill" performs the conversion of y values if	*)
+(*  necessary and ensures that the values are in the correct order.	*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE Fill256 (x0, y0, x1, y1: CARDINAL;  colour: ColourType);
+
+    (* This is the "fill" procedure for the modes supporting 256 or	*)
+    (* more colours.							*)
+
+    CONST MaxOffset = 0FFFFH;
+
+    VAR loc: ScreenLocation;
+	count, y, M1, BytesPerPixel, bytesleft: CARDINAL;
+
+    BEGIN
+	WITH ModeData DO
+	    M1 := BytesPerRow;
+	    BytesPerPixel := BitsPerPixel DIV 8;
+	END (*WITH*);
+
+	count := x1 - x0 + 1;
+	WITH loc DO
+	    L := LineStart[y0].L + Mul(BytesPerPixel,x0);
+	    bank := high;  high := ScreenSeg;
+	    SelectWriteBank (bank);
+	END (*WITH*);
+
+	FOR y := y0 TO y1 DO
+
+	    (* Slightly faked calculation below, as a temporary(?)	*)
+	    (* expedient.						*)
+
+	    IF loc.offset = 0 THEN bytesleft := MaxOffset
+	    ELSE bytesleft := MaxOffset - loc.offset + 1;
+	    END (*IF*);
+
+	    IF BytesPerPixel*count <= bytesleft THEN
+		IF BytesPerPixel = 1 THEN
+		    BlockFill (loc.pb, count, VAL(BYTE,colour));
+		ELSE
+		    BlockFillWord (loc.pw, count, colour);
+		END (*IF*);
+		StepForwardDst (loc, M1);
+	    ELSE
+		IF BytesPerPixel = 1 THEN
+		    BlockFill (loc.pb, bytesleft, VAL(BYTE,colour));
+		ELSE
+		    BlockFillWord (loc.pw, bytesleft DIV 2, colour);
+		END (*IF*);
+		StepForwardDst (loc, bytesleft);
+		IF BytesPerPixel = 1 THEN
+		    BlockFill (loc.pb, count-bytesleft, VAL(BYTE,colour));
+		ELSE
+		    BlockFillWord (loc.pw, count - bytesleft DIV 2, colour);
+		END (*IF*);
+		StepForwardDst (loc, M1-bytesleft);
+	    END (*IF*);
+	END (*FOR*);
+
+    END Fill256;
+
+(************************************************************************)
+
+PROCEDURE MultibankPlanarFill (ytop, ybottom: CARDINAL;  Lmask, Rmask: BYTE;
+					firstcol, middlecount: CARDINAL);
+
+    (* This procedure does part of the work for PlanarFill (see below)	*)
+    (* in cases where memory bank switching is required.		*)
+
+    CONST DotsPerByte = 8;  MaxOffset = 0FFFFH;
+
+    VAR loc, BaseLocation: ScreenLocation;
+	y, M1, bytesleft: CARDINAL;
+
+    BEGIN
+	(* Calculate the starting address in the video memory.  In what	*)
+	(* follows, the actual data read and written are irrelevant;	*)
+	(* the actual data are taken from the set/reset register (which	*)
+	(* has already been loaded by the caller), and the pixels	*)
+	(* affected are controlled by the bit mask register.		*)
+
+	M1 := ModeData.BytesPerRow;
+	WITH BaseLocation DO
+	    L := LineStart[ytop].L + LONGCARD(firstcol);
+	    bank := high;  high := ScreenSeg;
+	    SelectWriteBank (bank);
+	END (*WITH*);
+	loc := BaseLocation;
+
+	(* Redefine M1 to be the byte step between the end of a row	*)
+	(* and the start of the next row.				*)
+
+	DEC (M1, middlecount);
+	IF Lmask <> BYTE(0FFH) THEN DEC(M1) END(*IF*);
+
+	(* We go around the following loop once for each row. *)
+
+	FOR y := ytop TO ybottom DO
+
+	    (* Draw the dots in the first partial column, if any.	*)
+
+	    IF Lmask <> BYTE(0FFH) THEN
+		SelectReadBank (loc.bank);
+		OutByte (3CFH, Lmask);
+		loc.pb^ := loc.pb^;
+		StepForwardDst (loc, 1);
+	    END (*IF*);
+
+	    (* Fill up the middle columns.	*)
+
+	    IF middlecount > 0 THEN
+		OutByte (3CFH, 0FFH);
+
+		(* Slightly faked calculation below, as a temporary(?)	*)
+		(* expedient.  It works because the case offset=0 will	*)
+		(* never require a bank switch in the middle of a line.	*)
+
+		IF loc.offset = 0 THEN bytesleft := MaxOffset
+		ELSE bytesleft := MaxOffset - loc.offset + 1;
+		END (*IF*);
+
+		IF middlecount <= bytesleft THEN
+		    BlockFill (loc.pb, middlecount, 0);
+		    StepForwardDst (loc, middlecount);
+		ELSE
+		    BlockFill (loc.pb, bytesleft, 0);
+		    StepForwardDst (loc, bytesleft);
+		    BlockFill (loc.pb, middlecount-bytesleft, 0);
+		    StepForwardDst (loc, middlecount-bytesleft);
+		END (*IF*);
+	    END (*IF*);
+
+	    (* Draw the dots in the last partial column, if any.	*)
+
+	    IF Rmask <> BYTE(0FFH) THEN
+		SelectReadBank (loc.bank);
+		OutByte (3CFH, Rmask);
+		loc.pb^ := loc.pb^;
+	    END (*IF*);
+
+	    (* Move to the start of the next row. *)
+
+	    StepForwardDst (loc, M1);
+
+	END (*FOR*);
+
+    END MultibankPlanarFill;
+
+(************************************************************************)
+
+PROCEDURE PlanarFill (x0, y0, x1, y1: CARDINAL;  colour: ColourType);
+
+    (* This procedure is used only for the modes for which the video	*)
+    (* memory is arranged as 4 planes.  (Most of the 16-colour modes	*)
+    (* work this way.)  We treat these cases separately since the	*)
+    (* method required is somewhat different than for the other modes.	*)
+
+    CONST DotsPerByte = 8;
+
+    VAR Lmask, Rmask: BYTE;
+	loc: ScreenLocation;
+	baseoffset, firstcol, middlecount, y, M1: CARDINAL;
+
+    BEGIN
+	M1 := ModeData.BytesPerRow;
+
+	(* Work out the horizontal column range.  For our present	*)
+	(* purposes, a "column" is a group of pixels which fit into one	*)
+	(* byte.							*)
+
+	firstcol := x0 DIV DotsPerByte;
+	middlecount := x1 DIV DotsPerByte - firstcol;
+
+	(* Work out the bit mask values for the left and right edges.	*)
+
+	Lmask := KeepR2[x0 MOD DotsPerByte];
+	Rmask := KeepL2[x1 MOD DotsPerByte];
+	IF middlecount = 0 THEN
+	    Lmask := IANDB (Lmask, Rmask);
+	    Rmask := 0FFH;
+	END (*IF*);
+
+	IF Lmask = BYTE(0FFH) THEN
+	    INC (middlecount);
+	END (*IF*);
+
+	IF Rmask <> BYTE(0FFH) THEN
+	    DEC (middlecount);
+	END (*IF*);
+
+	(* Load the colour code into the set/reset register, then	*)
+	(* select the bit mask register for all future operations.	*)
+
+	OutByte (3CEH, 0);  OutByte (3CFH, VAL(BYTE,colour));
+	OutByte (3CEH, 8);
+
+	(* For modes where bank switching is required, the rest of this	*)
+	(* job is done by a separate procedure.				*)
+
+	IF ModeData.MultiBank THEN
+	    MultibankPlanarFill (y0, y1, Lmask, Rmask, firstcol, middlecount);
+	    RETURN;
+	END (*IF*);
+
+	(* Turn the (x0,y0) coordinates into an address in the video	*)
+	(* memory.  In what follows, the actual data read and written	*)
+	(* are irrelevant; the actual data are taken from the set/reset	*)
+	(* register, and the pixels affected are controlled by the	*)
+	(* bit mask register.						*)
+
+	WITH loc DO
+	    offset := LineStart[y0].offset + firstcol;
+	    bank := 0;  high := ScreenSeg;
+	END (*WITH*);
+	baseoffset := loc.offset;
+
+	(* Draw the strip in the first partial column, if any.	*)
+
+	IF Lmask <> BYTE(0FFH) THEN
+	    OutByte (3CFH, Lmask);
+	    FOR y := y0 TO y1 DO
+		loc.pb^ := loc.pb^;
+		INC (loc.offset, M1);
+	    END (*FOR*);
+	    INC (baseoffset);
+	    loc.offset := baseoffset;
+	END (*IF*);
+
+	(* Fill up the middle columns.	*)
+
+	IF middlecount > 0 THEN
+	    OutByte (3CFH, 0FFH);
+	    FOR y := y0 TO y1 DO
+		BlockFill (loc.pb, middlecount, 0);
+		INC (loc.offset, M1);
+	    END (*IF*);
+	    INC (baseoffset, middlecount);
+	    loc.offset := baseoffset;
+	END (*IF*);
+
+	(* Draw the strip in the last partial column, if any.	*)
+
+	IF Rmask <> BYTE(0FFH) THEN
+	    OutByte (3CFH, Rmask);
+	    FOR y := y0 TO y1 DO
+		loc.pb^ := loc.pb^;
+		INC (loc.offset, M1);
+	    END (*FOR*);
+	END (*IF*);
+
+    END PlanarFill;
+
+(************************************************************************)
+
+PROCEDURE Fill0 (x0, y0, x1, y1: CARDINAL;  colour: ColourType);
+
+    (* This is the version of the Fill operation used for packed modes	*)
+    (* with no bank switching.						*)
+
+    VAR Lmask, Rmask, fillvalue: BYTE;
+	Lfill, Rfill: SHORTCARD;
+	loc: ScreenLocation;
+	firstcol, middlecount, y: CARDINAL;
+	DotsPerByte: [1..8];
+
+    BEGIN
+	DotsPerByte := 8 DIV ModeData.BitsPerPixel;
+	fillvalue := FillArray[colour];
+
+	(* Work out the horizontal column range.  For our present	*)
+	(* purposes, a "column" is a group of pixels which fit into one	*)
+	(* byte.							*)
+
+	firstcol := x0 DIV DotsPerByte;
+	middlecount := x1 DIV DotsPerByte - firstcol;
+
+	(* Work out the mask values for the left and right edges.	*)
+	(* Note: in the current version, each mask is the complement	*)
+	(* of the corresponding mask in PlanarFill.  I have considered	*)
+	(* changing my conventions, but it looks as if the hardware	*)
+	(* differences justify keeping this inconsistency.		*)
+
+	Lmask := INOTB (KeepR[x0 MOD DotsPerByte]);
+	Rmask := INOTB (KeepL[x1 MOD DotsPerByte]);
+	IF middlecount = 0 THEN
+	    INC (Lmask, Rmask);  Rmask := 0;
+	END (*IF*);
+
+	IF Lmask = BYTE(0) THEN
+	    INC (middlecount);
+	ELSE
+	    Lfill := IANDB (INOTB(Lmask), fillvalue);
+	END (*IF*);
+
+	IF Rmask <> BYTE(0) THEN
+	    DEC (middlecount);
+	    Rfill := IANDB (INOTB(Rmask), fillvalue);
+	END (*IF*);
+
+	loc.high := ScreenSeg;
+
+	FOR y := y0 TO y1 DO
+
+	    (* Turn the (x0,y) coordinates into an address in	*)
+	    (* the video memory.				*)
+
+	    loc.offset := LineStart[y].offset+firstcol;
+
+	    (* Fix up the bits in the first partial column, if any.	*)
+
+	    IF Lmask <> BYTE(0) THEN
+		loc.pb^ := IORB(IANDB(loc.pb^, Lmask),Lfill);
+		INC (loc.offset);
+	    END (*IF*);
+
+	    (* Fill up the middle columns.	*)
+
+	    IF middlecount > 0 THEN
+		BlockFill (loc.pb, middlecount, fillvalue);
+		INC (loc.offset, middlecount);
+	    END (*IF*);
+
+	    (* Fix up the bits in the last partial column, if any.	*)
+
+	    IF Rmask <> BYTE(0) THEN
+		loc.pb^ := IORB(IANDB(loc.pb^, Rmask),Rfill);
+	    END (*IF*);
+
+	END (*FOR*);
+
+    END Fill0;
+
+(************************************************************************)
+
+PROCEDURE Fill (x0, y0, x1, y1: CARDINAL;  colour: ColourType);
+
+    (* Fills a rectangle with the indicated colour.  The rectangle is	*)
+    (* specified by giving two opposite corners (x0,y0) and (x1,y1).	*)
+
+    VAR temp: CARDINAL;
+
+    BEGIN
+	IF BLorigin THEN
+	    WITH ModeData DO
+		y0 := MaxY - y0;
+		y1 := MaxY - y1;
+	    END (*WITH*);
+	END (*IF*);
+	IF x0 > x1 THEN
+	    temp := x0;  x0 := x1;  x1 := temp;
+	END (*IF*);
+	IF y0 > y1 THEN
+	    temp := y0;  y0 := y1;  y1 := temp;
+	END (*IF*);
+	FillProc (x0, y0, x1, y1, colour);
+    END Fill;
+
+(************************************************************************)
+(*			SETTING THE 256 COLOUR PALETTE			*)
+(************************************************************************)
+
+PROCEDURE SetPaletteColour (Palette_Index, Red, Green, Blue: SHORTCARD);
+
+    (* Sets the colour for one palette register.  Applicable only to	*)
+    (* VGA or better.							*)
+
+    (* This procedure has apparently been observed to fail on a		*)
+    (* Trident 9000C, though I haven't observed this myself.  Possibly	*)
+    (* a problem of accessing the registers too quickly.  Apparently	*)
+    (* a delay of 240 ns is needed between accesses to the PEL data	*)
+    (* register.							*)
+
+    VAR old_clock_value: SHORTCARD;
+
+    BEGIN
+	(* First disable the screen before the palette change. *)
+(*
+        OutByte(03C4H,1);
+        old_clock_value := InByte(03C5H);
+        OutByte(03C5H,IANDB(old_clock_value,254));
+*)
+
+	(* Now load the desired colour combination. *)
+
+	OutByte(03C8H, Palette_Index);
+	OutByte(03C9H, IANDB(Red,63));
+	OutByte(03C9H, IANDB(Green,63));
+	OutByte(03C9H, IANDB(Blue,63));
+
+	(* Re-enable the screen. *)
+
+	(* OutByte(03C5H,old_clock_value); *)
+
+    END SetPaletteColour;
+
+(************************************************************************)
+(*									*)
+(*			PLOTTING STRAIGHT LINES				*)
+(*									*)
+(************************************************************************)
+(*									*)
+(*  In the following group of procedures, a line is specified by giving	*)
+(*  one point on it, a Boolean goingdown, and the slope deltay/deltax,	*)
+(*  where deltax and deltay are nonnegative integers.  We always draw	*)
+(*  lines from left to right, and the vertical direction is defined by	*)
+(*  goingdown.  The "current point" is represented by a triple		*)
+(*  (x,y,ScaledError).  The integer ScaledError is a measure of how far	*)
+(*  the discretized point is from the true straight line; it is		*)
+(*  implicitly calculated as						*)
+(*		(y-y0)*deltax - (x-x0)*deltay				*)
+(*  where (x0,y0) is a point which lies precisely on the line.  When	*)
+(*  drawing a line which is partly hidden, we have to pass ScaledError	*)
+(*  from one procedure to another, and for this to work we must use	*)
+(*  the same deltax and deltay for each segment of the line.  This is	*)
+(*  the main reason for passing deltax, deltay, and goingdown as	*)
+(*  procedure parameters rather than calculating them internally from	*)
+(*  the endpoints.							*)
+(*									*)
+(*  For efficiency, these procedures do not call PlotDot; instead, they	*)
+(*  do the equivalent operations internally.  Although this produces	*)
+(*  some code redundancy, the consequent gain in speed is worthwhile.	*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE VisibleLine64K (xcurrent, ycurrent: CARDINAL;  ScaledError: INTEGER;
+			deltax, deltay, xlimit, ylimit: CARDINAL;
+			goingdown: BOOLEAN;  colour: ColourType);
+
+    (* Plots a straight line of slope deltay/deltax starting from	*)
+    (* (xcurrent,ycurrent,ScaledError).  This procedure is used only	*)
+    (* for the direct colour modes using two bytes per pixel.  For	*)
+    (* details about the parameters, etc., see procedure VisibleLine0.	*)
+
+    VAR xthreshold, ythreshold, OldError: INTEGER;
+	M1, temp: CARDINAL;
+	PixelLocation: ScreenLocation;
+
+    BEGIN
+
+	WITH ModeData DO
+	    M1 := BytesPerRow;
+	    IF BLorigin THEN temp := MaxY - ycurrent
+	    ELSE temp := ycurrent
+	    END (*IF*);
+	END (*WITH*);
+
+	(* Plot the initial point. *)
+
+	WITH PixelLocation DO
+	    L := LineStart[temp].L + Mul(2,xcurrent);
+	    bank := high;  high := ScreenSeg;
+	    SelectWriteBank (bank);
+	    pw^ := colour;
+	END (*WITH*);
+
+	IF (deltax = 0) AND (deltay = 0) THEN RETURN END(*IF*);
+
+	xthreshold := INTEGER(deltay DIV 2) - INTEGER(deltax);
+	ythreshold := INTEGER(deltay) - INTEGER(deltax DIV 2);
+
+	(* Now, here is the main part of the line algorithm.  Each time	*)
+	(* around the loop we decide in which direction to move for the	*)
+	(* next point. and then plot that point.			*)
+
+	LOOP
+	    OldError := ScaledError;
+
+	    (* Increment x, if appropriate. *)
+
+	    IF OldError > xthreshold THEN
+		IF xcurrent = xlimit THEN EXIT(*LOOP*) END(*IF*);
+		DEC (ScaledError, deltay);
+		INC (xcurrent);
+		WITH PixelLocation DO
+		    IF INCV (offset, 2) THEN
+			INC (bank);
+			SelectWriteBank (bank);
+		    END (*IF*);
+		END (*WITH*);
+	    END (*IF*);
+
+	    (* Increment or decrement y, if appropriate. *)
+
+	    IF OldError < ythreshold THEN
+		IF ycurrent = ylimit THEN EXIT(*LOOP*) END(*IF*);
+		INC (ScaledError, deltax);
+		IF goingdown THEN
+		    IF BLorigin THEN DEC(ycurrent) ELSE INC(ycurrent) END(*IF*);
+		    WITH PixelLocation DO
+			IF INCV (offset, M1) THEN
+			    INC (bank);
+			    SelectWriteBank (bank);
+			END (*IF*);
+		    END (*WITH*);
+		ELSE			(* NOT goingdown*)
+		    IF BLorigin THEN INC(ycurrent) ELSE DEC(ycurrent) END(*IF*);
+		    WITH PixelLocation DO
+			IF DECV (offset, M1) THEN
+			    DEC (bank);
+			    SelectWriteBank (bank);
+			END (*IF*);
+		    END (*WITH*);
+		END (*IF*);
+	    END (*IF*);
+
+	    (* Plot the new point *)
+
+	    PixelLocation.pw^ := colour;
+
+	END (*LOOP*);
+
+    END VisibleLine64K;
+
+(************************************************************************)
+
+PROCEDURE VisibleLinePlanar (xcurrent, ycurrent: CARDINAL;
+			ScaledError: INTEGER;
+			deltax, deltay, xlimit, ylimit: CARDINAL;
+			goingdown: BOOLEAN;  colour: ColourType);
+
+    (* For details about parameters, etc., see VisibleLine0 below.	*)
+    (* This is a specialised version for the planar modes.  We single	*)
+    (* out the planar modes for special treatment because there are	*)
+    (* several such modes, they are popular, and therefore it is	*)
+    (* worthwhile speeding up this case.				*)
+
+    CONST DotsPerByte = 8;
+
+    VAR xthreshold, ythreshold, OldError: INTEGER;
+	mask0, mask: BYTE;
+	M1, temp: CARDINAL;
+	PixelLocation: ScreenLocation;
+
+    BEGIN
+	OutByte (3CEH, 0);  OutByte (3CFH, VAL(BYTE,colour));
+	OutByte (3CEH, 8);
+	mask0 := Mask2[0];
+	mask := Mask2[xcurrent MOD DotsPerByte];
+
+	WITH ModeData DO
+	    M1 := BytesPerRow;
+	    IF BLorigin THEN
+		temp := MaxY - ycurrent;
+	    ELSE
+		temp := ycurrent;
+	    END (*IF*);
+	END (*WITH*);
+
+	(* Plot the initial point. *)
+
+	WITH PixelLocation DO
+	    IF ModeData.MultiBank THEN
+		L := LineStart[temp].L + LONGCARD(xcurrent DIV DotsPerByte);
+		bank := high;
+		SelectWriteBank (bank);
+		SelectReadBank (bank);
+	    ELSE
+		offset := LineStart[temp].offset + xcurrent DIV DotsPerByte;
+		bank := 0;
+	    END (*IF*);
+	    high := ScreenSeg;
+	    OutByte (3CFH, mask);
+	    pb^ := pb^;
+	END (*WITH*);
+
+	IF (deltax = 0) AND (deltay = 0) THEN RETURN END(*IF*);
+
+	xthreshold := INTEGER(deltay DIV 2) - INTEGER(deltax);
+	ythreshold := INTEGER(deltay) - INTEGER(deltax DIV 2);
+
+	(* Now, here is the main part of the line algorithm.  Each time	*)
+	(* around the loop we decide in which direction to move for the	*)
+	(* next point. and then plot that point.			*)
+
+	LOOP
+	    OldError := ScaledError;
+
+	    (* Increment x, if appropriate. *)
+
+	    IF OldError > xthreshold THEN
+		IF xcurrent = xlimit THEN EXIT(*LOOP*) END(*IF*);
+		DEC (ScaledError, deltay);
+		INC (xcurrent);
+		mask := RSB (mask, 1);
+		IF mask = BYTE(0) THEN
+		    mask := mask0;
+		    WITH PixelLocation DO
+			IF INCV (offset, 1) THEN
+			    INC (bank);
+			    SelectWriteBank (bank);
+			    SelectReadBank (bank);
+			END (*IF*);
+		    END (*WITH*);
+		END (*IF*);
+	    END (*IF*);
+
+	    (* Increment or decrement y, if appropriate. *)
+
+	    IF OldError < ythreshold THEN
+		IF ycurrent = ylimit THEN EXIT(*LOOP*) END(*IF*);
+		INC (ScaledError, deltax);
+		IF goingdown THEN
+		    IF BLorigin THEN DEC(ycurrent) ELSE INC(ycurrent) END(*IF*);
+		    WITH PixelLocation DO
+			IF INCV (offset, M1) THEN
+			    INC (bank);
+			    SelectWriteBank (bank);
+			    SelectReadBank (bank);
+			END (*IF*);
+		    END (*WITH*);
+		ELSE			(* NOT goingdown*)
+		    IF BLorigin THEN INC(ycurrent) ELSE DEC(ycurrent) END(*IF*);
+		    WITH PixelLocation DO
+			IF DECV (offset, M1) THEN
+			    DEC (bank);
+			    SelectWriteBank (bank);
+			    SelectReadBank (bank);
+			END (*IF*);
+		    END (*WITH*);
+		END (*IF*);
+	    END (*IF*);
+
+	    (* Plot the new point *)
+
+	    OutByte (3CFH, mask);
+	    PixelLocation.pb^ := PixelLocation.pb^;
+
+	END (*LOOP*);
+
+    END VisibleLinePlanar;
+
+(************************************************************************)
+
+PROCEDURE VisibleLine0 (xcurrent, ycurrent: CARDINAL;  ScaledError: INTEGER;
+			deltax, deltay, xlimit, ylimit: CARDINAL;
+			goingdown: BOOLEAN;  colour: ColourType);
+
+    (* Plots a straight line of slope deltay/deltax starting from	*)
+    (* (xcurrent,ycurrent,ScaledError).  The method used is a variant	*)
+    (* of Bresenham's algorithm.  Stops plotting when xcurrent is about	*)
+    (* to step beyond xlimit or when ycurrent is about to step beyond	*)
+    (* ylimit.  It is assumed that the input data have been		*)
+    (* pre-processed to ensure that the initial point does not violate	*)
+    (* the bounds, and that there is no risk of plotting a point	*)
+    (* outside the range of the screen.					*)
+
+    (* This version of the procedure works for all non-planar modes	*)
+    (* which use one byte or less per pixel.				*)
+
+    VAR xthreshold, ythreshold, OldError: INTEGER;
+	mask0, mask, fill: BYTE;
+	M1, D1, temp, frame, framewrap, DotsPerByte: CARDINAL;
+	PixelLocation: ScreenLocation;
+
+    BEGIN
+
+	WITH ModeData DO
+	    M1 := BytesPerRow;  D1 := FramesPerScreen;
+	    IF D1 <> 1 THEN
+		framewrap := 8192*(D1-1) - M1;
+	    END (*IF*);
+	    DotsPerByte := 8 DIV BitsPerPixel;
+
+	    IF MaxColour < 16 THEN
+		fill := FillArray[colour];
+	    END (*IF*);
+
+	    mask0 := Mask[0];
+	    mask := Mask[xcurrent MOD DotsPerByte];
+
+	    IF BLorigin THEN
+		temp := MaxY - ycurrent;
+	    ELSE
+		temp := ycurrent;
+	    END (*IF*);
+
+	END (*WITH*);
+
+	(* Plot the initial point. *)
+
+	WITH PixelLocation DO
+	    IF ModeData.MultiBank THEN
+		frame := 0;
+		L := LineStart[temp].L + LONGCARD(xcurrent DIV DotsPerByte);
+		bank := high;
+		SelectWriteBank (bank);
+		IF DotsPerByte > 1 THEN
+		    SelectReadBank (bank);
+		END (*IF*);
+	    ELSE
+		frame := temp MOD D1;
+		offset := LineStart[temp].offset + xcurrent DIV DotsPerByte;
+		bank := 0;
+	    END (*IF*);
+	    high := ScreenSeg;
+
+	    IF DotsPerByte = 1 THEN
+		pb^ := VAL(SHORTCARD,colour);
+	    ELSE
+		pb^ := IANDB (pb^, INOTB(mask)) + IANDB (mask, fill);
+	    END (*IF*);
+	END (*WITH*);
+
+	IF (deltax = 0) AND (deltay = 0) THEN RETURN END(*IF*);
+
+	xthreshold := INTEGER(deltay DIV 2) - INTEGER(deltax);
+	ythreshold := INTEGER(deltay) - INTEGER(deltax DIV 2);
+
+	(* Now, here is the main part of the line algorithm.  Each time	*)
+	(* around the loop we decide in which direction to move for the	*)
+	(* next point. and then plot that point.			*)
+
+	LOOP
+	    OldError := ScaledError;
+
+	    (* Increment x, if appropriate. *)
+
+	    IF OldError > xthreshold THEN
+		IF xcurrent = xlimit THEN EXIT(*LOOP*) END(*IF*);
+		DEC (ScaledError, deltay);
+		INC (xcurrent);
+		mask := RSB (mask, ModeData.BitsPerPixel);
+		IF mask = BYTE(0) THEN
+		    mask := mask0;
+		    WITH PixelLocation DO
+			IF INCV (offset, 1) THEN
+			    INC (bank);
+			    SelectWriteBank (bank);
+			    IF DotsPerByte > 1 THEN
+				SelectReadBank (bank);
+			    END (*IF*);
+			END (*IF*);
+		    END (*WITH*);
+		END (*IF*);
+	    END (*IF*);
+
+	    (* Increment or decrement y, if appropriate. *)
+
+	    IF OldError < ythreshold THEN
+		IF ycurrent = ylimit THEN EXIT(*LOOP*) END(*IF*);
+		INC (ScaledError, deltax);
+		IF goingdown THEN
+		    IF BLorigin THEN DEC(ycurrent) ELSE INC(ycurrent) END(*IF*);
+		    IF D1 = 1 THEN
+			IF INCV (PixelLocation.offset, M1) THEN
+			    INC (PixelLocation.bank);
+			    SelectWriteBank (PixelLocation.bank);
+			    IF DotsPerByte > 1 THEN
+				SelectReadBank (PixelLocation.bank);
+			    END (*IF*);
+			END (*IF*);
+		    ELSIF frame = D1-1 THEN
+			frame := 0;
+			DEC (PixelLocation.offset, framewrap);
+		    ELSE
+			INC (frame);
+			INC (PixelLocation.offset, 8192);
+		    END (*IF*);
+		ELSE			(* NOT goingdown*)
+		    IF BLorigin THEN INC(ycurrent) ELSE DEC(ycurrent) END(*IF*);
+		    IF D1 = 1 THEN
+			IF DECV (PixelLocation.offset, M1) THEN
+			    DEC (PixelLocation.bank);
+			    SelectWriteBank (PixelLocation.bank);
+			    IF DotsPerByte > 1 THEN
+				SelectReadBank (PixelLocation.bank);
+			    END (*IF*);
+			END (*IF*);
+		    ELSIF frame = 0 THEN
+			frame := D1-1;
+			INC (PixelLocation.offset, framewrap);
+		    ELSE
+			DEC (frame);
+			DEC (PixelLocation.offset, 8192);
+		    END (*IF*);
+		END (*IF*);
+	    END (*IF*);
+
+	    (* Plot the new point *)
+
+	    IF DotsPerByte = 1 THEN
+		PixelLocation.pb^ := VAL(SHORTCARD,colour);
+	    ELSE
+		PixelLocation.pb^ := IANDB (PixelLocation.pb^, INOTB(mask))
+						+ IANDB (mask, fill);
+	    END (*IF*);
+
+	END (*LOOP*);
+
+    END VisibleLine0;
+
+(************************************************************************)
+(*
+PROCEDURE OldVisibleLine (xcurrent, ycurrent: CARDINAL;  ScaledError: INTEGER;
+			deltax, deltay, xlimit, ylimit: CARDINAL;
+			goingdown: BOOLEAN;  colour: CARDINAL);
+
+    (* Plots a straight line of slope deltay/deltax starting from	*)
+    (* (xcurrent,ycurrent,ScaledError).  The method used is a variant	*)
+    (* of Bresenham's algorithm.  Stops plotting when xcurrent is about	*)
+    (* to step beyond xlimit or when ycurrent is about to step beyond	*)
+    (* ylimit.  It is assumed that the input data have been		*)
+    (* pre-processed to ensure that the initial point does not violate	*)
+    (* the bounds, and that there is no risk of plotting a point	*)
+    (* outside the range of the screen.					*)
+
+    (* This procedure is no longer used, but is left here as internal	*)
+    (* documentation: it uses the same logic as the more efficient	*)
+    (* versions above, and is easier to read.				*)
+
+    VAR xthreshold, ythreshold, OldError: INTEGER;
+
+    BEGIN
+
+	(* Plot the initial point. *)
+
+	PlotDot (xcurrent, ycurrent, colour);
+	IF (deltax = 0) AND (deltay = 0) THEN RETURN END(*IF*);
+
+	xthreshold := INTEGER(deltay DIV 2) - INTEGER(deltax);
+	ythreshold := INTEGER(deltay) - INTEGER(deltax DIV 2);
+
+	(* Now, here is the main part of the line algorithm.  Each time	*)
+	(* around the loop we decide in which direction to move for the	*)
+	(* next point. and then plot that point.			*)
+
+	LOOP
+	    OldError := ScaledError;
+	    IF OldError > xthreshold THEN
+		IF xcurrent = xlimit THEN EXIT(*LOOP*) END(*IF*);
+		DEC (ScaledError, deltay);
+		INC (xcurrent);
+	    END (*IF*);
+	    IF OldError < ythreshold THEN
+		IF ycurrent = ylimit THEN EXIT(*LOOP*) END(*IF*);
+		INC (ScaledError, deltax);
+		IF goingdown = BLorigin THEN
+		    DEC (ycurrent);
+		ELSE
+		    INC (ycurrent);
+		END (*IF*);
+	    END (*IF*);
+	    PlotDot (xcurrent, ycurrent, colour);
+	END (*LOOP*);
+
+    END OldVisibleLine;
+*)
+(************************************************************************)
+
+PROCEDURE MoveToX (x0, y0, deltax, deltay, X: CARDINAL;  goingdown: BOOLEAN;
+			VAR (*OUT*) ScaledError: INTEGER): CARDINAL;
+
+    (* For the line starting at (x0,y0) of slope deltay/deltax, returns	*)
+    (* the first y for which the discrete approximation to the line	*)
+    (* hits x=X.  Also calculates the ScaledError at that point.	*)
+
+    VAR result: LONGINT;
+	longX, longdx, longdy: LONGINT;
+
+    BEGIN
+	(* Shift the origin. *)
+
+	DEC (X, x0);
+
+	(* The calculations below produce CARDINAL or INTEGER results,	*)
+	(* but a greater range is needed for the temporary values after	*)
+	(* each multiplication.  This is one of those unfortunate cases	*)
+	(* where something which can be expressed clearly and concisely	*)
+	(* in assembly language becomes obscure when written in a	*)
+	(* high-level language.  The Modula-2 rules on assignment	*)
+	(* compatibility don't help, either.				*)
+
+	longX := LONGCARD(X);
+	longdx := LONGCARD(deltax);  longdy := LONGCARD(deltay);
+	
+	(* We have to use a different method depending on whether the	*)
+	(* line slope is greater or less than 1.			*)
+
+	IF deltay <= deltax THEN
+	    result := (2*longX*longdy + longdx - 1) DIV (2*longdx)
+	ELSE
+	    result := (2*longX - 1)*longdy DIV (2*longdx) + 1
+	END (*IF*);
+
+	ScaledError := INTEGER(result*longdx - longX*longdy);
+
+	(* Reverse the origin shift. *)
+
+	IF goingdown = BLorigin THEN RETURN y0-CARDINAL(result)
+	ELSE RETURN y0+CARDINAL(result);
+	END (*IF*);
+
+    END MoveToX;
+
+(************************************************************************)
+
+PROCEDURE MoveToY (x0, y0, deltax, deltay, Y: CARDINAL;  goingdown: BOOLEAN;
+			VAR (*OUT*) ScaledError: INTEGER): CARDINAL;
+
+    (* For the line starting at (x0,y0) of slope deltay/deltax, returns	*)
+    (* the first x for which the discrete approximation to the line	*)
+    (* hits y=Y.  Also calculates the ScaledError at that point.	*)
+
+    VAR result: LONGINT;
+	longY, longdx, longdy: LONGINT;
+
+    BEGIN
+	(* Shift the origin. *)
+
+	IF goingdown=BLorigin THEN Y := y0 - Y ELSE DEC (Y, y0) END(*IF*);
+
+	longY := LONGINT(Y);
+	longdx := LONGINT(deltax);  longdy := LONGINT(deltay);
+
+	(* We have to use a different method depending on whether the	*)
+	(* line slope is greater or less than 1.			*)
+
+	IF deltay <= deltax THEN
+	    result := (2*longY - 1)*longdx DIV (2*longdy) + 1
+	ELSE
+	    result := (2*longY*longdx + longdy - 1) DIV (2*longdy)
+	END (*IF*);
+	ScaledError := INTEGER(longY*longdx - result*longdy);
+
+	(* Reverse the origin shift. *)
+
+	RETURN VAL(CARDINAL,result)+x0;
+
+    END MoveToY;
+
+(************************************************************************)
+
+PROCEDURE PlotLine (x0, y0, x1, y1: CARDINAL;  colour: ColourType);
+
+    (* Plots a straight line from (x0,y0) to (x1,y1).  It is the	*)
+    (* caller's responsibility to ensure that the coordinates are in	*)
+    (* range for the current video mode.				*)
+
+    VAR temp, deltay: CARDINAL;
+	goingdown: BOOLEAN;
+
+    BEGIN
+
+	(* First, ensure that we are working in the +X direction.	*)
+
+	IF x1 < x0 THEN
+	    temp := x1;  x1 := x0;  x0 := temp;
+	    temp := y1;  y1 := y0;  y0 := temp;
+	END (*IF*);
+
+	(* Check the Y direction. *)
+
+	IF y1 >= y0 THEN
+	    goingdown := NOT BLorigin;  deltay := y1 - y0;
+	ELSE
+	    goingdown := BLorigin;  deltay := y0 - y1;
+	END (*IF*);
+
+	(* Draw the line.*)
+
+	VisibleLine (x0, y0, 0, x1-x0, deltay, x1, y1, goingdown, colour);
+
+    END PlotLine;
+
+(************************************************************************)
+
+PROCEDURE PlotRectangle (R: Rectangle;  colour: ColourType);
+
+    (* Plots a rectangle, with clipping if necessary to keep the	*)
+    (* points within the screen boundary.				*)
+
+    VAR leftOK, rightOK, topOK, bottomOK: BOOLEAN;
+
+    BEGIN
+	WITH R DO
+	    WITH ModeData DO
+		IF (left > INTEGER(MaxX)) OR (right < 0)
+			OR (bottom > INTEGER(MaxY)) OR (top < 0) THEN RETURN;
+		END (*IF*);
+		leftOK := TRUE;  rightOK := TRUE;
+		topOK := TRUE;  bottomOK := TRUE;
+		IF left < 0 THEN
+		    left := 0;  leftOK := FALSE;
+		END(*IF*);
+		IF right > INTEGER(MaxX) THEN
+		    right := INTEGER(MaxX);  rightOK := FALSE;
+		END(*IF*);
+		IF bottom < 0 THEN
+		    bottom := 0;  bottomOK := FALSE;
+		END(*IF*);
+		IF top > INTEGER(MaxY) THEN
+		    top := INTEGER(MaxY);  topOK := FALSE;
+		END(*IF*);
+	    END (*WITH*);
+	    IF leftOK THEN
+		PlotLine (left, bottom, left, top, colour);
+	    END(*IF*);
+	    IF rightOK THEN
+		PlotLine (right, bottom, right, top, colour);
+	    END(*IF*);
+	    IF bottomOK THEN
+		PlotLine (left, bottom, right, bottom, colour);
+	    END(*IF*);
+	    IF topOK THEN
+		PlotLine (left, top, right, top, colour);
+	    END(*IF*);
+	END (*WITH*);
+    END PlotRectangle;
+
+(************************************************************************)
+
+PROCEDURE ClippedLine (x0, y0, x1, y1: CARDINAL;  colour: ColourType;
+			left, right, ymin, ymax: CARDINAL);
+
+    (* Like PlotLine, but plots only that part of the line which lies	*)
+    (* in the rectangle (left <= x <= right), (ymin <= y <= ymax).	*)
+    (* The caller is expected to ensure, by appropriate definition of	*)
+    (* the rectangle, that all plotted points are in range for the	*)
+    (* current video mode.						*)
+
+    VAR temp, deltax, deltay, xlimit, ylimit: CARDINAL;
+	goingdown: BOOLEAN;
+	ScaledError: INTEGER;
+
+    BEGIN
+
+	(* First, ensure that we are working in the +X direction; and	*)
+	(* check the Y direction.					*)
+
+	IF x1 < x0 THEN
+	    temp := x1;  x1 := x0;  x0 := temp;
+	    temp := y1;  y1 := y0;  y0 := temp;
+	END (*IF*);
+	IF BLorigin THEN
+	    goingdown := y1 < y0;
+	ELSE
+	    goingdown := y0 < y1;
+	END (*IF*);
+
+	(* Eliminate some (but not all) cases where we are going to	*)
+	(* miss the rectangle entirely.  Also calculate the slope and	*)
+	(* boundary parameters.						*)
+
+	IF x1 < left THEN RETURN END(*IF*);
+	ylimit := y1;
+	IF goingdown = BLorigin THEN
+	    IF (y0 < ymin) OR (y1 > ymax) THEN RETURN END(*IF*);
+	    deltay := y0 - y1;
+	    IF ylimit < ymin THEN ylimit := ymin END(*IF*);
+	ELSE
+	    IF (y0 > ymax) OR (y1 < ymin) THEN RETURN END(*IF*);
+	    deltay := y1 - y0;
+	    IF ylimit > ymax THEN ylimit := ymax END(*IF*);
+	END (*IF*);
+
+	deltax := x1 - x0;
+	xlimit := x1;
+	IF xlimit > right THEN xlimit := right END(*IF*);
+
+	(* We've now extracted all we need to know about the target	*)
+	(* point.  From here on, we use (x1,y1,ScaledError) to		*)
+	(* represent the current point.					*)
+
+	x1 := x0;  y1 := y0;  ScaledError := 0;
+
+	(* Step up to the left boundary, if we're at the left of it.	*)
+
+	IF x0 < left THEN
+	    x1 := left;
+	    y1 := MoveToX (x0, y0, deltax, deltay, left,
+						goingdown, ScaledError);
+	END (*IF*);
+
+	(* We might not yet have hit the rectangle.	*)
+
+	IF goingdown = BLorigin THEN
+	    IF y1 < ymin THEN RETURN END(*IF*);
+	    IF y1 > ymax THEN
+		x1 := MoveToY (x0, y0, deltax, deltay, ymax,
+					goingdown, ScaledError);
+		y1 := ymax;
+	    END (*IF*);
+	ELSE
+	    IF y1 > ymax THEN RETURN END(*IF*);
+	    IF y1 < ymin THEN
+		x1 := MoveToY (x0, y0, deltax, deltay, ymin,
+					goingdown, ScaledError);
+		y1 := ymin;
+	    END (*IF*);
+	END (*IF*);
+
+	(* Check whether we missed the rectangle entirely.	*)
+
+	IF x1 > right THEN RETURN END (*IF*);
+
+	(* At last, we have something to plot.	*)
+
+	VisibleLine (x1, y1, ScaledError, deltax, deltay,
+					xlimit, ylimit, goingdown, colour);
+
+    END ClippedLine;
+
+(************************************************************************)
+(*			PUTTING A MARK AT A POINT			*)
+(************************************************************************)
+
+PROCEDURE PlotMark (x, y: CARDINAL;
+			colour: ColourType;  pointtype: SHORTCARD);
+
+    (* Writes a symbol at screen position (x, y).	*)
+
+    BEGIN
+	CASE pointtype OF
+	    1:	PlotLine (x-1,y-1,x+1,y+1, colour);	(*  X	*)
+		PlotLine (x+1,y-1,x-1,y+1, colour);
+	  |
+	    2:	PlotLine (x-2,y-1,x+2,y-1, colour);	(* box	*)
+		PlotLine (x+2,y-1,x+2,y+1, colour);
+		PlotLine (x+2,y+1,x-2,y+1, colour);
+		PlotLine (x-2,y+1,x-2,y-1, colour);
+	  |
+	    ELSE
+		PlotDot (x, y, colour);			(* point *)
+	END (*CASE*);
+    END PlotMark;
+
+(************************************************************************)
+(*			    DRAWING CHARACTERS				*)
+(************************************************************************)
+
+PROCEDURE FontAddress (ch: CHAR): FarBytePointer;
+
+    (* Returns the address of the font table entry for ch.	*)
+
+    BEGIN
+	IF ORD(ch) < 128 THEN
+	    RETURN FarAddOffset (FontAddress0,
+				(ModeData.LastCharRow+1)*ORD(ch));
+	ELSE
+	    RETURN FarAddOffset (FontAddress1,
+				(ModeData.LastCharRow+1)*(ORD(ch)-128));
+	END (*IF*);
+    END FontAddress;
+
+(************************************************************************)
+
+PROCEDURE MakeCode (ch: CHAR;  row: CARDINAL): BYTE;
+
+    (* Returns a bit pattern for one scan row of ch. *)
+
+    VAR fontptr: FarBytePointer;
+
+    BEGIN
+	IF ORD(ch) < 128 THEN
+	    fontptr := FarAddOffset (FontAddress0,
+			(ModeData.LastCharRow+1)*ORD(ch) + row);
+	ELSE
+	    fontptr := FarAddOffset (FontAddress1,
+			(ModeData.LastCharRow+1)*(ORD(ch)-128) + row);
+	END (*IF*);
+	RETURN fontptr^;
+    END MakeCode;
+
+(************************************************************************)
+
+PROCEDURE DrawChar (ch: CHAR;  x, y: CARDINAL;  colour: ColourType);
+
+    (* Draws the single character ch.  The coordinates (x,y) are the	*)
+    (* location of the bottom left of the character.			*)
+
+    VAR fontptr: FarBytePointer;  i: CARDINAL;
+
+    BEGIN
+	IF BLorigin THEN INC (y, ModeData.LastCharRow)
+	ELSE DEC (y, ModeData.LastCharRow)
+	END (*IF*);
+	fontptr := FontAddress (ch);
+	FOR i := 0 TO ModeData.LastCharRow DO
+	    PlotPattern (fontptr^, x, y, colour);
+	    IF BLorigin THEN DEC(y) ELSE INC(y) END(*IF*);
+	    fontptr := FarAddOffset (fontptr, 1);
+	END (*FOR*);
+    END DrawChar;
+
+(************************************************************************)
+
+PROCEDURE ClippedChar (ch: CHAR;  x, y: CARDINAL;  colour: ColourType;
+			left, right, ymin, ymax: CARDINAL);
+
+    (* Like DrawChar, but excludes those parts of the character which	*)
+    (* fall outside the given clip rectangle.				*)
+
+    VAR fontptr: FarBytePointer;  i: CARDINAL;
+	mask, Rmask: BYTE;
+
+    BEGIN
+	(* Eliminate the trivial cases.	*)
+
+	IF BLorigin THEN
+	    IF (x > right) OR (x+7 < left)
+			OR (y > ymax) OR (y+ModeData.LastCharRow < ymin) THEN
+		RETURN;
+	    END (*IF*);
+	ELSE
+	    IF (x > right) OR (x+7 < left)
+			OR (y > ymax) OR (y-ModeData.LastCharRow < ymin) THEN
+		RETURN;
+	    END (*IF*);
+	END (*IF*);
+
+	(* Check for going beyond the right boundary. *)
+
+	Rmask := 0FFH;
+	IF x+7 > right THEN
+	    Rmask := LSB (0FFH, x+7-right);
+	END(*IF*);
+
+	(* Check for the case of a character clipped at the left side.	*)
+
+	mask := 0FFH;
+	IF x < left THEN
+	    mask := RSB (mask, left - x);
+	END (*IF*);
+	mask := IANDB (mask, Rmask);
+
+	(* Establish the desired vertical range.	*)
+
+	IF BLorigin THEN
+	    IF y > ymin THEN ymin := y END(*IF*);
+	ELSE
+	    IF y < ymax THEN ymax := y END(*IF*);
+	END (*IF*);
+	fontptr := FontAddress (ch);
+	IF BLorigin THEN INC (y, ModeData.LastCharRow)
+	ELSE DEC (y, ModeData.LastCharRow)
+	END (*IF*);
+
+	(* Check for a character clipped at the top.	*)
+
+	IF BLorigin THEN
+	    IF y <= ymax THEN
+		ymax := y;
+	    ELSE
+		fontptr := FarAddOffset (fontptr, y-ymax);
+	    END (*IF*);
+	ELSE
+	    IF y >= ymin THEN
+		ymin := y;
+	    ELSE
+		fontptr := FarAddOffset (fontptr, ymin-y);
+	    END (*IF*);
+	END (*IF*);
+
+	(* The following loop steps through bytes in the font table,	*)
+	(* while stepping downwards on the screen.			*)
+
+	IF BLorigin THEN
+	    FOR i := ymax TO ymin BY -1 DO
+		PlotPattern (IANDB(fontptr^,mask), x, i, colour);
+		fontptr := FarAddOffset (fontptr, 1);
+	    END (*FOR*);
+	ELSE
+	    FOR i := ymin TO ymax DO
+		PlotPattern (IANDB(fontptr^,mask), x, i, colour);
+		fontptr := FarAddOffset (fontptr, 1);
+	    END (*FOR*);
+	END (*IF*);
+
+    END ClippedChar;
+
+(************************************************************************)
+
+PROCEDURE DrawCharUp (ch: CHAR;  x, y: CARDINAL;  colour: ColourType);
+
+    (* Draws the single character ch sideways.  The coordinates (x,y)	*)
+    (* are the location of the bottom left of the unrotated character,	*)
+    (* or equivalently the bottom right of the character as plotted.	*)
+
+    VAR fontptr: FarBytePointer;  pattern: SHORTCARD;
+	i, j: CARDINAL;
+
+    BEGIN
+	fontptr := FontAddress (ch);
+	FOR i := 0 TO ModeData.LastCharRow DO
+	    pattern := fontptr^;
+	    FOR j := 0 TO 7 DO
+		IF ODD(pattern) THEN
+		    IF BLorigin THEN
+			PlotDot (x+i-7, y+7-j, colour);
+		    ELSE
+			PlotDot (x+i-7, y-7+j, colour);
+		    END (*IF*);
+		END (*IF*);
+		pattern := pattern DIV 2;
+	    END (*FOR*);
+	    fontptr := FarAddOffset (fontptr, 1);
+	END (*FOR*);
+    END DrawCharUp;
+
+(************************************************************************)
+
+PROCEDURE ClippedCharUp (ch: CHAR;  x, y: CARDINAL;  colour: ColourType;
+			left, right, ymin, ymax: CARDINAL);
+
+    (* Like DrawCharUp, but excludes those parts of the character which	*)
+    (* fall outside the given clip rectangle.				*)
+
+    VAR fontptr: FarBytePointer;  pattern, mask: BYTE;
+	ystart: CARDINAL;
+
+    BEGIN
+	(* Eliminate the trivial cases.	*)
+
+	IF BLorigin THEN
+	    IF (x > right+ModeData.LastCharRow) OR (x < left)
+			OR (y > ymax) OR (y+7 < ymin) THEN
+		RETURN;
+	    END (*IF*);
+	ELSE
+	    IF (x > right+ModeData.LastCharRow) OR (x < left)
+			OR (y < ymin) OR (y-7 > ymax) THEN
+		RETURN;
+	    END (*IF*);
+	END (*IF*);
+
+	ystart := y;  mask := 128;
+
+	(* Check for the case of a character clipped at the side.	*)
+
+	IF BLorigin THEN
+	    IF ystart+7 < ymax THEN ymax := ystart+7 END(*IF*);
+	    IF ystart < ymin THEN
+		mask := RSB (mask, ymin - ystart);
+		ystart := ymin;
+	    END (*IF*);
+	ELSE
+	    IF ystart-7 > ymin THEN ymin := ystart-7 END(*IF*);
+	    IF ystart > ymax THEN
+		mask := RSB (mask, ystart - ymax);
+		ystart := ymax;
+	    END (*IF*);
+	END (*IF*);
+
+	(* Establish the desired horizontal range.	*)
+
+	IF x < right THEN right := x END(*IF*);
+	fontptr := FontAddress (ch);
+	DEC (x, ModeData.LastCharRow);
+
+	(* Check for a character clipped at the top.	*)
+
+	IF x < left THEN
+	    fontptr := FarAddOffset (fontptr, left-x);  x := left;
+	END (*IF*);
+
+	(* The outer loop steps through bytes in the font table,	*)
+	(* while stepping in the +X direction.				*)
+
+	LOOP
+	    pattern := fontptr^;  y := ystart;
+
+	    (* The inner loop steps towards the top of the screen while	*)
+	    (* stepping through bits in the font table entry.		*)
+
+	    LOOP
+		IF pattern = BYTE(0) THEN EXIT(*LOOP*) END(*IF*);
+		IF IANDB (pattern, mask) <> BYTE(0) THEN
+		    PlotDot (x, y, colour);
+		END (*IF*);
+		IF BLorigin THEN
+		    INC (y);
+		    IF y > ymax THEN EXIT(*LOOP*) END(*IF*);
+		ELSE
+		    DEC (y);
+		    IF y < ymin THEN EXIT(*LOOP*) END(*IF*);
+		END (*IF*);
+		pattern := LSB (pattern, 1);
+	    END (*LOOP*);
+
+	    INC (x);
+	    IF x > right THEN EXIT(*LOOP*) END(*IF*);
+	    fontptr := FarAddOffset (fontptr, 1);
+
+	END (*LOOP*);
+
+    END ClippedCharUp;
+
+(************************************************************************)
+
+PROCEDURE RasterPlotString (VAR (*IN*) text: ARRAY OF CHAR;
+			x, y, length: CARDINAL;  colour: ColourType);
+
+    (* Draws a string of "length" characters starting at location (x,y)	*)
+    (* We assume length > 0.  This procedure is for packed modes which	*)
+    (* have fewer than 8 bits per pixel.				*)
+    (* The approach being used is a "raster" approach where we write	*)
+    (* text a scan row at a time, rather than a character at a time.	*)
+
+    TYPE TwoByte = RECORD
+			CASE :BOOLEAN OF
+			    | FALSE:	w: CARDINAL;
+			    | TRUE:	l, h: BYTE;
+			END (*CASE*);
+		   END (*RECORD*);
+
+    VAR row, CharCount, PixelsPerByte, s0, DotsToGo, LowDots: CARDINAL;
+	code: TwoByte;
+
+    BEGIN
+	IF BLorigin THEN INC (y, ModeData.LastCharRow);
+	ELSE DEC (y, ModeData.LastCharRow);
+	END (*IF*);
+	PixelsPerByte := 8 DIV ModeData.BitsPerPixel;
+	s0 := x MOD PixelsPerByte;
+	SetColour (colour);
+
+	FOR row := 0 TO ModeData.LastCharRow DO
+
+	    CharCount := 0;
+	    SetScreenLocation (x, y);
+
+	    (* Set up initial character with correct alignment. *)
+
+	    DotsToGo := 8 + s0;
+	    code.h := MakeCode (text[0], row);
+	    code.l := 0;
+	    IF s0 > 0 THEN
+		code.w := RS (code.w, s0);
+	    END (*IF*);
+
+	    LOOP
+		AlignedPattern (code.h);
+		IF DotsToGo < PixelsPerByte THEN
+		    EXIT (*LOOP*);
+		END (*IF*);
+		DEC (DotsToGo, PixelsPerByte);
+		IF DotsToGo >= 8 THEN
+		    code.w := LS (code.w, PixelsPerByte);
+		ELSE
+
+		    (* Load in next character. *)
+
+		    INC (CharCount);
+		    IF CharCount >= length THEN
+			code.w := LS (code.w, PixelsPerByte);
+		    ELSE
+			LowDots := DotsToGo + PixelsPerByte - 8;
+			IF LowDots > 0 THEN
+			    code.w := LS (code.w, LowDots);
+			END (*IF*);
+			code.l := MakeCode (text[CharCount], row);
+			code.w := LS (code.w, PixelsPerByte - LowDots);
+			INC (DotsToGo, 8);
+		    END (*IF*);
+		END (*IF*);
+	    END (*LOOP*);
+
+	    IF BLorigin THEN DEC(y) ELSE INC(y) END(*IF*);
+
+	END (*FOR*);
+
+   END RasterPlotString;
+
+(************************************************************************)
+
+PROCEDURE PlotStringSimple (VAR (*IN*) text: ARRAY OF CHAR;
+			x, y, length: CARDINAL;  colour: ColourType);
+
+    (* Draws a string of "length" characters starting at location (x,y)	*)
+    (* This is the version to use for unpacked video modes.		*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	FOR j := 0 TO length-1 DO
+	    DrawChar (text[j], x, y, colour);
+	    INC (x, 8);
+	END (*FOR*);
+    END PlotStringSimple;
+
+(************************************************************************)
+
+PROCEDURE PlotString (VAR (*IN*) text: ARRAY OF CHAR;
+			x, y, length: CARDINAL;  colour: ColourType);
+
+    (* Draws a string of "length" characters starting at location (x,y)	*)
+
+    BEGIN
+	IF length = 0 THEN RETURN
+	ELSIF ModeData.BitsPerPixel < 8 THEN
+	    RasterPlotString (text, x, y, length, colour);
+	ELSE
+	    PlotStringSimple (text, x, y, length, colour);
+	END (*IF*);
+    END PlotString;
+
+(************************************************************************)
+
+PROCEDURE PlotStringUp (VAR (*IN*) text: ARRAY OF CHAR;
+			x, y, length: CARDINAL;  colour: ColourType);
+
+    (* Like PlotString, but with text written in the +Y direction.	*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	FOR j := 0 TO length-1 DO
+	    DrawCharUp (text[j], x, y, colour);
+	    IF BLorigin THEN INC (y, 8) ELSE DEC(y,8) END(*IF*);
+	END (*FOR*);
+    END PlotStringUp;
+
+(************************************************************************)
+
+PROCEDURE RasterClippedString (VAR (*IN*) text: ARRAY OF CHAR;
+			x, y, length: CARDINAL;  colour: ColourType;
+			left, right, ymin, ymax: CARDINAL);
+
+    (* Draws a string of "length" characters starting at location (x,y)	*)
+    (* We assume length > 0.  This procedure is for packed modes which	*)
+    (* have fewer than 8 bits per pixel.				*)
+    (* The approach being used is a "raster" approach where we write	*)
+    (* text a scan row at a time, rather than a character at a time.	*)
+
+    TYPE TwoByte = RECORD
+			CASE :BOOLEAN OF
+			    | FALSE:	w: CARDINAL;
+			    | TRUE:	l, h: BYTE;
+			END (*CASE*);
+		   END (*RECORD*);
+
+    VAR row, firstrow, lastrow: CARDINAL;
+	CharNum, FirstCharNum, LastCharNum, gap: CARDINAL;
+	PixelsPerByte, s0, DotsToGo, LowDots: CARDINAL;
+	code: TwoByte;
+	Lmask, Rmask: BYTE;
+
+    BEGIN
+	(* Set the vertical bounds. *)
+
+	firstrow := 0;
+	lastrow := ModeData.LastCharRow;
+	IF BLorigin THEN
+	    IF y < ymin THEN
+		IF ymin-y > lastrow THEN RETURN END(*IF*);
+		DEC (lastrow, ymin-y);
+	    END (*IF*);
+	    INC (y, ModeData.LastCharRow);
+	    IF y > ymax THEN
+		INC (firstrow, y-ymax);
+		y := ymax;
+	    END (*IF*);
+	ELSE
+	    IF y > ymax THEN
+		IF y-ymax > lastrow THEN RETURN END(*IF*);
+		DEC (lastrow, y-ymax);
+	    END (*IF*);
+	    DEC (y, ModeData.LastCharRow);
+	    IF y < ymin THEN
+		INC (firstrow, ymin-y);
+		y := ymin;
+	    END (*IF*);
+	END (*IF*);
+	IF firstrow > lastrow THEN RETURN END(*IF*);
+
+	(* Set the horizontal bounds and masks. *)
+
+	FirstCharNum := 0;  Lmask := 0FFH;
+	IF x < left THEN
+	    gap := left - x;
+	    FirstCharNum := gap DIV 8;
+	    gap := gap MOD 8;
+	    IF gap > 0 THEN
+		Lmask := RSB (Lmask, gap);
+	    END (*IF*);
+	END (*IF*);
+	LastCharNum := length-1;  Rmask := 0FFH;
+	IF x + 8*length - 1 > right THEN
+	    gap := x + 8*length - 1 - right;
+	    IF 8*LastCharNum < gap THEN RETURN END(*IF*);
+	    DEC (LastCharNum, gap DIV 8);
+	    gap := gap MOD 8;
+	    IF gap > 0 THEN
+		Rmask := LSB (Rmask, gap);
+	    END (*IF*);
+	END (*IF*);
+	IF FirstCharNum = LastCharNum THEN
+	    Lmask := IANDB (Lmask, Rmask);
+	ELSIF FirstCharNum > LastCharNum THEN
+	    RETURN;
+	END (*IF*);
+	INC (x, 8*FirstCharNum);
+
+	(* At last, we are ready to plot. *)
+
+	PixelsPerByte := 8 DIV ModeData.BitsPerPixel;
+	s0 := x MOD PixelsPerByte;
+	SetColour (colour);
+
+	FOR row := firstrow TO lastrow DO
+
+	    CharNum := FirstCharNum;
+	    SetScreenLocation (x, y);
+
+	    (* Set up initial character with correct alignment. *)
+
+	    DotsToGo := 8 + s0;
+	    code.h := IANDB (MakeCode (text[CharNum], row), Lmask);
+	    code.l := 0;
+	    IF s0 > 0 THEN
+		code.w := RS (code.w, s0);
+	    END (*IF*);
+
+	    LOOP
+		AlignedPattern (code.h);
+		IF DotsToGo < PixelsPerByte THEN
+		    EXIT (*LOOP*);
+		END (*IF*);
+		DEC (DotsToGo, PixelsPerByte);
+		IF DotsToGo >= 8 THEN
+		    code.w := LS (code.w, PixelsPerByte);
+		ELSE
+
+		    (* Load in next character. *)
+
+		    INC (CharNum);
+		    IF CharNum > LastCharNum THEN
+			code.w := LS (code.w, PixelsPerByte);
+		    ELSE
+			LowDots := DotsToGo + PixelsPerByte - 8;
+			IF LowDots > 0 THEN
+			    code.w := LS (code.w, LowDots);
+			END (*IF*);
+			code.l := MakeCode (text[CharNum], row);
+			IF CharNum = LastCharNum THEN
+			    code.l := IANDB (code.l, Rmask);
+			END (*IF*);
+			code.w := LS (code.w, PixelsPerByte - LowDots);
+			INC (DotsToGo, 8);
+		    END (*IF*);
+		END (*IF*);
+	    END (*LOOP*);
+
+	    IF BLorigin THEN DEC(y) ELSE INC(y) END(*IF*);
+
+	END (*FOR*);
+
+   END RasterClippedString;
+
+(************************************************************************)
+
+PROCEDURE ClippedStringSimple (VAR (*IN*) text: ARRAY OF CHAR;
+			x, y, length: CARDINAL;  colour: ColourType;
+			left, right, ymin, ymax: CARDINAL);
+
+    (* Draws a string of "length" characters starting at location (x,y)	*)
+    (* This is the version to use for unpacked video modes.		*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	FOR j := 0 TO length-1 DO
+	    ClippedChar (text[j], x, y, colour, left, right, ymin, ymax);
+	    INC (x, 8);
+	END (*FOR*);
+    END ClippedStringSimple;
+
+(************************************************************************)
+
+PROCEDURE ClippedString (VAR (*IN*) text: ARRAY OF CHAR;
+			x, y, length: CARDINAL;  colour: ColourType;
+			left, right, ymin, ymax: CARDINAL);
+
+    (* Like PlotString, but excludes any points which fall outside the	*)
+    (* clip rectangle defined by (left,right,ymin,ymax).		*)
+
+    BEGIN
+	IF length = 0 THEN RETURN
+	ELSIF ModeData.BitsPerPixel < 8 THEN
+	    RasterClippedString (text, x, y, length, colour,
+					left, right, ymin, ymax);
+	ELSE
+	    ClippedStringSimple (text, x, y, length, colour,
+					left, right, ymin, ymax);
+	END (*IF*);
+    END ClippedString;
+
+(************************************************************************)
+
+PROCEDURE ClippedUpString (VAR (*IN*) text: ARRAY OF CHAR;
+			x, y, length: CARDINAL;  colour: ColourType;
+			left, right, ymin, ymax: CARDINAL);
+
+    (* Like ClippedString, but with text written in the +Y direction.	*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	FOR j := 0 TO length-1 DO
+	    ClippedCharUp (text[j], x, y, colour, left, right, ymin, ymax);
+	    IF BLorigin THEN INC (y, 8) ELSE DEC(y,8) END(*IF*);
+	END (*FOR*);
+    END ClippedUpString;
+
+(************************************************************************)
+(*		      OPERATIONS ON THE VIDEO MODE			*)
+(************************************************************************)
+
+PROCEDURE SetMode (newmode: CARDINAL;  ClearScreen: BOOLEAN);
+
+    (* Sets the video mode. *)
+
+    VAR y, j: CARDINAL;  p: FarPointerPointer;
+
+    BEGIN
+	IF NOT SetVideoMode (newmode, ClearScreen) THEN
+	    RETURN;
+	END (*IF*);
+	GetAddresses (ScreenSeg, IObase);
+	GetModeInfo (newmode, ModeData);
+
+	(* Assign procedures appropriate to this mode. *)
+
+	VisibleLine := VisibleLine0;  FillProc := Fill0;
+	CopyRectangle := ACopy0;  CopyPartByte := CopyPartByte0;
+	CopyString := StringCopy0;
+
+	WITH ModeData DO
+
+	    IF Planar THEN
+		FillProc := PlanarFill;
+		VisibleLine := VisibleLinePlanar;
+		CopyPartByte := CopyPartBytePlanar;
+
+		(* For the 4-plane modes supported in the 16-colour	*)
+		(* model, we use set/reset mode as the default.		*)
+
+		OutByte (3CEH, 1);  OutByte (3CFH, 0FH);
+
+	    ELSIF BitsPerPixel >= 8 THEN
+		FillProc := Fill256;
+		IF BitsPerPixel > 8 THEN
+		    VisibleLine := VisibleLine64K;
+		END (*IF*);
+	    END (*IF*);
+
+	    IF BitsPerPixel >= 8 THEN
+		CopyRectangle := ACopy1;
+	    ELSIF MultiBank THEN
+		CopyRectangle := ACopyMultibank;
+	    END (*IF*);
+
+	    IF MultiBank THEN
+		CopyString := StringCopyMultibank;
+	    END (*IF*);
+
+	    (* Set up the character set pointers. *)
+
+	    p := MakePointer (0, 4*43H);
+	    FontAddress0 := p^;
+	    IF newmode < 7 THEN
+		p := MakePointer (0, 4*1FH);
+		FontAddress1 := p^;
+	    ELSE
+		FontAddress1
+			:= FarAddOffset (FontAddress0, (LastCharRow+1)*128);
+	    END (*IF*);
+
+	    (* Calculate the table of screen addresses. *)
+
+	    FOR y := 0 TO MaxY DO
+		LineStart[y].L := Mul (BytesPerRow, y DIV FramesPerScreen)
+					+ Mul (8192, y MOD FramesPerScreen);
+	    END (*FOR*);
+
+	    (* Set up the mask and fill arrays. *)
+
+	    IF BitsPerPixel <= 8 THEN
+		FOR j := 0 TO (8 DIV BitsPerPixel)-1 DO
+		    IF BitsPerPixel = 1 THEN
+			Mask[j] := Mask2[j];
+			KeepL[j] := KeepL2[j];
+			KeepR[j] := KeepR2[j];
+		    ELSIF BitsPerPixel = 2 THEN
+			Mask[j] := Mask4[j];
+			KeepL[j] := KeepL4[j];
+			KeepR[j] := KeepR4[j];
+		    ELSIF BitsPerPixel = 4 THEN
+			Mask[j] := Mask16[j];
+			KeepL[j] := KeepL16[j];
+			KeepR[j] := KeepR16[j];
+		    ELSE     (* 8 bits/pixel - do we need to cover this? *)
+			Mask[j] := 0FFH;
+			KeepL[j] := 0FFH;
+			KeepR[j] := 0FFH;
+		    END (*IF*);
+		END (*FOR*);
+	    END (*IF*);
+	    IF MaxColour < 16 THEN
+
+		(* Note that we allow for 16 entries in FillArray even	*)
+		(* for modes which support fewer colours.  This maps	*)
+		(* illegal colours down to legal ones.			*)
+
+		FOR j := 0 TO 15 DO
+		    IF MaxColour = 1 THEN FillArray[j] := Fill2[j MOD 2]
+		    ELSIF MaxColour = 3 THEN FillArray[j] := Fill4[j MOD 4]
+		    ELSE FillArray[j] := Fill16[j];
+		    END (*IF*);
+		END (*IF*);
+	    END (*IF*);
+
+	END (*WITH*);
+
+    END SetMode;
+
+(************************************************************************)
+
+PROCEDURE SetDefaultMode;
+
+    (* Sets the video mode to (our opinion of) the best mode supported	*)
+    (* by the hardware.							*)
+
+    BEGIN
+	SetMode (DefaultGraphicsMode, TRUE);
+    END SetDefaultMode;
+
+(************************************************************************)
+
+PROCEDURE GraphicsOff (ClearScreen: BOOLEAN);
+
+    (* Sets the video mode to a default text mode. *)
+
+    BEGIN
+	SetMode (DefaultTextMode, ClearScreen);
+    END GraphicsOff;
+
+(************************************************************************)
+
+PROCEDURE GetScreenShape (VAR (*OUT*) xmax, ymax: CARDINAL;
+				VAR (*OUT*) maxcolour: ColourType;
+				VAR (*OUT*) CharHeight: CARDINAL);
+
+    (* Returns the maximum values permitted by the current mode for	*)
+    (* x, y, and colour; and the number of rows in a character.		*)
+
+    BEGIN
+	WITH ModeData DO
+	    xmax := MaxX;  ymax := MaxY;
+	    maxcolour := MaxColour;
+	    CharHeight := LastCharRow + 1;
+	END (*WITH*);
+    END GetScreenShape;
+
+(************************************************************************)
+(*			      INITIALISATION				*)
+(************************************************************************)
+
+BEGIN
+    (* Find out the video adaptor type.	*)
+
+    AdaptorKind := VideoKind();
+    FontAddress0 := Virtual (0FFA6EH);
+    FontAddress1 := FarAddOffset (FontAddress0, 8*128);
+
+    (* Work out the "best" modes to use for the available adaptor type.	*)
+
+    CASE AdaptorKind OF
+	MDA:		DefaultGraphicsMode := 7;
+     |	Hercules:	DefaultGraphicsMode := HercGraphics;
+     |	CGA:		DefaultGraphicsMode := 4;
+     |	EGA:		DefaultGraphicsMode := 16;
+     |	VGA, SVGA:	DefaultGraphicsMode := 18;
+     |	ATI:		DefaultGraphicsMode := 84;
+     |	S3:		DefaultGraphicsMode := 257;
+     |	Trident:	DefaultGraphicsMode := 91;
+    END (*CASE*);
+
+    IF (AdaptorKind = MDA) OR (AdaptorKind = Hercules) THEN
+	DefaultTextMode := 7;
+    ELSE
+	DefaultTextMode := 3;
+    END (*IF*);
+
+    (* Set up default values for the ModeData record.  This is helpful	*)
+    (* for debugging: if SetMode is never called, the program will run	*)
+    (* in a text mode but the graphics routines will still be working	*)
+    (* with plausible values.						*)
+
+    WITH ModeData DO
+	MaxX := 639;  MaxY := 349;
+	MaxColour := 15;
+	LastCharRow := 7;
+	BitsPerPixel := 1;
+	BytesPerRow := 80;  FramesPerScreen := 1;
+	Planar := TRUE;  MultiBank := FALSE;  TextMode := FALSE;
+    END (*WITH*);
+    FillProc := PlanarFill;  VisibleLine := VisibleLinePlanar;
+    GetAddresses (ScreenSeg, IObase);
+
+END Graphics.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/gwindows.def b/examples/Modula-2_Libraries/PMOS/sources/general/gwindows.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/gwindows.def
@@ -0,0 +1,154 @@
+DEFINITION MODULE GWindows;
+
+	(********************************************************)
+	(*							*)
+	(*	    Windows module for screen graphics		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	18 April 1994			*)
+	(*  Status:						*)
+	(*	Mostly working, still adding features.		*)
+	(*							*)
+	(********************************************************)
+
+FROM ScreenGeometry IMPORT
+    (* type *)	Point, Rectangle;
+
+FROM Graphics IMPORT
+    (* type *)	ColourType;
+
+(************************************************************************)
+
+TYPE
+    Window;	(* is private *)
+
+    BorderType = (single, double);
+
+(************************************************************************)
+
+PROCEDURE InitGraphics (mode: CARDINAL);
+
+    (* Sets up the Graphics mode.  Optional, since the module starts up	*)
+    (* with a best estimate of the "best" mode possible on the		*)
+    (* available hardware.						*)
+
+PROCEDURE OpenWindow (VAR (*OUT*) w: Window;
+				left, bottom, right, top: CARDINAL;
+				Foregrnd, Backgrnd: ColourType;
+				b: BorderType);
+
+    (* Creates a new window.	*)
+
+PROCEDURE OpenWindowR (VAR (*OUT*) w: Window;  location: Rectangle;
+					Foregrnd, Backgrnd: ColourType;
+					b: BorderType);
+
+    (* Same as OpenWindow, except for method of specifying location.	*)
+
+PROCEDURE WindowMemory (w: Window;  memory: BOOLEAN);
+
+    (* Specifying a FALSE value for the memory parameter means that	*)
+    (* subsequent data sent to this window will be written to the	*)
+    (* screen but not remembered.  This saves time and memory, the only	*)
+    (* penalty being that data covered by an overlapping window will	*)
+    (* be lost.  Specifying TRUE restores the default condition, where	*)
+    (* all window data are retained for refreshing the screen when	*)
+    (* necessary.							*)
+
+PROCEDURE CloseWindow (VAR (*INOUT*) w: Window);
+
+    (* Destroys the window.	*)
+
+PROCEDURE SetColour (w: Window;  colour: ColourType);
+
+    (* Specifies the foreground colour to be used until further notice.	*)
+
+PROCEDURE PutPixel (w: Window;  p: Point);
+
+    (* Plots a dot at the point (x,y) in window w.  The coordinates are	*)
+    (* relative to the bottom left of the window.  If the dot lies	*)
+    (* outside the window it will be ignored.				*)
+
+PROCEDURE PutPixel2 (w: Window;  x, y: INTEGER);
+
+    (* Same as PutPixel, with a different way of specifying the point.	*)
+
+PROCEDURE PutPixel2C (w: Window;  x, y: INTEGER;  colour: ColourType);
+
+    (* Same as PutPixel2, with the colour explicitly specified.	*)
+
+PROCEDURE Line (w: Window;  start, end: Point);
+
+    (* Draws a straight line.  The points are relative to the bottom	*)
+    (* left corner of w.  Parts of the line lying outside the window	*)
+    (* are clipped.							*)
+
+PROCEDURE Line2 (w: Window;  xstart, ystart, xend, yend: INTEGER);
+
+    (* The same operation as Line, with a different way of specifying	*)
+    (* the parameters.							*)
+
+PROCEDURE Line2C (w: Window;  xstart, ystart, xend, yend: INTEGER;
+							colour: ColourType);
+
+    (* The same operation as Line2, but with the colour explicitly	*)
+    (* specified.							*)
+
+PROCEDURE GString (w: Window;  x, y: CARDINAL;  text: ARRAY OF CHAR);
+
+    (* Writes a horizontal character string at graphics position (x,y)	*)
+    (* relative to window w.  Characters which do not fit are not	*)
+    (* displayed.  This is not considered to be a text operation since	*)
+    (* the text cursor is not affected and there is no line wrap.	*)
+
+PROCEDURE GStringUp (w: Window;  x, y: CARDINAL;  text: ARRAY OF CHAR);
+
+    (* Like GString, but the string is rotated counterclockwise by	*)
+    (* 90 degrees, i.e. it is written in the +Y direction.		*)
+
+PROCEDURE ClearWindow (w: Window);
+
+    (* Erases all data from w, but keeps it open.	*)
+
+(************************************************************************)
+(*			    TEXT OPERATIONS				*)
+(************************************************************************)
+(*									*)
+(*  Every open window has a "text cursor" which is used only for text	*)
+(*  operations and is independent of any operations on dots and lines.	*)
+(*  The text cursor is updated after any text operation in such a way	*)
+(*  that the characters follow one another in the way one would expect	*)
+(*  for non-graphics windows.						*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE SetCursor (w: Window;  row, column: CARDINAL);
+
+    (* Sets the text cursor to the specified row and column.  The row	*)
+    (* and column are measured in units of characters (not pixels),	*)
+    (* with (0,0) representing the first character position at the	*)
+    (* upper left of the window.					*)
+
+PROCEDURE SaveCursor (w: Window;  VAR (*OUT*) row, column: CARDINAL);
+
+    (* Returns the current row and column of the text cursor. *)
+
+PROCEDURE WriteChar (w: Window;  ch: CHAR);
+
+    (* Writes a horizontal character at the current text cursor		*)
+    (* position for window w.  The text cursor is updated.		*)
+
+PROCEDURE WriteString (w: Window;  text: ARRAY OF CHAR);
+
+    (* Writes a horizontal character string at the current text cursor	*)
+    (* position for window w.  Characters which do not fit on the	*)
+    (* current line are wrapped around to a new row.			*)
+
+PROCEDURE WriteLn (w: Window);
+
+    (* Sets the text cursor to the start of the next text line down.	*)
+    (* If the cursor reaches the bottom of the window, the text in the	*)
+    (* window is scrolled.						*)
+
+END GWindows.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/gwindows.mod b/examples/Modula-2_Libraries/PMOS/sources/general/gwindows.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/gwindows.mod
@@ -0,0 +1,611 @@
+IMPLEMENTATION MODULE GWindows;
+
+	(********************************************************)
+	(*							*)
+	(*	    Windows module for screen graphics		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 February 1995		*)
+	(*  Status:						*)
+	(*	Points, lines, and text working.		*)
+	(*	Still adding more features.			*)
+	(*	Now working on scrolling, setting cursor, etc.	*)
+	(*							*)
+	(********************************************************)
+
+FROM Graphics IMPORT
+    (* proc *)	SetMode, SetDefaultMode, GetScreenShape;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM ScreenGeometry IMPORT
+    (* proc *)	Inside, TrimLine;
+
+FROM Tiles IMPORT
+    (* type *)	TileSet,
+    (* proc *)	CreateTileSet, DiscardTileSet, AddPoint, AddLine,
+		AddRectangle, AddString, ClearTileSet, ScrollContents,
+		AddRotatedString, TileSetMemory;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure, TerminationMessage;
+
+(************************************************************************)
+
+TYPE
+    (* A window is described by a record with the following fields.	*)
+    (*	absborder	the outside edge of the window, in absolute	*)
+    (*			(i.e. screen-relative) coordinates.		*)
+    (*	databorder	the rectangle, in screen-relative coordinates,	*)
+    (*			outside which data should not be plotted.	*)
+    (*	tiles		the set of tiles making up the window.		*)
+    (*	background	the background colour for the window.		*)
+    (*	foreground	the foreground colour for the window.		*)
+    (*	cursor		the text cursor, in terms of points.		*)
+    (*	row, column	the text cursor, in terms of characters.	*)
+    (*	ScrollRegion	the "normal" region for text, measured in	*)
+    (*			  terms of character positions.			*)
+
+    Window = POINTER TO
+		RECORD
+		    absborder, databorder: Rectangle;
+		    tiles: TileSet;
+		    background, foreground: ColourType;
+		    cursor: Point;
+
+		    (* The following fields are in units of characters	*)
+		    (* rather than (x,y) coordinates.			*)
+
+		    row, column: INTEGER;
+		    ScrollRegion: Rectangle;
+
+		END (*RECORD*);
+
+(************************************************************************)
+
+VAR
+    (* Maximum screen coordinates and colour for the selected mode.	*)
+    (* (Minimum value is zero in all three cases.)			*)
+
+    XMAX, YMAX, CharHeight: CARDINAL;
+    MaxColour: ColourType;
+
+(************************************************************************)
+(*			OPENING AND CLOSING WINDOWS			*)
+(************************************************************************)
+
+PROCEDURE DrawFrame (w: Window);
+
+    (* Draws the window frame.  Used when first opening a window, or	*)
+    (* for putting back the frame after clearing the window.		*)
+
+    VAR R: Rectangle;
+
+    BEGIN
+	WITH w^ DO
+	    AddRectangle (tiles, absborder, foreground);
+	    IF databorder.left <> absborder.left+1 THEN
+		R := databorder;
+		WITH R DO
+		    DEC(left);  INC (right);
+		    DEC(bottom);  INC (top);
+		END (*WITH*);
+		AddRectangle (tiles, R, foreground);
+	    END (*IF*);
+	END (*WITH*);
+    END DrawFrame;
+
+(************************************************************************)
+
+PROCEDURE OpenWindow (VAR (*OUT*) w: Window;
+				left, bottom, right, top: CARDINAL;
+				Foregrnd, Backgrnd: ColourType;
+				b: BorderType);
+
+    (* Creates a new window.	*)
+
+    VAR temp: CARDINAL;
+
+    BEGIN
+	(* Make sure that the parameters are within the legal ranges.	*)
+
+	IF left > XMAX THEN left := XMAX END(*IF*);
+	IF right > XMAX THEN right := XMAX END(*IF*);
+	IF left > right THEN
+	    temp := left;  left := right;  right := temp;
+	END (*IF*);
+	IF bottom > YMAX THEN bottom := YMAX END(*IF*);
+	IF top > YMAX THEN top := YMAX END(*IF*);
+	IF bottom > top THEN
+	    temp := bottom;  bottom := top;  top := temp;
+	END (*IF*);
+
+	IF Backgrnd > MaxColour THEN Backgrnd := MaxColour END (*IF*);
+	IF Foregrnd > MaxColour THEN Foregrnd := MaxColour END (*IF*);
+	IF Foregrnd = Backgrnd THEN
+	    Foregrnd := (Backgrnd + 1) MOD (MaxColour + 1);
+	END (*IF*);
+
+	NEW (w);
+	WITH w^ DO
+	    background := Backgrnd;  foreground := Foregrnd;
+	    absborder.left := left;
+	    absborder.right := right;
+	    absborder.bottom := bottom;
+	    absborder.top := top;
+	    databorder := absborder;
+	    IF b = double THEN temp := 3
+	    ELSE temp := 1;
+	    END (*IF*);
+	    WITH databorder DO
+		INC (left, temp);  DEC (right, temp);
+		INC (bottom, temp);  DEC (top, temp);
+	    END (*WITH*);
+	    WITH ScrollRegion DO
+		left := 0;  top := 0;
+
+		(* The following two lines might need fine tuning.	*)
+
+		right := (databorder.right - databorder.left) DIV 8 - 1;
+		bottom := (databorder.top - databorder.bottom)
+					DIV VAL(INTEGER,CharHeight) - 1;
+
+	    END (*WITH*);
+	    tiles := CreateTileSet (absborder, background);
+	END (*WITH*);
+
+	DrawFrame (w);
+	SetCursor (w, 0, 0);
+
+    END OpenWindow;
+
+(************************************************************************)
+
+PROCEDURE OpenWindowR (VAR (*OUT*) w: Window;  location: Rectangle;
+					Foregrnd, Backgrnd: ColourType;
+					b: BorderType);
+
+    (* Same as OpenWindow, except for method of specifying location.	*)
+
+    BEGIN
+	WITH location DO
+	    IF left < 0 THEN left := 0 END(*IF*);
+	    IF right < 0 THEN right := 0 END(*IF*);
+	    IF bottom < 0 THEN bottom := 0 END(*IF*);
+	    IF top < 0 THEN top := 0 END(*IF*);
+	    OpenWindow (w, left, bottom, right, top, Backgrnd, Foregrnd, b);
+	END (*WITH*);
+    END OpenWindowR;
+
+(************************************************************************)
+
+PROCEDURE WindowMemory (w: Window;  memory: BOOLEAN);
+
+    (* Specifying a FALSE value for the memory parameter means that	*)
+    (* subsequent data sent to this window will be written to the	*)
+    (* screen but not remembered.  This saves time and memory, the only	*)
+    (* penalty being that data covered by an overlapping window will	*)
+    (* be lost.  Specifying TRUE restores the default condition, where	*)
+    (* all window data are retained for refreshing the screen when	*)
+    (* necessary.							*)
+
+    BEGIN
+	TileSetMemory (w^.tiles, memory);
+    END WindowMemory;
+
+(************************************************************************)
+
+PROCEDURE CloseWindow (VAR (*INOUT*) w: Window);
+
+    (* Destroys the window.	*)
+
+    BEGIN
+	DiscardTileSet (w^.tiles);
+	DISPOSE (w);
+    END CloseWindow;
+
+(************************************************************************)
+(*			     CLEARING A WINDOW				*)
+(************************************************************************)
+
+PROCEDURE ClearWindow (w: Window);
+
+    (* Erases all data from w, but keeps it open.	*)
+
+    BEGIN
+	ClearTileSet (w^.tiles);
+	DrawFrame (w);  SetCursor (w, 0, 0);
+    END ClearWindow;
+
+(************************************************************************)
+(*			SETTING THE FOREGROUND COLOUR			*)
+(************************************************************************)
+
+PROCEDURE SetColour (w: Window;  colour: ColourType);
+
+    (* Specifies the foreground colour to be used until further notice.	*)
+
+    BEGIN
+	w^.foreground := colour;
+    END SetColour;
+
+(************************************************************************)
+(*			     PLOTTING A POINT				*)
+(************************************************************************)
+
+PROCEDURE PutPixelC (w: Window;  p: Point;  c: ColourType);
+
+    (* Plots a dot at the point (x,y) in window w.  The coordinates are	*)
+    (* relative to the bottom left of the window.  If the dot lies	*)
+    (* outside the window it will be ignored.				*)
+
+    BEGIN
+	WITH w^ DO
+	    INC (p.x, absborder.left);
+	    INC (p.y, absborder.bottom);
+	    IF Inside (p.x, p.y, databorder) THEN
+		AddPoint (tiles, p, c);
+	    END (*WITH*);
+	END (*WITH*);
+    END PutPixelC;
+
+(************************************************************************)
+
+PROCEDURE PutPixel (w: Window;  p: Point);
+
+    (* Plots a dot at the point (x,y) in window w.  The coordinates are	*)
+    (* relative to the bottom left of the window.  If the dot lies	*)
+    (* outside the window it will be ignored.				*)
+
+    BEGIN
+	WITH w^ DO
+	    INC (p.x, absborder.left);
+	    INC (p.y, absborder.bottom);
+	    IF Inside (p.x, p.y, databorder) THEN
+		AddPoint (tiles, p, foreground);
+	    END (*WITH*);
+	END (*WITH*);
+    END PutPixel;
+
+(************************************************************************)
+
+PROCEDURE PutPixel2 (w: Window;  x, y: INTEGER);
+
+    (* Same as PutPixel, with a different way of specifying the point.	*)
+
+    VAR p: Point;
+
+    BEGIN
+	p.x := x;  p.y := y;
+	PutPixel (w, p);
+    END PutPixel2;
+
+(************************************************************************)
+
+PROCEDURE PutPixel2C (w: Window;  x, y: INTEGER;  colour: ColourType);
+
+    (* Same as PutPixel2, with the colour explicitly specified.	*)
+
+    VAR p: Point;
+
+    BEGIN
+	p.x := x;  p.y := y;
+	PutPixelC (w, p, colour);
+    END PutPixel2C;
+
+(************************************************************************)
+(*			DRAWING A STRAIGHT LINE				*)
+(************************************************************************)
+
+PROCEDURE LineC (w: Window;  start, end: Point;  colour: ColourType);
+
+    (* Draws a straight line.  The points are relative to the bottom	*)
+    (* left corner of w.  Parts of the line lying outside the window	*)
+    (* are clipped.							*)
+
+    BEGIN
+	WITH w^ DO
+	    WITH absborder DO
+		INC (start.x, left);  INC (start.y, bottom);
+		INC (end.x, left);  INC (end.y, bottom);
+	    END (*WITH*);
+	    IF TrimLine (start, end, databorder) THEN
+		AddLine (tiles, start, end, colour);
+	    END (*IF*);
+	END (*WITH*);
+    END LineC;
+
+(************************************************************************)
+
+PROCEDURE Line (w: Window;  start, end: Point);
+
+    (* Draws a straight line.  The points are relative to the bottom	*)
+    (* left corner of w.  Parts of the line lying outside the window	*)
+    (* are clipped.							*)
+
+    BEGIN
+	LineC (w, start, end, w^.foreground);
+    END Line;
+
+(************************************************************************)
+
+PROCEDURE Line2 (w: Window;  xstart, ystart, xend, yend: INTEGER);
+
+    (* The same operation as Line, with a different way of specifying	*)
+    (* the parameters.							*)
+
+    VAR start, end: Point;
+
+    BEGIN
+	start.x := xstart;  start.y := ystart;
+	end.x := xend;  end.y := yend;
+	Line (w, start, end);
+    END Line2;
+
+(************************************************************************)
+
+PROCEDURE Line2C (w: Window;  xstart, ystart, xend, yend: INTEGER;
+							colour: ColourType);
+
+    (* The same operation as Line2, but with the colour explicitly	*)
+    (* specified.							*)
+
+    VAR start, end: Point;
+
+    BEGIN
+	start.x := xstart;  start.y := ystart;
+	end.x := xend;  end.y := yend;
+	LineC (w, start, end, colour);
+    END Line2C;
+
+(************************************************************************)
+
+PROCEDURE StringLength (VAR (*IN*) text: ARRAY OF CHAR): CARDINAL;
+
+    (* Finds the true size of the text string, given that there	*)
+    (* could be a nul terminator in the middle.			*)
+
+    VAR count: CARDINAL;
+
+    BEGIN
+	count := 0;
+	WHILE (count <= HIGH(text)) AND (text[count] <> CHR(0)) DO
+	    INC (count);
+	END (*WHILE*);
+	RETURN count;
+    END StringLength;
+
+(************************************************************************)
+
+PROCEDURE GString (w: Window;  x, y: CARDINAL;  text: ARRAY OF CHAR);
+
+    (* Writes a horizontal character string at graphics position (x,y)	*)
+    (* relative to window w.  Characters which do not fit are not	*)
+    (* displayed.  This is not considered to be a text operation since	*)
+    (* the text cursor is not affected and there is no line wrap.	*)
+
+    VAR count: CARDINAL;  place: Point;
+
+    BEGIN
+	count := StringLength (text);
+	IF count = 0 THEN RETURN END(*IF*);
+
+	(* Add the string to the TileSet.	*)
+
+	WITH w^ DO
+	    place.x := x + CARDINAL (absborder.left);
+	    place.y := y + CARDINAL (absborder.bottom);
+	    AddString (tiles, place, text, count, foreground, databorder);
+	END (*WITH*);
+
+    END GString;
+
+(************************************************************************)
+
+PROCEDURE GStringUp (w: Window;  x, y: CARDINAL;  text: ARRAY OF CHAR);
+
+    (* Like GString, but the string is rotated counterclockwise by	*)
+    (* 90 degrees, i.e. it is written in the +Y direction.		*)
+
+    VAR count: CARDINAL;  place: Point;
+
+    BEGIN
+	count := StringLength (text);
+	IF count = 0 THEN RETURN END(*IF*);
+
+	(* Add the string to the TileSet.	*)
+
+	WITH w^ DO
+	    place.x := x + CARDINAL (absborder.left);
+	    place.y := y + CARDINAL (absborder.bottom);
+	    AddRotatedString (tiles, place, text, count, foreground,
+							databorder);
+	END (*WITH*);
+
+    END GStringUp;
+
+(************************************************************************)
+(*			    TEXT OPERATIONS				*)
+(************************************************************************)
+(*									*)
+(*  Every open window has a "text cursor" which is used only for text	*)
+(*  operations and is independent of any operations on dots and lines.	*)
+(*  The text cursor is updated after any text operation in such a way	*)
+(*  that the characters follow one another in the way one would expect	*)
+(*  for non-graphics windows.						*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE ComputeGraphicCursor (w: Window);
+
+    (* Converts character position to graphics coordinates in w^.cursor	*)
+
+    BEGIN
+	WITH w^ DO
+	    WITH cursor DO
+		x := databorder.left + 8*column + 3;
+		y := databorder.top - VAL(INTEGER,CharHeight)*(row+1) - 2;
+	    END (*WITH*);
+	END (*WITH*);
+    END ComputeGraphicCursor;
+
+(************************************************************************)
+
+PROCEDURE SetCursor (w: Window;  row, column: CARDINAL);
+
+    (* Sets the text cursor to the specified row and column.  The row	*)
+    (* and column are measured in units of characters (not pixels),	*)
+    (* with (0,0) representing the first character position at the	*)
+    (* upper left of the window.					*)
+
+    BEGIN
+	w^.row := row;  w^.column := column;
+	ComputeGraphicCursor (w);
+    END SetCursor;
+
+(************************************************************************)
+
+PROCEDURE SaveCursor (w: Window;  VAR (*OUT*) row, column: CARDINAL);
+
+    (* Returns the current row and column of the text cursor. *)
+
+    BEGIN
+	row := w^.row;  column := w^.column;
+    END SaveCursor;
+
+(************************************************************************)
+
+PROCEDURE ScrollUp (w: Window);
+
+    (* Moves all the text in w up by one line, discarding what falls	*)
+    (* off the top.							*)
+
+    BEGIN
+	ScrollContents (w^.tiles, CharHeight, w^.databorder);
+    END ScrollUp;
+
+(************************************************************************)
+
+PROCEDURE WriteLn (w: Window);
+
+    (* Sets the text cursor to the start of the next text line down.	*)
+    (* If the cursor reaches the bottom of the window, the text in the	*)
+    (* window is scrolled.						*)
+
+    BEGIN
+	WITH w^ DO
+	    column := ScrollRegion.left;
+	    IF row >= ScrollRegion.bottom THEN ScrollUp (w)
+	    ELSE INC (row);
+	    END (*IF*);
+	END (*WITH*);
+	ComputeGraphicCursor (w);
+    END WriteLn;
+
+(************************************************************************)
+
+PROCEDURE WriteString (w: Window;  text: ARRAY OF CHAR);
+
+    (* Writes a horizontal character string at the current text cursor	*)
+    (* position for window w.  Characters which do not fit on the	*)
+    (* current line are wrapped around to a new row.			*)
+
+    VAR count, amount, pos, j, canfit: CARDINAL;
+
+    BEGIN
+	amount := StringLength (text);
+	pos := 0;
+	WITH w^ DO
+	    WITH ScrollRegion DO
+		IF (amount = 0) OR (right < left) THEN RETURN END(*IF*);
+	    END (*WITH*);
+	    LOOP
+		IF column > ScrollRegion.right THEN
+		    WriteLn (w);
+		END (*IF*);
+		canfit := ScrollRegion.right - column + 1;
+		IF amount > canfit THEN count := canfit
+		ELSE count := amount;
+		END (*IF*);
+
+		AddString (tiles, cursor, text, count, foreground, databorder);
+		INC (column, count);  INC (cursor.x, 8*count);
+
+		DEC (amount, count);
+		IF amount = 0 THEN EXIT(*LOOP*) END(*IF*);
+
+		WriteLn (w);
+		INC (pos, count);
+		FOR j := 0 TO amount-1 DO
+		    text[j] := text[count+j];
+		END (*FOR*);
+
+	    END (*LOOP*);
+
+	END (*WITH*);
+
+    END WriteString;
+
+(************************************************************************)
+
+PROCEDURE WriteChar (w: Window;  ch: CHAR);
+
+    (* Writes a horizontal character at the current text cursor		*)
+    (* position for window w.  The text cursor is updated.		*)
+
+    VAR buffer: ARRAY [0..0] OF CHAR;
+
+    BEGIN
+	buffer[0] := ch;
+	WriteString (w, buffer);
+    END WriteChar;
+
+(************************************************************************)
+(*				SHUTDOWN				*)
+(************************************************************************)
+
+PROCEDURE ShutDown;
+
+    VAR w: Window;  dummy: CHAR;
+	message: ARRAY [0..79] OF CHAR;
+	
+    BEGIN
+	(* For abnormal termination, put an error diagnostic on the	*)
+	(* screen.							*)
+
+	IF TerminationMessage(message) THEN
+	    OpenWindow (w, 0,0, 300,30, 0, MaxColour, single);
+	    WriteString (w, message);
+	    dummy := InKey();
+	    CloseWindow (w);
+	END (*IF*);
+
+    END ShutDown;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE InitGraphics (mode: CARDINAL);
+
+    (* Sets up the Graphics mode.  Optional, since the module starts up	*)
+    (* with a best estimate of the "best" mode possible on the		*)
+    (* available hardware.						*)
+
+    BEGIN
+	SetMode (mode, TRUE);
+	GetScreenShape (XMAX, YMAX, MaxColour, CharHeight);
+    END InitGraphics;
+
+(************************************************************************)
+
+BEGIN
+    SetDefaultMode;
+    GetScreenShape (XMAX, YMAX, MaxColour, CharHeight);
+    SetTerminationProcedure (ShutDown);
+END GWindows.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/harddisk.def b/examples/Modula-2_Libraries/PMOS/sources/general/harddisk.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/harddisk.def
@@ -0,0 +1,24 @@
+DEFINITION MODULE HardDisk;
+
+	(********************************************************)
+	(*							*)
+	(*		Device driver for hard disk		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	27 July 1992			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(*	Note that there are no explicit entry		*)
+	(*	points to this module.  To use it, put an	*)
+	(*	"IMPORT HardDisk" declaration somewhere in	*)
+	(*	your program, and do all I/O through module	*)
+	(*	Files (for file-structured I/O), or module	*)
+	(*	Devices (for low-level operations).		*)
+	(*							*)
+	(*	Do not use this module under OS/2; use module	*)
+	(*	FileSys instead.				*)
+	(*							*)
+	(********************************************************)
+
+END HardDisk.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/harddisk.mod b/examples/Modula-2_Libraries/PMOS/sources/general/harddisk.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/harddisk.mod
@@ -0,0 +1,810 @@
+IMPLEMENTATION MODULE HardDisk;
+
+	(********************************************************)
+	(*							*)
+	(*		Device driver for hard disk		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	26 February 1995		*)
+	(*  Status:		Working				*)
+	(*	This module has been implicated in a number of	*)
+	(*	mysterious bugs, but every time I've tried to	*)
+	(*	track down problems they've turned out to be	*)
+	(*	artefacts of VID or unfortunate interactions	*)
+	(*	with SmartDrive.  Although it's hard to be	*)
+	(*	completely sure that the module is bug-free,	*)
+	(*	I'm reasonably certain that it is working as	*)
+	(*	intended.					*)
+	(*							*)
+	(*	Note however that the safety of this module is	*)
+	(*	suspect in an environment where the Windows	*)
+	(*	SmartDrive program is running.			*)
+	(*							*)
+	(*	Note also that OS/2 will prevent the		*)
+	(*	initialisation phase of this module from	*)
+	(*	reading the partition table; this will cause	*)
+	(*	the module to conclude that there are no	*)
+	(*	logical drives, which of course means that	*)
+	(*	the module does not do anything useful		*)
+	(*	under OS/2.					*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(*									*)
+(* The hardware interface is an array of 8 ports, starting at port 1F0H,*)
+(* as follows:								*)
+(*	0	read or write data					*)
+(*	1	set precompensation cylinder, when written to		*)
+(*		error register, when read				*)
+(*	2	sector count						*)
+(*	3	sector number						*)
+(*	4	cylinder number (bottom 8 bits)				*)
+(*	5	cylinder number (top 2 bits)				*)
+(*	6	ECC/size/drive/head, stored as:				*)
+(*			bits 3-0	head				*)
+(*			bit 4		drive				*)
+(*			bits 6, 5	sector size code: 00 for 256	*)
+(*					bytes, 01 for 512, 10 for 1024,	*)
+(*					11 for 128-byte sectors		*)
+(*			bit 7		extend length to include ECC	*)
+(*	7	command register, when written to			*)
+(*		status register, when read				*)
+(*									*)
+(* The status register bits have the meaning:				*)
+(*		bit 7	controller busy					*)
+(*		bit 6	drive ready					*)
+(*		bit 5	write fault					*)
+(*		bit 4	seek complete					*)
+(*		bit 3	data request					*)
+(*		bit 2	data error corrected from ECC			*)
+(*		bit 1	command in progress				*)
+(*		bit 0	status error, see error register		*)
+(*									*)
+(* The bit definitions for the error register are shown in procedure	*)
+(* CheckStatus.								*)
+(*									*)
+(* There is also a control byte at port 3F6H, for which we set bit 3	*)
+(* to specify >8 heads; in addition setting bit 6 or bit 7 of this	*)
+(* byte will disable retries.						*)
+(*									*)
+(* Interrupts are INT 76H, which is IRQ level 14, i.e. it is through	*)
+(* the slave interrupt controller.					*)
+(*									*)
+(************************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE, ADDRESS;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM IOErrorCodes IMPORT
+    (* type *)	ErrorCode;
+
+FROM LowLevel IMPORT
+    (* proc *)	InByte, OutByte, InStringWord, OutStringWord,
+		IANDB, IOR, LowByte, HighByte,
+		MakePointer, AddOffset;
+
+FROM MiscPMOS IMPORT
+    (* type *)	RegisterPacket,
+    (* proc *)	BIOS, EnterCriticalSection, LeaveCriticalSection;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Signal;
+
+FROM Timer IMPORT
+    (* proc *)	TimedWait;
+
+FROM TaskControl IMPORT
+    (* proc *)	CreateTask, WaitForInterrupt, CreateInterruptTask;
+
+FROM Devices IMPORT
+    (* type *)	BlockNumberType, Device, RequestBlock, RequestBlockPointer,
+		OperationType,
+    (* proc *)	InstallDeviceDriver, DeviceName, AcceptRequest;
+
+FROM DMA IMPORT
+    (* proc *)	CheckDMAAddress;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, WriteString, ChangeScrollingRegion;
+
+FROM MaintenancePages IMPORT
+    (* type *)	MaintenancePage,
+    (* proc *)	CreateMaintenancePage, Associate;
+
+(************************************************************************)
+
+CONST
+    testing = TRUE;		(* controls output to maintenance page *)
+    DataPort = 01F0H;
+    StatusPort = DataPort+7;
+    DiskInterrupt = 76H;
+    BlockSize = 512;		(* bytes per sector *)
+
+TYPE
+    (* The following declarations reflect the fact that a hard disk	*)
+    (* may be partitioned into several logical drives, each of which	*)
+    (* looks like a separate drive to the programmer.			*)
+
+    PhysicalDriveNumber = [0..1];
+    LogicalDriveNumber = [0..7];
+
+    CommandArray = ARRAY [1..7] OF BYTE;
+
+    (* Because we have to allow for a variety of disk types, there is a	*)
+    (* fixed disk parameter table where each entry describes one	*)
+    (* supported disk type.  Interrupt vector 41H (address 104H) is a	*)
+    (* pointer to the table entry for drive 0, and vector 46H (address	*)
+    (* 118H) points to the table entry for drive 1.  The table entry is	*)
+    (* 16 bytes long:							*)
+    (*	max # of cylinders	: CARDINAL;				*)
+    (*	max # of heads		: BYTE;					*)
+    (*	unused			: WORD;					*)
+    (*	starting write precompensation cylinder: WORD;			*)
+    (*	max ECC data burst length: BYTE;				*)
+    (*	control byte		: BYTE;					*)
+    (*					bit 7 disables retries -or-	*)
+    (*					bit 6 disables retries		*)
+    (*					bit 3 means more than 8 heads	*)
+    (*	unused:			: ARRAY [1..3] OF BYTE;			*)
+    (*	landing zone:		: WORD;					*)
+    (*	sectors per track:	: BYTE;					*)
+    (*	reserved		: BYTE					*)
+    (* The relevant parts of this table are copied by the module	*)
+    (* initialisation code into PhysicalDriveData.  Note that a lot of	*)
+    (* this information is never used by this module.			*)
+
+    DiskParameterTable = RECORD
+			    maxcylinders: CARDINAL;
+			    maxheads: BYTE;
+			    dummy1: CARDINAL;		(* unused *)
+			    precomp: CARDINAL;
+			    maxECCburstlength: BYTE;
+			    optionbyte: BYTE;
+			    dummy2: ARRAY [1..3] OF BYTE; (* unused *)
+			    landingzone: CARDINAL;
+			    sectorspertrack: BYTE;
+			    dummy3: BYTE;		(* unused *)
+			 END (*RECORD*);
+
+VAR
+    log: Window;		(* for maintenance page output *)
+    harddisk: Device;
+    DataRequest: Semaphore;
+    NumberOfPhysicalDrives: [0..MAX(PhysicalDriveNumber)+1];
+    NumberOfLogicalDrives: [0..MAX(LogicalDriveNumber)+1];
+
+    PhysicalDriveData: ARRAY PhysicalDriveNumber OF
+			    RECORD
+				SectorsPerTrack: CARDINAL;
+				NumberOfHeads: CARDINAL;
+				PrecompensationCylinder: CARDINAL;
+				ExtraHeadOption: BYTE;
+			    END (*RECORD*);
+
+    LogicalUnit: ARRAY LogicalDriveNumber OF
+			    RECORD
+				physicaldrive: PhysicalDriveNumber;
+				bootblock: BlockNumberType;
+				numberofsectors: BlockNumberType;
+			    END (*RECORD*);
+
+(************************************************************************)
+(*			HARDWARE STATUS CHECKS				*)
+(************************************************************************)
+
+PROCEDURE TestReady (VAR (*IN*) CommandBlock: CommandArray): ErrorCode;
+
+    (* Checks that both the controller and the drive are ready to	*)
+    (* accept a command.						*)
+
+    CONST lots = 32767;
+
+    VAR patience: CARDINAL;
+
+    BEGIN
+
+	(* First test the controller status byte, looping until the	*)
+	(* busy bit is clear or until we run out of patience.		*)
+
+	patience := lots;
+	WHILE ORD(IANDB (InByte (StatusPort), 80H)) <> 0 DO
+	    DEC (patience);
+	    IF patience = 0 THEN
+		RETURN ControllerNotListening;
+	    END(*IF*);
+	END (*WHILE*);
+
+	(* Put out the ECC/size/drive/head code, to check whether the	*)
+	(* drive is ready.						*)
+
+	OutByte (DataPort+6, CommandBlock[6]);
+
+	IF ORD(IANDB (InByte(StatusPort), 40H)) = 0 THEN
+	    RETURN DriveNotReady;
+	END (*IF*);
+
+	RETURN OK;
+    END TestReady;
+
+(************************************************************************)
+
+PROCEDURE CheckStatus (): ErrorCode;
+
+    (* Returns the current status of the disk controller.	*)
+    (* N.B. Reports OK if the controller is still busy.		*)
+
+    VAR StatusByte: BYTE;
+
+    BEGIN
+	StatusByte := InByte (StatusPort);
+	IF ORD(IANDB (StatusByte, 80H)) <> 0 THEN RETURN OK;
+	ELSIF ORD(IANDB (StatusByte, 20H)) <> 0 THEN RETURN WriteFault;
+	ELSIF ORD(IANDB (StatusByte, 40H)) = 0 THEN RETURN DriveNotReady;
+	ELSIF ORD(IANDB (StatusByte, 10H)) = 0 THEN RETURN SeekFailure;
+
+	(* If the low-order bit of the status register is set, we need	*)
+	(* to look at the error register.				*)
+
+	ELSIF ODD (StatusByte) THEN
+
+	    StatusByte := InByte (DataPort+1);
+	    IF ORD(IANDB(StatusByte,80H)) <> 0 THEN RETURN BadBlock
+	    ELSIF ORD(IANDB(StatusByte,40H)) <> 0 THEN RETURN BadData
+	    ELSIF ORD(IANDB(StatusByte,20H)) <> 0 THEN RETURN UndiagnosedFailure
+	    ELSIF ORD(IANDB(StatusByte,10H)) <> 0 THEN RETURN SectorNotFound
+	    ELSIF ORD(IANDB(StatusByte,08H)) <> 0 THEN RETURN UndiagnosedFailure
+	    ELSIF ORD(IANDB(StatusByte,04H)) <> 0 THEN RETURN BadCommand
+	    ELSIF ORD(IANDB(StatusByte,02H)) <> 0 THEN RETURN CalibrationFailure
+	    ELSIF ORD(IANDB(StatusByte,01H)) <> 0 THEN RETURN BadData
+	    ELSE RETURN OK;
+	    END (*IF*);
+
+	ELSE RETURN OK;
+	END (*IF*);
+
+    END CheckStatus;
+
+(************************************************************************)
+(*		  SENDING A COMMAND TO THE DISK CONTROLLER		*)
+(************************************************************************)
+
+PROCEDURE Command (VAR (*IN*) CommandBlock: CommandArray): ErrorCode;
+
+    (* Outputs the command block.  *)
+
+    VAR patience: CARDINAL;
+	status: ErrorCode;
+	j: [1..7];
+
+    BEGIN
+	patience := 1000;
+	LOOP
+	    status := TestReady (CommandBlock);
+	    IF status = OK THEN EXIT (*LOOP*) END (*IF*);
+	    IF status = ControllerNotListening THEN
+		RETURN status;
+	    END (*IF*);
+	    DEC (patience);
+	    IF patience = 0 THEN RETURN status; END (*IF*);
+	END (*LOOP*);
+
+	(* Send the command block to the device interface.	*)
+
+	FOR j := 1 TO 7 DO
+	    OutByte (DataPort+j, CommandBlock[j]);
+	END (*FOR*);
+
+	RETURN OK;
+
+    END Command;
+
+(************************************************************************)
+(*			    THE INTERRUPT TASK				*)
+(************************************************************************)
+
+PROCEDURE DRQInterruptHandler;
+
+    (* Performs a Signal(DataRequest) on each hardware interrupt.	*)
+
+    BEGIN
+	LOOP (*FOREVER*)
+	    WaitForInterrupt;
+	    Signal (DataRequest);
+	END (*LOOP*);
+    END DRQInterruptHandler;
+
+(************************************************************************)
+(*			CHECK FOR DISK READY				*)
+(************************************************************************)
+
+PROCEDURE WaitDRQ (VAR (*OUT*) TimedOut: BOOLEAN);
+
+    (* Busy waits for a data request. *)
+
+    VAR patience: CARDINAL;
+
+    BEGIN
+	patience := 100H;  TimedOut := FALSE;
+	LOOP
+	    IF ORD(IANDB (InByte(StatusPort), 8)) <> 0 THEN
+		EXIT(*LOOP*);
+	    END(*IF*);
+	    DEC(patience);
+	    IF patience = 0 THEN
+		TimedOut := TRUE;
+		EXIT (*LOOP*);
+	    END (*IF*);
+	END (*LOOP*);
+    END WaitDRQ;
+
+(************************************************************************)
+(*		   THE ACTUAL READ AND WRITE OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE ReadOperation (VAR (*INOUT*) CommandBlock: CommandArray;
+					BufferAddress: ADDRESS): ErrorCode;
+
+    (* Data transfer from disk to DataBuffer, where CommandBlock	*)
+    (* specifies the precise operation desired.				*)
+
+    CONST largenumber = 1000;
+
+    VAR status: ErrorCode;  TimedOut: BOOLEAN;
+	sectors: SHORTCARD;
+
+    BEGIN
+	(* Check for 64K boundary error. *)
+
+	IF NOT CheckDMAAddress (BufferAddress,
+				BlockSize*VAL(CARDINAL,CommandBlock[2])) THEN
+	    RETURN BadDMAAddress;
+	END (*IF*);
+
+	status := Command (CommandBlock);
+	IF status <> OK THEN
+	    RETURN status;
+	END (*IF*);
+
+	sectors := CommandBlock[2];
+	REPEAT
+	    TimedWait (DataRequest, largenumber, TimedOut);
+
+	    IF TimedOut THEN
+		RETURN TimeoutError;
+	    END (*IF*);
+
+	    (* Get the sector, via block input *)
+
+	    InStringWord (DataPort, BufferAddress, 256 (*words*) );
+	    BufferAddress := AddOffset (BufferAddress, BlockSize);
+
+	    status := CheckStatus();
+	    IF status <> OK THEN
+		RETURN status;
+	    END (*IF*);
+	    DEC (sectors);
+
+	UNTIL sectors = 0;
+	RETURN OK;
+
+    END ReadOperation;
+
+(************************************************************************)
+
+PROCEDURE WriteOperation (VAR (*INOUT*) CommandBlock: CommandArray;
+					BufferAddress: ADDRESS): ErrorCode;
+
+    (* Writes a block of data from BufferAddress^.  CommandBlock	*)
+    (* specifies the disk block, amount of data to transfer, etc.	*)
+
+    CONST largenumber = 1000;
+
+    VAR status: ErrorCode;  TimedOut: BOOLEAN;
+
+    BEGIN
+	(* Check for 64K boundary error. *)
+
+	IF NOT CheckDMAAddress (BufferAddress,
+				BlockSize*VAL(CARDINAL,CommandBlock[2])) THEN
+	    RETURN BadDMAAddress;
+	END (*IF*);
+
+	status := Command (CommandBlock);
+	IF status <> OK THEN
+	    RETURN status;
+	END (*IF*);
+	WaitDRQ (TimedOut);
+	IF TimedOut THEN RETURN TimeoutError END (*IF*);
+
+	REPEAT
+	    (* Put the sector, via block output *)
+
+	    OutStringWord (DataPort, BufferAddress, 256 (*words*) );
+	    BufferAddress := AddOffset (BufferAddress, BlockSize);
+
+	    TimedWait (DataRequest, largenumber, TimedOut);
+	    IF TimedOut THEN RETURN TimeoutError END (*IF*);
+	    IF CheckStatus() <> OK THEN RETURN status END (*IF*);
+
+	    (* Remark: the termination test below is a check on the	*)
+	    (* data request bit of the status register.  When the data	*)
+	    (* request bit becomes 0, we know that there are no further	*)
+	    (* sectors to transfer.					*)
+
+	UNTIL ORD(IANDB(InByte (StatusPort), 8)) = 0;
+	RETURN OK;
+
+    END WriteOperation;
+
+(************************************************************************)
+(*			SETTING UP THE COMMAND BLOCK			*)
+(************************************************************************)
+
+PROCEDURE Decompose (BlockNumber: BlockNumberType;  drive: PhysicalDriveNumber;
+			VAR (*OUT*) head, cylinder, sector: CARDINAL);
+
+    (* Translates a block number into head/cylinder/sector coordinates.	*)
+    (* The relationship is						*)
+    (*	BlockNumber = SectorsPerTrack*(NumberOfHeads*cylinder+head)	*)
+    (*						+ sector - 1		*)
+    (* Note that sector number starts from 1, while the numbering	*)
+    (* of blocks, heads, and cylinders all start from 0.		*)
+
+    VAR H: CARDINAL;
+
+    BEGIN
+	WITH PhysicalDriveData[drive] DO
+	    sector := CARDINAL(BlockNumber MOD LONGCARD(SectorsPerTrack)) + 1;
+	    cylinder := CARDINAL(BlockNumber DIV LONGCARD(SectorsPerTrack));
+	    H := NumberOfHeads;
+	END (*WITH*);
+	head := cylinder MOD H;
+	cylinder := cylinder DIV H;
+    END Decompose;
+
+(************************************************************************)
+
+PROCEDURE Encode (VAR (*OUT*) CommandBlock: CommandArray;  opcode: BYTE;
+			drive: PhysicalDriveNumber;
+			BlockNumber: BlockNumberType; count: CARDINAL);
+
+    (* Given the drive number, block number, and byte count of a	*)
+    (* disk operation, fills in the appropriate CommandBlock fields.	*)
+
+    VAR sector, cylinder, head: CARDINAL;
+
+    BEGIN
+
+	(* Deal with the write precompensation cylinder, the "extra	*)
+	(* head" option, and retry suppression.				*)
+
+	WITH PhysicalDriveData[drive] DO
+	    CommandBlock[1] := SHORTCARD(PrecompensationCylinder DIV 4);
+	    OutByte (3F6H, ExtraHeadOption);
+	    IF ORD(IANDB (ExtraHeadOption, 0C0H)) <> 0 THEN
+		INC (opcode);			(* to disable retries *)
+	    END (*IF*);
+	END (*WITH*);
+
+	(* CommandBlock[2] specifies the number of sectors.	*)
+
+	CommandBlock[2] := SHORTCARD(count DIV BlockSize);
+
+	(* Turn the block number into head/cylinder/sector form. *)
+
+	Decompose (BlockNumber, drive, head, cylinder, sector);
+	CommandBlock[3] := SHORTCARD(sector);
+	CommandBlock[4] := LowByte (cylinder);
+	CommandBlock[5] := HighByte (cylinder);		(* only 2 bits *)
+
+	(* The 0A0H below is the code for ECC and 512-byte sectors.	*)
+
+	CommandBlock[6] := BYTE(16*drive + head + 0A0H);
+	CommandBlock[7] := opcode;
+
+    END Encode;
+
+(************************************************************************)
+(*		    THE USER-CALLABLE READ OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE ReadPhysicalBlock (drive: PhysicalDriveNumber;
+			BlockNumber: BlockNumberType;  count: CARDINAL;
+			BufferAddress: ADDRESS): ErrorCode;
+
+    (* Reads "count" bytes, starting at the beginning of disk block	*)
+    (* "BlockNumber" on the specified drive, into a memory buffer.	*)
+
+    VAR CommandBlock: CommandArray;  result: ErrorCode;
+
+    BEGIN
+	IF drive >= NumberOfPhysicalDrives THEN
+	    result := NoSuchUnit;
+	ELSE
+	    Encode (CommandBlock, 20H, drive, BlockNumber, count);
+	    result := ReadOperation (CommandBlock, BufferAddress);
+	END (*IF*);
+	RETURN result;
+    END ReadPhysicalBlock;
+
+(************************************************************************)
+
+PROCEDURE ReadLogicalBlock (unit: LogicalDriveNumber;
+			RelativeBlock: BlockNumberType;  count: CARDINAL;
+			BufferAddress: ADDRESS): ErrorCode;
+
+    (* Reads "count" bytes, starting at the beginning of disk block	*)
+    (* "RelativeBlock" on the specified logical unit, into memory	*)
+    (* starting at "BufferAddress".					*)
+
+    VAR drive: PhysicalDriveNumber;  BlockNo: BlockNumberType;
+
+    BEGIN
+	WITH LogicalUnit[unit] DO
+	    IF RelativeBlock >= numberofsectors THEN
+		RETURN IllegalBlockNumber;
+	    END (*IF*);
+	    drive := physicaldrive;
+	    BlockNo := bootblock + RelativeBlock;
+	END (*WITH*);
+	RETURN ReadPhysicalBlock (drive, BlockNo, count, BufferAddress);
+    END ReadLogicalBlock;
+
+(************************************************************************)
+(*		    THE USER-CALLABLE WRITE OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE WritePhysicalBlock (drive: PhysicalDriveNumber;
+				BlockNumber: BlockNumberType;  count: CARDINAL;
+				BufferAddress: ADDRESS): ErrorCode;
+
+    (* Writes "count" bytes, starting at the beginning of disk block	*)
+    (* "BlockNumber" on the specified drive, from a memory buffer.	*)
+
+    VAR CommandBlock: CommandArray;  result: ErrorCode;
+
+    BEGIN
+	IF drive >= NumberOfPhysicalDrives THEN
+	    result := NoSuchUnit;
+	ELSE
+	    Encode (CommandBlock, 30H, drive, BlockNumber, count);
+	    result := WriteOperation (CommandBlock, BufferAddress);
+	END (*IF*);
+	RETURN result;
+    END WritePhysicalBlock;
+
+(************************************************************************)
+
+PROCEDURE WriteLogicalBlock (unit: LogicalDriveNumber;
+			RelativeBlock: BlockNumberType;  count: CARDINAL;
+			BufferAddress: ADDRESS): ErrorCode;
+
+    (* Writes "count" bytes, starting at the beginning of disk block	*)
+    (* "RelativeBlock" on the specified logical unit, from memory	*)
+    (* starting at "BufferAddress".					*)
+
+    VAR drive: PhysicalDriveNumber;  BlockNo: BlockNumberType;
+
+    BEGIN
+	WITH LogicalUnit[unit] DO
+	    IF RelativeBlock >= numberofsectors THEN
+		RETURN IllegalBlockNumber;
+	    END (*IF*);
+	    drive := physicaldrive;
+	    BlockNo := bootblock + RelativeBlock;
+	END (*WITH*);
+	RETURN WritePhysicalBlock (drive, BlockNo, count, BufferAddress);
+    END WriteLogicalBlock;
+
+(************************************************************************)
+(*		     INTERFACE TO "Devices" MODULE			*)
+(************************************************************************)
+
+PROCEDURE DiskOperation (VAR (*INOUT*) details: RequestBlock);
+
+    (* Performs a disk transfer as specified in the request block.	*)
+
+    BEGIN
+	WITH details DO
+	    IF operation = read THEN
+		Status := ReadLogicalBlock (unit, BlockNumber,
+						ByteCount, BufferAddress);
+	    ELSIF operation = write THEN
+		Status := WriteLogicalBlock (unit, BlockNumber,
+						ByteCount, BufferAddress);
+	    ELSIF operation = physicalread THEN
+		Status := ReadPhysicalBlock (LogicalUnit[unit].physicaldrive,
+					BlockNumber, BlockSize, BufferAddress);
+	    ELSIF operation = physicalwrite THEN
+		Status := WritePhysicalBlock (LogicalUnit[unit].physicaldrive,
+					BlockNumber, BlockSize, BufferAddress);
+	    ELSE
+		Status := FeatureNotImplemented;
+	    END (*IF*);
+	END (*WITH*);
+    END DiskOperation;
+
+(************************************************************************)
+
+PROCEDURE DiskRequestHandler;
+
+    (* This procedure runs as an independent task.  Each time around	*)
+    (* its main loop, it picks up one enqueued I/O request and executes	*)
+    (* the request.  The requests are placed on the queue by calls to	*)
+    (* module Devices.  On completion of an operation, we inform the	*)
+    (* caller by performing a Signal on a user-specified semaphore.	*)
+
+    CONST MaxNumberOfRetries = 3;
+
+    VAR reply: ErrorCode;  retries: CARDINAL;
+	RequestPointer: RequestBlockPointer;
+
+    BEGIN
+	LOOP
+	    RequestPointer := AcceptRequest (harddisk);
+	    WITH RequestPointer^ DO
+		IF operation = shutdown THEN
+		    Signal (DoneSemaphorePointer^);
+		    EXIT (*LOOP*);
+		END (*IF*);
+	    END (*WITH*);
+	    retries := 0;
+	    REPEAT
+		DiskOperation (RequestPointer^);
+		reply := RequestPointer^.Status;
+		INC (retries);
+	    UNTIL (reply = OK) OR (retries>MaxNumberOfRetries);
+	    Signal (RequestPointer^.DoneSemaphorePointer^);
+
+	END (*LOOP*);
+
+    END DiskRequestHandler;
+
+(************************************************************************)
+(*			     INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE SetUpDrive (d: PhysicalDriveNumber;  pplace: CARDINAL);
+
+    (* Sets up PhysicalDriveData[d] by copying the appropriate		*)
+    (* information from a table which already exists and whose address	*)
+    (* is held at absolute location pplace in low memory.		*)
+
+    (*# save, data(near_ptr=>off) *)
+
+    TYPE TblPtr = POINTER TO DiskParameterTable;
+
+    VAR TablePointer: TblPtr;
+	PointerPointer: POINTER TO TblPtr;
+
+    (*# restore *)
+
+    BEGIN
+
+	PointerPointer := MakePointer (0, pplace);
+	TablePointer := PointerPointer^;
+	IF TablePointer = FarNIL THEN
+	    RETURN;
+	END (*IF*);
+	INC (NumberOfPhysicalDrives);
+
+	WITH PhysicalDriveData[d] DO
+	    SectorsPerTrack := CARDINAL(TablePointer^.sectorspertrack);
+	    NumberOfHeads := CARDINAL(TablePointer^.maxheads);
+	    PrecompensationCylinder := TablePointer^.precomp;
+	    ExtraHeadOption := TablePointer^.optionbyte;
+	END (*WITH*);
+
+    END SetUpDrive;
+
+(************************************************************************)
+
+PROCEDURE DecodePartitionTable;
+
+    (* On entry to this procedure, we have already initialised all data	*)
+    (* pertaining to the physical drives, but do not yet have a logical	*)
+    (* drive structure.  This procedure reads the partition table on	*)
+    (* physical block 0 of each physical drive, sets up the logical	*)
+    (* drive information, and installs us as a device driver known to	*)
+    (* module Devices.							*)
+
+    VAR bufptr: POINTER TO ARRAY [0..BlockSize-1] OF BYTE;
+	drive: PhysicalDriveNumber;  unit: CARDINAL;
+	bootblockptr, sizeptr: POINTER TO LONGCARD;
+	subscript: [0..BlockSize-1];
+	Registers: RegisterPacket;
+	(*# save, data(near_ptr=>off) *)
+	StringAddress: POINTER TO ARRAY [0..63] OF CHAR;
+	(*# restore *)
+
+    BEGIN
+	FOR unit := 0 TO MAX(LogicalDriveNumber) DO
+	    WITH LogicalUnit[unit] DO
+		physicaldrive := 0;  bootblock := 0;
+		numberofsectors := 0;
+	    END (*WITH*);
+	END (*FOR*);
+	unit := 0;
+	ALLOCATE (bufptr, BlockSize);
+	FOR drive := 0 TO NumberOfPhysicalDrives-1 DO
+	    IF ReadPhysicalBlock (drive, 0, BlockSize, bufptr) = OK
+	      THEN
+		FOR subscript := 01C0H TO 01F0H BY 10H DO
+		    IF bufptr^[subscript] <> BYTE(0) THEN
+			bootblockptr := AddOffset (bufptr, subscript+6);
+			sizeptr := AddOffset (bufptr, subscript+10);
+			WITH LogicalUnit[unit] DO
+			    physicaldrive := drive;
+			    bootblock := bootblockptr^;
+			    numberofsectors := sizeptr^;
+			END (*WITH*);
+			INC (unit);
+		    END (*IF*);
+		END (*FOR*);
+	    END (*IF*);
+	END (*FOR*);
+	DEALLOCATE (bufptr, BlockSize);
+
+	(* Having collected all necessary information from the	*)
+	(* partition tables, set up the drive names.		*)
+
+	NumberOfLogicalDrives := unit;
+	IF NumberOfLogicalDrives > 0 THEN
+	    harddisk := InstallDeviceDriver (NumberOfLogicalDrives);
+	    FOR unit := 0 TO NumberOfLogicalDrives-1 DO
+
+		(* Read the current directory for the this logical drive.	*)
+
+		WITH Registers DO
+		    DL := SHORTCARD(unit) + 3;
+		    AH := 71;
+		    BIOS (33, Registers);
+		    StringAddress := MakePointer (DS, SI);
+		END (*WITH*);
+
+		(* Pass the information to module Devices.	*)
+
+		DeviceName (harddisk, unit, CHR(ORD("C")+unit),
+			LogicalUnit[unit].numberofsectors, StringAddress^);
+
+	    END (*FOR*);
+	END (*IF*);
+
+    END DecodePartitionTable;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+VAR Mpage: MaintenancePage;
+
+BEGIN
+    IF testing THEN
+	CreateMaintenancePage (Mpage);
+	OpenWindow (log, black, green, 0,23, 0,60, simpleframe, doubledivider);
+	Associate (log, Mpage);
+	WriteString (log,"         Diagnostic output from hard disk driver");
+	ChangeScrollingRegion (log, 3, 22);
+    END (*IF*);
+    CreateSemaphore (DataRequest, 0);
+    NumberOfPhysicalDrives := 0;
+    SetUpDrive (0, 104H);
+    SetUpDrive (1, 118H);
+    IF NumberOfPhysicalDrives = 0 THEN
+	NumberOfLogicalDrives := 0;
+    ELSE
+	CreateInterruptTask (DiskInterrupt, DRQInterruptHandler,
+						"Hard disk int");
+	DecodePartitionTable;
+    END (*IF*);
+    IF NumberOfLogicalDrives > 0 THEN
+	CreateTask (DiskRequestHandler, 13, "Harddisk queue");
+    END (*IF*);
+END HardDisk.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/innerker.def b/examples/Modula-2_Libraries/PMOS/sources/general/innerker.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/innerker.def
@@ -0,0 +1,179 @@
+DEFINITION MODULE InnerKernel;
+
+(*<TopSpeed3*) (*# save, call(c_conv => off) *) (*>*)
+
+	(****************************************************************)
+	(*								*)
+	(*	This is the nonportable part of the PMOS kernel.	*)
+	(*	It contains procedures whose implementation depends	*)
+	(*	not only on the processor, but also on compiler		*)
+	(*	conventions (which registers are saved, etc.).		*)
+	(*								*)
+	(*	Programmer:	P. Moylan				*)
+	(*	Last edited:	21 March 1995				*)
+	(*	Status:		Working					*)
+	(*								*)
+	(****************************************************************)
+
+FROM Types IMPORT
+    (* type *)	FarPointer;
+
+TYPE
+    (*<TopSpeed3*) Code3 = ARRAY [0..2] OF SHORTCARD; (*>*)
+    TaskSelector = FarPointer;
+    FloatSaveSelector = CARDINAL;
+
+(************************************************************************)
+
+(*<TopSpeed3*) (*# call(reg_saved => (bx,cx,dx,si,di,ds,es,st1,st2)) *) (*>*)
+
+PROCEDURE EnterKernel (): CARDINAL;
+
+    (* Saves the processor flags word, including the current "interrupt	*)
+    (* enable" status, and returns with interrupts disabled.		*)
+    (* NOTE: this procedure and the following one should be used as a	*)
+    (* matched pair.							*)
+
+(*<TopSpeed3*)
+(*# call(reg_param => (ax), reg_saved => (ax,bx,cx,dx,si,di,ds,es,st1,st2)) *)
+(*>*)
+
+PROCEDURE LeaveKernel (PSW: CARDINAL);
+
+    (* Restores the processor flags word, including the "interrupt	*)
+    (* enable" status.  NOTE: this procedure and the one above should	*)
+    (* be used as a matched pair.					*)
+
+(*<TopSpeed3*)
+(*# call(reg_return => (bx,es), reg_saved => (dx,si,di,ds,st1,st2)) *)
+(*%T _fptr *)
+    (*# call(reg_param => (ax,bx,cx,dx)) *)
+(*%E*)
+(*%F _fptr *)
+    (*# call(reg_param => (ax,cx,dx)) *)
+(*%E*)
+(*>*)
+
+PROCEDURE TaskInit (StackBase: ADDRESS;  StackSize: CARDINAL;
+			EnableInterrupts: BOOLEAN;
+			TaskExit, StartAddress: PROC): TaskSelector;
+
+    (* Initialises the stack for a new task.  Parameter StackBase	*)
+    (* points to a block of memory which can be used to hold the stack	*)
+    (* (note that this is a pointer to the start of the memory block,	*)
+    (* not to the bottom of the stack); and StackSize is the size of	*)
+    (* this block.  The next parameter specifies whether processor	*)
+    (* interrupts should be enabled when the task is started.		*)
+    (* StartAddress and TaskExit are the start address of the task code	*)
+    (* and the start address of the code to execute when the task	*)
+    (* terminates.  The value returned is a selector for the new task.	*)
+
+(*<TopSpeed3*) (*# call(reg_saved => (ax,cx,dx,si,di,ds,st1,st2)) *) (*>*)
+
+PROCEDURE InitMainTask (): TaskSelector;
+
+    (* Like TaskInit, but for the special case of the original task	*)
+    (* which is running at program startup.  The function of this	*)
+    (* procedure is simply to ensure that the main stack layout is	*)
+    (* consistent with what we do for all other tasks.			*)
+
+(*<TopSpeed3*)
+(*# call(reg_saved => (ax,bx,cx,dx,si,di,ds,es,st1,st2)) *)
+(*%T _fptr *)
+    (*%T _fdata*)
+	(*# call(reg_param => (si, ds, ax, bx)) *)
+    (*%E*)
+    (*%F _fdata*)
+	(*# call(reg_param => (si, cx, ax, bx)) *)
+    (*%E*)
+(*%E*)
+(*%F _fptr *)
+    (*# call(reg_param => (si, ax, bx)) *)
+(*%E*)
+(*>*)
+
+PROCEDURE Transfer (VAR (*OUT*) source: TaskSelector;
+					destination: TaskSelector);
+
+    (* Performs a task switch to the destination task, at the same time	*)
+    (* saving a selector for the outgoing task in variable "source".	*)
+    (* This allows a subsequent call to Transfer to resume the		*)
+    (* original task.  By the time this procedure has returned to the	*)
+    (* caller, then, we are again executing the calling task.		*)
+
+    (* Special case: if this procedure is called by an interrupt task,	*)
+    (* the call is interpreted as a requiring a task switch from the	*)
+    (* interrupted task - i.e. the source parameter must specify the	*)
+    (* interrupted task - to the destination task.  In this case the	*)
+    (* actual switch to the destination task does not happen until the	*)
+    (* interrupt task makes its next call to IOTransfer.  The reason	*)
+    (* for this interpretation is that task switching to and from	*)
+    (* interrupt tasks is managed internally by this module; the	*)
+    (* occurrence of an interrupt is not something that can be		*)
+    (* controlled by the caller.					*)
+
+PROCEDURE IOTransfer;
+
+    (* May be called only from an interrupt task.  Performs a task	*)
+    (* switch from the current interrupt task to the task which it	*)
+    (* interrupted.  Unlike Transfer, no parameters are required	*)
+    (* because (a) the selector for the destination task is already	*)
+    (* known to this module, having been saved at the time of the	*)
+    (* interrupt; and (b) selectors for interrupt tasks are maintained	*)
+    (* directly by this module rather than by the caller.		*)
+
+(*<TopSpeed3*) (*# call(reg_param => (ax, bx, cx)) *) (*>*)
+
+PROCEDURE StartInterruptTask (TS: TaskSelector; InterruptNumber: CARDINAL);
+
+    (* Starts an interrupt task by running its initialisation section	*)
+    (* - i.e. everything up to the first IOTransfer - and arranging	*)
+    (* that from then on it will be activated by the given interrupt.	*)
+
+(*<TopSpeed3*)
+(*%T _fdata*)
+    (*# call(reg_param => (ax, ds)) *)
+(*%E*)
+(*%F _fdata*)
+    (*# call(reg_param => (ax, bx)) *)
+(*%E*)
+(*>*)
+
+PROCEDURE DisconnectFromInterrupt (TS: TaskSelector);
+
+    (* Restores the interrupt vector to which TS was connected to its	*)
+    (* state before TS was established as an interrupt task.  (N.B. The	*)
+    (* result could be chaotic if there was no previous call to		*)
+    (* StartInterruptTask.)						*)
+
+(*<TopSpeed3*) (*# call(reg_param => (ax,bx), reg_return => (bx)) *) (*>*)
+
+PROCEDURE MakeFloatSaveSelector (selector: TaskSelector): FloatSaveSelector;
+
+    (* Creates the special form of selector which must subsequently be	*)
+    (* used in calls to save and restore the floating point state.	*)
+    (* The parameter supplied must be the value of the task selector	*)
+    (* as created by TaskInit.						*)
+
+PROCEDURE NPXsave (selector: FloatSaveSelector);
+
+    (* Saves the state of the Numeric Processor Extension coprocessor.	*)
+
+PROCEDURE NPXrestore (selector: FloatSaveSelector);
+
+    (* The operation complementary to NewNPXsave.  Restores the		*)
+    (* previously saved state of the floating point coprocessor.	*)
+
+(*<TopSpeed3*) (*# restore *) (*>*)
+
+PROCEDURE PrepareForShutdown;
+
+    (* This procedure is needed just before executing the "exit from	*)
+    (* program" operation, and is provided to get around a problem	*)
+    (* with some memory models in TopSpeed version 3.  (With other	*)
+    (* compilers, this can afford to be a dummy procedure.)		*)
+    (* A (deliberate) side-effect of calling this procedure is that	*)
+    (* the stack is corrupted, so do NOT call it except as the final	*)
+    (* step of termination processing.					*)
+
+END InnerKernel.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/ioerrorc.def b/examples/Modula-2_Libraries/PMOS/sources/general/ioerrorc.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/ioerrorc.def
@@ -0,0 +1,92 @@
+DEFINITION MODULE IOErrorCodes;
+
+	(********************************************************)
+	(*							*)
+	(*		I/O subsystem error codes.		*)
+	(*							*)
+	(*  This module defines a set of error codes which may	*)
+	(*  be used uniformly throughout the file system.	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	11 May 1994			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+
+TYPE
+    ErrorCode = (
+
+	OK,			(* Normal return, no error	*)
+	OperationAborted,	(* Operator forced abort	*)
+
+	(* Error codes from module Files.	*)
+
+	FileNotOpen,		(* Should have opened file first  *)
+
+	(* Error codes from module Devices.	*)
+
+	NoSuchDevice,		(* Illegal device *)
+	NoSuchUnit,		(* Illegal unit number *)
+
+	(* Error codes from module Directories.	*)
+
+	FeatureNotImplemented,	(* Cannot yet handle this case *)
+	InvalidFileNameString,	(* Could not parse filename string *)
+	DirectoryNotFound,	(* Subdirectory name not found *)
+	NotADirectory,		(* Supposed directory name is not a dir	*)
+	NameNotFound,		(* File name not found in directory *)
+	DuplicateFileName,	(* File name already exists *)
+	DeviceFull,		(* No room to create/extend file *)
+	DirectoryFull,		(* No room to create new directory entry *)
+
+	(* Error codes from the disk device drivers.	*)
+
+	BadDMAAddress,		(* Operation uses a memory buffer which	*)
+				(* the DMA hardware cannot handle	*)
+	IllegalBlockNumber,	(* The caller requested an operation on	*)
+				(*  a non-existent disk block.		*)
+	BadCommand,		(* We tried to do something illegal.	*)
+	ControllerNotListening,	(* Could not get the disk controller	*)
+				(*  to accept a command.		*)
+	ControllerOutOfSync,	(* Status information from the disk	*)
+				(*  controller does not make sense.	*)
+	TimeoutError,		(* Data request interrupt did not	*)
+				(*  arrive within a reasonable time.	*)
+	CalibrationFailure,	(* Did not succeed in driving the head	*)
+				(*  back to its home position.		*)
+	SeekFailure,		(* Failed to seek to the desired track.	*)
+	DriveNotReady,		(* Could be an equipment failure, but	*)
+				(*  more commonly means that the drive	*)
+				(*  door is open or there is no disk in	*)
+				(*  the drive.				*)
+	SectorNotFound,		(* Missing sector, cylinder mismatch,	*)
+				(*  and similar errors.  This could	*)
+				(*  mean a badly formatted disk, it	*)
+				(*  could be just one faulty block, or	*)
+				(*  it could mean that a recalibration	*)
+				(*  is needed.				*)
+	BadBlock,		(* The sector has its "bad block"	*)
+				(*  mark set - should not be used.	*)
+	BadData,		(* Something on the disk is corrupted.	*)
+				(*  Could be a transient error, e.g.	*)
+				(*  read error caused by a speck of	*)
+				(*  dust, but it could also be true	*)
+				(*  corruption of the medium.		*)
+	WriteFault,		(* Occurs only with hard disk, reflects	*)
+				(*  a hardware fault signal.		*)
+	WriteProtected,		(* Attempted write to a write-protected	*)
+				(*  disk.				*)
+	UndiagnosedFailure	(* Miscellaneous error.			*)
+
+	);		(* End of the list of error codes *)
+
+(************************************************************************)
+
+PROCEDURE TranslateErrorCode (code: ErrorCode;
+				VAR (*OUT*) string: ARRAY OF CHAR);
+
+    (* Converts code to its textual representation. *)
+
+END IOErrorCodes.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/ioerrorc.mod b/examples/Modula-2_Libraries/PMOS/sources/general/ioerrorc.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/ioerrorc.mod
@@ -0,0 +1,95 @@
+IMPLEMENTATION MODULE IOErrorCodes;
+
+	(********************************************************)
+	(*							*)
+	(*		I/O subsystem error codes.		*)
+	(*							*)
+	(*  This module provides operations on the file system	*)
+	(*			error codes.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	11 May 1994			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM Conversions IMPORT
+    (* proc *)	CardinalToString;
+
+FROM MiscPMOS IMPORT
+    (* proc *)	CopyString;
+
+(************************************************************************)
+
+PROCEDURE TranslateErrorCode (code: ErrorCode;
+				VAR (*OUT*) string: ARRAY OF CHAR);
+
+    (* Converts code to its textual representation. *)
+
+    BEGIN
+	CASE code OF
+	    OK:			CopyString ("OK", string);
+	  |
+	    OperationAborted:	CopyString ("OperationAborted", string);
+	  |
+	    FileNotOpen:	CopyString ("FileNotOpen", string);
+	  |
+	    NoSuchDevice:	CopyString ("NoSuchDevice", string);
+	  |
+	    NoSuchUnit:		CopyString ("NoSuchUnit", string);
+	  |
+	    FeatureNotImplemented: CopyString ("FeatureNotImplemented", string);
+	  |
+	    InvalidFileNameString: CopyString ("InvalidFileNameString", string);
+	  |
+	    DirectoryNotFound:	CopyString ("DirectoryNotFound", string);
+	  |
+	    NotADirectory:	CopyString ("NotADirectory", string);
+	  |
+	    NameNotFound:	CopyString ("NameNotFound", string);
+	  |
+	    DuplicateFileName:	CopyString ("DuplicateFileName", string);
+	  |
+	    DeviceFull:		CopyString ("DeviceFull", string);
+	  |
+	    DirectoryFull:	CopyString ("DirectoryFull", string);
+	  |
+	    BadDMAAddress:	CopyString ("BadDMAAddress", string);
+	  |
+	    IllegalBlockNumber:	CopyString ("IllegalBlockNumber", string);
+	  |
+	    BadCommand:		CopyString ("BadCommand", string);
+	  |
+	    ControllerNotListening: CopyString ("ControllerNotListening", string);
+	  |
+	    ControllerOutOfSync: CopyString ("ControllerOutOfSync", string);
+	  |
+	    TimeoutError:	CopyString ("TimeoutError", string);
+	  |
+	    CalibrationFailure:	CopyString ("CalibrationFailure", string);
+	  |
+	    SeekFailure:	CopyString ("SeekFailure", string);
+	  |
+	    DriveNotReady:	CopyString ("DriveNotReady", string);
+	  |
+	    SectorNotFound:	CopyString ("SectorNotFound", string);
+	  |
+	    BadBlock:		CopyString ("BadBlock", string);
+	  |
+	    BadData:		CopyString ("BadData", string);
+	  |
+	    WriteFault:		CopyString ("WriteFault", string);
+	  |
+	    WriteProtected:	CopyString ("WriteProtected", string);
+	  |
+	    UndiagnosedFailure:	CopyString ("UndiagnosedFailure", string);
+	  |
+	  ELSE
+		CardinalToString (ORD(code), string, 6);
+	END (*CASE*);
+    END TranslateErrorCode;
+
+(************************************************************************)
+
+END IOErrorCodes.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/kbdriver.def b/examples/Modula-2_Libraries/PMOS/sources/general/kbdriver.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/kbdriver.def
@@ -0,0 +1,49 @@
+DEFINITION MODULE KBdriver;
+
+	(********************************************************)
+	(*							*)
+	(*	Device driver for the keyboard.			*)
+	(*							*)
+	(*	Author:		P. Moylan			*)
+	(*	Last edited:	19 August 1991			*)
+	(*							*)
+	(*	Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE;
+
+CONST
+
+    (* Codes to specify the keyboard indicator lights.	*)
+
+    ScrollLockLED = 1;
+    NumLockLED = 2;
+    CapsLockLED = 4;
+
+PROCEDURE GetScanCode () : BYTE;
+
+    (* Gets one scan code from the keyboard. *)
+
+PROCEDURE CheckScanCode () : BYTE;
+
+    (* Like GetScanCode, but returns 0 immediately if no scan code is	*)
+    (* available - i.e. does not wait for a keyboard press.		*)
+
+PROCEDURE PutLEDs (LEDcode: BYTE);
+
+    (* Sets the keyboard lock indicator lights, as specified by		*)
+    (* LEDcode.  Unlike the following two procedures, which can affect	*)
+    (* one LED without disturbing the others, this procedure alters all	*)
+    (* three LEDs as a group.						*)
+
+PROCEDURE ClearLED (LEDcode: BYTE);
+
+    (* Clears one or more of the keyboard lock indicator lights.	*)
+
+PROCEDURE ToggleLED (LEDcode: BYTE);
+
+    (* Toggles one or more of the keyboard lock indicator lights.	*)
+
+END KBdriver.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/kbdriver.mod b/examples/Modula-2_Libraries/PMOS/sources/general/kbdriver.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/kbdriver.mod
@@ -0,0 +1,360 @@
+IMPLEMENTATION MODULE KBdriver;
+
+	(****************************************************************)
+	(*								*)
+	(*		Device driver for the keyboard.			*)
+	(*								*)
+	(*	Author:		P. Moylan				*)
+	(*	Last edited:	17 March 1995				*)
+	(*	Status:		OK					*)
+	(*								*)
+	(*	The "Beep" call has been removed because of a problem:	*)
+	(*	semaphore wait inside an interrupt task.  For the	*)
+	(*	moment I have a temporary substitute solution, but it's	*)
+	(*	not really satisfactory; the issue of lost codes needs	*)
+	(*	re-thinking.						*)
+	(*								*)
+	(****************************************************************)
+
+(************************************************************************)
+(*									*)
+(* Scan codes produced by the keyboard are filtered and modified by the	*)
+(* keyboard controller; the result appears at port 60H and cause a type	*)
+(* 9 interrupt.  The keyboard controller is a semi-intelligent device,	*)
+(* and the processor can send commands to it by writing to port 60H or	*)
+(* port 64H.  (The distinction is that port 64H is for commands to the	*)
+(* keyboard controller, and port 60H is for commands to the keyboard	*)
+(* itself.)  After a lot of trial and (mostly) error, I have reached	*)
+(* the conclusion that this "intelligence" is more of a hindrance than	*)
+(* a help, so the only command sent by this module is the ED (hex)	*)
+(* command which turns the LED indicators on and off.  The second byte	*)
+(* of this command specifies which LEDs to light:			*)
+(*		bit 0		scroll lock				*)
+(*		bit 1		num lock				*)
+(*		bit 2		caps lock				*)
+(*		bits 3-7	must be 0				*)
+(* On input from port 64H, bit 1 is 0 when the controller is ready to	*)
+(* accept a new command byte.  Bit 0 goes to 1 each time a new data	*)
+(* byte is available, but we don't need to check that bit explicitly	*)
+(* because it causes an interrupt.  The other bits of that port are	*)
+(* status flags which I do not bother to use.				*)
+(*									*)
+(************************************************************************)
+
+FROM MiscPMOS IMPORT
+    (* proc *)	EnterCriticalSection, LeaveCriticalSection;
+
+FROM LowLevel IMPORT
+    (* proc *)	IANDB, IXORB, INOTB, InByte, OutByte;
+
+FROM TaskControl IMPORT
+    (* type *)	Lock,
+    (* proc *)	WaitForInterrupt, CreateTask, CreateInterruptTask,
+		KillInterruptTask,
+		NotUsingFloatingPoint, CreateLock, Obtain, Release;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure;
+
+(************************************************************************)
+
+CONST
+    InterruptNumber = 9;
+    KeyboardDataPort = 60H;
+    KeyboardOutputPort = 60H;
+    StatusRegister = 64H;
+    CommandPort = 64H;
+    MaxBufferSubscript = 15;
+
+TYPE
+    BufferSubscript = [0..MaxBufferSubscript];
+
+VAR
+
+    (* CodeBuffer is a circular buffer holding scan codes.  The		*)
+    (* DataCounter semaphore is a counting semaphore which keeps track	*)
+    (* of how many scan codes are at present in the buffer.  GetPlace	*)
+    (* points to the next scan code which will be retrieved by the	*)
+    (* consumer.  PutPlace is the place where the next keyboard input	*)
+    (* will be put.  The condition GetPlace=PutPlace could mean either	*)
+    (* that the buffer is completely empty or that it is completely	*)
+    (* full.  The flag BufferFull is used to distinguish between these	*)
+    (* two cases.							*)
+
+    CodeBuffer:	RECORD
+		    BufferFull, OverFlow: BOOLEAN;
+		    DataCounter: Semaphore;
+		    GetPlace, PutPlace: BufferSubscript;
+		    data: ARRAY BufferSubscript OF BYTE
+		END;
+
+    (* There are three lights on the keyboard which show the current	*)
+    (* state of Caps Lock, Num Lock, and Shift Lock.  The variable	*)
+    (* CurrentLEDstatus keeps track of which of these is currently lit.	*)
+    (* The encoding is defined by the constants declared in the		*)
+    (* the definition module for this module.				*)
+
+    CurrentLEDstatus: BYTE;
+
+    (* We perform a Signal(LEDstatusUpdate) whenever the value of	*)
+    (* CurrentLEDstatus changes.					*)
+
+    LEDstatusUpdate: Semaphore;
+
+    (* A Lock to make the sending of a multibyte command to the		*)
+    (* keyboard an indivisible operation.				*)
+
+    CommandLock: Lock;
+
+(************************************************************************)
+(*			COMMANDS TO THE KEYBOARD			*)
+(************************************************************************)
+
+PROCEDURE WaitForKeyboardReady;
+
+    (* Pauses, using a busy wait, until the keyboard status byte says	*)
+    (* that the keyboard is ready to receive a command or until we lose	*)
+    (* our patience.  This use of a busy wait is admittedly bad		*)
+    (* software design, but I couldn't decipher the keyboard controller	*)
+    (* documentation well enough to see where there is a way to do this	*)
+    (* job using interrupts.  In theory, the keyboard always responds	*)
+    (* to a command within 20 milliseconds.  The response to a command	*)
+    (* should be an ACK code (0FAH), but it hardly seems worth checking	*)
+    (* for that since it comes interleaved with any character data	*)
+    (* which might be arriving.  It's simpler just to discard any ACK	*)
+    (* codes which arrive with the data.  Of course this means that I	*)
+    (* lose the opportunity to check for some transmission errors, but	*)
+    (* the keyboard interface is so hard to work with that some		*)
+    (* shortcuts seem to be justified.					*)
+
+    CONST patience = 32767;
+
+    VAR count: CARDINAL;
+
+    BEGIN
+	count := patience;
+	REPEAT
+	    DEC (count);
+	UNTIL (count = 0) OR (ORD(IANDB(InByte (StatusRegister), 2)) = 0);
+    END WaitForKeyboardReady;
+
+(************************************************************************)
+
+PROCEDURE LEDdriver;
+
+    (* Runs as a separate task, which updates the keyboard lock		*)
+    (* indicator lights every time it gets a Signal(LEDstatusUpdate).	*)
+    (* Using a separate task for this job may seem a little silly, but	*)
+    (* I couldn't think of a better way to deal with the fact that the	*)
+    (* keyboard doesn't always correctly receive commands sent to it	*)
+    (* and is inclined to ask for retransmissions.  Anyway, this	*)
+    (* module seems to control the LEDs far more reliably than the BIOS	*)
+    (* does, so it can't be all that bad a method.			*)
+
+    BEGIN
+	NotUsingFloatingPoint;
+	LOOP (*forever*)
+	    Wait (LEDstatusUpdate);
+	    Obtain (CommandLock);
+	    WaitForKeyboardReady;
+	    OutByte (KeyboardOutputPort, 0EDH);
+	    WaitForKeyboardReady;
+	    OutByte (KeyboardOutputPort, CurrentLEDstatus);
+	    Release (CommandLock);
+	END (*LOOP*);
+    END LEDdriver;
+
+(************************************************************************)
+
+PROCEDURE PutLEDs (LEDcode: BYTE);
+
+    (* Sets the keyboard lock indicator lights, as specified by		*)
+    (* LEDcode.  Unlike the following two procedures, which can affect	*)
+    (* one LED without disturbing the others, this procedure alters all	*)
+    (* three LEDs as a group.						*)
+
+    BEGIN
+	CurrentLEDstatus := LEDcode;
+	Signal (LEDstatusUpdate);
+    END PutLEDs;
+
+(************************************************************************)
+
+PROCEDURE ClearLED (LEDcode: BYTE);
+
+    (* Clears one or more of the keyboard lock indicator lights.	*)
+
+    BEGIN
+	CurrentLEDstatus := IANDB (CurrentLEDstatus, INOTB(LEDcode));
+	Signal (LEDstatusUpdate);
+    END ClearLED;
+
+(************************************************************************)
+
+PROCEDURE ToggleLED (LEDcode: BYTE);
+
+    (* Toggles one or more of the keyboard lock indicator lights.	*)
+
+    BEGIN
+	CurrentLEDstatus := IXORB (CurrentLEDstatus, LEDcode);
+	Signal (LEDstatusUpdate);
+    END ToggleLED;
+
+(************************************************************************)
+(*			  THE INTERRUPT TASK				*)
+(************************************************************************)
+
+PROCEDURE KeyboardInterruptTask;
+
+    (* This is the interrupt task which responds to interrupts from the	*)
+    (* keyboard.  Each time an interrupt occurs, we deposit the		*)
+    (* keyboard scan code in the circular buffer CodeBuffer, and	*)
+    (* perform a semaphore Signal to indicate that a new scan code is	*)
+    (* available.  Special case: if there is no room in the buffer, we	*)
+    (* insert a special "LostCode" byte at the next available		*)
+    (* opportunity.  The LostCode code represents one or more lost	*)
+    (* scan codes.  Most device drivers should not be designed to lose	*)
+    (* data like this, but the keyboard is a special case: the error	*)
+    (* indication to the caller seems to be more useful than simply	*)
+    (* locking the keyboard.						*)
+
+    CONST RetransmitCode = BYTE(0FEH);  ACKcode = BYTE(0FAH);
+
+    VAR inputdatum: BYTE;  overflow: BOOLEAN;
+
+    BEGIN
+	overflow := FALSE;
+	LOOP (*FOREVER*)
+	    WaitForInterrupt;
+	    inputdatum := InByte (KeyboardDataPort);
+
+	    IF inputdatum = ACKcode THEN
+		(* do nothing - ignore ACK codes *)
+
+	    (* Check for retransmission request. *)
+
+	    ELSIF inputdatum = RetransmitCode THEN
+		Signal (LEDstatusUpdate);
+
+	    ELSE
+		WITH CodeBuffer DO
+		    IF BufferFull THEN OverFlow := TRUE;
+		    ELSE
+			data[PutPlace] := inputdatum;
+			IF PutPlace = MaxBufferSubscript THEN PutPlace := 0
+			ELSE INC (PutPlace);
+			END (*IF*);
+			BufferFull := PutPlace = GetPlace;
+			Signal (DataCounter);
+		    END (*IF*);
+		END (*WITH*);
+	    END (*IF*);
+
+	END (*LOOP*);
+
+    END KeyboardInterruptTask;
+
+(************************************************************************)
+(*			ENTRY POINTS FOR THE USER			*)
+(************************************************************************)
+
+PROCEDURE GetScanCode () : BYTE;
+
+    (* Gets one scan code from the keyboard input buffer.	*)
+
+    VAR result: BYTE;  savedPSW: CARDINAL;
+
+    BEGIN
+	WITH CodeBuffer DO
+	    Wait (DataCounter);
+	    IF OverFlow THEN
+		result := 0FFH;  OverFlow := FALSE;
+		Signal (DataCounter);
+	    ELSE
+		result := data[GetPlace];
+		savedPSW := EnterCriticalSection();
+		IF GetPlace = MaxBufferSubscript THEN GetPlace := 0
+		ELSE INC (GetPlace);
+		END (*IF*);
+		BufferFull := FALSE;
+		LeaveCriticalSection (savedPSW);
+	    END (*IF*);
+	END (*WITH*);
+	RETURN result;
+    END GetScanCode;
+
+(************************************************************************)
+
+PROCEDURE CheckScanCode () : BYTE;
+
+    (* Like GetScanCode, but returns 0 immediately if no scan code is	*)
+    (* available - i.e. does not wait for a keyboard press.		*)
+
+    VAR empty: BOOLEAN;  savedPSW: CARDINAL;
+
+    BEGIN
+	savedPSW := EnterCriticalSection();
+	WITH CodeBuffer DO
+	    empty := (GetPlace = PutPlace) AND NOT BufferFull;
+	END (*WITH*);
+	LeaveCriticalSection (savedPSW);
+	IF empty THEN RETURN 0
+	ELSE RETURN GetScanCode();
+	END (*IF*);
+    END CheckScanCode;
+
+(************************************************************************)
+(*			   SHUTDOWN PROCESSING				*)
+(************************************************************************)
+
+PROCEDURE ShutDownPhase2;
+
+    (* Removes the interrupt handler. *)
+
+    BEGIN
+	KillInterruptTask (InterruptNumber);
+    END ShutDownPhase2;
+
+(************************************************************************)
+
+PROCEDURE ShutDown;
+
+    (* The main function of this procedure is to ensure that we don't	*)
+    (* close down while in the middle of sending a command to the	*)
+    (* keyboard.							*)
+
+    BEGIN
+	Obtain (CommandLock);
+	(* SetTerminationProcedure (ShutDownPhase2); *)
+    END ShutDown;
+
+(************************************************************************)
+
+BEGIN
+
+    (* Initialize the scan code buffer.	*)
+
+    WITH CodeBuffer DO
+	BufferFull := FALSE;  OverFlow := FALSE;
+	CreateSemaphore (DataCounter, 0);
+	GetPlace := 0;  PutPlace := 0;
+    END (*WITH*);
+
+    (* Install the keyboard interrupt routine.	*)
+
+    CreateInterruptTask (InterruptNumber, KeyboardInterruptTask, "Kbd interrupt");
+
+    (* Install the LED driver. *)
+
+    SetTerminationProcedure (ShutDown);
+    CreateLock (CommandLock);
+    CreateSemaphore (LEDstatusUpdate, 0);
+    CreateTask (LEDdriver, 8, "Kbd LED driver");
+    CurrentLEDstatus := 0;  Signal (LEDstatusUpdate);
+
+END KBdriver.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/keyboard.def b/examples/Modula-2_Libraries/PMOS/sources/general/keyboard.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/keyboard.def
@@ -0,0 +1,72 @@
+DEFINITION MODULE Keyboard;
+
+	(************************************************)
+	(*						*)
+	(*	Module to deal with keyboard input.	*)
+	(*						*)
+	(*  Programmer:		P. Moylan		*)
+	(*  Last edited:	8 February 1994		*)
+	(*  Status:		OK			*)
+	(*						*)
+	(************************************************)
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore;
+
+PROCEDURE KeyPressed(): BOOLEAN;
+
+    (* Returns TRUE iff a character is available. *)
+
+PROCEDURE InKey (): CHAR;
+
+    (* Reads a single character code from the keyboard.	*)
+
+PROCEDURE PutBack (ch: CHAR);
+
+    (* This is an "un-read" operation, i.e. the character ch will	*)
+    (* re-appear on the next call to InKey.  This facility is provided	*)
+    (* for the use of software which can overshoot by one character	*)
+    (* when reading its input - a situation which can often occur.	*)
+    (* Some versions of this module will allow several calls to PutBack	*)
+    (* before the next call to InKey, but no guarantee is made in that	*)
+    (* case of uniform treatment from version to version.		*)
+
+PROCEDURE StuffKeyboardBuffer (ch: CHAR);
+
+    (* Stores ch as if it had come from the keyboard, so that a		*)
+    (* subsequent InKey() will pick it up.				*)
+
+    (* NOTE: Procedures PutBack and StuffKeyboardBuffer do almost the	*)
+    (* same thing, but not quite.  The differences are:			*)
+    (*  1. StuffKeyboardBuffer stores characters in a first-in-first-out*)
+    (*     order, whereas PutBack uses last-in-first-out.		*)
+    (*  2. StuffKeyboardBuffer is intended for the case of a task	*)
+    (*     sending data to another task (where that other task is	*)
+    (*     expecting keyboard input), and PutBack is designed for the	*)
+    (*     case of a task talking to itself (i.e. the PutBack(ch) and	*)
+    (*	   the InKey() are in the same task).  If you get this the	*)
+    (*     wrong way around then you could have timing-related		*)
+    (*     problems, up to and including deadlock.			*)
+
+PROCEDURE SetLocks (code: CARDINAL);
+
+    (* Set/clear the caps lock, num lock, and scroll lock conditions.	*)
+    (* The code is defined in KBDRIVER.DEF.				*)
+
+PROCEDURE LockStatus (): CARDINAL;
+
+    (* Returns the current state of the caps lock, num lock, and scroll	*)
+    (* lock conditions, using the code defined in KBDRIVER.DEF.		*)
+
+PROCEDURE HotKey (FunctionKey: BOOLEAN;  code: CHAR;  S: Semaphore);
+
+    (* After this procedure is called, typing the key combination for	*)
+    (* 'code' will cause a Signal(S).  Set FunctionKey=TRUE to trap one	*)
+    (* of the two-character special function keys, and FALSE otherwise.	*)
+    (* The character is consumed; if it should be passed on, then the	*)
+    (* user's hot key handler can do a PutBack().  Note: there is no	*)
+    (* provision for having multiple hot key handlers for the same key;	*)
+    (* any existing hot key mapping will be overridden.			*)
+
+END Keyboard.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/keyboard.mod b/examples/Modula-2_Libraries/PMOS/sources/general/keyboard.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/keyboard.mod
@@ -0,0 +1,636 @@
+IMPLEMENTATION MODULE Keyboard;
+
+	(****************************************************************)
+	(*								*)
+	(*			Keyboard Input				*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	9 March 1995				*)
+	(*  Status:							*)
+	(*	Basic operations are working.				*)
+	(*  Known shortcomings:						*)
+	(*	Some special combinations - e.g. break, printscreen,	*)
+	(*	 scroll lock - not yet handled.				*)
+	(*	The F11 and F12 keys of the extended keyboard are not	*)
+	(*	 yet handled.						*)
+	(*  Known faults:						*)
+	(*	When several keys are hit together, spurious characters	*)
+	(*	 can result, e.g. the <shift>ER combination produces a	*)
+	(*	 spurious "|".  Tests so far suggest that this is a	*)
+	(*	 fault in the keyboard controller rather than in my	*)
+	(*	 software.						*)
+	(*	On some machines, get a spurious NMI (INT 2) on startup.*)
+	(*								*)
+	(****************************************************************)
+
+(************************************************************************)
+(*									*)
+(*  This module is rather more complicated than a typical keyboard	*)
+(*  input routine, because the keyboard I'm using does not directly	*)
+(*  return standard character codes.  Rather, it returns codes known as	*)
+(*  "scan codes", and each keypress generates two codes, one on		*)
+(*  pressing the key and one on releasing it.  Module KBdriver picks up	*)
+(*  the scan codes, the present module translates scan codes to ASCII	*)
+(*  codes.  In principle we can detect things like several keys held	*)
+(*  down together, but in fact this module does not bother dealing with	*)
+(*  such cases except when one of the keys is a shift key or something	*)
+(*  similar.  (Software which wants to give special meanings to		*)
+(*  multi-key combinations should bypass this module and call KBdriver	*)
+(*  to get the scan codes directly).					*)
+(*									*)
+(*  The code for a key release is the same as the code for a key press	*)
+(*  except that the high order bit is set.  (In fact, it's slightly	*)
+(*  more complicated than that; the keyboard generates a two-byte code	*)
+(*  for a key release, but the keyboard controller turns this into a	*)
+(*  one-byte code before the software gets to see it.)  We can		*)
+(*  afford to ignore all key releases except for those for the shift,	*)
+(*  alt, and control keys.  The Caps Lock and Num Lock keys also	*)
+(*  require special handling.						*)
+(*									*)
+(*  To allow the keyboard user to type ahead, this module contains a	*)
+(*  task which puts characters into a circular buffer, where they are	*)
+(*  kept until picked up by a call to InKey.  (There are already	*)
+(*  type-ahead facilities in module KBdriver, and also in the keyboard	*)
+(*  hardware itself; but we might as well be generous to the user, and	*)
+(*  in any case having a separate keyboard task instead of doing the	*)
+(*  scan code translations in the user task simplifies some aspects of	*)
+(*  the software design, because of the way that getting one character	*)
+(*  can involve looking at several successive scan codes).		*)
+(*									*)
+(*  As a protection against deadlock, there is a timeout on the		*)
+(*  "circular buffer full" condition.  If the buffer remains full for	*)
+(*  too long, the oldest character in the buffer is discarded to make	*)
+(*  room for the newest character.					*)
+(*									*)
+(************************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE;
+
+FROM LowLevel IMPORT
+    (* type *)	IAND, IOR;
+
+FROM CircularBuffers IMPORT
+    (* type *)	CircularBuffer,
+    (* proc *)	CreateBuffer, PutBufferImpatient, GetBuffer, BufferEmpty;
+
+FROM KBdriver IMPORT
+    (* const *)	ScrollLockLED, NumLockLED, CapsLockLED,
+    (* proc *)	GetScanCode, ClearLED, ToggleLED;
+
+(*FROM SoundEffects IMPORT
+    (* const *)	Beep;
+*)
+
+FROM Semaphores IMPORT
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM TaskControl IMPORT
+    (* proc *)	CreateTask, NotUsingFloatingPoint;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure, Crash;
+
+(************************************************************************)
+(*			    TRANSLATION TABLES				*)
+(************************************************************************)
+
+    (* Note: in all of these tables a code of 0 means "no code".  Some	*)
+    (* of the keys in question are handled as special cases which do	*)
+    (* not require table lookup.  Others are simply cases where no	*)
+    (* function has been assigned to the key in question.		*)
+
+CONST
+    F1code = BYTE(3BH);		(* Scan code for F1 function key	*)
+    Delcode = BYTE(53H);	(* Scan code for Del on numeric keypad	*)
+
+TYPE
+    (* NormalCodeRange is the range of scan codes handled by our main	*)
+    (* translation tables.  Scan codes outside this range can in fact	*)
+    (* occur, but they are treated separately.				*)
+
+    NormalCodeRange = [BYTE(0)..BYTE(035H)];
+
+    Table1 = ARRAY NormalCodeRange OF BYTE;
+    Table2 = ARRAY [F1code..Delcode] OF BYTE;
+
+    (* Remark: the declarations below are not standard Modula-2.  In	*)
+    (* fact I'm not sure how to declare an array of constants in	*)
+    (* standard Modula-2, but the compiler I use accepts this.		*)
+
+CONST LowerCase = Table1 (
+	(* Nul Esc 123456	*)	 00, 27, 49, 50, 51, 52, 53, 54,
+	(* 7890-= Bsp Tab	*)	 55, 56, 57, 48, 45, 61, 08, 09,
+	(* qwertyui		*)	113,119,101,114,116,121,117,105,
+	(* op[] Enter Ctrl as	*)	111,112, 91, 93, 13, 00, 97,115,
+	(* dfghjkl;		*)	100,102,103,104,106,107,108, 59,
+	(* '` Lshift \zxcv	*)	 39, 96,  0, 92,122,120, 99,118,
+	(* bnm,./		*)	 98,110,109, 44, 46, 47 );
+
+CONST UpperCase = Table1 (
+	(* Nul Esc !@#$%^	*)	 00, 27, 33, 64, 35, 36, 37, 94,
+	(* &*()_+ Bsp Tab	*)	 38, 42, 40, 41, 95, 43, 08, 09,
+	(* QWERTYUI		*)	 81, 87, 69, 82, 84, 89, 85, 73,
+	(* OP{} Enter Ctrl AS	*)	 79, 80,123,125, 10, 00, 65, 83,
+	(* DFGHJKL:		*)	 68, 70, 71, 72, 74, 75, 76, 58,
+	(* "~ Lshift |ZXCV	*)	 34,126,  0,124, 90, 88, 67, 86,
+	(* BNM<>?		*)	 66, 78, 77, 60, 62, 63 );
+
+    (* The following three tables handle the function keys F1..F10 and	*)
+    (* the numeric keypad keys.  They do not cover F11 and F12, which	*)
+    (* exist only on some keyboards.					*)
+
+CONST KeypadTable = Table2 (
+	(*       F1F2F3F4F5		*)		 59,60,61,62,63,
+	(* F6F7F8F9F10 Num Scr Home	*)	64,65,66,67,68,00,00,71,
+	(* Up Pgup - Lft Mid Rgt + End	*)	72,73,45,75,76,77,43,79,
+	(* Dn Pgdn Ins Del		*)	80,81,82,83);
+
+CONST ShiftedKeypadTable = Table2 (
+	(*       F1F2F3F4F5		*)		 84,85,86,87,88,
+	(* F6F7F8F9F10 Num Scr 7	*)	89,90,91,92,93,00,00,55,
+	(* 89-456+1			*)	56,57,45,52,53,54,43,49,
+	(* 230.				*)	50,51,48,46);
+
+CONST CtrlKeypadTable = Table2 (
+	(*       F1F2F3F4F5		*)		 94,95,96,97,98,
+	(* F6F7F8F9F10 Num Scr 7	*)	99,100,101,102,103,00,00,119,
+	(* 89-456+1			*)	00,132,45,115,00,116,43,117,
+	(* 230.				*)	00,118,00,00);
+
+    (* Some of the entries in this last table are, I admit, somewhat	*)
+    (* illogical.  My only excuse is that I have tried to be compatible	*)
+    (* with existing software for this machine.				*)
+
+(************************************************************************)
+(*			THE 'HOT KEY' TABLES				*)
+(************************************************************************)
+
+TYPE CharSet = SET OF CHAR;
+
+VAR HotKeys, HotFunctionKeys: CharSet;
+    HotKeySemaphore: ARRAY CHAR OF Semaphore;
+    HotFunctionKeySemaphore: ARRAY CHAR OF Semaphore;
+
+(************************************************************************)
+(*			THE CHARACTER BUFFER				*)
+(************************************************************************)
+
+CONST
+    CharBufferSize = 8;
+
+VAR
+    (* CharBuffer is a circular buffer holding characters.	*)
+
+    CharBuffer:	CircularBuffer;
+
+    (* The state of the three "lock" conditions.  *)
+
+    CapsLock, NumLock, ScrollLock: BOOLEAN;
+
+    (* A semaphore to signal the Ctrl/Alt/Del combination.	*)
+
+    CtrlAltDel: Semaphore;
+
+(************************************************************************)
+(*			THE TRANSLATION TASK				*)
+(************************************************************************)
+
+PROCEDURE PutCode (FunctionKey: BOOLEAN;  code: CHAR);
+
+    BEGIN
+	IF FunctionKey THEN
+	    IF code IN HotFunctionKeys THEN
+		Signal (HotFunctionKeySemaphore[code]);
+	    ELSE
+		PutBufferImpatient (CharBuffer, CHR(0), 2000);
+		PutBufferImpatient (CharBuffer, code, 2000);
+	    END (*IF*);
+	ELSE
+	    IF code IN HotKeys THEN
+		Signal (HotKeySemaphore[code]);
+	    ELSE
+		PutBufferImpatient (CharBuffer, code, 2000);
+	    END (*IF*);
+	END (*IF*);
+    END PutCode;
+
+(************************************************************************)
+
+PROCEDURE TranslationTask;
+
+    (* This procedure, which is run as a separate task, picks up the	*)
+    (* scan codes and turns them into ASCII codes.			*)
+
+    CONST
+	(* Scan codes for some special keys.	*)
+
+	SpaceCode = BYTE(39H);		(* space bar *)
+	KeypadStarCode = BYTE(37H);	(* "*" on numeric keypad *)
+	LeftShiftCode = BYTE(2AH);	(* left shift key *)
+	RightShiftCode = BYTE(36H);	(* right shift key *)
+	LeftShiftRelease = BYTE(0AAH);	(* left shift key release *)
+	RightShiftRelease = BYTE(0B6H);	(* right shift key release *)
+	CtrlCode = BYTE(1DH);		(* ctrl key *)
+	CtrlRelease = BYTE(9DH);	(* ctrl key release *)
+	AltCode = BYTE(38H);		(* alt key *)
+	AltRelease = BYTE(0B8H);	(* alt key release *)
+	CapsLockCode = BYTE(3AH);	(* caps lock key *)
+	CapsLockRelease = BYTE(0BAH);	(* caps lock key release *)
+	NumLockCode = BYTE(45H);	(* num lock key *)
+	NumLockRelease = BYTE(0C5H);	(* num lock key release *)
+	InsCode = BYTE(52H);		(* Ins key *)
+	LostCode = BYTE(0FFH);		(* lost keypress *)
+
+    TYPE CharSet = SET OF CHAR;
+
+    VAR scancode: BYTE;  result: CHAR;
+	ShiftKeyIsDown, CtrlKeyIsDown, AltKeyIsDown: BOOLEAN;
+	CapsLockKeyIsDown, NumLockKeyIsDown: BOOLEAN;
+
+    (********************************************************************)
+    (*		The main body of TranslationTask starts here		*)
+    (********************************************************************)
+
+    BEGIN
+	NotUsingFloatingPoint;
+	ShiftKeyIsDown := FALSE;  CtrlKeyIsDown := FALSE;
+	AltKeyIsDown := FALSE;  CapsLockKeyIsDown := FALSE;
+	NumLockKeyIsDown := FALSE;
+
+	LOOP	(*FOREVER*)
+	    scancode := GetScanCode();
+	    IF scancode = LostCode THEN
+		(*Beep*);
+
+	    (* Check for the shift, ctrl, and alt keys.	*)
+
+	    ELSIF (scancode = LeftShiftCode)
+			OR (scancode = RightShiftCode) THEN
+		ShiftKeyIsDown := TRUE;
+	    ELSIF (scancode = LeftShiftRelease)
+			OR (scancode = RightShiftRelease) THEN
+		ShiftKeyIsDown := FALSE;
+	    ELSIF scancode = CtrlCode THEN
+		CtrlKeyIsDown := TRUE;
+	    ELSIF scancode = CtrlRelease THEN
+		CtrlKeyIsDown := FALSE;
+	    ELSIF scancode = AltCode THEN
+		AltKeyIsDown := TRUE;
+	    ELSIF scancode = AltRelease THEN
+		AltKeyIsDown := FALSE;
+
+	    (* The Caps Lock key is a bit harder to deal with.  If the	*)
+	    (* user holds it down it will auto-repeat, and we don't	*)
+	    (* want this repeating to toggle the Caps Lock state.	*)
+
+	    ELSIF scancode = CapsLockCode THEN
+		IF NOT CapsLockKeyIsDown THEN
+		    CapsLock := NOT CapsLock;
+		    CapsLockKeyIsDown := TRUE;
+		    ToggleLED (CapsLockLED);
+		END (*IF*);
+	    ELSIF scancode = CapsLockRelease THEN
+		CapsLockKeyIsDown := FALSE;
+
+	    (* The Num Lock key is treated similarly to Caps Lock.	*)
+
+	    ELSIF scancode = NumLockCode THEN
+		IF NOT NumLockKeyIsDown THEN
+		    NumLock := NOT NumLock;
+		    NumLockKeyIsDown := TRUE;
+		    ToggleLED (NumLockLED);
+		END (*IF*);
+	    ELSIF scancode = NumLockRelease THEN
+		NumLockKeyIsDown := FALSE;
+
+	    (* All other codes with the high order bit set can be	*)
+	    (* ignored, as they are either key releases which we don't	*)
+	    (* need to know about, or they are the "E0" or "E1" codes	*)
+	    (* for the extended keyboard, which are not given special	*)
+	    (* treatment in this version.				*)
+
+	    ELSIF scancode >= BYTE(80H) THEN
+		(* Do nothing *)
+
+	    (* The space bar and the keypad "*" are treated separately,	*)
+	    (* because their scan codes fall outside the range of our	*)
+	    (* translation tables.					*)
+
+	    ELSIF scancode = SpaceCode THEN
+		PutCode (FALSE, " ");
+	    ELSIF scancode = KeypadStarCode THEN
+		PutCode (FALSE, "*");
+
+	    (* The "normal" case is where the scan code is within the	*)
+	    (* range of our translation tables.  In this case we do a	*)
+	    (* table lookup, although the result will be affected by	*)
+	    (* the state of the various shift keys.			*)
+
+	    ELSIF scancode <= BYTE(MAX(NormalCodeRange)) THEN
+
+		IF ShiftKeyIsDown THEN
+		    result := UpperCase[scancode];
+		    IF CapsLock AND (result IN CharSet{"A".."Z"}) THEN
+			result := LowerCase[scancode];
+		    END (*IF*);
+		ELSE
+		    result := LowerCase[scancode];
+		    IF CapsLock AND (result IN CharSet{"a".."z"}) THEN
+			result := UpperCase[scancode];
+		    END (*IF*);
+		END (*IF*);
+
+		(* If the Ctrl key is pressed, strip off the three high	*)
+		(* order bits of the character code.			*)
+
+		IF CtrlKeyIsDown THEN
+		    result := CHR (IAND(ORD(result), 1FH));
+		END (*IF*);
+
+		(* If the Alt key is pressed, set the high order bit of	*)
+		(* the character code.  In this we differ from the	*)
+		(* convention used by other software for this machine;	*)
+		(* but it seems to me to be a useful facility, in that	*)
+		(* it gives a simple way of generating the extended	*)
+		(* characters supported by the screen hardware.		*)
+
+		IF AltKeyIsDown THEN
+		    result := CHR (IOR(ORD(result), 80H));
+		END (*IF*);
+
+		PutCode (FALSE, result);
+
+	    (* Check for the numeric keypad and function keys.  In the	*)
+	    (* unshifted state, these produce a two-byte result, of	*)
+	    (* which the first byte is 0.  However, the result is	*)
+	    (* affected by the Ctrl, Shift, and Num Lock keys.		*)
+	    (* Special case: the Ctrl/Alt/Del combination is a reset.	*)
+	    (* To make this work under OS/2 (which intercepts this	*)
+	    (* combination before we get to see it, and which uses it	*)
+	    (* to cause a total system crash), we allow Ctrl/Alt/Ins	*)
+	    (* as an alternative.					*)
+
+	    ELSIF (scancode >= F1code) AND (scancode <= Delcode) THEN
+		IF CtrlKeyIsDown THEN
+		    IF ((scancode = Delcode) OR (scancode = InsCode))
+						AND AltKeyIsDown THEN
+			Signal (CtrlAltDel);  result := CHR(0);
+		    ELSE
+			result := CtrlKeypadTable[scancode]
+		    END (*IF*);
+		ELSIF NumLock = ShiftKeyIsDown THEN
+		    result := KeypadTable[scancode];
+		ELSE
+		    result := ShiftedKeypadTable[scancode]
+		END (*IF*);
+
+		(* If the result is a numeric or punctuation character,	*)
+		(* we produce a simple one-byte result.  The keys which	*)
+		(* give a two-byte code always have the second byte	*)
+		(* greater than or equal to ";".  Key combinations	*)
+		(* which do not produce anything are given a code of 0	*)
+		(* in the tables.					*)
+
+		IF result >= ";" THEN
+		    PutCode (TRUE, result);
+		ELSIF result <> CHR(0) THEN
+		    PutCode (FALSE, result);
+		END (*IF*);
+
+	    (* In the case of a code not known to us, return a "?" to	*)
+	    (* indicate that something unexpected happened.		*)
+
+	    ELSIF scancode >= BYTE(MAX(NormalCodeRange)) THEN
+		PutCode (FALSE, "?");
+
+	    END (*IF*);
+	END (*LOOP*);
+    END TranslationTask;
+
+(************************************************************************)
+(*			    THE PUTBACK BUFFER				*)
+(************************************************************************)
+
+MODULE PutBackBuffer;
+
+    (* Implementation of the PutBack procedure poses some awkward	*)
+    (* problems, to the point where it would not be worth implementing	*)
+    (* if it were not such a useful operation.  The obvious solution,	*)
+    (* of stuffing characters back into the character buffer, creates	*)
+    (* deadlock if we try to avoid losing characters, and creates some	*)
+    (* critical section problems even if we accept the risk of losing	*)
+    (* characters.  The critical section problems can easily be solved,	*)
+    (* but only at the cost of making input less efficient, and this	*)
+    (* is hard to justify given that PutBack operations will typically	*)
+    (* be infrequent.  (That is, it is undesirable to cripple the	*)
+    (* "normal" case just for the sake of supporting a special case	*)
+    (* which accounts for just a small proportion of total operations).	*)
+    (* The solution adopted in this version is to have a separate data	*)
+    (* structure to hold the characters which are put back.  These	*)
+    (* characters are held in a "lossy stack" - we discard the oldest	*)
+    (* datum whenever the stack is going to overflow.			*)
+
+    EXPORT
+	(* var  *)  NoCharsSaved,
+	(* proc *)  Push, Pop;
+
+    CONST
+	stacksize = 8;
+
+    VAR
+	NoCharsSaved: BOOLEAN;
+	stackptr: [0..stacksize];
+	stack: ARRAY [1..stacksize] OF CHAR;
+
+    (********************************************************************)
+
+    PROCEDURE Push (ch: CHAR);
+
+	(* Pushes ch onto the stack.  If the stack is already full, the	*)
+	(* character at the bottom of the stack is lost.		*)
+
+	VAR j: [1..stacksize];
+
+	BEGIN
+	    IF stackptr = stacksize THEN
+		FOR j := 1 TO stacksize-1 DO
+		    stack[j] := stack[j+1];
+		END (*FOR*);
+		stack[stacksize] := ch;
+	    ELSE
+		INC (stackptr);  stack[stackptr] := ch;
+		NoCharsSaved := FALSE;
+	    END (*IF*);
+	END Push;
+
+    (********************************************************************)
+
+    PROCEDURE Pop(): CHAR;
+
+	(* Returns the character from the top of the stack.	*)
+
+	VAR result: CHAR;
+
+	BEGIN
+	    result := stack[stackptr];  DEC(stackptr);
+	    NoCharsSaved := stackptr = 0;
+	    RETURN result;
+	END Pop;
+
+    (********************************************************************)
+
+    BEGIN
+	NoCharsSaved := TRUE;
+	stackptr := 0;
+    END PutBackBuffer;
+
+(************************************************************************)
+(*		THE EXTERNALLY CALLABLE INPUT PROCEDURES		*)
+(************************************************************************)
+
+PROCEDURE KeyPressed(): BOOLEAN;
+
+    (* Returns TRUE iff a character is available. *)
+
+    BEGIN
+	IF NoCharsSaved THEN RETURN NOT BufferEmpty (CharBuffer)
+	ELSE RETURN TRUE
+	END (*IF*);
+    END KeyPressed;
+
+(************************************************************************)
+
+PROCEDURE InKey(): CHAR;
+
+    (* Reads one key from the circular buffer, or from the putback	*)
+    (* buffer if any characters have been put back.			*)
+
+    BEGIN
+	IF NoCharsSaved THEN RETURN GetBuffer (CharBuffer)
+	ELSE RETURN Pop()
+	END (*IF*);
+    END InKey;
+
+(************************************************************************)
+
+PROCEDURE PutBack (ch: CHAR);
+
+    (* This is an "un-read" operation, i.e. the character ch will	*)
+    (* re-appear on the next call to InKey.  This facility is provided	*)
+    (* for the use of software which can overshoot by one character	*)
+    (* when reading its input - a situation which can often occur.	*)
+
+    BEGIN
+	Push (ch);
+    END PutBack;
+
+(************************************************************************)
+
+PROCEDURE StuffKeyboardBuffer (ch: CHAR);
+
+    (* Stores ch as if it had come from the keyboard, so that a		*)
+    (* subsequent InKey() will pick it up.				*)
+
+    BEGIN
+	PutBufferImpatient (CharBuffer, ch, 2000);
+    END StuffKeyboardBuffer;
+
+(************************************************************************)
+
+PROCEDURE SetLocks (code: CARDINAL);
+
+    (* Set/clear the caps lock, num lock, and scroll lock conditions.	*)
+    (* The code is defined in KBDRIVER.DEF.				*)
+
+    BEGIN
+	CapsLock := ORD(IAND (code, CapsLockLED)) <> 0;
+	NumLock := ORD(IAND (code, NumLockLED)) <> 0;
+	ScrollLock := ORD(IAND (code, ScrollLockLED)) <> 0;
+	ClearLED (CapsLockLED+NumLockLED+ScrollLockLED);
+	ToggleLED (BYTE(code));
+    END SetLocks;
+
+(************************************************************************)
+
+PROCEDURE LockStatus (): CARDINAL;
+
+    (* Returns the current state of the caps lock, num lock, and scroll	*)
+    (* lock conditions, using the code defined in KBDRIVER.DEF.		*)
+
+    VAR result: CARDINAL;
+
+    BEGIN
+	result := 0;
+	IF CapsLock THEN INC (result, CapsLockLED) END(*IF*);
+	IF NumLock THEN INC (result, NumLockLED) END(*IF*);
+	IF ScrollLock THEN INC (result, ScrollLockLED) END(*IF*);
+	RETURN result;
+    END LockStatus;
+
+(************************************************************************)
+
+PROCEDURE HotKey (FunctionKey: BOOLEAN;  code: CHAR;  S: Semaphore);
+
+    (* After this procedure is called, typing the key combination for	*)
+    (* 'code' will cause a Signal(S).  Set FunctionKey=TRUE to trap one	*)
+    (* of the two-character special function keys, and FALSE otherwise.	*)
+    (* The character is consumed; if it should be passed on, then the	*)
+    (* user's hot key handler can do a PutBack().  Note: there is no	*)
+    (* provision for having multiple hot key handlers for the same key;	*)
+    (* any existing hot key mapping will be overridden.			*)
+
+    BEGIN
+	IF FunctionKey THEN
+	    INCL (HotFunctionKeys, code);
+	    HotFunctionKeySemaphore[code] := S;
+	ELSE
+	    INCL (HotKeys, code);
+	    HotKeySemaphore[code] := S;
+	END (*IF*);
+    END HotKey;
+
+(************************************************************************)
+(*				SHUTDOWN				*)
+(************************************************************************)
+
+PROCEDURE StopProgram;
+
+    (* This is a task whose only function is to execute a HALT when	*)
+    (* the Ctrl/Alt/Del combination is pressed.  We handle this in a	*)
+    (* separate task, rather than in the code which detects the		*)
+    (* Ctrl/Alt/Del, because we want to keep the keyboard software	*)
+    (* alive until after higher-level modules have executed their	*)
+    (* termination procedures.						*)
+
+    BEGIN
+	NotUsingFloatingPoint;
+	Wait (CtrlAltDel);
+	Crash ("Ctrl/Alt/Del termination");
+    END StopProgram;
+
+(************************************************************************)
+
+PROCEDURE ShutDown;
+
+    (* Final cleanup of this module at program exit. *)
+
+    BEGIN
+	SetLocks (0);
+    END ShutDown;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+BEGIN
+    SetLocks (0);
+    HotKeys := CharSet{};
+    HotFunctionKeys := CharSet{};
+    SetTerminationProcedure (ShutDown);
+    CreateBuffer (CharBuffer, CharBufferSize);
+    CreateTask (TranslationTask, 8, "Keyboard main");
+    CreateSemaphore (CtrlAltDel, 0);
+    CreateTask (StopProgram, 15, "CtrlAltDel check");
+END Keyboard.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/ktrace.def b/examples/Modula-2_Libraries/PMOS/sources/general/ktrace.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/ktrace.def
@@ -0,0 +1,47 @@
+DEFINITION MODULE KTrace;
+
+	(****************************************************************)
+	(*								*)
+	(*	Trace routines for Modula 2 program development.	*)
+	(*								*)
+	(*  This is the version which does NOT use windows.  It is	*)
+	(*  intended for low-level tracing of the kernel, where a	*)
+	(*  window-based tracing facility would be unsuitable because	*)
+	(*  of critical section problems.  However, it is quite		*)
+	(*  adequate for any application where we don't care too much	*)
+	(*  about a pretty screen layout.				*)
+	(*								*)
+	(*  Note, however, that this module is missing the "Press any	*)
+	(*  key to continue" option which my other trace modules have.	*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	21 January 1989				*)
+	(*  Status:		OK					*)
+	(*								*)
+	(****************************************************************)
+
+PROCEDURE NYI (name: ARRAY OF CHAR);
+
+	(* Types a "not yet implemented" message.	*)
+
+PROCEDURE InTrace (name: ARRAY OF CHAR);
+
+	(* Types "Entering 'name'".	*)
+
+PROCEDURE OutTrace (name: ARRAY OF CHAR);
+
+	(* Types "Leaving 'name'".	*)
+
+PROCEDURE TraceOn;
+
+	(* Turns on tracing.	*)
+
+PROCEDURE TraceOff;
+
+	(* Turns off tracing.		*)
+
+PROCEDURE TraceStatus(): BOOLEAN;
+
+	(* Says whether tracing is currently on.	*)
+
+END KTrace.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/ktrace.mod b/examples/Modula-2_Libraries/PMOS/sources/general/ktrace.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/ktrace.mod
@@ -0,0 +1,122 @@
+IMPLEMENTATION MODULE KTrace;
+
+	(****************************************************************)
+	(*								*)
+	(*	Trace routines for Modula 2 program development.	*)
+	(*								*)
+	(*  This is the version which does NOT use windows.  It is	*)
+	(*  intended for low-level tracing of the kernel, where a	*)
+	(*  window-based tracing facility would be unsuitable because	*)
+	(*  of critical section problems.  However, it is quite		*)
+	(*  adequate for any application where we don't care too much	*)
+	(*  about a pretty screen layout.				*)
+	(*								*)
+	(*  Note, however, that this module is missing the "Press any	*)
+	(*  key to continue" option which my other trace modules have.	*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	6 February 1989				*)
+	(*  Status:		OK					*)
+	(*								*)
+	(****************************************************************)
+
+FROM GlassTTY IMPORT
+    (* proc *)	WriteString, WriteLn, WriteHexWord;
+
+FROM MiscPMOS IMPORT
+    (* proc *)	ProcessorStatus;
+
+VAR TraceEnabled: BOOLEAN;
+    nesting: CARDINAL;
+
+(************************************************************************)
+
+PROCEDURE NYI (name: ARRAY OF CHAR);
+
+    (* Types a "not yet implemented" message.	*)
+
+    BEGIN
+	WriteString (name);  WriteString (" is not yet implemented.");
+	WriteLn;
+    END NYI;
+
+(************************************************************************)
+
+PROCEDURE InTrace (name: ARRAY OF CHAR);
+
+    (* To be called when entering a procedure.	*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	IF TraceEnabled THEN
+	    FOR j := 1 TO nesting DO
+		WriteString ("   ");
+	    END (*FOR*);
+	    WriteString ("Entering ");  WriteString (name);
+	    WriteString (" <");  WriteHexWord (ProcessorStatus());
+	    WriteString (">");
+	    WriteLn;
+	END (*IF*);
+	INC (nesting);
+    END InTrace;
+
+(************************************************************************)
+
+PROCEDURE OutTrace (name: ARRAY OF CHAR);
+
+    (* To be called when leaving a procedure.	*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	DEC (nesting);
+	IF TraceEnabled THEN
+	    FOR j := 1 TO nesting DO
+		WriteString ("   ");
+	    END (*FOR*);
+	    WriteString ("Leaving ");  WriteString (name);
+	    WriteString (" <");  WriteHexWord (ProcessorStatus());
+	    WriteString (">");
+	    WriteLn;
+	END (*IF*);
+    END OutTrace;
+
+(************************************************************************)
+
+PROCEDURE TraceOn;
+
+    (* Turns tracing on.		*)
+
+    BEGIN
+	TraceEnabled := TRUE;
+    END TraceOn;
+
+(************************************************************************)
+
+PROCEDURE TraceOff;
+
+    (* Turns tracing off.		*)
+
+    BEGIN
+	TraceEnabled := FALSE;
+    END TraceOff;
+
+(************************************************************************)
+
+PROCEDURE TraceStatus (): BOOLEAN;
+
+    (* Says whether tracing is currently on.		*)
+
+    BEGIN
+	RETURN TraceEnabled;
+    END TraceStatus;
+
+(************************************************************************)
+(*				INITIALISATION				*)
+(************************************************************************)
+
+BEGIN
+    TraceEnabled := FALSE;  nesting := 0;
+END KTrace.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/listedit.def b/examples/Modula-2_Libraries/PMOS/sources/general/listedit.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/listedit.def
@@ -0,0 +1,87 @@
+DEFINITION MODULE ListEditor;
+
+	(********************************************************)
+	(*							*)
+	(*		"Generic" list editor			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	13 February 1991		*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	ADDRESS;
+
+FROM Windows IMPORT
+    (* type *)	Window;
+
+FROM FieldEditor IMPORT
+    (* type *)	FieldType, WriteProc, EditProc;
+
+(************************************************************************)
+(*									*)
+(*  The editor in this module is "generic" in a limited sense.  It	*)
+(*  performs screen editing of a linear list, but obviously it has to	*)
+(*  make some assumptions about the linkage method by which the list	*)
+(*  is implemented.  The list must have the general form		*)
+(*									*)
+(*	 TYPE List = POINTER TO	RECORD					*)
+(*				    next: List;				*)
+(*				    component: some pointer type;	*)
+(*				END (*RECORD*)				*)
+(*									*)
+(*  Notice however that this definition module actually defines lists	*)
+(*  and components in terms of type ADDRESS, so that there is no	*)
+(*  requirement that the caller's types and field names match the	*)
+(*  above definition.							*)
+(*									*)
+(*  The caller is required to supply, via FieldEditor.DefineFieldType,	*)
+(*  procedures which write and edit list components.			*)
+(*									*)
+(*  The procedures in this module obey the rules set by module		*)
+(*  FieldEditor.  In the case where a list of lists is being edited,	*)
+(*  the component editor can simply call EditList to do its job for it.	*)
+(*									*)
+(************************************************************************)
+
+TYPE
+    ListFormat;		(* is private *)
+    List = ADDRESS;
+
+(************************************************************************)
+
+PROCEDURE DefineListFormat (header, separator, trailer: ARRAY OF CHAR;
+				ComponentType: FieldType): ListFormat;
+
+    (* Sets up the output format for a class of lists.  The header is	*)
+    (* what is written before the first component; the separator is	*)
+    (* what is written between the components; and the trailer is what	*)
+    (* is written after the last component.  For an empty list, only	*)
+    (* the header and trailer will be written.  ComponentType		*)
+    (* implicitly specifies the procedures which will be used to write	*)
+    (* and edit the components of the list.				*)
+
+PROCEDURE DiscardFormat (format: ListFormat);
+
+    (* A notification from the user that this format will not be used	*)
+    (* again (unless it is redefined by another call to procedure	*)
+    (* DefineListFormat).  Use of this procedure is optional, but is	*)
+    (* recommended for the sake of "clean" memory management.		*)
+
+PROCEDURE WriteList (w: Window;  L: List;  format: ListFormat);
+
+    (* Writes L on the screen, including its delimiters.  This		*)
+    (* procedure is not actually used in this module, but is provided	*)
+    (* as something that a client module may find useful.		*)
+
+PROCEDURE EditList (w: Window;  VAR (*INOUT*) L: List;  format: ListFormat);
+
+    (* Edits a list at the current cursor position in window w.  We	*)
+    (* leave this procedure on seeing a keyboard character which does	*)
+    (* not belong to us.  The cursor is left just beyond the "trailer"	*)
+    (* string which terminates the displayed form of the list.  The	*)
+    (* terminating keystroke is returned to the keyboard driver so that	*)
+    (* it can still be read by the caller.				*)
+
+END ListEditor.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/listedit.mod b/examples/Modula-2_Libraries/PMOS/sources/general/listedit.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/listedit.mod
@@ -0,0 +1,340 @@
+IMPLEMENTATION MODULE ListEditor;
+
+	(********************************************************)
+	(*							*)
+	(*		"Generic" list editor			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 February 1995		*)
+	(*  Status:		Seems OK			*)
+	(*							*)
+	(********************************************************)
+
+FROM FieldEditor IMPORT
+    (* proc *)	WriteField, EditField;
+
+FROM Windows IMPORT
+    (* type *)	ColumnRange,
+    (* proc *)	SaveCursor, SetCursor, WriteString;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey, PutBack;
+
+(************************************************************************)
+
+CONST CursorLeftCode = "K";  CursorRightCode = "M";
+
+TYPE
+
+    String = ARRAY ColumnRange OF CHAR;
+
+    (* The following definition shows the general structure of the sort	*)
+    (* of lists which we can handle.					*)
+
+    InternalList = POINTER TO InternalListElement;
+    InternalListElement = RECORD
+				next: InternalList;
+				component: ADDRESS;
+			  END (*RECORD*);
+
+    (* Details needed for displaying a list on the screen.	*)
+
+    ListFormat = POINTER TO ListFormatRecord;
+    ListFormatRecord =	RECORD
+			   header, separator, trailer: String;
+			   ctype: FieldType;
+			END (*RECORD*);
+
+(************************************************************************)
+(*			DEFINING A NEW LIST FORMAT			*)
+(************************************************************************)
+
+PROCEDURE CopyString (source: ARRAY OF CHAR;  VAR (*OUT*) destination: String);
+
+    (* Copies the source string to the destination string.  Care is	*)
+    (* needed here in getting the terminator right, because of the	*)
+    (* strange way the FTL compiler deals with string constants.	*)
+
+    VAR j, last: ColumnRange;
+
+    BEGIN
+	last := MAX(ColumnRange);
+	IF last > HIGH(source) THEN
+	    last := HIGH(source);
+	    destination[last+1] := CHR(0);
+	END (*IF*);
+	FOR j := 0 TO last DO
+	    destination[j] := source[j];
+	END (*FOR*);
+    END CopyString;
+
+(************************************************************************)
+
+PROCEDURE DefineListFormat (s1, s2, s3: ARRAY OF CHAR;
+				ComponentType: FieldType): ListFormat;
+
+    (* Sets up the output format for a class of lists.	*)
+
+    VAR result: ListFormat;
+
+    BEGIN
+	NEW (result);
+	WITH result^ DO
+	    CopyString (s1, header);
+	    CopyString (s2, separator);
+	    CopyString (s3, trailer);
+	    ctype := ComponentType;
+	END (*WITH*);
+	RETURN result;
+    END DefineListFormat;
+
+(************************************************************************)
+
+PROCEDURE DiscardFormat (format: ListFormat);
+
+    (* A notification from the user that this format will not be used	*)
+    (* again (unless it is redefined by another call to procedure	*)
+    (* DefineListFormat).  Use of this procedure is optional, but is	*)
+    (* recommended for the sake of "clean" memory management.		*)
+
+    BEGIN
+	DISPOSE (format);
+    END DiscardFormat;
+
+(************************************************************************)
+(*			     SCREEN OUTPUT				*)
+(************************************************************************)
+
+PROCEDURE WriteTail (w: Window;  L: InternalList;  format: ListFormat);
+
+    (* Writes L on the screen, without its header string.  The screen	*)
+    (* cursor is left at the character position following the trailer.	*)
+
+    BEGIN
+	IF L <> NIL THEN
+	    LOOP
+		WriteField (w, L^.component, format^.ctype, 0);
+		L := L^.next;
+		IF L = NIL THEN EXIT(*LOOP*) END(*IF*);
+		WriteString (w, format^.separator);
+	    END (*LOOP*);
+	END (*IF*);
+	WriteString (w, format^.trailer);
+    END WriteTail;
+
+(************************************************************************)
+
+PROCEDURE WriteList (w: Window;  L: List;  format: ListFormat);
+
+    (* Writes L on the screen, including its delimiters.  This		*)
+    (* procedure is not actually used in this module, but is provided	*)
+    (* as something that a client module may find useful.		*)
+
+    BEGIN
+	WriteString (w, format^.header);
+	WriteTail (w, L, format);
+    END WriteList;
+
+(************************************************************************)
+(*			     KEYBOARD INPUT				*)
+(************************************************************************)
+
+PROCEDURE FunctionKey (code: CHAR): BOOLEAN;
+
+    (* Checks for CHR(0) followed by the given code from the keyboard.	*)
+    (* If found, returns TRUE.  If not found, returns FALSE and no	*)
+    (* keyboard input is consumed.					*)
+
+    VAR ch: CHAR;
+
+    BEGIN
+	ch := InKey();
+	IF ch <> CHR(0) THEN
+	    PutBack (ch);  RETURN FALSE;
+	END (*IF*);
+	ch := InKey();
+	IF ch <> code THEN
+	    PutBack (ch);  PutBack (CHR(0));  RETURN FALSE;
+	END (*IF*);
+	RETURN TRUE;
+    END FunctionKey;
+
+(************************************************************************)
+(*				  EDITING				*)
+(************************************************************************)
+(*									*)
+(*  Each of the editing procedures in this module has the properties:	*)
+(*									*)
+(*   1.	We leave the procedure on seeing a keyboard character which	*)
+(*	does not belong to us.  The terminating keystroke is returned	*)
+(*	to the keyboard driver so that it can still be read by the	*)
+(*	caller.								*)
+(*   2.	The window cursor is left just beyond the "trailer" string	*)
+(*	which terminates the written form of the list.			*)
+(*   3.	The list being edited may be empty on entry and/or exit.	*)
+(*									*)
+(*  The differences among the procedures are in terms of the starting	*)
+(*  point on the screen - that is, whether we start by writing a list	*)
+(*  separator, a component, or a header string.				*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE EditFromSeparator (w: Window;  VAR (*INOUT*) L: InternalList;
+					format: ListFormat);  FORWARD;
+
+(************************************************************************)
+
+PROCEDURE EditFromComponent (w: Window;  VAR (*INOUT*) L: InternalList;
+						format: ListFormat);
+
+    (* This procedure is the one which does most of the real work.	*)
+    (* On entry, the screen cursor is at the place where the first	*)
+    (* component must be written, i.e. the header or separator, as	*)
+    (* appropriate, has already been written.  The screen display is	*)
+    (* correct on exit in all cases except where an empty list is	*)
+    (* returned and the caller had placed a separator in front of the	*)
+    (* displayed list.  In that case, it is the caller's responsibility	*)
+    (* to get rid of the separator.					*)
+
+    VAR temp: InternalList;
+	startrow, newrow, startcolumn, newcolumn: CARDINAL;
+
+    BEGIN
+
+	(* If we are at the end of a list, extend it to allow a new	*)
+	(* component to be added.  (If the user does not take us up on	*)
+	(* that offer, the new element will be deleted - see below.)	*)
+
+	IF L = NIL THEN
+	    NEW (L);
+	    WITH L^ DO
+		next := NIL;  component := NIL;
+	    END (*WITH*);
+	END (*IF*);
+
+	SaveCursor (w, startrow, startcolumn);
+	WriteTail (w, L, format);
+
+	LOOP
+	    SetCursor (w, startrow, startcolumn);
+
+	    (* Edit the current list component.  Assumption: the	*)
+	    (* component editor will leave the window cursor at the	*)
+	    (* character position beyond the end of that component.	*)
+
+	    EditField (w, L^.component, format^.ctype, 0);
+
+	    (* If the user deleted this component - either as an	*)
+	    (* explicit deletion or by ignoring the invitation to add a	*)
+	    (* new component - discard the corresponding list element.	*)
+
+	    IF L^.component = NIL THEN
+		temp := L;  L := L^.next;  DISPOSE (temp);
+		SetCursor (w, startrow, startcolumn);
+		WriteTail (w, L, format);
+
+		(* If the list is now empty, even after we have given	*)
+		(* the user the chance to extend it, we can conclude	*)
+		(* that the user has finished editing this list.	*)
+
+		IF L = NIL THEN
+		    EXIT (*LOOP*);
+		END (*IF*);
+
+		(* If the user wants to move right at this stage,	*)
+		(* consume one "cursor right" keypress, because we are	*)
+		(* already at the element which used to be to the right	*)
+		(* of the now-deleted one.				*)
+
+		IF FunctionKey (CursorRightCode) THEN
+	 	    (* do nothing with the keypress	*)
+		END (*IF*);
+
+	    ELSE	(* component <> NIL *)
+
+		(* Just in case the component editor has messed up	*)
+		(* some of the screen display, write a clean copy.	*)
+
+		SaveCursor (w, newrow, newcolumn);
+		SetCursor (w, startrow, startcolumn);
+		WriteTail (w, L, format);
+
+		(* At this stage, a "cursor right" means that we should	*)
+		(* move on to the next group, and any other key should	*)
+		(* be given to the caller to deal with.			*)
+
+		IF NOT FunctionKey (CursorRightCode) THEN
+		    EXIT (*LOOP*);
+		END (*IF*);
+
+		(* We have indeed received a "cursor right" code.	*)
+
+		SetCursor (w, newrow, newcolumn);
+		EditFromSeparator (w, L^.next, format);
+		IF NOT FunctionKey (CursorLeftCode) THEN
+		    EXIT (*LOOP*)
+		END (*IF*);
+
+	    END (*IF*);
+
+	END (*LOOP*);
+
+    END EditFromComponent;
+
+(************************************************************************)
+
+PROCEDURE EditFromSeparator (w: Window;  VAR (*INOUT*) L: InternalList;
+						format: ListFormat);
+
+    (* On entry, the screen cursor is at the place where the separator	*)
+    (* must be written, or the trailer in the case L = NIL.  The case	*)
+    (* L = NIL is possible on entry and/or exit.  On exit, the screen	*)
+    (* display has been correctly updated.				*)
+
+    VAR startrow, startcolumn: CARDINAL;
+
+    BEGIN
+	SaveCursor (w, startrow, startcolumn);
+
+	(* Write the separator, and do the actual editing.	*)
+
+	WriteString (w, format^.separator);
+	EditFromComponent (w, L, format);
+
+	(* If we are left with an empty list, overwrite the redundant	*)
+	(* separator.							*)
+
+	IF L = NIL THEN
+	    SetCursor (w, startrow, startcolumn);
+	    WriteString (w, format^.trailer);
+	END (*IF*);
+
+    END EditFromSeparator;
+
+(************************************************************************)
+
+PROCEDURE EditList (w: Window;  VAR (*INOUT*) L: List;  format: ListFormat);
+
+    (* Edits a list at the current cursor position in window w.  We	*)
+    (* leave this procedure on seeing a keyboard character which does	*)
+    (* not belong to us.  The terminating keystroke is returned to the	*)
+    (* keyboard driver so that it can still be read by the caller.	*)
+    (* The window cursor is left just beyond the "trailer" string which	*)
+    (* terminates the written form of the list.				*)
+
+    VAR Alias: InternalList;
+
+    BEGIN
+	Alias := L;
+	WriteString (w, format^.header);
+	EditFromComponent (w, Alias, format);
+	L := Alias;
+    END EditList;
+
+(************************************************************************)
+
+END ListEditor.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/lossyque.def b/examples/Modula-2_Libraries/PMOS/sources/general/lossyque.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/lossyque.def
@@ -0,0 +1,44 @@
+DEFINITION MODULE LossyQueues;
+
+	(****************************************************************)
+	(*								*)
+	(*	A lossy queue is a bounded-length queue with the	*)
+	(*	property that the PutQueue operation never blocks;	*)
+	(*	if space is unavailable, the data to be put are lost.	*)
+	(*	This is appropriate for real-time applications where	*)
+	(*	losing data is more acceptable than losing time.	*)
+	(*	Of course, it is desirable to make the queue size big	*)
+	(*	enough to ensure that data loss will be rare.		*)
+	(*								*)
+	(*	Author:		P. Moylan				*)
+	(*	Last edited:	17 August 1993				*)
+	(*								*)
+	(*	Status:		OK.					*)
+	(*								*)
+	(****************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE;
+
+TYPE LossyQueue;	(* is private *)
+
+PROCEDURE CreateQueue (VAR (*OUT*) B: LossyQueue;
+					capacity, elementsize: CARDINAL);
+
+    (* Allocates space for a lossy queue, and initializes it.  The	*)
+    (* caller specifies how many elements (assumed to be of equal size)	*)
+    (* the queue will hold, and the size in bytes of each element.	*)
+
+PROCEDURE PutQueue (B: LossyQueue;  item: ARRAY OF BYTE): BOOLEAN;
+
+    (* If space is available, puts item at the tail of the queue and	*)
+    (* returns TRUE.  Returns FALSE if the new item would not fit.	*)
+    (* Note: it is assumed that SIZE(item) matches the element size	*)
+    (* declared when the queue was created.				*)
+
+PROCEDURE GetQueue (B: LossyQueue;  VAR (*OUT*) item: ARRAY OF BYTE);
+
+    (* Takes one item from the head of the queue, waiting if necessary. *)
+
+END LossyQueues.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/lossyque.mod b/examples/Modula-2_Libraries/PMOS/sources/general/lossyque.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/lossyque.mod
@@ -0,0 +1,138 @@
+IMPLEMENTATION MODULE LossyQueues;
+
+	(********************************************************)
+	(*							*)
+	(*	Implementation of lossy queue structures	*)
+	(*							*)
+	(*	Author:		P. Moylan			*)
+	(*	Last edited:	27 February 1995		*)
+	(*	Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* proc *)	ADR;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM TaskControl IMPORT
+    (* type *)	Lock,
+    (* proc *)	CreateLock, Obtain, Release;
+
+FROM LowLevel IMPORT
+    (* proc *)	Copy;
+
+(************************************************************************)
+
+TYPE
+    (* Most of the fields below are self-explanatory, but note that:	*)
+    (* (a) lastlocation, GetPlace, and PutPlace are measured as byte	*)
+    (*	   offsets from the beginning of the data array;		*)
+    (* (b) EltSize is the size, in bytes, of one element.		*)
+
+    QueueTemplate = RECORD
+			BufferFull: BOOLEAN;
+			DataPresent: Semaphore;
+			update: Lock;
+			lastlocation, EltSize: CARDINAL;
+			GetPlace, PutPlace: CARDINAL;
+			data: ARRAY [0..0] OF BYTE;
+		    END;
+
+	(* Remark: we do something slightly nonstandard here, because	*)
+	(* we want circular queues of various sizes and Modula-2 does	*)
+	(* not support variable-length arrays.  The trick is to define	*)
+	(* an array of one element, but then to extend it by calling	*)
+	(* ALLOCATE to give us the array size we really need.  Of	*)
+	(* course, this works only if we suppress "out of range" error	*)
+	(* checking while compiling this module.  This is, admittedly,	*)
+	(* an example of a programming style which probably should be	*)
+	(* outlawed, but I couldn't think of a legal way to achieve the	*)
+	(* desired result.						*)
+
+    LossyQueue = POINTER TO QueueTemplate;
+
+(************************************************************************)
+
+PROCEDURE CreateQueue (VAR (*OUT*) B: LossyQueue;
+					capacity, elementsize: CARDINAL);
+
+    (* Allocates space for a lossy queue, and initializes it.  The	*)
+    (* caller specifies how many elements (assumed to be of equal size)	*)
+    (* the queue will hold, and the size in bytes of each element.	*)
+
+    VAR size: CARDINAL;
+
+    BEGIN
+	size := capacity*elementsize;
+	ALLOCATE (B, SIZE(QueueTemplate) + size - 1);
+	WITH B^ DO
+	    BufferFull := FALSE;
+	    lastlocation := size - 1;
+	    EltSize := elementsize;
+	    CreateSemaphore (DataPresent, 0);
+	    CreateLock (update);
+	    GetPlace := 0;  PutPlace := 0;
+	END (*WITH*);
+    END CreateQueue;
+
+(************************************************************************)
+
+PROCEDURE PutQueue (B: LossyQueue;  item: ARRAY OF BYTE): BOOLEAN;
+
+    (* If space is available, puts item at the tail of the queue and	*)
+    (* returns TRUE.  Returns FALSE if the new item would not fit.	*)
+    (* Note: it is assumed that SIZE(item) matches the element size	*)
+    (* declared when the queue was created.				*)
+
+    BEGIN
+	WITH B^ DO
+	    IF BufferFull THEN
+		RETURN FALSE;
+	    END (*IF*);
+	    (*# save, check(index=>off) *)
+	    Copy (ADR(item), ADR(data[PutPlace]), EltSize);
+	    (*# restore *)
+
+	    Obtain (update);
+	    INC (PutPlace, EltSize);
+	    IF PutPlace > lastlocation THEN PutPlace := 0; END(*IF*);
+	    BufferFull := PutPlace = GetPlace;
+	    Release (update);
+
+	    Signal (DataPresent);
+	    RETURN TRUE;
+	END (*WITH*);
+    END PutQueue;
+
+(************************************************************************)
+
+PROCEDURE GetQueue (B: LossyQueue;  VAR (*OUT*) item: ARRAY OF BYTE);
+
+    (* Takes one item from the head of the queue, waiting if necessary. *)
+
+    BEGIN
+	WITH B^ DO
+	    Wait (DataPresent);
+	    (*# save, check(index=>off) *)
+	    Copy (ADR(data[GetPlace]), ADR(item), EltSize);
+	    (*# restore *)
+
+	    Obtain (update);
+	    INC (GetPlace, EltSize);
+	    IF GetPlace > lastlocation THEN GetPlace := 0 END (*IF*);
+	    BufferFull := FALSE;
+	    Release (update);
+
+	END (*WITH*);
+    END GetQueue;
+
+(************************************************************************)
+
+END LossyQueues.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/lowlevel.def b/examples/Modula-2_Libraries/PMOS/sources/general/lowlevel.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/lowlevel.def
@@ -0,0 +1,824 @@
+DEFINITION MODULE LowLevel;
+
+	(********************************************************)
+	(*							*)
+	(*	   Miscellaneous low-level procedures		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	11 March 1995			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(*	Note that the implementation of this module	*)
+	(*	is heavily compiler-dependent.  This version	*)
+	(*	is for use with the TopSpeed compiler,		*)
+	(*	version 1 or version 3.				*)
+	(*							*)
+	(*	Now making changes so that I can use it with	*)
+	(*	more compilers.					*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE, WORD, ADDRESS;
+
+FROM Types IMPORT
+    (* type *)	FarPointer;
+
+(*<TopSpeed3*)
+(*# module (init_code => off) *)
+
+CONST
+    (*%T _fcall *)
+	Ret = 0CBH;
+    (*%E *)
+    (*%F _fcall *)
+	Ret = 0C3H;
+    (*%E *)
+
+TYPE
+    Code1=ARRAY [0..0] OF BYTE;
+    Code2=ARRAY [0..1] OF BYTE;
+    Code3=ARRAY [0..2] OF BYTE;
+    Code5=ARRAY [0..4] OF BYTE;
+    Code7=ARRAY [0..6] OF BYTE;
+    Code9=ARRAY [0..8] OF BYTE;
+(*>*)
+
+(************************************************************************)
+(*			    BITWISE LOGIC				*)
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# save, call(inline => on, reg_param => (ax, bx), reg_return => (ax)) *)
+(*# call(reg_saved => (bx,cx,dx,si,di,ds,es,st1,st2)) *)
+
+INLINE (*>*)
+PROCEDURE IAND (first, second: WORD): WORD
+
+    (* Bit-by-bit logical AND.	*)
+
+    (*<TopSpeed3*)  = Code3 (21H, 0D8H, Ret)	(* and ax, bx *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE IANDB (first, second: BYTE): BYTE
+
+    (* Bit-by-bit logical AND for bytes. *)
+
+    (*<TopSpeed3*)  = Code3 (21H, 0D8H, Ret)	(* and ax, bx *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE IOR (first, second: WORD): WORD
+
+    (* Bit-by-bit inclusive OR.	*)
+
+    (*<TopSpeed3*) = Code3 (09H, 0D8H, Ret)	(* or ax, bx *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE IORB (first, second: BYTE): BYTE
+
+    (* Bit-by-bit inclusive OR.	*)
+
+    (*<TopSpeed3*) = Code3 (09H, 0D8H, Ret)	(* or ax, bx *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE IXOR (first, second: WORD): WORD
+
+    (* Bit-by-bit exclusive OR.	*)
+
+    (*<TopSpeed3*) = Code3 (31H, 0D8H, Ret)	(* xor ax, bx *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE IXORB (first, second: BYTE): BYTE
+
+    (* Bit-by-bit exclusive OR.	*)
+
+    (*<TopSpeed3*) = Code3 (31H, 0D8H, Ret)	(* xor ax, bx *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE INOT (value: WORD): WORD
+
+    (* Bit-by-bit Boolean complement.	*)
+
+    (*<TopSpeed3*) = Code3 (0F7H, 0D0H, Ret)	(* not ax *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE INOTB (value: BYTE): BYTE
+
+    (* Bit-by-bit Boolean complement.	*)
+
+    (*<TopSpeed3*) = Code3 (0F7H, 0D0H, Ret)	(* not ax *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(inline => on, reg_param => (ax, cx), reg_return => (ax)) *)
+
+INLINE (*>*)
+PROCEDURE ROL (value: WORD;  count: CARDINAL): WORD
+
+    (* Left rotation of "value" by "count" bit positions.	*)
+
+    (*<TopSpeed3*) = Code3 (0D3H, 0C0H, Ret)	(* rol ax, cl *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE ROLB (value: BYTE;  count: CARDINAL): BYTE
+
+    (* Left rotation of "value" by "count" bit positions.	*)
+
+    (*<TopSpeed3*) = Code3 (0D2H, 0C0H, Ret)	(* rol al, cl *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE LS (value: WORD;  count: CARDINAL): WORD
+
+    (* Left shift of "value" by "count" bit positions, with zero fill.	*)
+
+    (*<TopSpeed3*) = Code3 (0D3H, 0E0H, Ret)	(* shl ax, cl *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE LSB (value: BYTE;  count: CARDINAL): BYTE
+
+    (* Left shift of "value" by "count" bit positions, with zero fill.	*)
+
+    (*<TopSpeed3*) = Code3 (0D2H, 0E0H, Ret)	(* shl al, cl *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE ROR (value: WORD;  count: CARDINAL): WORD
+
+    (* Right rotation of "value" by "count" bit positions.	*)
+
+    (*<TopSpeed3*) = Code3 (0D3H, 0C8H, Ret)	(* ror ax, cl *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE RORB (value: BYTE;  count: CARDINAL): BYTE
+
+    (* Right rotation of "value" by "count" bit positions.	*)
+
+    (*<TopSpeed3*) = Code3 (0D2H, 0C8H, Ret)	(* ror al, cl *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE RS (value: WORD;  count: CARDINAL): WORD
+
+    (* Right shift of "value" by "count" bit positions, with zero fill.	*)
+
+    (*<TopSpeed3*) = Code3 (0D3H, 0E8H, Ret)	(* shr ax, cl *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE RSB (value: BYTE;  count: CARDINAL): BYTE
+
+    (* Right shift of "value" by "count" bit positions, with zero fill.	*)
+
+    (*<TopSpeed3*)
+     = Code3 (0D2H, 0E8H, Ret)	(* shr al, cl *)
+    (*>*);
+
+(************************************************************************)
+(*			    POINTER OPERATIONS				*)
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(reg_param => (ax,dx), reg_return => (ax,dx)) *)
+(*# call(reg_saved => (bx,cx,si,di,ds,es,st1,st2)) *)
+
+INLINE (*>*)
+PROCEDURE Far (A: ADDRESS): FarPointer
+
+    (* Converts a pointer to a far pointer. *)
+
+    (*<TopSpeed3*)
+    (*%T _fptr *)
+     = Code1 (Ret)
+    (*%E*)
+    (*%F _fptr *)
+     = Code3 (8CH,0DAH,Ret)	(* mov dx, ds *)
+    (*%E*)
+    (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(reg_param => (dx, ax), reg_return => (ax,dx)) *)
+
+INLINE (*>*)
+PROCEDURE MakePointer (segment, offset: WORD): FarPointer
+
+    (* Creates a pointer, given the segment and offset within segment.	*)
+
+    (*<TopSpeed3*)
+     = Code1 (Ret)
+    (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(reg_param => (ax,bx), reg_return => (bx)) *)
+(*# call(reg_saved => (cx,dx,si,di,ds,es,st1,st2)) *)
+
+INLINE (*>*)
+PROCEDURE SEGMENT (A: ADDRESS): WORD
+
+    (* Returns the segment part of an address.	*)
+
+    (*<TopSpeed3*)
+    (*%T _fptr *)
+     = Code1 (Ret)
+    (*%E*)
+    (*%F _fptr *)
+     = Code3 (8CH, 0DBH, Ret)	(* mov bx, ds *)
+    (*%E*)
+    (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(reg_saved => (ax,bx,cx,dx,si,di,ds,es,st1,st2)) *)
+
+INLINE (*>*)
+PROCEDURE FarSEGMENT (A: FarPointer): WORD
+
+    (* Returns the segment part of an address.	*)
+
+    (*<TopSpeed3*)
+     = Code1 (Ret)
+    (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(inline => on, reg_param => (ax,bx), reg_return => (ax)) *)
+
+INLINE (*>*)
+PROCEDURE OFFSET (A: ADDRESS): WORD
+
+    (* Returns the offset part of an address.	*)
+
+    (*<TopSpeed3*)
+     = Code1 (Ret)
+    (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(reg_saved => (bx,cx,dx,si,di,ds,es,st1,st2)) *)
+(*# call(reg_return => (ax,dx)) *)
+(*%T _fptr *)
+    (*# call(reg_param => (ax,dx,bx)) *)
+(*%E*)
+(*%F _fptr *)
+    (*# call(reg_param => (ax,bx)) *)
+(*%E*)
+
+INLINE (*>*)
+PROCEDURE AddOffset (A: ADDRESS;  increment: CARDINAL): ADDRESS
+
+    (* Returns a pointer to the memory location whose physical address	*)
+    (* is Physical(A)+increment.  In the present version, it is assumed	*)
+    (* that the caller will never try to run off the end of a segment.	*)
+
+    (*<TopSpeed3*) = Code3 (01H, 0D8H, Ret)	(* add ax, bx *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE SubtractOffset (A: ADDRESS;  decrement: CARDINAL): ADDRESS
+
+    (* Like AddOffset, except that we go backwards in memory.  Running	*)
+    (* off the beginning of the segment is an undetected error.		*)
+
+    (*<TopSpeed3*) = Code3 (29H, 0D8H, Ret)	(* sub ax, bx *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) (*# call(reg_param => (ax,dx,bx)) *)
+
+INLINE (*>*)
+PROCEDURE FarAddOffset (A: FarPointer;  increment: CARDINAL): FarPointer
+
+    (* Like AddOffset, except for the parameter types. *)
+
+    (*<TopSpeed3*) = Code3 (01H, 0D8H, Ret)	(* add ax, bx *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE FarSubtractOffset (A: FarPointer; decrement: CARDINAL): FarPointer
+
+    (* Like SubtractOffset, except for the parameter types. *)
+
+    (*<TopSpeed3*) = Code3 (29H, 0D8H, Ret)	(* sub ax, bx *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(inline => off) *)
+(*# call(reg_param => (ax, dx), reg_return => (dx, ax)) *)
+(*# call(reg_saved => (bx,cx,si,di,ds,es,st1,st2)) *)
+(*>*)
+
+PROCEDURE Virtual (PA: LONGCARD): FarPointer;
+
+    (* Converts a physical address to a virtual address, if possible.	*)
+    (* There are no guarantees in the case where there is no such	*)
+    (* virtual address.							*)
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(reg_param => (ax,bx), reg_return => (ax, bx)) *)
+(*# call(reg_saved => (cx,dx,si,di,ds,es,st1,st2)) *)
+(*>*)
+
+PROCEDURE Physical (A: ADDRESS): LONGCARD;
+
+    (* Converts a virtual address to a physical address.  Use with care!*)
+
+(************************************************************************)
+(*			BYTE/WORD/LONGCARD CONVERSIONS			*)
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(inline => on, reg_param => (ax), reg_return => (ax)) *)
+(*# call(reg_saved => (bx,cx,dx,si,di,ds,es,st1,st2)) *)
+
+INLINE (*>*)
+PROCEDURE LowByte (w: WORD): BYTE
+
+    (* Returns the low-order byte of its argument.	*)
+
+    (*<TopSpeed3*) = Code1 (Ret) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE HighByte (w: WORD): BYTE
+
+    (* Returns the high-order byte of its argument.	*)
+
+    (*<TopSpeed3*) = Code3 (88H, 0E0H, Ret)	(* mov al, ah *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(reg_param => (bx, ax), reg_return => (ax)) *)
+
+INLINE (*>*)
+PROCEDURE MakeWord (high, low: BYTE): WORD
+
+    (* Combines two bytes into a word.  The first argument becomes the	*)
+    (* most significant byte of the result.				*)
+
+    (*<TopSpeed3*)
+     = Code3 (8AH, 0E3H, Ret)	(* mov ah, bl *)
+    (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(reg_param => (ax), reg_return => (ax)) *)
+
+INLINE (*>*)
+PROCEDURE SignExtend (val: BYTE): INTEGER
+
+    (* Converts a signed 8-bit number to signed integer. *)
+
+    (*<TopSpeed3*)
+     = Code2 (98H, Ret)		(* cbw *)
+    (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(inline => on, reg_param => (ax,bx), reg_return => (ax)) *)
+
+INLINE (*>*)
+PROCEDURE LowWord (w: LONGCARD): WORD
+
+    (* Returns the low-order word of its argument.	*)
+
+    (*<TopSpeed3*)
+     = Code1 (Ret)
+    (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(inline => on, reg_param => (bx, ax), reg_return => (ax)) *)
+
+INLINE (*>*)
+PROCEDURE HighWord (w: LONGCARD): WORD
+
+    (* Returns the high-order word of its argument.	*)
+
+    (*<TopSpeed3*)
+     = Code1 (Ret)
+    (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(inline => on, reg_param => (dx,ax), reg_return => (ax,dx)) *)
+
+INLINE (*>*)
+PROCEDURE MakeLongword (high, low: WORD): LONGCARD
+
+    (* Combines two words into a longword.  The first argument becomes	*)
+    (* the most significant word of the result.				*)
+
+    (*<TopSpeed3*)
+     = Code1 (Ret)
+    (*>*);
+
+(************************************************************************)
+(*			MISCELLANEOUS ARITHMETIC			*)
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(inline => on, reg_return => (ax)) *)
+(*%T _fptr *)
+    (*%T _fdata*)
+	(*# call(reg_param => (si,ds,ax)) *)
+    (*%E*)
+    (*%F _fdata*)
+	(*# call(reg_param => (si,bx,ax)) *)
+    (*%E*)
+(*%E*)
+(*%F _fptr *)
+    (*# call(reg_param => (si,ax)) *)
+(*%E*)
+
+INLINE (*>*)
+PROCEDURE INCV (VAR (*INOUT*) dest: CARDINAL;  src: CARDINAL): BOOLEAN
+
+    (* Computes dest := dest + src, and returns TRUE iff the addition	*)
+    (* produced a carry.						*)
+
+    (*<TopSpeed3*)
+    (*%F _fptr *)
+       = Code5 (01H, 04H, 1BH, 0C0H, Ret)  (* add [si], ax; sbb ax, ax	*)
+    (*%E*)
+    (*%T _fptr *)
+    (*%T _fdata*)
+       = Code5 (01H, 04H, 1BH, 0C0H, Ret)  (* add [si], ax; sbb ax, ax	*)
+    (*%E*)
+    (*%F _fdata*)
+       = Code9 (01EH, 08EH, 0DBH,	(* push ds; mov ds, bx;		*)
+		01H, 04H, 1BH, 0C0H,	(* add [si], ax; sbb ax, ax;	*)
+		01FH, Ret)		(* pop ds			*)
+    (*%E*)
+    (*%E*)
+    (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE INCVB (VAR (*INOUT*) dest: BYTE;  src: BYTE): BOOLEAN
+
+    (* Computes dest := dest + src, and returns TRUE iff the addition	*)
+    (* produced a carry.						*)
+
+    (*<TopSpeed3*)
+    (*%F _fptr *)
+       = Code5 (00H, 04H, 1BH, 0C0H, Ret)  (* add [si], al; sbb ax, ax	*)
+    (*%E*)
+    (*%T _fptr *)
+    (*%T _fdata*)
+       = Code5 (00H, 04H, 1BH, 0C0H, Ret)  (* add [si], al; sbb ax, ax	*)
+    (*%E*)
+    (*%F _fdata*)
+       = Code9 (01EH, 08EH, 0DBH,	(* push ds; mov ds, bx;		*)
+		00H, 04H, 1BH, 0C0H,	(* add [si], al; sbb ax, ax;	*)
+		01FH, Ret)		(* pop ds			*)
+    (*%E*)
+    (*%E*)
+    (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE DECV (VAR (*INOUT*) dest: CARDINAL;  src: CARDINAL): BOOLEAN
+
+    (* Computes dest := dest - src, and returns TRUE iff the		*)
+    (* subtraction produced a borrow.					*)
+
+    (*<TopSpeed3*)
+    (*%F _fptr *)
+       = Code5 (29H, 04H, 1BH, 0C0H, Ret)  (* sub [si], ax; sbb ax, ax	*)
+    (*%E*)
+    (*%T _fptr *)
+    (*%T _fdata*)
+       = Code5 (29H, 04H, 1BH, 0C0H, Ret)  (* sub [si], ax; sbb ax, ax	*)
+    (*%E*)
+    (*%F _fdata*)
+       = Code9 (01EH, 08EH, 0DBH,	(* push ds; mov ds, bx;		*)
+		29H, 04H, 1BH, 0C0H,	(* sub [si], ax; sbb ax, ax;	*)
+		01FH, Ret)		(* pop ds			*)
+    (*%E*)
+    (*%E*)
+    (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE DECVB (VAR (*INOUT*) dest: BYTE;  src: BYTE): BOOLEAN
+
+    (* Computes dest := dest - src, and returns TRUE iff the		*)
+    (* subtraction produced a borrow.					*)
+
+    (*<TopSpeed3*)
+    (*%F _fptr *)
+       = Code5 (28H, 04H, 1BH, 0C0H, Ret)  (* sub [si], al; sbb ax, ax	*)
+    (*%E*)
+    (*%T _fptr *)
+    (*%T _fdata*)
+       = Code5 (28H, 04H, 1BH, 0C0H, Ret)  (* sub [si], al; sbb ax, ax	*)
+    (*%E*)
+    (*%F _fdata*)
+       = Code9 (01EH, 08EH, 0DBH,	(* push ds; mov ds, bx;		*)
+		28H, 04H, 1BH, 0C0H,	(* sub [si], al; sbb ax, ax;	*)
+		01FH, Ret)		(* pop ds			*)
+    (*%E*)
+    (*%E*)
+    (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(inline => on, reg_param => (ax, bx), reg_return => (ax,dx)) *)
+(*# call(reg_saved => (bx,cx,si,di,ds,es,st1,st2)) *)
+
+INLINE (*>*)
+PROCEDURE Mul (A, B: CARDINAL): LONGCARD
+
+    (* Same as A*B, except for the type of the result.  We provide this	*)
+    (* as a general-purpose function since this combination of operands	*)
+    (* is often precisely what is wanted.				*)
+
+    (*<TopSpeed3*) = Code3 (0F7H, 0E3H, Ret)	(* mul bx *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE MulB (A, B: BYTE): CARDINAL
+
+    (* Same as A*B, except for the type of the result.  We provide this	*)
+    (* as a general-purpose function since this combination of operands	*)
+    (* is often precisely what is wanted.				*)
+
+    (*<TopSpeed3*) = Code3 (0F6H, 0E3H, Ret)	(* mul bl *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE IMul (A, B: INTEGER): LONGINT
+
+    (* Like Mul, but signed. *)
+
+    (*<TopSpeed3*) = Code3 (0F7H, 0EBH, Ret)	(* imul bx *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE IMulB (A, B: BYTE): INTEGER
+
+    (* Like MulB, but signed. *)
+
+    (*<TopSpeed3*) = Code3 (0F6H, 0EBH, Ret)	(* imul bl *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE DivB (A: CARDINAL;  B: BYTE): BYTE
+
+    (* Same as A DIV B, except for the type of A.  We provide this as	*)
+    (* a general-purpose function since this combination of operands	*)
+    (* is often precisely what is wanted.				*)
+
+    (*<TopSpeed3*)
+     = Code3 (0F6H, 0F3H, Ret)	(* div bl *)
+    (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(inline => on, reg_param => (ax,dx,bx), reg_return => (ax)) *)
+
+INLINE (*>*)
+PROCEDURE Div (A: LONGCARD;  B: CARDINAL): CARDINAL
+
+    (* Same as A DIV B, except for the type of A.  We provide this as	*)
+    (* a general-purpose function since this combination of operands	*)
+    (* is often precisely what is wanted.				*)
+
+    (*<TopSpeed3*)
+     = Code3 (0F7H, 0F3H, Ret)	(* div bx *)
+    (*>*);
+
+(************************************************************************)
+(*			     BLOCK MOVES				*)
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(inline => on) *)
+(*# call(reg_saved => (ax,bx,dx,ds,st1,st2)) *)
+(*%T _fptr*)
+    (*%T _fdata*)
+	(*# call(reg_param => (si, ds, di, es, cx)) *)
+    (*%E*)
+    (*%F _fdata*)
+	(*# call(reg_param => (si, ax, di, es, cx)) *)
+    (*%E*)
+(*%E*)
+(*%F _fptr*)
+    (*# call(reg_param => (si, di, cx)) *)
+(*%E*)
+
+INLINE (*>*)
+PROCEDURE Copy (source, destination: ADDRESS;  bytecount: CARDINAL)
+
+    (* Copies an array of bytes from the source address to the		*)
+    (* destination address.  In the case where the two arrays overlap,	*)
+    (* the destination address should be lower in physical memory than	*)
+    (* the source address.						*)
+
+    (*<TopSpeed3*)
+    (*%T _fptr*)
+	(*%T _fdata*)
+	    = Code3 (0F3H, 0A4H, Ret)	(* rep movsb *)
+	(*%E*)
+	(*%F _fdata*)
+	    = Code7 (01EH, 08EH, 0D8H,	(* push ds; mov ds, ax;	*)
+		0F3H, 0A4H, 01FH, Ret)	(* rep movsb;  pop ds	*)
+	(*%E*)
+    (*%E*)
+    (*%F _fptr*)
+        = Code5 (01EH,07H,0F3H,0A4H,Ret)  (* push ds; pop es; rep movsb	*)
+    (*%E*)
+    (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(inline => on) *)
+(*# call(reg_saved => (ax,bx,dx,ds,es,st1,st2)) *)
+(*%T _fdata*)
+    (*# call(reg_param => (si, ds, di, es, cx)) *)
+(*%E*)
+(*%F _fdata*)
+    (*# call(reg_param => (si, ax, di, es, cx)) *)
+(*%E*)
+
+INLINE (*>*)
+PROCEDURE FarCopy (source, destination: FarPointer;  bytecount: CARDINAL)
+
+    (* Copies an array of bytes from the source address to the		*)
+    (* destination address.  In the case where the two arrays overlap,	*)
+    (* the destination address should be lower in physical memory than	*)
+    (* the source address.						*)
+
+    (*<TopSpeed3*)
+    (*%T _fdata*)
+        = Code3 (0F3H, 0A4H, Ret)	(* rep movsb *)
+    (*%E*)
+    (*%F _fdata*)
+        = Code7 (01EH, 08EH, 0D8H,	(* push ds; mov ds, ax;	*)
+		0F3H, 0A4H, 01FH, Ret)	(* rep movsb;  pop ds	*)
+    (*%E*)
+    (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)(*# call(inline => off) *) (*>*)
+
+PROCEDURE CopyUp (source, destination: FarPointer;  bytecount: CARDINAL);
+
+    (* A variant of Copy which does the move backwards, in order	*)
+    (* to handle the case where the destination address is inside the	*)
+    (* source array.  In this special case Copy cannot be used,		*)
+    (* because it would overwrite data it was about to copy.		*)
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(inline => on, reg_param => (di, es, cx, ax)) *)
+(*# call(reg_saved => (ax,bx,dx,si,ds,es,st1,st2)) *)
+
+INLINE (*>*)
+PROCEDURE BlockFill (destination: FarPointer;
+				bytecount: CARDINAL;  value: BYTE)
+
+    (* Fills the destination array with the given value.	*)
+
+    (*<TopSpeed3*) = Code3 (0F3H, 0AAH, Ret)	(* rep stosb *) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*) INLINE (*>*)
+PROCEDURE BlockFillWord (destination: FarPointer;  wordcount: CARDINAL;
+							value: WORD)
+
+    (* Fills the destination array with the given value.	*)
+
+    (*<TopSpeed3*)
+     = Code3 (0F3H, 0ABH, Ret)	(* rep stosw *)
+    (*>*);
+
+(************************************************************************)
+(*			    INPUT AND OUTPUT				*)
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(inline => on, reg_param => (dx, ax)) *)
+(*# call(reg_saved => (bx,cx,dx,si,di,ds,es,st1,st2)) *)
+
+INLINE (*>*)
+PROCEDURE OutByte (port: CARDINAL; value: BYTE)
+
+    (* Puts the value out to an output port.	*)
+
+    (*<TopSpeed3*) = Code2 (0EEH, Ret) (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(inline => on, reg_param => (dx), reg_return => (ax)) *)
+
+INLINE (*>*)
+PROCEDURE InByte (port: CARDINAL): BYTE
+
+    (* Reads a byte from an input port.	*)
+
+    (*<TopSpeed3*)
+     = Code2 (0ECH, Ret)
+    (*>*);
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*# call(inline => off) *)
+(*# call(reg_saved => (ax,bx,dx,si,di,ds,es,st1,st2)) *)
+(*%T _fptr *)
+    (*# call(reg_param => (dx, di, es, cx)) *)
+(*%E*)
+(*%F _fptr *)
+    (*# call(reg_param => (dx, di, cx)) *)
+(*%E*)
+(*>*)
+
+PROCEDURE InStringWord (port: CARDINAL;  BufferAddress: ADDRESS;
+						count: CARDINAL);
+
+    (* Reads count words from an input port.	*)
+
+(************************************************************************)
+
+(*<TopSpeed3*)
+(*%T _fptr*)
+    (*%T _fdata*)
+	(*# call(reg_param => (dx, si, ds, cx)) *)
+    (*%E*)
+    (*%F _fdata*)
+	(*# call(reg_param => (dx, si, ax, cx)) *)
+    (*%E*)
+(*%E*)
+(*%F _fptr*)
+    (*# call(reg_param => (dx, si, cx)) *)
+(*%E*)
+(*>*)
+
+PROCEDURE OutStringWord (port: CARDINAL;  BufferAddress: ADDRESS;
+						count: CARDINAL);
+
+    (* Writes count words to an output port.	*)
+
+(************************************************************************)
+
+(*<TopSpeed3*) (*# restore *) (*>*)
+
+END LowLevel.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/mailboxe.def b/examples/Modula-2_Libraries/PMOS/sources/general/mailboxe.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/mailboxe.def
@@ -0,0 +1,40 @@
+DEFINITION MODULE Mailboxes;
+
+	(********************************************************)
+	(*							*)
+	(*	Mailboxes for intertask communication		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	8 June 1993			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+TYPE Mailbox;		(* is private *)
+
+PROCEDURE CreateMailbox (LengthLimit: CARDINAL): Mailbox;
+
+    (* Creates a new mailbox.  LengthLimit is the maximum number of	*)
+    (* characters in a single message.  (A limit is needed so that a	*)
+    (* task reading the mailbox knows how much space to allocate.)	*)
+
+PROCEDURE SendMessage (MB: Mailbox;  messageptr: ADDRESS;
+					length: CARDINAL): BOOLEAN;
+
+    (* Copies a string, specified by its address and length, into the	*)
+    (* specified mailbox.  Returns TRUE if successful, and FALSE if the	*)
+    (* message is too long or the mailbox does not exist.		*)
+
+PROCEDURE ReceiveMessage (MB: Mailbox;  VAR (*OUT*) message: ARRAY OF CHAR;
+					TimeLimit: CARDINAL): CARDINAL;
+
+    (* Returns the next message (after waiting if necessary) from	*)
+    (* mailbox MB.  TimeLimit is a timeout value in milliseconds.	*)
+    (* (Specify TimeLimit=0 for infinite patience.)  The function	*)
+    (* return value is the message length; this is zero if no message	*)
+    (* was obtained, either because of a faulty mailbox or because of	*)
+    (* timeout.  Note: it is also possible to have a genuine message of	*)
+    (* zero length.							*)
+
+END Mailboxes.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/mailboxe.mod b/examples/Modula-2_Libraries/PMOS/sources/general/mailboxe.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/mailboxe.mod
@@ -0,0 +1,185 @@
+IMPLEMENTATION MODULE Mailboxes;
+
+	(********************************************************)
+	(*							*)
+	(*	Mailboxes for intertask communication		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	27 February 1995		*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM Timer IMPORT
+    (* proc *)	TimedWait;
+
+FROM TaskControl IMPORT
+    (* type *)	Lock,
+    (* proc *)	CreateLock, Obtain, Release;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM LowLevel IMPORT
+    (* proc *)	Copy;
+
+(************************************************************************)
+
+CONST GuardConst = 3579;
+
+TYPE
+    MessagePtr = POINTER TO Message;
+
+    Message = RECORD
+		  next: MessagePtr;
+		  size: CARDINAL;
+		  content: ARRAY [0..0] OF BYTE;
+	      END (*RECORD*);
+
+    Mailbox = POINTER TO
+		    RECORD
+			guard: CARDINAL;
+			limit: CARDINAL;
+			mutex: Lock;
+			count: Semaphore;
+			head, tail: MessagePtr;
+		    END (*RECORD*);
+
+(************************************************************************)
+
+PROCEDURE CreateMailbox (LengthLimit: CARDINAL): Mailbox;
+
+    (* Creates a new mailbox.  LengthLimit is the maximum number of	*)
+    (* characters in a single message.  (A limit is needed so that a	*)
+    (* task reading the mailbox knows how much space to allocate.)	*)
+
+    VAR result: Mailbox;
+
+    BEGIN
+	NEW (result);
+	WITH result^ DO
+	    guard := GuardConst;
+	    limit := LengthLimit;
+	    CreateLock (mutex);
+	    CreateSemaphore (count, 0);
+	    head := NIL;  tail := NIL;
+	END (*WITH*);
+	RETURN result;
+    END CreateMailbox;
+
+(************************************************************************)
+
+PROCEDURE SendMessage (MB: Mailbox;  messageptr: ADDRESS;
+					length: CARDINAL): BOOLEAN;
+
+    (* Copies a string, specified by its address and length, into the	*)
+    (* specified mailbox.  Returns TRUE if successful, and FALSE if the	*)
+    (* message is too long or the mailbox does not exist.		*)
+
+    VAR pnew: MessagePtr;
+
+    BEGIN
+
+	(* Check for invalid mailbox. *)
+
+	IF (MB = NIL) OR (MB^.guard <> GuardConst)
+			OR (length > MB^.limit) THEN
+	    RETURN FALSE;
+	END (*IF*);
+
+	(* Create a new queue element containing the message. *)
+
+	NEW (pnew);
+	ALLOCATE (pnew, SIZE(Message) + length - 1);
+	WITH pnew^ DO
+	    next := NIL;  size := length;
+	    IF length > 0 THEN
+		Copy (messageptr, ADR(content), length);
+	    END (*IF*);
+	END (*WITH*);
+
+	(* Insert the new entry into the mailbox queue. *)
+
+	WITH MB^ DO
+	    Obtain (mutex);
+	    IF head = NIL THEN
+		head := pnew;
+	    ELSE
+		tail^.next := pnew;
+	    END (*IF*);
+	    tail := pnew;
+	    Release (mutex);
+	    Signal (count);
+	END (*WITH*);
+	RETURN TRUE;
+
+    END SendMessage;
+
+(************************************************************************)
+
+PROCEDURE ReceiveMessage (MB: Mailbox;  VAR (*OUT*) message: ARRAY OF CHAR;
+					TimeLimit: CARDINAL): CARDINAL;
+
+    (* Returns the next message (after waiting if necessary) from	*)
+    (* mailbox MB.  TimeLimit is a timeout value in milliseconds.	*)
+    (* (Specify TimeLimit=0 for infinite patience.)  The function	*)
+    (* return value is the message length; this is zero if no message	*)
+    (* was obtained, either because of a faulty mailbox or because of	*)
+    (* timeout.  Note: it is also possible to have a genuine message of	*)
+    (* zero length.							*)
+
+    VAR length: CARDINAL;  TimedOut: BOOLEAN;
+	second: MessagePtr;
+
+    BEGIN
+
+	(* Check for invalid mailbox.	*)
+
+	IF (MB = NIL) OR (MB^.guard <> GuardConst) THEN
+	    RETURN 0;
+	END (*IF*);
+
+	WITH MB^ DO
+
+	    (* Wait no longer than TimeLimit for a message to arrive. *)
+
+	    IF TimeLimit = 0 THEN
+		Wait (count);
+	    ELSE
+		TimedWait (count, TimeLimit, TimedOut);
+		IF TimedOut THEN RETURN 0 END(*IF*);
+	    END (*IF*);
+
+	    (* If we reach here, at least one message is available. *)
+
+	    Obtain (mutex);
+
+	    (* Copy the message. *)
+
+	    WITH head^ DO
+		second := next;  length := size;
+		IF length > 0 THEN
+		    Copy (ADR(content), ADR(message), length);
+		END (*IF*);
+	    END (*WITH*);
+	    DEALLOCATE (head, SIZE(Message) + length - 1);
+
+	    (* Update the queue. *)
+
+	    head := second;
+	    IF head = NIL THEN
+		tail := NIL;
+	    END (*IF*);
+	    Release (mutex);
+	END (*WITH*);
+	RETURN length;
+    END ReceiveMessage;
+
+(************************************************************************)
+
+END Mailboxes.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/maintena.def b/examples/Modula-2_Libraries/PMOS/sources/general/maintena.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/maintena.def
@@ -0,0 +1,37 @@
+DEFINITION MODULE MaintenancePages;
+
+	(********************************************************)
+	(*							*)
+	(*	Support for "maintenance page" screen output	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	12 March 1993			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM Windows IMPORT
+    (* type *)	Window;
+
+TYPE MaintenancePage;	(* is private *)
+
+PROCEDURE CreateMaintenancePage (VAR (*OUT*) page: MaintenancePage);
+
+    (* Creates a new maintenance page.	*)
+
+PROCEDURE Associate (w: Window;  page: MaintenancePage);
+
+    (* Before calling this procedure, both w and page must have been	*)
+    (* created.  This procedure ensures that window w is visible on	*)
+    (* the screen only when the given maintenance page is active.	*)
+    (* The association lasts until the window is closed or the page	*)
+    (* is removed.							*)
+
+PROCEDURE RemoveMaintenancePage (VAR (*INOUT*) page: MaintenancePage);
+
+    (* Destroys all associations between the given page and its screen	*)
+    (* windows (but does not close the windows), and permanently	*)
+    (* removes this page from the collection of maintenance pages.	*)
+
+END MaintenancePages.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/maintena.mod b/examples/Modula-2_Libraries/PMOS/sources/general/maintena.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/maintena.mod
@@ -0,0 +1,83 @@
+IMPLEMENTATION MODULE MaintenancePages;
+
+	(********************************************************)
+	(*							*)
+	(*	Support for "maintenance page" screen output	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	3 July 1993			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM MultiScreen IMPORT
+    (* type *)	ScreenGroup, VirtualScreen,
+    (* proc *)	CreateScreenGroup, CreateVirtualScreen,
+		RemoveVirtualScreen, MapToVirtualScreen;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, WriteString, PutOnPage, SetCursor;
+
+(************************************************************************)
+
+TYPE MaintenancePage = VirtualScreen;
+
+VAR
+    (* All maintenance pages are collected together as a single group.	*)
+
+    MPGroup: ScreenGroup;
+
+    (* The prompt window appears on every maintenance page.	*)
+
+    prompt: Window;
+
+(************************************************************************)
+(*			EXTERNALLY CALLABLE PROCEDURES			*)
+(************************************************************************)
+
+PROCEDURE CreateMaintenancePage (VAR (*OUT*) page: MaintenancePage);
+
+    (* Creates a new maintenance page.	*)
+
+    BEGIN
+	page := CreateVirtualScreen (MPGroup);
+    END CreateMaintenancePage;
+
+(************************************************************************)
+
+PROCEDURE RemoveMaintenancePage (VAR (*INOUT*) page: MaintenancePage);
+
+    (* Destroys all associations between the given page and its screen	*)
+    (* windows (but does not close the windows), and permanently	*)
+    (* removes this page from the collection of maintenance pages.	*)
+
+    BEGIN
+	RemoveVirtualScreen (page);
+    END RemoveMaintenancePage;
+
+(************************************************************************)
+
+PROCEDURE Associate (w: Window;  page: MaintenancePage);
+
+    (* Before calling this procedure, both w and page must have been	*)
+    (* created.  This procedure ensures that window w is visible on	*)
+    (* the screen only when the given maintenance page is active.	*)
+
+    BEGIN
+	MapToVirtualScreen (w, page);
+    END Associate;
+
+(************************************************************************)
+(*			   MODULE INITIALISATION			*)
+(************************************************************************)
+
+BEGIN
+    MPGroup := CreateScreenGroup (1);
+    OpenWindow (prompt, blue, cyan, 24, 24, 0, 79, noframe, nodivider);
+    PutOnPage (prompt, 1);
+    WriteString (prompt, "  F6 cycle");
+    SetCursor (prompt, 0, 51);
+    WriteString (prompt, "^P maintenance pages on/off");
+END MaintenancePages.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/menus.def b/examples/Modula-2_Libraries/PMOS/sources/general/menus.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/menus.def
@@ -0,0 +1,193 @@
+DEFINITION MODULE Menus;
+
+	(****************************************************************)
+	(*								*)
+	(*	Displays menus on screen, allows terminal user to	*)
+	(*			select from them.			*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	14 December 1994			*)
+	(*  Status:		OK					*)
+	(*								*)
+	(****************************************************************)
+
+(************************************************************************)
+(*									*)
+(*  NOTE: This module gives you the choice of specifying your own	*)
+(*  window in which to display the menu, or using a window which is	*)
+(*  created for you when SelectFromMenu is called.  In either case,	*)
+(*  you use CreateMenu to define the menu initially, SelectFromMenu	*)
+(*  to prompt the user to choose from the menu, and DestroyMenu when	*)
+(*  you have finished using the menu.  You can also control some	*)
+(*  aspects of menu behaviour by calling the optional procedures	*)
+(*  MenuColours, SetOptions, and OffEdge after calling CreateMenu.	*)
+(*									*)
+(*  In most applications, you will want to let this module look after	*)
+(*  the screen window for you.  You need to call PositionMenu to	*)
+(*  define where on the screen the menu will be displayed, but you	*)
+(*  don't need to open a window explicitly.  The menu does not appear	*)
+(*  on the screen until SelectFromMenu is called, and - unless you	*)
+(*  have specified the MNoClose option - it disappears from the		*)
+(*  screen as soon as the keyboard user has made a selection.		*)
+(*  You may, if you wish, use a new call to PositionMenu before each	*)
+(*  call to SelectFromMenu, although the more common case would be to	*)
+(*  call PositionMenu just once, after the call to CreateMenu.		*)
+(*									*)
+(*  The alternative is to open your own screen window, and to call	*)
+(*  DisplayMenu to show the menu on the screen.  (This also means	*)
+(*  that DisplayMenu defines the location of the menu on the screen,	*)
+(*  so in this case PositionMenu should not be called.)  After that,	*)
+(*  you call SelectFromMenu to prompt the user to choose an item.	*)
+(*  This possibility is provided for applications where, for example,	*)
+(*  you want multiple menus within the same screen window.		*)
+(*									*)
+(*  Note for users of earlier versions of this module: the earlier	*)
+(*  distinction between Normal Mode and Special Mode is now obsolete.	*)
+(*									*)
+(************************************************************************)
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, RowRange, ColumnRange;
+
+TYPE
+    Menu;		(* is private *)
+    ItemText = ARRAY ColumnRange OF CHAR;
+    MenuColumn = CARDINAL;
+
+    (* Note the dual use of the word "column".  A variable of type	*)
+    (* ColumnRange refers to a horizontal screen position.  But in	*)
+    (* menus we use "column" to a column of character strings, which	*)
+    (* is why we have the separate type MenuColumn.  The type		*)
+    (* MenuColumn is defined primarily to make it clear which type of	*)
+    (* column is being referred to in every case.			*)
+
+    MenuOption = (MTitle, MNoTitle, MBorder, MNoBorder, MClose, MNoClose,
+			MKeyBack, MNoKeyBack, MFastSelect, MNoFastSelect,
+			MMouse, MNoMouse);
+
+    MO = SET OF MenuOption;
+
+    (* The options have the following meanings:				*)
+    (*	MTitle		Messages[0], as specified in the CreateMenu	*)
+    (*			call, is used as a menu title to be displayed.	*)
+    (*	MNoTitle	No title is displayed, Messages[0] is ignored.	*)
+    (*	MBorder		The menu has a border.				*)
+    (*	MNoBorder	The menu has no border.				*)
+    (*	MClose		The window containing the menu is closed after	*)
+    (*			a selection has been made.			*)
+    (*	MNoClose	The window containing the menu is kept open on	*)
+    (*			return from SelectFromMenu (and the same window	*)
+    (*			will be re-used on the next call).		*)
+    (*	MKeyBack	The keystroke that caused an exit from		*)
+    (*			SelectFromMenu remains available to the caller,	*)
+    (*			via InKey() or equivalent.			*)
+    (*	MNoKeyBack	On return from SelectFromMenu, the keystroke	*)
+    (*			that caused the exit has been consumed.		*)
+    (*	MFastSelect	A menu item reached by selection key or mouse	*)
+    (*			click is selected immediately.			*)
+    (*	MNoFastSelect	The user has to type Space or Return to select	*)
+    (*			the highlighted menu item.			*)
+    (*	MMouse		The user may move and hide the menu with the	*)
+    (*			mouse, if a mouse driver is present.		*)
+    (*	MNoMouse	User may click on the menu but may not move it	*)
+    (*			with the mouse.					*)
+    (* Note that some of the options are mutually contradictory.  This	*)
+    (* way of specifying options was chosen to make it easy to specify	*)
+    (* "no change to previously set option", e.g. if you specify	*)
+    (* neither MTitle nor MNoTitle then the behaviour of the menu with	*)
+    (* respect to the title display remains at what was already in	*)
+    (* force.  If you specify contradictory options (e.g. MTitle and	*)
+    (* MNoTitle) at the same time then the result is not guaranteed to	*)
+    (* be consistent between versions of this module.			*)
+
+    OffEdgeOption = (stick, wrap, escape, return);
+
+    (* An OffEdgeOption specifies what is to be done when the user	*)
+    (* tries to run the menu cursor off the edge of the menu.  The	*)
+    (* possibilities are:						*)
+    (*	stick		The cursor refuses to move in that direction.	*)
+    (*	wrap		The cursor wraps to the opposite edge.		*)
+    (*	escape		Return to caller with a result of 0.		*)
+    (*	return		Return to caller with a result that reflects	*)
+    (*			the currently highlighted item.			*)
+
+(************************************************************************)
+
+PROCEDURE CreateMenu (VAR (*OUT*) M: Menu;  columns: MenuColumn;
+			VAR (*IN*) Messages: ARRAY OF ItemText;
+			NumberOfItems: CARDINAL);
+
+    (* Introduces a menu into the system, but does not display it yet.	*)
+    (* For a simple vertical menu, columns = 1.  Use columns > 1 for	*)
+    (* shorter and wider menus.  Messages[0] is the label to put into	*)
+    (* the menu header, if present.  The remaining entries in Messages	*)
+    (* are the items displayed when the menu is put on the screen.	*)
+    (* Special case: if you specify NumberOfItems = 0 then the whole of	*)
+    (* array Messages is used.						*)
+    (* For each entry of Messages, the selection character is the	*)
+    (* character following a "\".  If there is no "\", the selection	*)
+    (* character is the first character.  The selection character must	*)
+    (* be alphanumeric.  To disable the selection character feature,	*)
+    (* put the "\" in front of a non-alphanumeric character or put it	*)
+    (* at the end of the string.					*)
+
+PROCEDURE PositionMenu (M: Menu;  startline, endline: RowRange;
+				leftcol, rightcol: ColumnRange);
+
+    (* Sets the screen position and size to be used when this menu is	*)
+    (* displayed by a call to SelectFromMenu.  This procedure does not	*)
+    (* actually display the menu - that doesn't happen until		*)
+    (* SelectFromMenu is called.					*)
+
+PROCEDURE MenuColours (M: Menu;  fore, back, hfore, hback, select: Colour);
+
+    (* Set the colours for the screen display of the menu.  The colours	*)
+    (* fore and back are used as the normal foreground and background	*)
+    (* colours, and the highlighted menu item is displayed in colours	*)
+    (* hfore, hback.  The "select" colour is for highlighting the	*)
+    (* selection character.  This procedure is optional.		*)
+
+PROCEDURE SetOptions (M: Menu;  options: MO);
+
+    (* See the MenuOptions declaration for the possible options.  This	*)
+    (* procedure is optional.  If it is not called, the default options	*)
+    (* are {MTitle,MBorder,MClose,MNoKeyBack,MNoFastSelect,MMouse}.	*)
+
+PROCEDURE OffEdge (M: Menu;  top, bottom, left, right: OffEdgeOption);
+
+    (* Sets the menu behaviour when the user runs the cursor off the	*)
+    (* edge of the menu.  There is one parameter for each edge of the	*)
+    (* menu.								*)
+    (* See the OffEdgeOption type declaration for the possible options.	*)
+
+PROCEDURE SelectFromMenu (M: Menu): CARDINAL;
+
+    (* Displays menu M on the screen, allows terminal user to use	*)
+    (* cursor keys to move about the menu and the ENTER key to select	*)
+    (* an item.  (The space bar is also accepted, as an alternative to	*)
+    (* the ENTER key, to select an item.)  An item may also be selected	*)
+    (* by typing its initial letter, followed by space or ENTER.	*)
+    (* Returns the number of the item which was selected.		*)
+    (* (Item numbers start from 1).  An answer of 0 indicates that the	*)
+    (* user typed the ESC key to return without selecting anything.	*)
+
+PROCEDURE DestroyMenu (M: Menu);
+
+    (* Removes a menu from the system, freeing up the space it used.	*)
+
+(************************************************************************)
+(*			ALTERNATIVE DISPLAY PROCEDURE			*)
+(************************************************************************)
+
+PROCEDURE DisplayMenu (w: Window;  M: Menu;
+				rows, columns, initialvalue: CARDINAL);
+
+    (* Displays menu M at the current cursor position in window w,	*)
+    (* with initialvalue specifying a field to highlight.  The space	*)
+    (* reserved on the screen is "rows" screen rows in height and	*)
+    (* "columns" character positions wide.  (The remainder of window w	*)
+    (* may of course be used for other purposes, including other	*)
+    (* menus.)  When SelectFromMenu is called, it will use window w.	*)
+
+END Menus.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/menus.mod b/examples/Modula-2_Libraries/PMOS/sources/general/menus.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/menus.mod
@@ -0,0 +1,1245 @@
+IMPLEMENTATION MODULE Menus;
+
+	(****************************************************************)
+	(*								*)
+	(*	Displays menus on screen, allows terminal user to	*)
+	(*			select from them.			*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	21 February 1995			*)
+	(*  Status:		OK					*)
+	(*								*)
+	(****************************************************************)
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM TaskControl IMPORT
+    (* type *)	Lock,
+    (* proc *)	CreateLock, Obtain, Release;
+
+FROM Keyboard IMPORT
+    (* proc *)	PutBack, StuffKeyboardBuffer;
+
+FROM Windows IMPORT
+    (* const*)	MaxColumnNumber,
+    (* type *)	Window, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, ChangeScrollingRegion,
+		GetKey, WriteChar, WriteString, SetColours, Blink,
+		SetCursor, SaveCursor, ScrollUp, ScrollDown, EraseLine,
+		NewScrollingRegion, ResetScrollingRegion;
+
+FROM TextLines IMPORT
+    (* type *)	LineType,
+    (* proc *)	Box, HLine;
+
+FROM Mouse IMPORT
+    (* type *)	Buttons, ButtonSet,
+    (* proc *)	MouseAvailable, HideMouseCursor, ShowMouseCursor;
+
+FROM UserInterface IMPORT
+    (* type *)	UIWindow, Capability, CapabilitySet,
+    (* proc *)	AllowMouseControl, AddActiveRegion;
+
+(************************************************************************)
+
+CONST
+    gap = 1;			(* space between menu columns *)
+    ClickIndicator = CHR(1);	(* special code to indicate mouse click	*)
+    LeftOnly = ButtonSet{LeftButton};
+    Esc = CHR(01BH);		(* keyboard Escape character *)
+    NilWindow = Window(NIL);
+
+TYPE
+    (* An ItemBuffer record holds the text for the screen display of	*)
+    (* one menu item.  The "selpos" field shows which character acts	*)
+    (* as the selection character.					*)
+
+    ItemBuffer = RECORD
+		     selpos: CARDINAL;
+		     text: ItemText;
+		 END (*RECORD*);
+
+CONST
+    MaxItems = MAX(CARDINAL) DIV SIZE(ItemBuffer);
+
+TYPE
+    ItemNo = [0..MaxItems];
+
+    (* The following declaration uses a large upper subscript bound	*)
+    (* because Modula-2 provides no way of declaring a variable-length	*)
+    (* array (except as a procedure parameter).  The correct array size	*)
+    (* will be established on a call to ALLOCATE.			*)
+
+    TextPointer = POINTER TO ARRAY [1..MaxItems] OF ItemBuffer;
+
+    Menu = POINTER TO MenuDetails;
+
+    (********************************************************************)
+    (*									*)
+    (* The fields in a MenuDetails record have the following meaning:	*)
+    (*									*)
+    (*	win		The window used to display this menu		*)
+    (*			 on the screen					*)
+    (*	foreground,	The colours to use when displaying the menu	*)
+    (*	 background,							*)
+    (*	 selchar,							*)
+    (*	 highforeground,						*)
+    (*	 highbackground							*)
+    (*	ScreenPosition	The row and column numbers which will be	*)
+    (*			 occupied by the menu on the screen.  This	*)
+    (*			 includes space for the border and title, if	*)
+    (*			 present.  The space taken by the menu itself,	*)
+    (*			 not including border and title, is given by	*)
+    (*			 the LocationInWindow record - see below.	*)
+    (*	heading		The text to display in the menu header		*)
+    (*	NoOfItems	Number of menu items				*)
+    (*	ItemsPerColumn  Number of items allocated to each column	*)
+    (*	NoOfColumns	Number of columns of menu items			*)
+    (*	hstep		The increment in item number resulting from	*)
+    (*			 one "cursor right" operation.			*)
+    (*	vstep		The increment in item number resulting from	*)
+    (*			 one "cursor down" operation.  Note that hstep	*)
+    (*			 and vstep depend on whether the items are	*)
+    (*			 numbered horizontally or vertically, and that	*)
+    (*			 in turn depends on whether we have a short fat	*)
+    (*			 display or a tall thin one.			*)
+    (*	LocationInWindow: The location of the menu itself, relative to	*)
+    (*			 the window in which it is displayed, and not	*)
+    (*			 counting the space taken by borders or a	*)
+    (*			 header.  The top left character is at location	*)
+    (*			 (firstrow,firstcol), the menu takes 'height'	*)
+    (*			 screen lines and is 'width' characters wide.	*)
+    (*			 To fit the text exactly into this space, we	*)
+    (*			 would need					*)
+    (*			    NoOfItems = height*NoOfColumns		*)
+    (*			 If NoOfItems is smaller than this, the menu	*)
+    (*			 will be displayed with some blank areas.  If	*)
+    (*			 it is larger, the menu scrolls.		*)
+    (*	ColumnWidth	The number of characters of TextPtr^[j] which	*)
+    (*			 will be written on the screen.  Approximately	*)
+    (*			 equal to LocationInWindow.width/NoOfColumns.	*)
+    (*	ShowTitle	Says whether to display a menu title.		*)
+    (*	ShowBorder	Says whether to put a border around the menu.	*)
+    (*	CloseAfterSelection  If TRUE, specifies that the menu window	*)
+    (*			 will be closed on return from SelectFromMenu.	*)
+    (*	PutBackExitKey	If TRUE, the keystroke that caused a return	*)
+    (*			 from SelectFromMenu remains available to the	*)
+    (*			 caller.  If FALSE, that key is consumed.	*)
+    (*	FastSelect	If TRUE, user can select a menu item without	*)
+    (*			 having to confirm with Enter or Space.		*)
+    (*	MouseControl	If TRUE, user can move the menu with the mouse.	*)
+    (*	offL, offR,	What to do when the user tries to run off the	*)
+    (*	  offT, offB	left/right/top/bottom edge of the menu.		*)
+    (*  CurrentItemNo	The item number currently selected.		*)
+    (*  row		The current menu row selected.  Note that row=1	*)
+    (*			 means the top row of items displayed; this is	*)
+    (*			 not necessarily the top row of the entire menu	*)
+    (*			 since some items may have scrolled off the top.*)
+    (*  column		The current menu column selected.		*)
+    (*	ExtraAtTop	The number of rows which have disappeared off	*)
+    (*				the top of the display.			*)
+    (*	ExtraAtBottom	The number of rows which have disappeared off	*)
+    (*				the bottom of the display.		*)
+    (*	RanOffEdge	Set if a cursor movement ran us off the edge	*)
+    (*				of the menu.				*)
+    (*	TextPtr^[j]	The text to display for menu item j.		*)
+    (*									*)
+    (********************************************************************)
+
+    MenuDetails =
+
+	   RECORD
+		(* The screen window. *)
+
+		win: Window;
+		foreground, background, selchar,
+			highforeground, highbackground: Colour;
+		ScreenPosition:
+		    RECORD
+			firstrow, lastrow: RowRange;
+			firstcol, lastcol: ColumnRange;
+		    END (*RECORD*);
+		heading: ItemText;
+
+		(* The layout of the menu within its window, determined	*)
+		(* at the time that the menu is created.		*)
+
+		NoOfItems: ItemNo;
+		ItemsPerColumn: ItemNo;
+		NoOfColumns: MenuColumn;
+
+		(* Further layout details, determined at the time we	*)
+		(* discover how much space the menu will be given on	*)
+		(* the screen.						*)
+
+		hstep, vstep: CARDINAL;
+		LocationInWindow:
+		    RECORD
+			firstrow, firstcol: CARDINAL;
+			height, width: CARDINAL;
+		    END (*RECORD*);
+		ColumnWidth: ColumnRange;
+
+		(* Options. *)
+
+		ShowTitle, ShowBorder, CloseAfterSelection,
+			PutBackExitKey, FastSelect, MouseControl: BOOLEAN;
+		offL, offR, offT, offB: OffEdgeOption;
+
+		(* Information about the current state of the menu.	*)
+
+		CurrentItemNo: ItemNo;
+		row: RowRange;
+		column: MenuColumn;
+		ExtraAtTop, ExtraAtBottom: CARDINAL;
+		RanOffEdge: BOOLEAN;
+
+		(* Pointer to the text of the menu items.	*)
+
+		TextPtr: TextPointer;
+
+	    END (*RECORD*);
+
+(************************************************************************)
+
+VAR
+    (* The following record contains the details of the last mouse	*)
+    (* click.  Because users can't move a mouse very fast, we don't	*)
+    (* bother to keep a queue of clicks, we just record the last seen.	*)
+    (* In the event that a click arrives before the last has been	*)
+    (* consumed, the earlier click is lost.  I haven't yet seen an	*)
+    (* application where that has been a major problem.			*)
+
+    LastMouseClick: RECORD
+			access: Lock;
+			win: Window;
+			X: ColumnRange;  Y: RowRange;
+			valid: BOOLEAN;
+		    END (*RECORD*);
+
+(************************************************************************)
+(*			MISCELLANEOUS UTILITIES				*)
+(************************************************************************)
+
+PROCEDURE Setselpos (VAR (*INOUT*) item: ItemBuffer);
+
+    (* Looks for a "\" in the item text, adjusts item.selpos if found.	*)
+
+    VAR j, k, high: CARDINAL;
+
+    BEGIN
+	j := 0;  high := HIGH(item.text);
+	LOOP
+	    IF (j > high) OR (ORD(item.text[j]) = 0) THEN
+		EXIT (*LOOP*);
+	    ELSIF item.text[j] = "\" THEN
+		item.selpos := j;
+		FOR k := j TO high-1 DO
+		    item.text[k] := item.text[k+1];
+		END (*FOR*);
+		item.text[high] := CHR(0);
+		EXIT (*LOOP*);
+	    ELSE
+		INC (j);
+	    END (*IF*);
+	END (*LOOP*);
+    END Setselpos;
+
+(************************************************************************)
+
+PROCEDURE resize (VAR (*INOUT*) text: ItemText;  size: CARDINAL);
+
+    (* Makes text equal to the given size, by space filling on the	*)
+    (* right and inserting a Nul to terminate the text.			*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	j := 0;
+	WHILE (j < size) AND (ORD(text[j]) <> 0) DO
+	    INC(j);
+	END (*WHILE*);
+	WHILE j < size DO text[j] := " "; INC(j) END (*WHILE*);
+	IF j <= MaxColumnNumber THEN text[j] := CHR(0) END (*IF*);
+    END resize;
+
+(************************************************************************)
+(*			   CREATING A MENU				*)
+(************************************************************************)
+
+PROCEDURE CreateMenu (VAR (*OUT*) M: Menu; columns: MenuColumn;
+			VAR (*IN*) Messages: ARRAY OF ItemText;
+			NumberOfItems: CARDINAL);
+
+    (* Introduces a menu into the system, but does not display it yet.	*)
+
+    VAR j, count: CARDINAL;
+
+    BEGIN
+	NEW (M);
+	WITH M^ DO
+	    win := NilWindow;
+	    NoOfColumns := columns;
+
+	    (* Store the header text, with space fill.	*)
+
+	    heading := Messages[0];
+	    resize (heading, MaxColumnNumber);
+
+	    (* Work out how many menu items there are.	*)
+
+	    count := NumberOfItems;
+	    IF (count = 0) OR (count > HIGH (Messages)) THEN
+		count := HIGH (Messages);
+	    END (*IF*);
+	    NoOfItems := count;
+	    ItemsPerColumn := (count + NoOfColumns - 1) DIV NoOfColumns;
+	    CurrentItemNo := 1;
+
+	    (* Store the item text.	*)
+
+	    ALLOCATE (TextPtr, NoOfItems*SIZE(ItemBuffer));
+	    FOR j := 1 TO NoOfItems DO
+		WITH TextPtr^[j] DO
+		    selpos := 0;
+		    text := Messages[j];
+		END (*WITH*);
+		Setselpos (TextPtr^[j]);
+	    END (*FOR*);
+
+	    (* Set default options. *)
+
+	    ShowTitle := TRUE;  ShowBorder := TRUE;
+	    CloseAfterSelection := TRUE;  PutBackExitKey := FALSE;
+	    FastSelect := FALSE;  MouseControl := MouseAvailable();
+	    offL := stick;  offR := stick;  offT := stick;  offB := stick;
+
+	END (*WITH*);
+
+	(* Give the menu a default initial position, size, and colour.	*)
+
+	PositionMenu (M, 0, 10, 0, MaxColumnNumber);
+	MenuColours (M, blue, white, black, cyan, red);
+
+    END CreateMenu;
+
+(************************************************************************)
+
+PROCEDURE MenuColours (M: Menu;  fore, back, hfore, hback, select: Colour);
+
+    (* Set the colours for the screen display of the menu.  The colours	*)
+    (* fore and back are used as the normal foreground and background	*)
+    (* colours, and the highlighted menu item is displayed in colours	*)
+    (* hfore, hback.  The "select" colour is for highlighting the	*)
+    (* selection character.						*)
+
+    BEGIN
+	WITH M^ DO
+	    foreground := fore;  background := back;
+	    highforeground := hfore;  highbackground := hback;
+	    selchar := select;
+	END (*WITH*);
+    END MenuColours;
+
+(************************************************************************)
+
+PROCEDURE SetOptions (M: Menu;  options: MO);
+
+    (* See the MenuOption declaration for the possible options. *)
+
+    BEGIN
+	WITH M^ DO
+	    IF MTitle IN options THEN ShowTitle := TRUE END (*IF*);
+	    IF MNoTitle IN options THEN ShowTitle := FALSE END (*IF*);
+	    IF MBorder IN options THEN ShowBorder := TRUE END (*IF*);
+	    IF MNoBorder IN options THEN ShowBorder := FALSE END (*IF*);
+	    IF MClose IN options THEN CloseAfterSelection := TRUE END (*IF*);
+	    IF MNoClose IN options THEN CloseAfterSelection := FALSE END (*IF*);
+	    IF MKeyBack IN options THEN PutBackExitKey := TRUE END (*IF*);
+	    IF MNoKeyBack IN options THEN PutBackExitKey := FALSE END (*IF*);
+	    IF MFastSelect IN options THEN FastSelect := TRUE END (*IF*);
+	    IF MNoFastSelect IN options THEN FastSelect := FALSE END (*IF*);
+	    IF MMouse IN options THEN MouseControl := MouseAvailable() END (*IF*);
+	    IF MNoMouse IN options THEN MouseControl := FALSE END (*IF*);
+	END (*WITH*);
+    END SetOptions;
+
+(************************************************************************)
+
+PROCEDURE OffEdge (M: Menu;  top, bottom, left, right: OffEdgeOption);
+
+    (* Sets the menu behaviour when the user runs the cursor off the	*)
+    (* edge of the menu.  There is one parameter for each edge of the	*)
+    (* menu.								*)
+    (* See the OffEdgeOption type declaration for the possible options.	*)
+
+    BEGIN
+	WITH M^ DO
+	    offT := top;  offB := bottom;
+	    offL := left;  offR := right;
+	END (*WITH*);
+    END OffEdge;
+
+(************************************************************************)
+(*			  POSITIONING A MENU				*)
+(************************************************************************)
+
+PROCEDURE SetRelativeLocation (M: Menu;  row1, col1, rows, columns: CARDINAL);
+
+    (* Gives initial values to M^.LocationInWindow and M^.ColumnWidth,	*)
+    (* and resizes the item text to the space available.  Also sets	*)
+    (* M^.hstep and M^.vstep, based on the following criterion: if the	*)
+    (* display will be wider than it is tall then we use row major	*)
+    (* ordering (hstep = 1), whereas for tall narrow menus we use	*)
+    (* column major ordering (vstep = 1).  This distinction is actually	*)
+    (* irrelevant to the caller, but it affects the appearance of the	*)
+    (* menu, and the decision taken here seems to give a result which	*)
+    (* someone reading the screen would consider intuitively logical.	*)
+
+    VAR j: ItemNo;
+
+    BEGIN
+	WITH M^ DO
+	    WITH LocationInWindow DO
+		firstrow := row1;  firstcol := col1;
+		height := rows;  width := columns;
+		IF ItemsPerColumn <= height THEN
+		    height := ItemsPerColumn;
+		END (*IF*);
+		IF NoOfColumns > height THEN
+		    hstep := 1;  vstep := NoOfColumns;
+		ELSE
+		    hstep := ItemsPerColumn;  vstep := 1;
+		END (*IF*);
+	    END (*WITH*);
+
+	    resize (heading, columns);
+	    ColumnWidth := (columns - (NoOfColumns-1)*gap) DIV NoOfColumns;
+	    FOR j := 1 TO NoOfItems DO
+		resize (TextPtr^[j].text, ColumnWidth);
+	    END (*FOR*);
+
+	END (*WITH*);
+
+    END SetRelativeLocation;
+
+(************************************************************************)
+
+PROCEDURE PositionMenu (M: Menu;  startline, endline: RowRange;
+				leftcol, rightcol: ColumnRange);
+
+    (* Sets the screen location of the window which will hold the menu.	*)
+
+    VAR row1, col1, height, width: CARDINAL;
+
+    BEGIN
+	WITH M^ DO
+
+	    (* Work out the space available on the screen.	*)
+
+	    WITH ScreenPosition DO
+		firstrow := startline;  lastrow := endline;
+		firstcol := leftcol;  lastcol := rightcol;
+	    END (*WITH*);
+
+	    (* How much of this space is used for the actual menu? *)
+
+	    row1 := 0;  col1 := 0;
+	    height := endline - startline + 1;
+	    width := rightcol - leftcol + 1;
+	    IF ShowBorder THEN
+		INC (row1);  INC(col1);
+		DEC (height, 2);  DEC (width, 2);
+	    END(*IF*);
+	    IF ShowTitle THEN
+		INC (row1,2);  DEC (height, 2);
+	    END(*IF*);
+	    SetRelativeLocation (M, row1, col1, height, width);
+
+	END (*WITH*);
+    END PositionMenu;
+
+(************************************************************************)
+(*			    CLOSING A MENU				*)
+(************************************************************************)
+
+PROCEDURE DestroyMenu (M: Menu);
+
+    (* Removes a menu from the system, freeing up the space it used.	*)
+
+    BEGIN
+	WITH M^ DO
+	    IF (win <> NilWindow) AND CloseAfterSelection THEN
+		CloseWindow (win);
+	    END (*IF*);
+	    DEALLOCATE (TextPtr, NoOfItems*SIZE(ItemBuffer));
+	END (*WITH*);
+	DISPOSE (M);
+    END DestroyMenu;
+
+(************************************************************************)
+(*			    SCREEN DISPLAY				*)
+(************************************************************************)
+
+PROCEDURE NewColours (M: Menu;  fore, back, select: Colour);
+
+    (* Changes the foreground and background colours of the current	*)
+    (* menu item.  The "select" colour is for highlighting the		*)
+    (* selection character.						*)
+
+    BEGIN
+	IF MouseAvailable() THEN HideMouseCursor END (*IF*);
+	WITH M^ DO
+	    SetColours (win, LocationInWindow.firstrow+row-1,
+		(column-1)*(ColumnWidth+gap) + LocationInWindow.firstcol,
+			ColumnWidth, fore, back);
+	    IF CurrentItemNo <= NoOfItems THEN
+		SetColours (win, LocationInWindow.firstrow+row-1,
+			(column-1)*(ColumnWidth+gap) + LocationInWindow.firstcol
+					+ TextPtr^[CurrentItemNo].selpos,
+			1, select, back);
+	    END (*IF*);
+	END (*WITH*);
+	IF MouseAvailable() THEN ShowMouseCursor END (*IF*);
+    END NewColours;
+
+(************************************************************************)
+
+PROCEDURE Highlight (M: Menu);
+
+    (* Highlights the current menu item.	*)
+
+    BEGIN
+	NewColours (M, M^.highforeground, M^.highbackground, M^.selchar);
+    END Highlight;
+
+(************************************************************************)
+
+PROCEDURE Unhighlight (M: Menu);
+
+    (* Removes any highlighting from the current menu item.	*)
+
+    BEGIN
+	NewColours (M, M^.foreground, M^.background, M^.selchar);
+    END Unhighlight;
+
+(************************************************************************)
+
+PROCEDURE RefreshRow (M: Menu);
+
+    (* Refreshes the current menu row.	*)
+
+    VAR screenrow: RowRange;  j: ColumnRange;  savecurrent: ItemNo;
+	savecolumn: CARDINAL;
+
+    BEGIN
+	WITH M^ DO
+	    savecurrent := CurrentItemNo;  savecolumn := column;
+	    WITH LocationInWindow DO
+		screenrow := firstrow + row - 1;
+		j := LocationInWindow.firstcol;
+	    END (*WITH*);
+	    SetCursor (win, screenrow, j);  EraseLine (win, 1);
+	    column := 1;
+	    CurrentItemNo := 1 + vstep*(row + ExtraAtTop - 1);
+	    LOOP
+		WriteString (win, TextPtr^[CurrentItemNo].text);
+		Unhighlight (M);
+		IF (column = NoOfColumns)
+			OR (CurrentItemNo+hstep > NoOfItems) THEN
+		    EXIT (*LOOP*);
+		END (*IF*);
+		INC (column);
+		INC (CurrentItemNo, hstep);  INC (j, ColumnWidth + gap);
+		SetCursor (win, screenrow, j);
+	    END (*LOOP*);
+	    column := savecolumn;  CurrentItemNo := savecurrent;
+	END (*WITH*);
+    END RefreshRow;
+
+(************************************************************************)
+
+PROCEDURE DisplayMOREatTop (M: Menu);
+
+    BEGIN
+	WITH M^ DO
+	    IF ShowTitle OR (ShowBorder AND NOT MouseControl) THEN
+		WITH LocationInWindow DO
+		    SetCursor (win, firstrow-1, firstcol+width-6);
+		END (*WITH*);
+		WriteString (win, "*MORE*");
+	    END (*IF*);
+	END (*WITH*);
+    END DisplayMOREatTop;
+
+(************************************************************************)
+
+PROCEDURE RemoveMOREatTop (M: Menu);
+
+    CONST DoubleBar = '═';  SingleBar = '─';
+
+    VAR j: [1..6];  bar: CHAR;
+
+    BEGIN
+	WITH M^ DO
+	    IF ShowTitle OR (ShowBorder AND NOT MouseControl) THEN
+		WITH LocationInWindow DO
+		    SetCursor (win, firstrow-1, firstcol+width-6);
+		END (*WITH*);
+		IF ShowTitle THEN bar := DoubleBar
+		ELSE bar := SingleBar
+		END (*IF*);
+		FOR j := 1 TO 6 DO
+		    WriteChar (win, bar);
+		END (*FOR*);
+	    END (*IF*);
+	END (*WITH*);
+    END RemoveMOREatTop;
+
+(************************************************************************)
+
+PROCEDURE DisplayMOREatBottom (M: Menu);
+
+    BEGIN
+	WITH M^ DO
+	    IF ShowBorder THEN
+		WITH LocationInWindow DO
+		    SetCursor (win, firstrow+height, firstcol+width-6);
+		END (*WITH*);
+		WriteString (win, "*MORE*");
+	    END (*IF*);
+	END (*WITH*);
+    END DisplayMOREatBottom;
+
+(************************************************************************)
+
+PROCEDURE RemoveMOREatBottom (M: Menu);
+
+    CONST HorizontalBar = '─';
+
+    VAR j: [1..6];
+
+    BEGIN
+	WITH M^ DO
+	    IF ShowBorder THEN
+		WITH LocationInWindow DO
+		    SetCursor (win, firstrow+height, firstcol+width-6);
+		END (*WITH*);
+		FOR j := 1 TO 6 DO
+		    WriteChar (win, HorizontalBar);
+		END (*FOR*);
+	    END (*IF*);
+	END (*WITH*);
+    END RemoveMOREatBottom;
+
+(************************************************************************)
+
+PROCEDURE BlinkCurrent (M: Menu);
+
+    (* Toggles the blinking state of the current menu item.	*)
+
+    BEGIN
+	WITH M^ DO
+	    Blink (win, LocationInWindow.firstrow+row-1,
+		(column-1)*(ColumnWidth+gap) + LocationInWindow.firstcol,
+			ColumnWidth);
+	END (*WITH*);
+    END BlinkCurrent;
+
+(************************************************************************)
+(*			    CURSOR MOVEMENTS				*)
+(************************************************************************)
+
+PROCEDURE DownARow (M: Menu);  FORWARD;
+
+(************************************************************************)
+
+PROCEDURE UpARow (M: Menu);
+
+    (* Moves to the next item up, if present.  Scrolls if necessary.	*)
+
+    BEGIN
+	WITH M^ DO
+	    IF row > 1 THEN
+		DEC (row);  DEC (CurrentItemNo, vstep);
+	    ELSIF ExtraAtTop > 0 THEN
+		DEC (CurrentItemNo, vstep);
+		ScrollDown (win);
+		DEC (ExtraAtTop);  INC (ExtraAtBottom);
+		RefreshRow (M);
+		IF MouseAvailable() THEN HideMouseCursor END (*IF*);
+		IF ExtraAtTop = 0 THEN RemoveMOREatTop(M) END (*IF*);
+		IF ExtraAtBottom = 1 THEN DisplayMOREatBottom(M) END(*IF*);
+		IF MouseAvailable() THEN ShowMouseCursor END (*IF*);
+	    ELSE
+		CASE offT OF
+		  | stick:	(* no action needed*) ;
+		  | wrap:	WHILE (row < LocationInWindow.height)
+					OR (ExtraAtBottom > 0) DO
+				    DownARow(M);
+				END (*WHILE*);
+		  | escape:	CurrentItemNo := 0;  RanOffEdge := TRUE;
+		  | return:	RanOffEdge := TRUE;
+		END (*CASE*);
+	    END (*IF*);
+	END (*WITH*);
+    END UpARow;
+
+(************************************************************************)
+
+PROCEDURE DownARow (M: Menu);
+
+    (* Moves to the next item down, if present.  Scrolls if necessary.	*)
+
+    BEGIN
+	WITH M^ DO
+	    IF row < LocationInWindow.height THEN
+		INC (row);  INC (CurrentItemNo, vstep);
+	    ELSIF ExtraAtBottom > 0 THEN
+		INC (CurrentItemNo, vstep);  ScrollUp (win);
+		INC (ExtraAtTop);  DEC (ExtraAtBottom);
+		RefreshRow (M);
+		IF MouseAvailable() THEN HideMouseCursor END (*IF*);
+		IF ExtraAtTop = 1 THEN DisplayMOREatTop(M) END (*IF*);
+		IF ExtraAtBottom = 0 THEN RemoveMOREatBottom(M) END (*IF*);
+		IF MouseAvailable() THEN ShowMouseCursor END (*IF*);
+	    ELSE
+		CASE offB OF
+		  | stick:	(* no action needed*) ;
+		  | wrap:	WHILE (row > 1) OR (ExtraAtTop > 0) DO
+				    UpARow (M);
+				END (*WHILE*);
+		  | escape:	CurrentItemNo := 0;  RanOffEdge := TRUE;
+		  | return:	RanOffEdge := TRUE;
+		END (*CASE*);
+	    END (*IF*);
+	END (*WITH*);
+    END DownARow;
+
+(************************************************************************)
+
+PROCEDURE MoveRight (M: Menu);
+
+    (* Moves to the next item right, if present.	*)
+
+    BEGIN
+	WITH M^ DO
+	    IF column < NoOfColumns THEN
+		INC (column);  INC (CurrentItemNo, hstep);
+	    ELSE
+		CASE offR OF
+		  | stick:	(* no action needed*) ;
+		  | wrap:	DEC (CurrentItemNo, hstep*(column-1));
+				column := 1;
+		  | escape:	CurrentItemNo := 0;  RanOffEdge := TRUE;
+		  | return:	RanOffEdge := TRUE;
+		END (*CASE*);
+	    END (*IF*);
+	END (*WITH*);
+    END MoveRight;
+
+(************************************************************************)
+
+PROCEDURE MoveLeft (M: Menu);
+
+    (* Moves to the next item left, if present.	*)
+
+    BEGIN
+	WITH M^ DO
+	    IF column > 1 THEN
+		DEC (column);  DEC (CurrentItemNo, hstep);
+	    ELSE
+		CASE offL OF
+		  | stick:	(* no action needed*) ;
+		  | wrap:	INC (CurrentItemNo, hstep*(NoOfColumns-1));
+				column := NoOfColumns;
+		  | escape:	CurrentItemNo := 0;  RanOffEdge := TRUE;
+		  | return:	RanOffEdge := TRUE;
+		END (*CASE*);
+	    END (*IF*);
+	END (*WITH*);
+    END MoveLeft;
+
+(************************************************************************)
+
+PROCEDURE GotoItem (M: Menu;  newitem: ItemNo);
+
+    (* Moves to the menu item whose number is specified.  We move a row	*)
+    (* at a time, rather than taking one big leap, since this is less	*)
+    (* disconcerting to the user.					*)
+
+    BEGIN
+	WITH M^ DO
+	    IF newitem <> CurrentItemNo THEN
+		IF vstep = 1 THEN	(* we are using column major order *)
+		    column := ((newitem-1) DIV hstep) + 1;
+		ELSE			(* we are using row major order *)
+		    column := ((newitem-1) MOD vstep) + 1;
+		END (*IF*);
+		CurrentItemNo := (column-1)*hstep
+					+ (ExtraAtTop+row-1)*vstep + 1;
+		WHILE CurrentItemNo > newitem DO UpARow(M) END (*WHILE*);
+		WHILE CurrentItemNo < newitem DO DownARow(M) END (*WHILE*);
+	    END (*IF*);
+	END (*WITH*);
+    END GotoItem;
+
+(************************************************************************)
+
+PROCEDURE RepositionTo (M: Menu;  searchchar: CHAR): BOOLEAN;
+
+    (* Finds the next menu item whose selection character matches	*)
+    (* selchar, and adjusts the display appropriately.  Returns TRUE if	*)
+    (* searchchar was actually found; otherwise the current menu item	*)
+    (* doesn't change and the function result is FALSE.			*)
+
+    VAR j: ItemNo;  found: BOOLEAN;
+
+    BEGIN
+	WITH M^ DO
+	    j := CurrentItemNo;
+	    REPEAT
+		IF j >= NoOfItems THEN j := 1
+		ELSE INC (j)
+		END (*IF*);
+		WITH TextPtr^[j] DO
+		    found := CAP(text[selpos]) = searchchar;
+		END (*WITH*);
+	    UNTIL found OR (j = CurrentItemNo);
+	END (*WITH*);
+	GotoItem (M, j);
+	RETURN found;
+    END RepositionTo;
+
+(************************************************************************)
+
+PROCEDURE HandleFunctionKey (M: Menu;  VAR (*INOUT*) option: CHAR);
+
+    (* Deals with the case where the user typed a function key - i.e.	*)
+    (* any key which produces a two-code sequence where the first code	*)
+    (* is CHR(0).  On entry, the CHR(0) has already been read.		*)
+
+    VAR count: CARDINAL;
+
+    BEGIN
+	WITH M^ DO
+	    option := GetKey(win);
+	    IF option = "H" THEN UpARow(M)		(* cursor up *)
+	    ELSIF option = "P" THEN DownARow(M)		(* cursor down *)
+	    ELSIF option = "M" THEN MoveRight(M)	(* cursor right *)
+	    ELSIF option = "K" THEN MoveLeft(M)		(* cursor left *)
+	    ELSIF option = "G" THEN			(* home *)
+		GotoItem (M, 1);
+	    ELSIF option = "O" THEN			(* end *)
+		GotoItem (M, NoOfColumns*ItemsPerColumn);
+		GotoItem (M, NoOfItems);
+	    ELSIF option = "I" THEN			(* page up *)
+		IF row = 1 THEN
+		    IF ExtraAtTop > 0 THEN
+			count := LocationInWindow.height;
+			REPEAT
+			    UpARow(M);  DEC (count);
+			UNTIL (count=0) OR (ExtraAtTop=0);
+		    END (*IF*)
+		ELSE
+		    WHILE row > 1 DO UpARow(M) END (*WHILE*)
+		END (*IF*)
+	    ELSIF option = "Q" THEN			(* page down *)
+		IF row = LocationInWindow.height THEN
+		    IF ExtraAtBottom > 0 THEN
+			count := LocationInWindow.height;
+			REPEAT
+			    DownARow(M);  DEC (count);
+			UNTIL (count=0) OR (ExtraAtBottom=0);
+		    END (*IF*)
+		ELSE
+		    WHILE row < LocationInWindow.height DO
+			DownARow(M);
+		    END (*WHILE*)
+		END (*IF*)
+	    END (*IF*);
+	END (*WITH*);
+    END HandleFunctionKey;
+
+(************************************************************************)
+(*			DEALING WITH MOUSE CLICKS			*)
+(************************************************************************)
+
+PROCEDURE SelectItemAt (M: Menu;  r: RowRange;  c: ColumnRange);
+
+    VAR NewItemNo: ItemNo;  OnAnItem: BOOLEAN;
+
+    BEGIN
+	WITH M^ DO
+	    WITH LocationInWindow DO
+		DEC (r, firstrow);  DEC (c, firstcol);
+	    END (*WITH*);
+	    OnAnItem := c MOD (ColumnWidth+gap) < ColumnWidth;
+	    c := c DIV (ColumnWidth+gap);
+	    IF c >= NoOfColumns THEN OnAnItem := FALSE END(*IF*);
+
+	    IF OnAnItem THEN
+		(* We have now reduced (r,c) to be the coordinates of	*)
+		(* an item in the visible part of the array, with (0,0)	*)
+		(* corresponding to the top left position.		*)
+
+		NewItemNo := c*hstep + (ExtraAtTop+r)*vstep + 1;
+
+		(* The first click on an item simply means that we	*)
+		(* should go to that item; a second click on the same	*)
+		(* item means that we should accept it as the result.	*)
+		(* If the FastSelect option is enabled, the first click	*)
+		(* will select the item as the result.			*)
+
+		IF FastSelect OR (NewItemNo = CurrentItemNo) THEN
+		    PutBack (" ");
+		END (*IF*);
+		HideMouseCursor;
+		GotoItem (M, NewItemNo);
+		ShowMouseCursor;
+	    END (*IF*);
+
+	END (*WITH*);
+
+    END SelectItemAt;
+
+(************************************************************************)
+
+PROCEDURE InterpretMouseClick (M: Menu);
+
+    (* This procedure is called when we know that a mouse click has	*)
+    (* been detected and its details stored in LastMouseClick.  This	*)
+    (* procedure checks whether the click is relevant to menu M, and	*)
+    (* takes the appropriate action if so.				*)
+
+    VAR OK: BOOLEAN;  row: RowRange;  column: ColumnRange;
+
+    BEGIN
+	WITH LastMouseClick DO
+	    Obtain (access);
+	    OK := valid AND (win = M^.win);
+	    IF OK THEN
+		column := X;  row := Y;
+	    END (*IF*);
+	    valid := FALSE;
+	    Release (access);
+	END (*WITH*);
+	IF OK THEN
+	    SelectItemAt (M, row, column);
+	END (*IF*);
+    END InterpretMouseClick;
+
+(************************************************************************)
+
+PROCEDURE RecordClick (w: Window;  row: RowRange;  col: ColumnRange);
+
+    (* This procedure is called asynchronously as the result of a mouse	*)
+    (* click.  The parameters tell us which window was clicked on, and	*)
+    (* where in that window the click occurred, but they don't tell us	*)
+    (* which menu is involved.  Rather than work that out here, we	*)
+    (* stuff a special character into the keyboard.  Procedure		*)
+    (* MakeTheSelection will pick up that special character and from	*)
+    (* that deduce that it needs to look at the LastMouseClick data.	*)
+
+    BEGIN
+	WITH LastMouseClick DO
+	    Obtain (access);
+	    win := w;
+	    X := col;  Y := row;
+	    valid := TRUE;
+	    Release (access);
+	    StuffKeyboardBuffer (ClickIndicator);
+	END (*WITH*);
+    END RecordClick;
+
+(************************************************************************)
+
+PROCEDURE ClickOnTop (w: Window;  row: RowRange;  col: ColumnRange);
+
+    (* This procedure is triggered by a mouse click on the window	*)
+    (* divider.  We turn this into a "cursor up" command.		*)
+
+    BEGIN
+	StuffKeyboardBuffer (CHR(0));
+	StuffKeyboardBuffer ("H");
+    END ClickOnTop;
+
+(************************************************************************)
+
+PROCEDURE ClickOnTopMORE (w: Window;  row: RowRange;  col: ColumnRange);
+
+    (* This procedure is triggered by a mouse click on the top *MORE*	*)
+    (* indicator.  We turn this into a "page up" command.		*)
+
+    BEGIN
+	StuffKeyboardBuffer (CHR(0));
+	StuffKeyboardBuffer ("I");
+    END ClickOnTopMORE;
+
+(************************************************************************)
+
+PROCEDURE ClickOnBottom (w: Window;  row: RowRange;  col: ColumnRange);
+
+    (* This procedure is triggered by a mouse click on the bottom	*)
+    (* of the window frame.  We turn this into a "cursor down" command.	*)
+
+    BEGIN
+	StuffKeyboardBuffer (CHR(0));
+	StuffKeyboardBuffer ("P");
+    END ClickOnBottom;
+
+(************************************************************************)
+
+PROCEDURE ClickOnBottomMORE (w: Window;  row: RowRange;  col: ColumnRange);
+
+    (* This procedure is triggered by a mouse click on the bottom	*)
+    (* *MORE* indicator.  We turn this into a "page down" command.	*)
+
+    BEGIN
+	StuffKeyboardBuffer (CHR(0));
+	StuffKeyboardBuffer ("Q");
+    END ClickOnBottomMORE;
+
+(************************************************************************)
+(*			    SCREEN DISPLAY				*)
+(************************************************************************)
+
+PROCEDURE OpeningDisplay (M: Menu;  initialvalue: CARDINAL);
+
+    (* Sets up the initial state of the display of M.  It is assumed	*)
+    (* that window M^.win is already open and that the position of the	*)
+    (* menu has already been set.  It is also assumed that the border	*)
+    (* and title, if needed, have already been displayed.		*)
+
+    VAR j: RowRange;
+
+    BEGIN
+	WITH M^ DO
+	    IF (initialvalue = 0) OR (initialvalue > NoOfItems) THEN
+		initialvalue := 1;
+	    END (*IF*);
+	    RanOffEdge := FALSE;
+	    CurrentItemNo := 1;  column := 1;  ExtraAtTop := 0;
+	    ExtraAtBottom := ItemsPerColumn - LocationInWindow.height;
+	    FOR j := 1 TO LocationInWindow.height DO
+		row := j;  RefreshRow (M);
+	    END (*FOR*);
+	    row := 1;
+	    IF (ExtraAtBottom > 0) THEN
+		IF MouseAvailable() THEN HideMouseCursor END (*IF*);
+		DisplayMOREatBottom (M);
+		IF MouseAvailable() THEN ShowMouseCursor END (*IF*);
+	    END (*IF*);
+	END (*WITH*);
+	GotoItem (M, initialvalue);
+    END OpeningDisplay;
+
+(************************************************************************)
+
+PROCEDURE DisplayMenu (w: Window;  M: Menu;
+				rows, columns, initialvalue: CARDINAL);
+
+    (* Displays menu M at the current cursor position in window w,	*)
+    (* with initialvalue specifying a field to highlight.		*)
+
+    VAR row1, col1: CARDINAL;
+
+    BEGIN
+	SaveCursor (w, row1, col1);
+	WITH M^ DO
+	    win := w;
+	    IF ShowBorder THEN
+		Box (w, row1, col1, columns-1, rows-1, single);
+		INC (row1);  INC (col1);
+		DEC (rows, 2);  DEC (columns, 2);
+	    END (*IF*);
+	    IF ShowTitle THEN
+		INC (row1, 2);  DEC (rows, 2);
+		IF ShowBorder THEN
+		    HLine (w, row1-1, col1-1, col1+columns, double);
+		ELSE
+		    HLine (w, row1-1, col1, col1+columns-1, double);
+		END (*IF*);
+	    END (*IF*);
+	    SetRelativeLocation (M, row1, col1, rows, columns);
+	    IF ShowTitle THEN
+		SetCursor (w, row1-2, col1);  WriteString (w, heading);
+	    END (*IF*);
+	END (*WITH*);
+	NewScrollingRegion (w, row1, row1+rows-1, col1, col1+columns-1);
+	OpeningDisplay (M, initialvalue);
+	Highlight (M);  ResetScrollingRegion (w);
+    END DisplayMenu;
+
+(************************************************************************)
+(*		     MAKING A SELECTION FROM A MENU			*)
+(************************************************************************)
+
+PROCEDURE MakeTheSelection (M: Menu);
+
+    (* Allows the keyboard user to alter the state of menu M by use of	*)
+    (* the cursor control keys, or by typing the initial letter of a	*)
+    (* menu item.  Returns when Space or Enter is typed, also returns	*)
+    (* with M^.CurrentItem=0 if Esc is typed.  In Special Mode only,	*)
+    (* also returns if a cursor movement key would run us off the edge	*)
+    (* of the menu.  (In Normal Mode, any attempt to run off the edge	*)
+    (* is ignored.)  In addition, in Special Mode the final key typed	*)
+    (* remains available (e.g. by InKey()) to the caller.		*)
+
+    TYPE CHARSET = SET OF CHAR;
+
+    CONST CR = CHR(0DH);
+
+    VAR option: CHAR;
+
+    BEGIN
+	WITH M^ DO
+	    RanOffEdge := FALSE;
+	    LOOP
+		Highlight (M);
+		option := GetKey (M^.win);
+		Unhighlight (M);
+		IF option = ClickIndicator THEN
+		    InterpretMouseClick(M);
+		ELSIF option = " " THEN EXIT(*LOOP*)
+		ELSIF option = CR THEN EXIT (*LOOP*)
+		ELSIF option = Esc THEN
+		    CurrentItemNo := 0;  EXIT (*LOOP*)
+		ELSIF option IN CHARSET{"0".."9", "A".."Z", "a".."z"} THEN
+		    IF RepositionTo(M, CAP(option)) AND FastSelect THEN
+			EXIT (*LOOP*);
+		    END (*IF*);
+		ELSIF option = CHR(0) THEN
+		    HandleFunctionKey (M, option);
+		    IF RanOffEdge THEN
+			IF PutBackExitKey THEN
+			    PutBack (option);  option := CHR(0);
+			END (*IF*);
+			EXIT (*LOOP*);
+		    END (*IF*);
+		END (*IF*);
+	    END (*LOOP*);
+	    IF PutBackExitKey THEN
+		PutBack (option);
+	    END (*IF*);
+	    IF CurrentItemNo > NoOfItems THEN
+		CurrentItemNo := 0;
+	    END (*IF*);
+	END (*WITH*);
+    END MakeTheSelection;
+
+(************************************************************************)
+
+PROCEDURE SelectFromMenu (M: Menu): CARDINAL;
+
+    (* Displays menu M on the screen, allows terminal user to use	*)
+    (* cursor keys to move about the menu and the ENTER key to select	*)
+    (* an item.  (The space bar is also accepted, as an alternative to	*)
+    (* the ENTER key, to select an item).  An item may also be selected	*)
+    (* by typing its initial letter, followed by space or ENTER.	*)
+    (* Returns the number of the item which was selected.		*)
+    (* (Item numbers start from 1).  An answer of 0 indicates that the	*)
+    (* user typed the ESC key to return without selecting anything.	*)
+
+    (* Remark: it is possible with the cursor keys to "select" a	*)
+    (* nonexistent item at the bottom of the last column.  The result	*)
+    (* will be 0 in this case.  Although this might appear to be a bug,	*)
+    (* it is deliberate.  I found by experiment that the more "logical"	*)
+    (* approach of stopping the user from moving the cursor into a	*)
+    (* blank region was a nuisance for the user.			*)
+
+    VAR UIW: UIWindow;  frame: FrameType;
+	capabilities: CapabilitySet;  framesize: CARDINAL;
+
+    BEGIN
+	WITH M^ DO
+
+	    (* Open the window, unless it's already open. *)
+
+	    IF win = NilWindow THEN
+		framesize := 0;
+		IF MouseAvailable() THEN HideMouseCursor END(*IF*);
+		WITH ScreenPosition DO
+		    IF ShowBorder THEN
+			frame := simpleframe;  INC(framesize);
+		    ELSE frame := noframe
+		    END (*IF*);
+		    OpenWindow (win, foreground, background,
+				firstrow, lastrow, firstcol, lastcol,
+				frame, doubledivider);
+		    IF ShowTitle THEN
+			WriteString (win, heading);
+			ChangeScrollingRegion (win, 2+framesize,
+						lastrow-firstrow-framesize);
+		    END (*IF*);
+		END (*WITH*);
+		IF MouseAvailable() THEN
+		    IF ShowBorder AND MouseControl THEN
+			capabilities := CapabilitySet {wshow, wmove, wescape};
+		    ELSE
+			capabilities := CapabilitySet {wshow};
+		    END (*IF*);
+		    UIW := AllowMouseControl (win, heading, capabilities);
+		    WITH LocationInWindow DO
+			AddActiveRegion (UIW, firstrow, firstrow+height-1,
+				firstcol, firstcol+width-1,
+				LeftOnly, RecordClick);
+			IF ShowTitle OR (ShowBorder AND NOT MouseControl) THEN
+			    AddActiveRegion (UIW, firstrow-1, firstrow-1,
+				firstcol, firstcol+width-7,
+				LeftOnly, ClickOnTop);
+			    AddActiveRegion (UIW, firstrow-1, firstrow-1,
+				firstcol+width-6, firstcol+width-1,
+				LeftOnly, ClickOnTopMORE);
+			END (*IF*);
+			IF ShowBorder THEN
+			    AddActiveRegion (UIW, firstrow+height, firstrow+height,
+				firstcol, firstcol+width-7,
+				LeftOnly, ClickOnBottom);
+			    AddActiveRegion (UIW, firstrow+height, firstrow+height,
+				firstcol+width-6, firstcol+width-1,
+				LeftOnly, ClickOnBottomMORE);
+			END (*IF*);
+		    END (*WITH*);
+		    ShowMouseCursor;
+		END (*IF*);
+		OpeningDisplay (M, 1);
+	    END (*IF*);
+
+	    WITH LocationInWindow DO
+		NewScrollingRegion (win, firstrow, firstrow+height-1,
+					firstcol, firstcol+width-1);
+	    END (*WITH*);
+
+	    (* Window is now open, let the user make a selection. *)
+
+	    MakeTheSelection (M);
+	    IF CurrentItemNo > 0 THEN
+		Highlight (M);
+	    END (*IF*);
+	    ResetScrollingRegion (win);
+
+	    (* Close the window, if appropriate. *)
+
+	    IF CloseAfterSelection THEN
+		IF MouseAvailable() THEN HideMouseCursor END(*IF*);
+		CloseWindow (win);  win := NilWindow;
+		IF MouseAvailable() THEN ShowMouseCursor END(*IF*);
+	    END (*IF*);
+
+	    RETURN CurrentItemNo;
+
+	END (*WITH*);
+
+    END SelectFromMenu;
+
+(************************************************************************)
+
+BEGIN
+    WITH LastMouseClick DO
+        CreateLock (access);
+        valid := FALSE;
+    END (*WITH*);
+END Menus.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/misclib.def b/examples/Modula-2_Libraries/PMOS/sources/general/misclib.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/misclib.def
@@ -0,0 +1,28 @@
+DEFINITION MODULE MiscLib;
+
+	(********************************************************)
+	(*							*)
+	(*	   Miscellaneous library procedures		*)
+	(*	for which the implementation has to be in	*)
+	(*		assembly language			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	22 August 1994			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(*	This version is for TopSpeed version 1.17	*)
+	(*							*)
+	(********************************************************)
+
+PROCEDURE InStringWord (port: CARDINAL;  BufferAddress: ADDRESS;
+						count: CARDINAL);
+
+    (* Reads count words from an input port.	*)
+
+PROCEDURE OutStringWord (port: CARDINAL;  BufferAddress: ADDRESS;
+						count: CARDINAL);
+
+    (* Writes count words to an output port.	*)
+
+END MiscLib.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/miscpmos.def b/examples/Modula-2_Libraries/PMOS/sources/general/miscpmos.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/miscpmos.def
@@ -0,0 +1,110 @@
+DEFINITION MODULE MiscPMOS;
+
+	(************************************************)
+	(*						*)
+	(*	Miscellaneous PMOS procedures		*)
+	(*						*)
+	(*  Programmer:		P. Moylan		*)
+	(*  Last edited:	24 August 1994		*)
+	(*  Status:		OK			*)
+	(*						*)
+	(************************************************)
+
+IMPORT SYSTEM;
+
+TYPE RegisterPacket =
+		(*<TopSpeed*) SYSTEM.Registers; (*>*)
+		(*<FST
+		(* We don't bother covering everything here, just	*)
+		(* the registers we have a need for.			*)
+		RECORD
+		    CASE :BOOLEAN OF
+		     | FALSE:	AL, AH, BL, BH, CL, CH, DL, DH: SYSTEM.BYTE;
+		     | TRUE:	AX, BX, CX, DX, BP, SI, DI, DS, ES: CARDINAL;
+		    END (*CASE*);
+		END (*RECORD*);
+		>*)
+     CMOSaddress = [0..63];
+
+(************************************************************************)
+(*				STRING COPY				*)
+(************************************************************************)
+
+PROCEDURE CopyString (source: ARRAY OF CHAR;  VAR (*OUT*) dest: ARRAY OF CHAR);
+
+    (* Copies a string, with truncation or null termination as needed.	*)
+    (* This function is provided in order to help software portability,	*)
+    (* i.e. to avoid having to rewrite code for no reason other than	*)
+    (* a change of compilers.						*)
+
+(************************************************************************)
+(*			PROCEDURES TO ACCESS CMOS			*)
+(************************************************************************)
+(*									*)
+(*  The first 14 bytes of CMOS are used for the real-time clock - see	*)
+(*  module TimeOfDay for details.					*)
+(*									*)
+(*  The contents of the remaining bytes would take too long to describe	*)
+(*  here, so only the ones of current interest are mentioned:		*)
+(*									*)
+(*	10H	Diskette drive type.  The high order 4 bits describe	*)
+(*		drive A, the lower order 4 bits describe drive B.	*)
+(*		The encoding is:					*)
+(*			0	no drive present			*)
+(*			1	double sided drive, 48 TPI		*)
+(*			2	high capacity drive, 96 TPI		*)
+(*			4	3.5" 1.44MB drive			*)
+(*		    (other values are reserved).			*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE ReadCMOS (location: CMOSaddress): SYSTEM.BYTE;
+
+    (* Returns the value at the given CMOS location.	*)
+
+PROCEDURE WriteCMOS (location: CMOSaddress;  value: SYSTEM.BYTE);
+
+    (* Stores a value at the given CMOS location.	*)
+
+(************************************************************************)
+(*			   BIOS/MS-DOS CALLS				*)
+(************************************************************************)
+
+PROCEDURE BIOS (InterruptNumber: CARDINAL;
+			VAR (*INOUT*) Registers: RegisterPacket);
+
+    (* Performs a software interrupt, with the given interrupt number,	*)
+    (* after loading the components of variable "Registers" into the	*)
+    (* machine registers.  After the handler returns, the updated	*)
+    (* register values are put back into variable "Registers".		*)
+
+(************************************************************************)
+(*		     MISCELLANEOUS LOW-LEVEL OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE EnterCriticalSection(): CARDINAL;
+
+    (* Saves the processor flags word, including the current "interrupt	*)
+    (* enable" status, on the caller's stack, and returns with		*)
+    (* interrupts disabled.   NOTE: this procedure and the following	*)
+    (* one should be used as a matched pair.				*)
+
+PROCEDURE LeaveCriticalSection (savedPSW: CARDINAL);
+
+    (* Restores the processor flags word, including the "interrupt	*)
+    (* enable" status, from the stack.  NOTE: this procedure and the	*)
+    (* one above should be used as a matched pair.			*)
+
+PROCEDURE ProcessorStatus(): CARDINAL;
+
+    (* Returns the current value of the processor flags word.	*)
+
+PROCEDURE ShortDelay (amount: CARDINAL);
+
+    (* Provides a time delay for those cases where the required delay	*)
+    (* is not long enough to justify a Sleep() operation.		*)
+    (* The present version is not entirely satisfactory - needs to be	*)
+    (* re-tuned for different compiler options, different processor	*)
+    (* models, etc.  This should be seen as an interim solution only. 	*)
+
+END MiscPMOS.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/miscpmos.mod b/examples/Modula-2_Libraries/PMOS/sources/general/miscpmos.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/miscpmos.mod
@@ -0,0 +1,216 @@
+IMPLEMENTATION MODULE MiscPMOS;
+
+	(************************************************)
+	(*						*)
+	(*	Miscellaneous PMOS procedures		*)
+	(*						*)
+	(*  Programmer:         P. Moylan		*)
+	(*  Last edited:        24 August 1994		*)
+	(*  Status:             OK			*)
+	(*	The FST code is incompletely tested.	*)
+	(*						*)
+	(************************************************)
+
+FROM SYSTEM IMPORT BYTE (*<FST , ASSEMBLER >*);
+
+(*<TopSpeed*)
+FROM SYSTEM IMPORT
+    (* proc *)  DI, SetFlags, GetFlags;
+
+FROM Lib IMPORT
+    (* proc *)  Intr;
+(*>*)
+
+(*<FST IMPORT System; >*)
+
+FROM LowLevel IMPORT
+    (* proc *)	LowByte, InByte, OutByte;
+
+(************************************************************************)
+(*				STRING COPY				*)
+(************************************************************************)
+
+PROCEDURE CopyString (source: ARRAY OF CHAR;  VAR (*OUT*) dest: ARRAY OF CHAR);
+
+    (* Copies a string, with truncation or null termination as needed.	*)
+    (* This function is provided in order to help software portability,	*)
+    (* i.e. to avoid having to rewrite code for no reason other than	*)
+    (* a change of compilers.						*)
+
+    VAR j, last: CARDINAL;  AddNull: BOOLEAN;
+
+    BEGIN
+	last := HIGH(dest);
+	AddNull := HIGH(source) < last;
+	IF AddNull THEN last := HIGH(source) END (*IF*);
+	FOR j := 0 TO last DO dest[j] := source[j] END (*FOR*);
+	IF AddNull THEN dest[last+1] := CHR(0) END (*IF*);
+    END CopyString;
+
+(************************************************************************)
+(*                      PROCEDURES TO ACCESS CMOS                       *)
+(************************************************************************)
+
+CONST
+    CMOSAddressPort = 70H;
+    CMOSDataPort = CMOSAddressPort + 1;
+
+(************************************************************************)
+
+PROCEDURE ReadCMOS (location: CMOSaddress): BYTE;
+
+    (* Returns the value at the given CMOS location.    *)
+
+    BEGIN
+	OutByte (CMOSAddressPort, LowByte(location));
+	RETURN InByte (CMOSDataPort);
+    END ReadCMOS;
+
+(************************************************************************)
+
+PROCEDURE WriteCMOS (location: CMOSaddress;  value: BYTE);
+
+    (* Stores a value at the given CMOS location.       *)
+
+    BEGIN
+	OutByte (CMOSAddressPort, LowByte(location));
+	OutByte (CMOSDataPort, value);
+    END WriteCMOS;
+
+(************************************************************************)
+(*                        BIOS/MS-DOS CALLS                             *)
+(************************************************************************)
+
+PROCEDURE BIOS (InterruptNumber: CARDINAL;
+			VAR (*INOUT*) Registers: RegisterPacket);
+
+    (* Performs a software interrupt, with the given interrupt number,  *)
+    (* after loading the components of variable "Registers" into the    *)
+    (* machine registers.  After the handler returns, the updated       *)
+    (* register values are put back into variable "Registers".          *)
+
+    BEGIN
+	(*<TopSpeed*) Intr (Registers, CARDINAL(InterruptNumber)); (*>*)
+	(*<FST
+	System.AX := Registers.AX;
+	System.BX := Registers.BX;
+	System.CX := Registers.CX;
+	System.DX := Registers.DX;
+	System.BP := Registers.BP;
+	System.SI := Registers.SI;
+	System.DI := Registers.DI;
+	System.DS := Registers.DS;
+	System.ES := Registers.ES;
+	System.XTrap (InterruptNumber);
+	Registers.AX := System.AX;
+	Registers.BX := System.BX;
+	Registers.CX := System.CX;
+	Registers.DX := System.DX;
+	Registers.BP := System.BP;
+	Registers.SI := System.SI;
+	Registers.DI := System.DI;
+	Registers.DS := System.DS;
+	Registers.ES := System.ES;
+	>*)
+    END BIOS;
+
+(************************************************************************)
+(*                   MISCELLANEOUS LOW-LEVEL OPERATIONS                 *)
+(************************************************************************)
+
+PROCEDURE EnterCriticalSection (): CARDINAL;
+
+    (* Saves the processor flags word, including the current "interrupt	*)
+    (* enable" status, on the caller's stack, and returns with		*)
+    (* interrupts disabled.   NOTE: this procedure and the following    *)
+    (* one should be used as a matched pair.                            *)
+
+    VAR SavedProcessorStatus: CARDINAL;
+
+    BEGIN
+
+	(*<TopSpeed*)
+	SavedProcessorStatus := GetFlags ();
+	DI();
+	(*>*)
+
+	(*<FST
+	ASM
+	    PUSHF
+	    POP AX
+	    MOV SavedProcessorStatus, AX
+	    CLI
+	END (*ASM*);
+	>*)
+
+	RETURN SavedProcessorStatus;
+
+    END EnterCriticalSection;
+
+(************************************************************************)
+
+PROCEDURE LeaveCriticalSection (SavedProcessorStatus: CARDINAL);
+
+    (* Restores the processor flags word, including the "interrupt	*)
+    (* enable" status, from the stack.  NOTE: this procedure and the	*)
+    (* one above should be used as a matched pair.                      *)
+
+    BEGIN
+
+	(*<TopSpeed*)
+	SetFlags (SavedProcessorStatus);
+	(*>*)
+
+	(*<FST
+	ASM
+	    MOV AX, SavedProcessorStatus
+	    PUSH AX
+	    POPF
+	END (*ASM*);
+	>*)
+
+    END LeaveCriticalSection;
+
+(************************************************************************)
+
+PROCEDURE ProcessorStatus(): CARDINAL;
+
+    (* Returns the current value of the processor flags word.   *)
+
+    VAR result: CARDINAL;
+
+    BEGIN
+	(*<TopSpeed*)
+	RETURN GetFlags();
+	(*>*)
+
+	(*<FST
+	ASM
+	    PUSHF
+	    POP AX
+	    MOV result, AX
+	END (*ASM*);
+	RETURN result;
+	>*)
+    END ProcessorStatus;
+
+(************************************************************************)
+
+PROCEDURE ShortDelay (amount: CARDINAL);
+
+    (* Provides a time delay for those cases where the required delay   *)
+    (* is not long enough to justify a Sleep() operation.               *)
+    (* The present version is not entirely satisfactory - needs to be   *)
+    (* re-tuned for different compiler options, different processor     *)
+    (* models, etc.  This should be seen as an interim solution only.   *)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	FOR j := 1 TO amount DO
+	END (*FOR*);
+    END ShortDelay;
+
+(************************************************************************)
+
+END MiscPMOS.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/mouse.def b/examples/Modula-2_Libraries/PMOS/sources/general/mouse.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/mouse.def
@@ -0,0 +1,88 @@
+DEFINITION MODULE Mouse;
+
+	(********************************************************)
+	(*							*)
+	(*		    Mouse driver			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 July 1994			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(*	This module is actually an intermediary		*)
+	(*	between the user and the low-level mouse	*)
+	(*	driver; this is to make it easy to change	*)
+	(*	mouse drivers.					*)
+	(*							*)
+	(********************************************************)
+
+FROM Windows IMPORT
+    (* type *)	RowRange, ColumnRange;
+
+IMPORT Mouse0;
+
+TYPE
+    Buttons	 = Mouse0.Buttons;
+    ButtonSet	 = Mouse0.ButtonSet;
+    Events	 = Mouse0.Events;
+    EventSet	 = Mouse0.EventSet;
+    EventHandler = Mouse0.EventHandler;
+
+(************************************************************************)
+
+PROCEDURE MouseAvailable (): BOOLEAN;
+
+    (* Returns TRUE iff a mouse driver is loaded, a mouse exists, and	*)
+    (* mouse operation is permitted in module ConfigurationOptions.	*)
+
+PROCEDURE ResetMouse (VAR (*OUT*) MousePresent: BOOLEAN;
+			VAR (*OUT*) NumberOfButtons: CARDINAL);
+
+    (* Initializes mouse, returning MousePresent as FALSE if no mouse	*)
+    (* available and as TRUE if it is, and NumberOfButtons as the	*)
+    (* number of buttons for the mouse if installed.			*)
+
+PROCEDURE GetTextMousePosition (VAR (*OUT*) Xposition: ColumnRange;
+				VAR (*OUT*) Yposition: RowRange);
+
+    (* Returns the current position of the mouse cursor. *)
+
+PROCEDURE GetTextMouseStatus (VAR (*OUT*) buttons: ButtonSet;
+				VAR (*OUT*) Xposition: ColumnRange;
+				VAR (*OUT*) Yposition: RowRange);
+
+    (* Returns the current mouse position and state of the buttons.	*)
+
+PROCEDURE SetTextMousePosition (Xposition: ColumnRange; Yposition: RowRange);
+
+    (* Initialises the mouse position. *)
+
+PROCEDURE SetTextMousePage (page: CARDINAL);
+
+    (* Sets the hardware screen page where the mouse is visible. *)
+
+PROCEDURE SetMouseCursorLimits (top, bottom: RowRange;
+					left, right: ColumnRange);
+
+    (* Specifies a rectangular region outside which the mouse cursor	*)
+    (* may not go.							*)
+
+PROCEDURE ShowMouseCursor;
+
+    (* Makes the mouse cursor visible on the screen. *)
+
+PROCEDURE HideMouseCursor;
+
+    (* Makes the mouse cursor invisible. *)
+
+PROCEDURE InstallEventHandler (DetectedEvents: EventSet;
+					Handler: EventHandler);
+
+    (* Nominates the procedure to be called whenever an event in the	*)
+    (* set DetectedEvents occurs.  Note: the Handler is like an		*)
+    (* interrupt procedure, in that it is executing in the context of	*)
+    (* an unknown task; typically it should probably restrict its	*)
+    (* actions to fairly elementary things, like a Signal to wake up	*)
+    (* the task that really wants to know about the event.		*)
+
+END Mouse.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/mouse.mod b/examples/Modula-2_Libraries/PMOS/sources/general/mouse.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/mouse.mod
@@ -0,0 +1,167 @@
+IMPLEMENTATION MODULE Mouse;
+
+	(********************************************************)
+	(*							*)
+	(*		    Mouse driver			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	17 August 1994			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(*	This module is actually an intermediary		*)
+	(*	between the user and the true mouse driver;	*)
+	(*	this is so that I can easily experiment		*)
+	(*	with different mouse drivers.			*)
+	(*							*)
+	(*	Note: this module contains preprocessor		*)
+	(*	directives and should be processed by PP.	*)
+	(*							*)
+	(********************************************************)
+
+FROM
+(*<~UseMouse DummyMouse >*)
+(*<MouseKind=INT33*) Mouse33 (*>*)
+(*<UseMouse&(MouseKind<>INT33) SerialMouse >*)
+  IMPORT
+    (* proc *)	InitialiseMouseDriver, Reset, SetCursorPos, SetPage,
+		GetPosBut, ShowCursor, HideCursor, SetEventHandler,
+		SetHorizontalLimits, SetVerticalLimits;
+
+(************************************************************************)
+
+VAR
+    HaveMouse: BOOLEAN;
+    NumberOfButtons: CARDINAL;
+
+(************************************************************************)
+
+PROCEDURE MouseAvailable (): BOOLEAN;
+
+    (* Returns TRUE iff a mouse driver is loaded, a mouse exists, and	*)
+    (* mouse operation is permitted in module ConfigurationOptions.	*)
+
+    BEGIN
+	RETURN HaveMouse AND (NumberOfButtons > 0);
+    END MouseAvailable;
+
+(************************************************************************)
+
+PROCEDURE ResetMouse (VAR (*OUT*) MousePresent: BOOLEAN;
+			VAR (*OUT*) NumberOfButtons: CARDINAL);
+
+    (* Initializes mouse, returning MousePresent as FALSE if no mouse	*)
+    (* available and as TRUE if it is, and NumberOfButtons as the	*)
+    (* number of buttons for the mouse if installed.			*)
+
+    BEGIN
+	Reset (MousePresent, NumberOfButtons);
+    END ResetMouse;
+
+(************************************************************************)
+
+PROCEDURE GetTextMousePosition (VAR (*OUT*) Xposition: ColumnRange;
+				VAR (*OUT*) Yposition: RowRange);
+
+    (* Returns the current position of the mouse cursor. *)
+
+    VAR Buttons: ButtonSet;  X, Y: CARDINAL;
+
+    BEGIN
+	GetPosBut (Buttons, X, Y);
+	Xposition := X DIV 8;
+	Yposition := Y DIV 8;
+    END GetTextMousePosition;
+
+(************************************************************************)
+
+PROCEDURE GetTextMouseStatus (VAR (*OUT*) buttons: ButtonSet;
+				VAR (*OUT*) Xposition: ColumnRange;
+				VAR (*OUT*) Yposition: RowRange);
+
+    (* Returns the current mouse position and state of the buttons.	*)
+
+    VAR X, Y: CARDINAL;
+
+    BEGIN
+	GetPosBut (buttons, X, Y);
+	Xposition := X DIV 8;
+	Yposition := Y DIV 8;
+    END GetTextMouseStatus;
+
+(************************************************************************)
+
+PROCEDURE SetTextMousePosition (Xposition: ColumnRange; Yposition: RowRange);
+
+    (* Initialises the mouse position. *)
+
+    BEGIN
+	SetCursorPos (8*Xposition, 8*Yposition);
+    END SetTextMousePosition;
+
+(************************************************************************)
+
+PROCEDURE SetTextMousePage (page: CARDINAL);
+
+    (* Sets the hardware screen page where the mouse is visible. *)
+
+    BEGIN
+	SetPage (page);
+    END SetTextMousePage;
+
+(************************************************************************)
+
+PROCEDURE SetMouseCursorLimits (top, bottom: RowRange;
+					left, right: ColumnRange);
+
+    (* Specifies a rectangular region outside which the mouse cursor	*)
+    (* may not go.							*)
+
+    VAR X: ColumnRange;  Y: RowRange;
+
+    BEGIN
+	SetHorizontalLimits (8*left, 8*right);
+	SetVerticalLimits (8*top, 8*bottom);
+    END SetMouseCursorLimits;
+
+(************************************************************************)
+
+PROCEDURE ShowMouseCursor;
+
+    (* Makes the mouse cursor visible on the screen. *)
+
+    BEGIN
+	ShowCursor;
+    END ShowMouseCursor;
+
+(************************************************************************)
+
+PROCEDURE HideMouseCursor;
+
+    (* Makes the mouse cursor invisible. *)
+
+    BEGIN
+	HideCursor;
+    END HideMouseCursor;
+
+(************************************************************************)
+
+PROCEDURE InstallEventHandler (DetectedEvents: EventSet;
+					Handler: EventHandler);
+
+    (* Nominates the procedure to be called whenever an event in the	*)
+    (* set DetectedEvents occurs.					*)
+
+    BEGIN
+	SetEventHandler (DetectedEvents, Handler);
+    END InstallEventHandler;
+
+(************************************************************************)
+
+BEGIN
+    HaveMouse := InitialiseMouseDriver();
+    IF HaveMouse THEN
+	ResetMouse (HaveMouse, NumberOfButtons);
+    ELSE
+	NumberOfButtons := 0;
+    END (*IF*);
+END Mouse.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/mouse0.def b/examples/Modula-2_Libraries/PMOS/sources/general/mouse0.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/mouse0.def
@@ -0,0 +1,35 @@
+DEFINITION MODULE Mouse0;
+
+	(********************************************************)
+	(*							*)
+	(*	Common definitions for the mouse drivers	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	24 February 1995		*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+TYPE
+    Buttons = (LeftButton, RightButton, MiddleButton);
+
+    ButtonSet = SET OF Buttons;
+
+    Events =  (Motion, LeftDown, LeftUp, RightDown, RightUp, MiddleDown,
+              MiddleUp);
+
+    EventSet = SET OF Events;
+
+    (*<TopSpeed3*)
+    (*# save, call(c_conv => off, same_ds => off, near_call => off) *)
+    (*# call(reg_param => (ax,bx,cx,dx,st0,st6,st5,st4,st3)) *)
+    (*>*)
+
+    EventHandler = PROCEDURE (EventSet,		(* condition mask *)
+				ButtonSet,	(* Button state *)
+				CARDINAL,	(* horizontal cursor position *)
+				CARDINAL);	(* vertical cursor position *)
+
+    (*<TopSpeed3*) (*# restore *) (*>*)
+
+END Mouse0.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/mouse0.mod b/examples/Modula-2_Libraries/PMOS/sources/general/mouse0.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/mouse0.mod
@@ -0,0 +1,15 @@
+IMPLEMENTATION MODULE Mouse0;
+
+	(********************************************************)
+	(*							*)
+	(*	Common definitions for the mouse drivers	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 July 1994			*)
+	(*  Status:		Dummy file - this module has	*)
+	(*			no implementation part		*)
+	(*							*)
+	(********************************************************)
+
+END Mouse0.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/mouse33.def b/examples/Modula-2_Libraries/PMOS/sources/general/mouse33.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/mouse33.def
@@ -0,0 +1,127 @@
+DEFINITION MODULE Mouse33;
+
+	(****************************************************************)
+	(*								*)
+	(*		   Mouse driver using INT 33H			*)
+	(*		to call a resident mouse driver			*)
+	(*								*)
+	(*	Originally developed by Roger Carvalho and Pat Terry.	*)
+	(*	The present version is maintained by Peter Moylan.	*)
+	(*								*)
+	(*	Last edited:	17 August 1994				*)
+	(*								*)
+	(****************************************************************)
+
+FROM Mouse0 IMPORT
+    (* type *)	Buttons, ButtonSet, EventSet, EventHandler;
+
+PROCEDURE InitialiseMouseDriver(): BOOLEAN;
+
+    (* Does all initialisation needed for this module.  We make this a	*)
+    (* procedure rather than an initialisation section because module	*)
+    (* Mouse has to decide which mouse driver to use.  The function	*)
+    (* result indicates success; if it is FALSE, none of the following	*)
+    (* procedures will work.  Note: this is not an end-user procedure,	*)
+    (* it's intended to be called only by module Mouse.			*)
+
+PROCEDURE Reset (VAR (*OUT*) MousePresent: BOOLEAN;
+			VAR (*OUT*) NumberOfButtons: CARDINAL);
+
+    (* Initializes mouse, returning MousePresent as FALSE if no mouse	*)
+    (* available and as TRUE if it is, and NumberOfButtons as the	*)
+    (* number of buttons for the mouse if installed.			*)
+
+PROCEDURE ShowCursor;
+
+    (* Turns mouse cursor on. *)
+
+PROCEDURE HideCursor;
+
+    (* Turns mouse cursor off. *)
+
+PROCEDURE GetPosBut (VAR (*OUT*) Buttons: ButtonSet;
+				VAR (*OUT*) X, Y : CARDINAL);
+
+    (* Gets position and Button state. *)
+
+PROCEDURE SetCursorPos (X, Y : CARDINAL);
+
+    (* Sets the mouse cursor position. *)
+
+PROCEDURE GetButPress (Button: Buttons;  VAR (*OUT*) Status: ButtonSet;
+		VAR (*OUT*) Count: CARDINAL;  VAR (*OUT*) X, Y: CARDINAL);
+
+    (* Gets Button press information. *)
+
+PROCEDURE GetButRelease (Button: Buttons;  VAR (*OUT*) Status : ButtonSet;
+				VAR (*OUT*) Count: CARDINAL;
+				VAR (*OUT*) X, Y: CARDINAL);
+
+    (* Gets Button release information. *)
+
+PROCEDURE SetHorizontalLimits (MinX, MaxX : CARDINAL);
+PROCEDURE SetVerticalLimits (MinY, MaxY : CARDINAL);
+
+    (* Sets the cursor limits. *)
+
+TYPE
+    GraphicCursor = RECORD
+			ScreenMask,
+			CursorMask : ARRAY [0 .. 15] OF BITSET;
+			HotX, HotY : INTEGER [-16 .. 16];
+                    END (*RECORD*);
+
+PROCEDURE SetGraphicsCursor (Cursor : GraphicCursor);
+
+    (* Sets the graphics cursor shape.  The ScreenMask is first ANDed	*)
+    (* into the display, then the CursorMask is XORed into the display.	*)
+    (* The hot spot coordinates are relative to the upper-left corner	*)
+    (* of the cursor image, and define where the cursor actually	*)
+    (* 'points to'.							*)
+
+PROCEDURE SetTextCursor (HardWare: BOOLEAN;  Start, Stop: CARDINAL);
+
+    (* Sets the text cursor.  For the software text cursor, the second	*)
+    (* two parameters specify the screen and cursor masks.  The screen	*)
+    (* mask is first ANDed into the display, then the cursor mask is	*)
+    (* XORed into the display.  For the hardware text cursor, the	*)
+    (* second two parameters contain the line numbers of the first and	*)
+    (* last scan line in the cursor to be shown on the screen.		*)
+
+PROCEDURE ReadMotionCounters (VAR (*OUT*) X, Y: CARDINAL);
+
+    (* Read motion counters. *)
+
+PROCEDURE SetEventHandler (Mask: EventSet;  Handler: EventHandler);
+
+    (* Establish conditions and Handler for mouse events.  After this,	*)
+    (* when an event occurs that is in the Mask, the Handler is called	*)
+    (* with the event set that actually happened, the current Button	*)
+    (* status, and the cursor X and Y.					*)
+
+PROCEDURE LightPenOn;
+
+    (* Sets light pen on. *)
+
+PROCEDURE LightPenOff;
+
+    (* Sets light pen off. *)
+
+PROCEDURE SetMickeysPerPixel (HorMPP, VertMPP : CARDINAL);
+
+    (* Sets the Mickey / Pixel ratio. *)
+
+PROCEDURE ConditionalOff (Left, Top, Right, Bottom: CARDINAL);
+
+    (* Sets limits within which cursor is on. *)
+
+PROCEDURE SetSpeedThreshold (Threshold : CARDINAL);
+
+    (* Sets mimimum speed Threshold. *)
+
+PROCEDURE SetPage (page: CARDINAL);
+
+    (* Sets the hardware screen page where the mouse is visible. *)
+
+END Mouse33.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/mouse33.mod b/examples/Modula-2_Libraries/PMOS/sources/general/mouse33.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/mouse33.mod
@@ -0,0 +1,394 @@
+IMPLEMENTATION MODULE Mouse33;
+
+	(****************************************************************)
+	(*								*)
+	(*		   Mouse driver using INT 33H			*)
+	(*		to call a resident mouse driver			*)
+	(*								*)
+	(*	Author:		P.D. Terry, Rhodes University,		*)
+	(*			 Sun  01-10-1993			*)
+	(*			Based on an earlier version by		*)
+	(*				Roger Carvalho			*)
+	(*	Modified by:	Peter Moylan				*)
+	(*			(initially to run with TopSpeed v3,	*)
+	(*			 subsequently modified to handle both	*)
+	(*			 TopSpeed v1.17 and TopSpeed 3.10 with	*)
+	(*			 the aid of the PP preprocessor.)	*)
+	(*	Last edited:	22 February 1995			*)
+	(*	Status:		Working, not fully tested.  See note	*)
+	(*			below about problems with Microsoft	*)
+	(*			mouse driver.				*)
+	(*								*)
+	(*		Everything that I've tested works, but this	*)
+	(*		module has been tested only superficially	*)
+	(*		by me (PJM) so far.  The code should		*)
+	(*		however be fairly trustworthy, because I have	*)
+	(*		tested the parts which differ from the		*)
+	(*		implementation by Pat Terry.			*)
+	(*								*)
+	(*	NOTE: This file contains preprocessor directives, and	*)
+	(*	needs to be customised by running the PP preprocessor.	*)
+	(*								*)
+	(****************************************************************)
+	(*								*)
+	(*		PROBLEMS WITH MICROSOFT MOUSE DRIVER		*)
+	(*								*)
+	(*	Although this module works with the Logitech mouse	*)
+	(*	driver and with the OS/2 mouse drivers, it fails with	*)
+	(*	at least one version of the Microsoft mouse driver	*)
+	(*	for DOS.  The problem is that the mouse driver tries	*)
+	(*      to take over the timer interrupt vector, and this is	*)
+	(*      incompatible with the PMOS module Timer.  As a result	*)
+	(*      you should NOT use this module in conjunction with	*)
+	(*      a Microsoft mouse driver; use module SerialMouse	*)
+	(*      instead.						*)
+	(*								*)
+	(*	Possible fix: specify ChainTimerInt := TRUE in the	*)
+	(*	PP.CFG file.  I haven't tested this extensively		*)
+	(*	enough to be sure it's a good solution, but it works	*)
+	(*	in at least some cases.					*)
+	(*								*)
+	(*	This problem apparently does not arise when running	*)
+	(*	from inside Microsoft Windows.				*)
+	(*								*)
+	(****************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE, ADDRESS,
+    (* proc *)	ADR;
+
+FROM Mouse0 IMPORT
+    (* type *)	Buttons, ButtonSet, EventSet, EventHandler;
+
+FROM MiscPMOS IMPORT
+    (* type *)	RegisterPacket,
+    (* proc *)	BIOS;
+
+FROM LowLevel IMPORT
+    (* proc *)	SEGMENT, OFFSET, MakePointer;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure;
+
+VAR DriverInstalled: BOOLEAN;
+
+(************************************************************************)
+
+PROCEDURE Reset (VAR (*OUT*) MousePresent: BOOLEAN;
+                        VAR (*OUT*) NumberOfButtons: CARDINAL);
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 0;  BIOS (33H, R);
+	MousePresent := R.AX # 0;
+	IF MousePresent THEN
+	    NumberOfButtons := R.BX
+	ELSE
+	    NumberOfButtons := 0;
+	END (*IF*);
+    END Reset;
+
+(************************************************************************)
+
+PROCEDURE ShowCursor;
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 1;  BIOS (33H, R);
+    END ShowCursor;
+
+(************************************************************************)
+
+PROCEDURE HideCursor;
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 2;  BIOS (33H, R);
+    END HideCursor;
+
+(************************************************************************)
+
+PROCEDURE GetPosBut (VAR Buttons: ButtonSet;  VAR X, Y: CARDINAL);
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 3;  BIOS (33H, R);
+	Buttons := ButtonSet(R.BX);  X := R.CX;  Y := R.DX;
+    END GetPosBut;
+
+(************************************************************************)
+
+PROCEDURE SetCursorPos (X, Y : CARDINAL);
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 4;  R.CX := X;  R.DX := Y;  BIOS (33H, R);
+    END SetCursorPos;
+
+(************************************************************************)
+
+PROCEDURE GetButPress (Button : Buttons; VAR Status : ButtonSet;
+                         VAR Count : CARDINAL; VAR X, Y : CARDINAL);
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 5;  R.BX := ORD(Button);
+	BIOS (33H, R);
+	Status := ButtonSet(R.AX);  Count := R.BX;
+	X := R.CX;  Y := R.DX;
+    END GetButPress;
+
+(************************************************************************)
+
+PROCEDURE GetButRelease (Button : Buttons; VAR Status : ButtonSet;
+                           VAR Count : CARDINAL; VAR X ,Y : CARDINAL);
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 6;  R.BX := ORD(Button);  BIOS (33H, R);
+	Status := ButtonSet(R.AX);  Count := R.BX;
+	X := R.CX;  Y := R.DX;
+    END GetButRelease;
+
+(************************************************************************)
+
+PROCEDURE SetHorizontalLimits (MinX, MaxX : CARDINAL);
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 7;  R.CX := MinX;  R.DX := MaxX;  BIOS (33H, R);
+    END SetHorizontalLimits;
+
+(************************************************************************)
+
+PROCEDURE SetVerticalLimits (MinY, MaxY : CARDINAL);
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 8;  R.CX := MinY;  R.DX := MaxY;  BIOS (33H, R);
+    END SetVerticalLimits;
+
+(************************************************************************)
+
+PROCEDURE SetGraphicsCursor (Cursor: GraphicCursor);
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 9;  R.BX := Cursor.HotX;  R.CX := Cursor.HotY;
+	R.DX := ORD(OFFSET (ADR(Cursor.ScreenMask)));
+	R.ES := ORD(SEGMENT (ADR(Cursor.ScreenMask)));
+	BIOS (33H, R);
+    END SetGraphicsCursor;
+
+(************************************************************************)
+
+PROCEDURE SetTextCursor (Hardware: BOOLEAN;  Start, Stop: CARDINAL);
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 10;  R.BX := ORD(Hardware);  R.CX := Start;  R.DX := Stop;
+	BIOS (33H, R);
+    END SetTextCursor;
+
+(************************************************************************)
+
+PROCEDURE ReadMotionCounters (VAR X, Y : CARDINAL);
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 11;  BIOS (33H, R);  X := R.CX;  Y := R.DX;
+    END ReadMotionCounters;
+
+(************************************************************************)
+
+(*<~TopSpeed3
+
+(* The following record holds a machine language procedure.  (The	*)
+(* initialisation section of this module fills in the code.)  The	*)
+(* purpose of this procedure is to push AX, BX, CX, DX onto the stack	*)
+(* and then call the client's event handler - i.e. this is an interface	*)
+(* between a caller which passes parameters in registers and a called	*)
+(* procedure which expects the parameters to be on the stack.		*)
+
+VAR PrivateHandler: RECORD
+			PushDS, PushCS, PopDSO,
+			PushAX, PushBX, PushCX, PushDX : BYTE;
+			FarCall : BYTE;
+			handlerProc : EventHandler;
+			PopDS, FarRet : BYTE;
+		    END (*RECORD*);
+>*)
+
+(************************************************************************)
+
+PROCEDURE SetEventHandler (Mask : EventSet;  Handler : EventHandler);
+
+    VAR R: RegisterPacket;
+	subr: RECORD
+		CASE :BOOLEAN OF
+		  | FALSE:
+			(*<TopSpeed3*) proc: EventHandler; (*>*)
+			(*<~TopSpeed3 address: ADDRESS; >*)
+		  | TRUE:
+			offset, segment: CARDINAL;
+		END (*CASE*);
+	      END (*RECORD*);
+
+    BEGIN
+	(*<TopSpeed3*) subr.proc := Handler; (*>*)
+	(*<~TopSpeed3
+	PrivateHandler.handlerProc := Handler;
+	subr.address := ADR(PrivateHandler);
+	>*)
+	R.AX := 12; R.CX := CARDINAL(Mask);
+	R.DX := subr.offset; R.ES := subr.segment;
+	BIOS (33H, R);
+    END SetEventHandler;
+
+(************************************************************************)
+
+PROCEDURE LightPenOn;
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 13;  BIOS (33H, R);
+    END LightPenOn;
+
+(************************************************************************)
+
+PROCEDURE LightPenOff;
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 14;  BIOS (33H, R);
+    END LightPenOff;
+
+(************************************************************************)
+
+PROCEDURE SetMickeysPerPixel (HorMPP, VerMPP : CARDINAL);
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 15;  R.CX := HorMPP;  R.DX := VerMPP;
+	BIOS (33H, R);
+    END SetMickeysPerPixel;
+
+(************************************************************************)
+
+PROCEDURE ConditionalOff (Left, Top, Right, Bottom : CARDINAL);
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 16;  R.CX := Left;  R.DX := Top;
+	R.SI := Right;  R.DI := Bottom;
+	BIOS (33H, R);
+    END ConditionalOff;
+
+(************************************************************************)
+
+PROCEDURE SetSpeedThreshold (Threshold : CARDINAL);
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 19;  R.DX := Threshold;  BIOS (33H, R);
+    END SetSpeedThreshold;
+
+(************************************************************************)
+
+PROCEDURE SetPage (page: CARDINAL);
+
+    (* Sets the hardware screen page where the mouse is visible. *)
+
+    VAR R: RegisterPacket;
+
+    BEGIN
+	R.AX := 29;  R.BX := page;  BIOS (33H, R);
+    END SetPage;
+
+(************************************************************************)
+
+PROCEDURE Cleanup;
+
+    (* Final cleanup on program termination. *)
+
+    VAR HasMouse: BOOLEAN;  Count: CARDINAL;
+
+    BEGIN
+	Reset (HasMouse, Count);
+    END Cleanup;
+
+(************************************************************************)
+(*			MODULE INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE InitialiseMouseDriver(): BOOLEAN;
+
+    (* Does all initialisation needed for this module.  We make this a	*)
+    (* procedure rather than an initialisation section because module	*)
+    (* Mouse has to decide which mouse driver to use.  The function	*)
+    (* result indicates success; if it is FALSE, none of the following	*)
+    (* procedures will work.  Note: this is not an end-user procedure,	*)
+    (* it's intended to be called only by module Mouse.			*)
+
+    CONST IRET = CHR(207);
+
+    (*<TopSpeed3*)
+    (*# save, data(near_ptr=>off) *)
+    (*>*)
+    VAR p: POINTER TO RECORD
+			  CASE :BOOLEAN OF
+			      TRUE:	Routine: POINTER TO CHAR;
+			    | FALSE:	segment, offset : CARDINAL;
+			  END (*CASE*);
+		      END (*RECORD*);
+    (*<TopSpeed3*)
+    (*# restore *)
+    (*>*)
+
+    BEGIN
+	(*<~UseMouse RETURN FALSE; >*)
+	(*<UseMouse*)
+	p := MakePointer (0, 204);
+	DriverInstalled := (p^.segment # 0) AND (p^.offset # 0)
+					AND (p^.Routine^ # IRET);
+	IF DriverInstalled THEN
+	    (*<~TopSpeed3
+	    WITH PrivateHandler DO
+		PushCS  := VAL(BYTE,0EH);
+		PopDSO  := VAL(BYTE,1FH);
+		PushAX  := VAL(BYTE,50H);
+		PushBX  := VAL(BYTE,53H);
+		PushCX  := VAL(BYTE,51H);
+		PushDX  := VAL(BYTE,52H);
+		FarCall := VAL(BYTE,9AH);
+		FarRet  := VAL(BYTE,0CBH);
+		PushDS  := VAL(BYTE,1EH);
+		PopDS   := VAL(BYTE,1FH);
+	    END (*WITH*);
+	    >*)
+	    SetTerminationProcedure (Cleanup);
+	END (*IF*);
+	RETURN DriverInstalled;
+	(*>*)
+    END InitialiseMouseDriver;
+
+(************************************************************************)
+
+END Mouse33.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/multiscr.def b/examples/Modula-2_Libraries/PMOS/sources/general/multiscr.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/multiscr.def
@@ -0,0 +1,69 @@
+DEFINITION MODULE MultiScreen;
+
+	(********************************************************)
+	(*							*)
+	(*	This module allows the creation of multiple	*)
+	(*	virtual screens - complete screens, not just	*)
+	(*	windows - with two keyboard "hot keys" used	*)
+	(*		to navigate around the screens.		*)
+	(*							*)
+	(*	We support a two-level hierarchy: a virtual	*)
+	(*	screen is a collection of windows, and each	*)
+	(*	virtual screen is a member of a group.  (In	*)
+	(*	addition, there is a pseudo-group made up of	*)
+	(*	all windows which are not associated with	*)
+	(*	any virtual screen, to handle the "normal	*)
+	(*	output" which bypasses this module.)  One	*)
+	(*	hot key cycles through the groups, and the	*)
+	(*	second cycles through the virtual screens of	*)
+	(*	the currently active group.			*)
+	(*							*)
+	(*	In the present version, Ctrl/P is the hot	*)
+	(*	key used to select another group, and F6	*)
+	(*	cycles within a group.				*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	12 March 1993			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM Windows IMPORT
+    (* type *)	Window, DisplayPage;
+
+TYPE ScreenGroup;	(* is private *)
+     VirtualScreen;	(* is private *)
+
+PROCEDURE CreateScreenGroup (hardwarepage: DisplayPage): ScreenGroup;
+
+    (* Creates a new screen group, and maps it to the specified display	*)
+    (* page in the screen hardware.  It is permissible to map more than	*)
+    (* one group to the same hardware page.  Note that any group on	*)
+    (* hardware page 0 shares the screen with "normal output" which	*)
+    (* does not belong to any virtual page.  This is permitted, but	*)
+    (* on aesthetic grounds is usually not a good idea.			*)
+
+PROCEDURE CreateVirtualScreen (group: ScreenGroup): VirtualScreen;
+
+    (* Adds a new virtual screen to the specified group.	*)
+
+PROCEDURE MapToVirtualScreen (w: Window;  screen: VirtualScreen);
+
+    (* Before calling this procedure, both w and screen must have been	*)
+    (* created.  This procedure ensures that window w is visible on	*)
+    (* the screen only when the given virtual screen page is active.	*)
+    (* The association lasts until the window is closed or the virtual	*)
+    (* screen is removed.						*)
+
+PROCEDURE RemoveVirtualScreen (VAR (*INOUT*) screen: VirtualScreen);
+
+    (* Destroys all associations between the given virtual screen and	*)
+    (* its windows (but does not close the windows), and permanently	*)
+    (* removes this screen from the collection of virtual screens.	*)
+
+PROCEDURE RemoveScreenGroup (VAR (*INOUT*) group: ScreenGroup);
+
+    (* As above, but removes an entire group.	*)
+
+END MultiScreen.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/multiscr.mod b/examples/Modula-2_Libraries/PMOS/sources/general/multiscr.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/multiscr.mod
@@ -0,0 +1,564 @@
+IMPLEMENTATION MODULE MultiScreen;
+
+	(****************************************************************)
+	(*								*)
+	(*  This module allows the creation of multiple virtual	screens	*)
+	(*  - complete screens, not just windows - with two keyboard	*)
+	(*	"hot keys" used to navigate around the screens.		*)
+	(*								*)
+	(*  We support a two-level hierarchy: a virtual screen is a	*)
+	(*  collection of windows, and each virtual screen is a member	*)
+	(*  of a group.  (In addition, there is a pseudo-group made up	*)
+	(*  of all windows which are not associated with any virtual	*)
+	(*  screen, to handle the "normal output" which bypasses this	*)
+	(*  module.)  One hot key cycles through the groups, and the	*)
+	(*  second cycles through the virtual screens of the currently	*)
+	(*  active group.						*)
+	(*								*)
+	(*  In the present version, Ctrl/P is the hot key used to	*)
+	(*  select another group, and F6 cycles within a group.		*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	21 February 1995			*)
+	(*  Status:		Mostly working				*)
+	(*	Still don't properly support duplicating the same	*)
+	(*	window on multiple virtual screens.  At this stage	*)
+	(*	I'm not convinced that this would be worth the trouble.	*)
+	(*								*)
+	(****************************************************************)
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM TaskControl IMPORT
+    (* proc *)	CreateTask;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM Keyboard IMPORT
+    (* proc *)	HotKey;
+
+FROM Windows IMPORT
+    (* proc *)	Hide, PutOnTop, PutOnPage, SetActivePage, InstallCloseHandler;
+
+(************************************************************************)
+
+TYPE
+    (* A WindowRecord identifies one window. *)
+
+    WRpointer = POINTER TO WindowRecord;
+    WindowRecord =  RECORD
+			next: WRpointer;
+			window: Window;
+		    END (*RECORD*);
+
+    (* A WindowList is a linear list of all the windows which have	*)
+    (* been associated with a given virtual screen.			*)
+
+    WindowList = RECORD
+		     head, tail: WRpointer;
+		 END (*RECORD*);
+
+    (* Each group of virtual screens is arranged as a circular list.	*)
+    (* Each virtual screen has an associated list of windows.		*)
+
+    VirtualScreen = POINTER TO VirtualScreenRecord;
+    VirtualScreenRecord = RECORD
+			      next: VirtualScreen;
+			      group: ScreenGroup;
+			      windowlist: WindowList;
+			  END (*RECORD*);
+
+    (* The groups are also arranged as a circular list.  There is	*)
+    (* one special "sentinel" group, called NormalOutput, which refers	*)
+    (* to normal non-virtual screen output.				*)
+    (* The currentVS field selects the virtual screen which is at	*)
+    (* present the active virtual screen in this group, and - for ease	*)
+    (* of insertion - the preVS field identifies the predecessor of	*)
+    (* currentVS in the circular list.					*)
+
+    ScreenGroup = POINTER TO ScreenGroupRecord;
+    ScreenGroupRecord = RECORD
+			    previous, next: ScreenGroup;
+			    page: DisplayPage;
+			    preVS, currentVS: VirtualScreen;
+			END (*RECORD*);
+
+(************************************************************************)
+
+CONST testing = TRUE;
+      CtrlP = CHR(16);
+      F6 = '@';		(* second code returned by F6 function key	*)
+
+VAR
+    (* The wakeup semaphores are signalled (by the keyboard module)	*)
+    (* whenever the hot keys are typed.  We interpret this as a command	*)
+    (* to switch to the next group, or the next virtual screen within	*)
+    (* the current group, depending on which hot key was typed.		*)
+
+    wakeup1, wakeup2: Semaphore;
+
+    (* ActiveGroup is the currently active group, and NormalOutput is a	*)
+    (* pointer to a sentinel record in the master list of all groups.	*)
+    (* The condition ActiveGroup = NormalOutput is interpreted to mean	*)
+    (* that no group should be active, i.e. the only windows displayed	*)
+    (* are those not associated with any virtual screen.		*)
+
+    ActiveGroup, NormalOutput: ScreenGroup;
+
+    (* We use a single lock to protect references to the entire group	*)
+    (* structure, including references to ActiveGroup and Occupant.	*)
+    (* The alternative, of separate protection for the various		*)
+    (* substructures, turns out to create potential deadlock problems,	*)
+    (* whose solution becomes messy.					*)
+    (* Remark: I'd rather use a Lock rather than a semaphore here.	*)
+    (* However this will have to wait until I can remove semaphore	*)
+    (* waits from procedures Hide and PutOnTop (in module Windows).	*)
+
+    guard: Semaphore;
+
+    (* Occupant[p] is the virtual screen currently occupying hardware	*)
+    (* page p.  We use this in our Hide/Unhide decisions.  Note that	*)
+    (* windows not belonging to any virtual screen will not show up in	*)
+    (* the Occupant information.					*)
+
+    Occupant: ARRAY DisplayPage OF VirtualScreen;
+
+(************************************************************************)
+(*		REMOVING A WINDOW FROM THE GROUP STRUCTURE		*)
+(************************************************************************)
+
+PROCEDURE RemoveFromVirtualScreen (w: Window;  VS: VirtualScreen);
+
+    (* Removes window w from virtual screen VS (without closing it)	*)
+    (* if it is found there.						*)
+
+    VAR previous, current: WRpointer;
+
+    BEGIN
+	previous := NIL;  current := VS^.windowlist.head;
+	LOOP
+	    IF current = NIL THEN
+		EXIT (*LOOP*);
+	    ELSIF current^.window = w THEN
+		IF previous = NIL THEN
+		    VS^.windowlist.head := current^.next;
+		ELSE
+		    previous^.next := current^.next;
+		END (*IF*);
+		IF VS^.windowlist.tail = current THEN
+		    VS^.windowlist.tail := previous;
+		END (*IF*);
+		DISPOSE (current);
+		EXIT (*LOOP*);
+	    ELSE
+		previous := current;  current := current^.next;
+	    END (*IF*);
+	END (*LOOP*);
+    END RemoveFromVirtualScreen;
+
+(************************************************************************)
+
+PROCEDURE RemoveFromGroup (w: Window;  group: ScreenGroup);
+
+    (* See description of RemoveWindow, below.	*)
+
+    VAR current: VirtualScreen;
+
+    BEGIN
+	WITH group^ DO
+	    current := currentVS;
+	    IF current <> NIL THEN
+		REPEAT
+		    RemoveFromVirtualScreen (w, current);
+		    current := current^.next;
+		UNTIL current = currentVS;
+	    END (*IF*);
+	END (*WITH*);
+    END RemoveFromGroup;
+
+(************************************************************************)
+
+PROCEDURE RemoveWindow (w: Window;  page: DisplayPage);
+
+    (* Removes the association, if any, between window w and the	*)
+    (* virtual screen(s) with which it is associated.  It is possible	*)
+    (* that no such association exists, in which case we do nothing.	*)
+
+    VAR current: ScreenGroup;
+
+    BEGIN
+	Wait (guard);
+	current := NormalOutput^.next;
+	WHILE current <> NormalOutput DO
+	    IF current^.page = page THEN
+		RemoveFromGroup (w, current);
+	    END (*IF*);
+	    current := current^.next;
+	END (*WHILE*);
+	Signal (guard);
+    END RemoveWindow;
+
+(************************************************************************)
+(*		    HIDING AND UNHIDING SCREEN OUTPUT			*)
+(************************************************************************)
+
+PROCEDURE HideAll (MP: VirtualScreen);
+
+    (* Makes all windows in this virtual screen invisible.	*)
+
+    VAR list: WRpointer;
+
+    BEGIN
+	IF MP <> NIL THEN
+	    list := MP^.windowlist.head;
+	    WHILE list <> NIL DO
+		Hide (list^.window);
+		list := list^.next;
+	    END (*WHILE*);
+	END (*IF*);
+    END HideAll;
+
+(************************************************************************)
+
+PROCEDURE UnhideAll (MP: VirtualScreen);
+
+    (* Makes all windows in this virtual screen visible.	*)
+
+    VAR list: WRpointer;
+
+    BEGIN
+	IF MP <> NIL THEN
+	    list := MP^.windowlist.head;
+	    WHILE list <> NIL DO
+		PutOnTop (list^.window);
+		list := list^.next;
+	    END (*WHILE*);
+	END (*IF*);
+    END UnhideAll;
+
+(************************************************************************)
+(*			TASKS TO HANDLE KEYBOARD INPUT			*)
+(************************************************************************)
+
+PROCEDURE StepToNextGroup;
+
+    VAR newgroup: ScreenGroup;
+
+    BEGIN
+	newgroup := ActiveGroup^.next;
+	WITH newgroup^ DO
+	    IF page <> ActiveGroup^.page THEN
+		SetActivePage (page);
+	    END (*IF*);
+	    IF Occupant[page] <> currentVS THEN
+		HideAll (Occupant[page]);
+		UnhideAll (currentVS);
+		Occupant[page] := currentVS;
+	    END (*IF*);
+	END (*WITH*);
+	ActiveGroup := newgroup;
+    END StepToNextGroup;
+
+(************************************************************************)
+
+PROCEDURE HotKeyHandler1;
+
+    (* Each time a CTRL/P key is typed, this task switches to the next	*)
+    (* group of virtual pages.						*)
+
+    BEGIN
+	LOOP	(* forever *)
+	    Wait (wakeup1);
+	    Wait (guard);
+	    StepToNextGroup;
+	    Signal (guard);
+	END (*LOOP*);
+    END HotKeyHandler1;
+
+(************************************************************************)
+
+PROCEDURE HotKeyHandler2;
+
+    (* Each time the F6 key is typed, this task switches to the next	*)
+    (* virtual page within the current group.				*)
+
+    BEGIN
+	LOOP	(* forever *)
+	    Wait (wakeup2);
+	    Wait (guard);
+	    WITH ActiveGroup^ DO
+		IF (currentVS <> NIL) AND (currentVS^.next <> currentVS) THEN
+		    preVS := currentVS;  currentVS := currentVS^.next;
+		    HideAll (preVS);
+		    UnhideAll (currentVS);
+		    Occupant[page] := currentVS;
+		END (*IF*);
+	    END (*WITH*);
+	    Signal (guard);
+	END (*LOOP*);
+    END HotKeyHandler2;
+
+(************************************************************************)
+(*			EXTERNALLY CALLABLE PROCEDURES			*)
+(************************************************************************)
+
+PROCEDURE CreateScreenGroup (hardwarepage: DisplayPage): ScreenGroup;
+
+    (* Creates a new screen group, and maps it to the specified display	*)
+    (* page in the screen hardware.  It is permissible to map more than	*)
+    (* one group to the same hardware page.  Note that putting a group	*)
+    (* on hardware page 0 means that it shares the screen with the	*)
+    (* "normal output" which does not belong to any virtual page.  This	*)
+    (* is permitted, but usually inadvisable on aesthetic grounds.	*)
+
+    VAR result: ScreenGroup;
+
+    BEGIN
+	NEW (result);
+	WITH result^ DO
+	    previous := NIL;  next := NIL;
+	    page := hardwarepage;  currentVS := NIL;  preVS := NIL;
+	END (*WITH*);
+
+	(* Insert the new result into the circular list of groups.	*)
+	(* In the present version, we insert it just ahead of the	*)
+	(* special group NormalOutput, which gives the effect of	*)
+	(* putting the groups in order of creation.			*)
+
+	Wait (guard);
+	NormalOutput^.previous^.next := result;
+	result^.previous := NormalOutput^.previous;
+	result^.next := NormalOutput;
+	NormalOutput^.previous := result;
+	Signal (guard);
+
+	RETURN result;
+
+    END CreateScreenGroup;
+
+(************************************************************************)
+
+PROCEDURE CreateVirtualScreen (group: ScreenGroup): VirtualScreen;
+
+    (* Adds a new virtual screen to the specified group.	*)
+
+    VAR result: VirtualScreen;
+
+    BEGIN
+	NEW (result);
+	WITH result^ DO
+	    next := NIL;  windowlist.head := NIL;  windowlist.tail := NIL;
+	END (*WITH*);
+	result^.group := group;
+
+	(* Insert the new result into the list of virtual screens	*)
+	(* belonging to the specified group.  It's inserted just before	*)
+	(* the current virtual screen for this group; in most cases	*)
+	(* this means that virtual screens are ordered according to the	*)
+	(* order of their creation.					*)
+
+	Wait (guard);
+	WITH group^ DO
+	    IF currentVS = NIL THEN
+		currentVS := result;
+		preVS := result;
+		result^.next := result;
+	    ELSE
+		result^.next := currentVS;
+		preVS^.next := result;
+		preVS := result;
+	    END (*IF*);
+	END (*WITH*);
+	Signal (guard);
+
+	RETURN result;
+
+    END CreateVirtualScreen;
+
+(************************************************************************)
+
+PROCEDURE MapToVirtualScreen (w: Window;  screen: VirtualScreen);
+
+    (* Before calling this procedure, both w and screen must have been	*)
+    (* created.  This procedure ensures that window w is visible on	*)
+    (* the screen only when the given virtual screen page is active.	*)
+    (* The association lasts until the window is closed or the virtual	*)
+    (* screen is removed.						*)
+
+    VAR p: WRpointer;
+
+    BEGIN
+	NEW (p);
+	WITH p^ DO
+	    next := NIL;  window := w;
+	END (*WITH*);
+
+	Wait (guard);
+
+	WITH screen^ DO
+	    WITH windowlist DO
+		IF head = NIL THEN
+		    head := p;
+		ELSE
+		    tail^.next := p;
+		END (*IF*);
+		tail := p;
+	    END (*WITH*);
+	    PutOnPage (w, group^.page);
+	END (*WITH*);
+
+	(* Hide the new window if appropriate.	*)
+
+	WITH screen^.group^ DO
+	    IF Occupant[page] = NIL THEN
+		Occupant[page] := screen;
+	    ELSIF Occupant[page] <> screen THEN
+		Hide(w);
+	    END (*IF*);
+	END (*WITH*);
+
+	InstallCloseHandler (w, RemoveWindow);
+	Signal (guard);
+
+    END MapToVirtualScreen;
+
+(************************************************************************)
+(*		REMOVING VIRTUAL SCREENS AND SCREEN GROUPS		*)
+(************************************************************************)
+
+PROCEDURE RemoveVirtualScreen (VAR (*INOUT*) screen: VirtualScreen);
+
+    (* Destroys all associations between the given virtual screen and	*)
+    (* its windows (but does not close the windows), and permanently	*)
+    (* removes this screen from the collection of virtual screens.	*)
+
+    VAR wptr, wnext: WRpointer;
+	VSptr: VirtualScreen;
+
+    BEGIN
+	Wait (guard);
+
+	(* Detach the VirtualScreenRecord from its group.  This might	*)
+	(* require updating preVS and currentVS for the group.  Beware	*)
+	(* of the special case of a group with only one element.	*)
+
+	WITH screen^.group^ DO
+	    IF currentVS = preVS THEN
+		preVS := NIL;  currentVS := NIL;
+	    ELSIF screen = currentVS THEN
+		currentVS := screen^.next;
+		preVS^.next := currentVS;
+	    ELSE
+		(* Let VSptr point to the screen ahead of this one.	*)
+		VSptr := currentVS;
+		WHILE VSptr^.next <> screen DO
+		    VSptr := VSptr^.next;
+		END(*WHILE*);
+		IF screen = preVS THEN
+		    preVS := VSptr;
+		END (*IF*);
+		VSptr^.next := screen^.next;
+	    END (*IF*);
+
+	    (* Deal with the special case of a virtual screen which is	*)
+	    (* now the occupant of its hardware page - i.e. it is now	*)
+	    (* visible, or will become visible as soon as that hardware	*)
+	    (* page is activated.					*)
+
+	    IF screen = Occupant[page] THEN
+		HideAll (screen);
+		UnhideAll (currentVS);
+		Occupant[page] := currentVS;
+	    END (*IF*);
+	END (*WITH*);
+
+	(* Discard the windowlist for this screen.	*)
+
+	wptr := screen^.windowlist.head;
+	WHILE wptr <> NIL DO
+	    wnext := wptr^.next;
+	    DISPOSE (wptr);
+	    wptr := wnext;
+	END (*WHILE*);
+
+	DISPOSE (screen);
+	Signal (guard);
+
+    END RemoveVirtualScreen;
+
+(************************************************************************)
+
+PROCEDURE RemoveScreenGroup (VAR (*INOUT*) group: ScreenGroup);
+
+    (* As above, but removes an entire group.	*)
+
+    BEGIN
+	(* Start by emptying the group.  We can cut down the overhead	*)
+	(* a little by leaving group^.currentVS until last.		*)
+
+	WITH group^ DO
+	    WHILE currentVS <> NIL DO
+		RemoveVirtualScreen (currentVS^.next);
+	    END (*WHILE*);
+	END (*WITH*);
+
+	(* Detach this group from the circular list of all groups.	*)
+
+	Wait (guard);
+	IF ActiveGroup = group THEN
+	    StepToNextGroup;
+	END (*IF*);
+	WITH group^ DO
+	    previous^.next := next;
+	    next^.previous := previous;
+	END (*WITH*);
+	Signal (guard);
+
+	DISPOSE (group);
+
+    END RemoveScreenGroup;
+
+(************************************************************************)
+(*			   MODULE INITIALISATION			*)
+(************************************************************************)
+
+VAR p: DisplayPage;
+
+BEGIN
+    (* There are initially no virtual screens.	*)
+
+    FOR p := 0 TO MAX(DisplayPage) DO
+	Occupant[p] := NIL;
+    END (*FOR*);
+
+    (* Create the global semaphores.	*)
+
+    CreateSemaphore (wakeup1, 0);
+    CreateSemaphore (wakeup2, 0);
+    CreateSemaphore (guard, 1);
+
+    (* Create the initial list of groups: a circular list with one	*)
+    (* element, that element being the special sentinel which refers to	*)
+    (* normal screen output rather than one of the created groups.	*)
+
+    Wait (guard);
+    NEW (ActiveGroup);
+    WITH ActiveGroup^ DO
+	previous := ActiveGroup;  next := ActiveGroup;
+	preVS := NIL;  currentVS := NIL;  page := 0;
+    END (*WITH*);
+    NormalOutput := ActiveGroup;
+    Signal (guard);
+
+    (* Create the "hot key" tasks, and enable the hot keys.	*)
+
+    HotKey (FALSE, CtrlP, wakeup1);
+    CreateTask (HotKeyHandler1, 9, "^P hot key");
+    HotKey (TRUE, F6, wakeup2);
+    CreateTask (HotKeyHandler2, 9, "F6 hot key");
+
+END MultiScreen.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/music.def b/examples/Modula-2_Libraries/PMOS/sources/general/music.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/music.def
@@ -0,0 +1,64 @@
+DEFINITION MODULE Music;
+
+	(********************************************************)
+	(*							*)
+	(*		Module to play music.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	28 May 1989			*)
+	(*  Status:						*)
+	(*	Initial version working well.  Still testing.	*)
+	(*							*)
+	(********************************************************)
+
+PROCEDURE SetNoteDuration (D: CARDINAL);
+
+    (* Sets the duration of each of the following notes, until further	*)
+    (* notice, to D milliseconds.  The precision of this setting is	*)
+    (* limited by the clock interrupt frequency used in module Timer;	*)
+    (* the resolution can be as poor as 1/9 second.  The duration can	*)
+    (* subsequently be modified by the * and / options (see below), or	*)
+    (* by another call to SetNoteDuration.				*)
+
+PROCEDURE PlayMusic (notes: ARRAY OF CHAR);
+
+    (* Plays the tune specified in array "notes".  The playing is done	*)
+    (* asynchronously; that is, this procedure returns before the music	*)
+    (* is over.  However, a return from this procedure does imply that	*)
+    (* array "notes" can be re-used or destroyed; the notes might not	*)
+    (* yet have been played, but the data necessary to play them have	*)
+    (* been processed and the necessary information stored.		*)
+
+PROCEDURE WaitForMusicFinished;
+
+    (* Blocks the calling task until there is no more music playing.	*)
+    (* This is a guard against things like premature task termination.	*)
+
+(************************************************************************)
+(*									*)
+(*  In the "notes" argument to PlayMusic, the following options are	*)
+(*  accepted:								*)
+(*	C D E F G A B	the usual notation for a note.			*)
+(*	b #		flat or sharp, modifying the previously given	*)
+(*			 note.  There is no legality checking; for	*)
+(*			 example, B# is illegal but the software does	*)
+(*			 check for this.				*)
+(*	R		a rest.						*)
+(*	*		double the duration of the following notes.	*)
+(*	/		halve the duration of the following notes.	*)
+(*	3		divide the duration of the following notes	*)
+(*			 by 3.  The *, /, and 3 options take effect for	*)
+(*			 all following notes, until the duration is	*)
+(*			 modified again by one of these options or by	*)
+(*			 an explicit call to SetNoteDuration.		*)
+(*	u		go up one octave.				*)
+(*	d		go down one octave.  In many cases the u and d	*)
+(*			 options are not needed because PlayMusic	*)
+(*			 chooses the appropriate octave based on the	*)
+(*			 assumption that successive notes will be	*)
+(*			 close to each other; but u and d can override	*)
+(*			 this assumption.				*)
+(*									*)
+(************************************************************************)
+
+END Music.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/music.mod b/examples/Modula-2_Libraries/PMOS/sources/general/music.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/music.mod
@@ -0,0 +1,323 @@
+IMPLEMENTATION MODULE Music;
+
+	(********************************************************)
+	(*							*)
+	(*		Module to play music.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	26 July 1994			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+IMPORT Keyboard;		(* To enable Ctrl/Alt/Del detection *)
+
+FROM SoundEffects IMPORT
+    (* type *)	Note,
+    (* proc *)	Play;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+(************************************************************************)
+
+CONST
+    Rest = 1;			(* code for no sound *)
+    irrelevantnote = 12;	(* used when remembering last note	*)
+
+TYPE
+    buffersubscript = [0..10];
+    ZeroToEleven = [0..11];
+    Octave = [0..8];
+    buffernumber = [0..1];
+
+VAR
+    (* CurrentDuration and CurrentOctave are the current duration of a	*)
+    (* note and the octave in which we are playing, respectively.	*)
+
+    CurrentDuration: CARDINAL;
+    CurrentOctave: Octave;
+
+    (* NoteTable performs the mapping C -> 0, D -> 2, E -> 4, F -> 5,	*)
+    (* etc.  The gaps in this sequence are accounted for by sharps and	*)
+    (* flats, which are handled elsewhere.				*)
+
+    NoteTable: ARRAY ["A".."G"] OF ZeroToEleven;
+
+    (* LastNote is either the ZeroToEleven code for the last note	*)
+    (* played, or it has the special value "irrelevantnote".  It is	*)
+    (* used when deciding when to change octaves.			*)
+
+    LastNote: CARDINAL;
+
+    (* PeriodTable converts the ZeroToEleven note code into a period	*)
+    (* code as required by module SoundEffects.				*)
+
+    PeriodTable: ARRAY ZeroToEleven OF CARDINAL;
+
+    (* The arrays buffer[0] and buffer[1] each hold data to be send to	*)
+    (* module SoundEffects.  We use them alternately, so that one can	*)
+    (* be filling up while the other is being emptied.  This frees the	*)
+    (* caller from having to worry about synchronisation problems, and	*)
+    (* lets the caller stay far enough ahead of the actual playing to	*)
+    (* make it unlikely that there will be gaps in the sound output due	*)
+    (* to delays in the caller task.					*)
+    (* We have to make the buffers global, even though they are used by	*)
+    (* only one procedure in this module, because they remain in use	*)
+    (* between calls to PlayMusic.					*)
+
+    buffer: ARRAY buffernumber OF ARRAY buffersubscript OF Note;
+
+    (* Variable currentbuffer keeps track of whether we are currently	*)
+    (* putting data in buffer[0] or buffer[1].				*)
+
+    currentbuffer: buffernumber;
+
+    (* FreeBuffer is a counting semaphore, which keeps track of how	*)
+    (* many empty output buffers are currently available.		*)
+
+    FreeBuffer: Semaphore;
+
+(************************************************************************)
+
+PROCEDURE SetNoteDuration (D: CARDINAL);
+
+    (* Sets the duration of each of the following notes, until further	*)
+    (* notice, to D milliseconds.  The precision of this setting is	*)
+    (* limited by the clock interrupt frequency used in module Timer;	*)
+    (* the resolution can be as poor as 1/9 second.  The duration can	*)
+    (* subsequently be modified by the * and / options (see PlayMusic),	*)
+    (* or by another call to SetNoteDuration.				*)
+
+    BEGIN
+	CurrentDuration := D;
+    END SetNoteDuration;
+
+(************************************************************************)
+
+PROCEDURE Translate (VAR (*IN*) notes: ARRAY OF CHAR;
+			VAR (*INOUT*) place: CARDINAL;
+			VAR (*OUT*) period: CARDINAL);
+
+    (* Translates a note code in the conventional notation (C,D,etc.),	*)
+    (* as stored in notes[place], into the numeric period code expected	*)
+    (* by module SoundEffects.  Parameter place is updated, so that on	*)
+    (* return notes[place] is the first character not processed by this	*)
+    (* procedure.							*)
+
+    VAR note: ZeroToEleven;
+	j: Octave;
+
+    BEGIN
+	IF notes[place] = "R" THEN
+	    period := Rest;  INC (place);
+	ELSE
+	    note := NoteTable[notes[place]];
+	    INC (place);
+	    IF place <= HIGH(notes) THEN
+
+		(* Check for sharp or flat. *)
+
+		IF notes[place] = "#" THEN
+	    	    INC(note);  INC(place);
+		ELSIF notes[place] = "b" THEN
+	    	    DEC(note);  INC(place);
+		END (*IF*);
+
+	    END (*IF*);
+
+	    (* We now have the note in the form of a ZeroToEleven code,	*)
+	    (* but we still have to decide the octave.  The criterion	*)
+	    (* we use is to minimise the distance from the last note	*)
+	    (* played.  This can be overridden by the "u" and "d" codes.*)
+
+	    IF LastNote <> irrelevantnote THEN
+		IF INTEGER(note)-INTEGER(LastNote) > 6 THEN
+		    IF CurrentOctave > 0 THEN DEC(CurrentOctave) END(*IF*);
+		ELSIF INTEGER(LastNote) - INTEGER(note) > 6 THEN
+		    IF CurrentOctave < MAX(Octave) THEN
+			INC(CurrentOctave)
+		    END (*IF*);
+		END (*IF*);
+	    END (*IF*);
+	    LastNote := note;
+	    period := PeriodTable[note];
+	    FOR j := 1 TO CurrentOctave DO
+		period := period DIV 2;
+	    END (*FOR*);
+	END (*IF*);
+    END Translate;
+
+(************************************************************************)
+
+PROCEDURE PlayMusic (notes: ARRAY OF CHAR);
+
+    (* Plays the tune specified in array "notes".  The playing is done	*)
+    (* asynchronously; that is, this procedure returns before the music	*)
+    (* is over.  However, a return from this procedure does imply that	*)
+    (* array "notes" can be re-used or destroyed; the notes might not	*)
+    (* yet have been played, but the data necessary to play them have	*)
+    (* been processed and the necessary information stored.		*)
+
+    VAR	inplace: CARDINAL;  outplace: buffersubscript;
+
+    BEGIN
+	inplace := 0;
+
+	(* On entry to this procedure, currentbuffer is the number of	*)
+	(* the last buffer which was last sent to procedure Play.  The	*)
+	(* Wait(FreeBuffer) which we are about to execute is, because	*)
+	(* we are using a double-buffered approach, a wait for the	*)
+	(* second-last buffer which was sent to Play.  After the Wait,	*)
+	(* we can be sure that that alternate buffer is available.	*)
+
+	Wait (FreeBuffer);
+	currentbuffer := 1 - currentbuffer;  outplace := 0;
+
+	(* The following loop translates from letter codes in array	*)
+	(* "notes" to numeric codes in array buffer[currentbuffer],	*)
+	(* calling SoundEffects.Play each time the output buffer fills	*)
+	(* up.  At such times, we switch to the other buffer (after	*)
+	(* waiting for it to be emptied).				*)
+
+	REPEAT
+
+	    IF notes[inplace] = " " THEN INC(inplace)	(* ignore spaces *)
+
+	    (* Check for duration changes.	*)
+
+	    ELSIF notes[inplace] = "*" THEN
+		CurrentDuration := 2*CurrentDuration;  INC(inplace);
+	    ELSIF notes[inplace] = "3" THEN
+		CurrentDuration := CurrentDuration DIV 3;  INC(inplace);
+	    ELSIF notes[inplace] = "/" THEN
+		CurrentDuration := CurrentDuration DIV 2;  INC(inplace);
+
+	    (* Check for octave changes.	*)
+
+	    ELSIF notes[inplace] = "u" THEN
+		IF CurrentOctave < MAX(Octave) THEN
+		    INC(CurrentOctave);
+		END (*IF*);
+		INC (inplace);
+	    ELSIF notes[inplace] = "d" THEN
+		IF CurrentOctave > 0 THEN DEC(CurrentOctave) END(*IF*);
+		INC (inplace);
+	    ELSE
+
+		(* We have a note to play.			*)
+		(* N.B. procedure Translate updates inplace.	*)
+
+		Translate (notes, inplace,
+				buffer[currentbuffer][outplace].period);
+		buffer[currentbuffer][outplace].duration := CurrentDuration;
+
+		IF outplace = HIGH(buffer[currentbuffer]) THEN
+
+		    (* The current buffer is full, so send that batch	*)
+		    (* of data to procedure Play.			*)
+
+		    Play (buffer[currentbuffer], FreeBuffer);
+
+		    (* Wait, if necessary, for the other buffer to	*)
+		    (* become available, and switch to using it.	*)
+
+		    Wait (FreeBuffer);
+		    currentbuffer := 1 - currentbuffer;  outplace := 0;
+
+		ELSE
+		    INC (outplace);
+		END (*IF*);
+
+	    END (*IF*);
+	UNTIL (inplace > HIGH(notes)) OR (notes[inplace] = CHR(0));
+
+	(* On exit from the above loop, we still have a partially	*)
+	(* filled final buffer to send to Play.  There is a special	*)
+	(* case where the "partially filled buffer" is in fact empty,	*)
+	(* but Play can handle that case.				*)
+
+	buffer[currentbuffer][outplace].duration := 0;(* to mark end of data*)
+	Play (buffer[currentbuffer], FreeBuffer);
+
+    END PlayMusic;
+
+(************************************************************************)
+
+PROCEDURE WaitForMusicFinished;
+
+    (* Blocks the calling task until there is no more music playing.	*)
+    (* This is a guard against things like premature task termination.	*)
+
+    BEGIN
+
+	(* Put in a claim for both of the output buffers, i.e. wait	*)
+	(* until they are both unused.					*)
+
+	Wait (FreeBuffer);  Wait (FreeBuffer);
+
+	(* Now release them, because we didn't really want to use them.	*)
+
+	Signal (FreeBuffer);  Signal (FreeBuffer);
+
+    END WaitForMusicFinished;
+
+(************************************************************************)
+(*			MODULE INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE Initialise;
+
+    (* Sets the initial duration and octave, and sets up the tables	*)
+    (* for translating from music notation to duration codes.		*)
+
+    CONST scale = 0.943874313;		(*  2^(-1/12)	*)
+
+    VAR period: REAL;  j: ZeroToEleven;
+
+    BEGIN
+	CurrentDuration := 3;  CurrentOctave := 4;
+	LastNote := irrelevantnote;
+
+	(* NoteTable translates from letter codes into a numeric code	*)
+	(* consistent with a well-tempered tuning.			*)
+
+	NoteTable["C"] := 0;  NoteTable["D"] := 2;
+	NoteTable["E"] := 4;  NoteTable["F"] := 5;
+	NoteTable["G"] := 7;  NoteTable["A"] := 9;
+	NoteTable["B"] := 11;
+
+	(* For PeriodTable, we give the lowest (octave 0) C a frequency	*)
+	(* which is the lowest frequency which can be handled, and then	*)
+	(* derive all other frequencies by successive scaling by the	*)
+	(* twelfth root of 2.  Our base frequency is about one note out	*)
+	(* when compared with the standard A4 = 440Hz tuning, but in	*)
+	(* this version I take that as an acceptable imperfection.	*)
+	(* To repair this flaw, we would have to take into account the	*)
+	(* fact that C in octave 0 cannot be played, which suggests	*)
+	(* that an improved version of this module would need to be	*)
+	(* "tuned" to a key other than C major.				*)
+
+	period := 65535.0;
+	PeriodTable[0] := 65535;
+	FOR j := 1 TO 11 DO
+	    period := scale*period;
+	    PeriodTable[j] := TRUNC(period + 0.5);
+	END (*FOR*);
+
+	(* We initially have two empty output buffers, so initialise	*)
+	(* semaphore FreeBuffer to record this fact; and arbitrarily	*)
+	(* choose one of the buffers as the initially active buffer.	*)
+
+	CreateSemaphore (FreeBuffer, 2);
+	currentbuffer := 0;
+
+    END Initialise;
+
+(************************************************************************)
+
+BEGIN
+    Initialise;
+END Music.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/music3.def b/examples/Modula-2_Libraries/PMOS/sources/general/music3.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/music3.def
@@ -0,0 +1,89 @@
+DEFINITION MODULE Music3;
+
+	(********************************************************)
+	(*							*)
+	(*		Translates 3-part music from		*)
+	(*		musical notation to the form		*)
+	(*		expected by module Play3C.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+TYPE
+    VoiceNumber = [1..3];
+    WaveformNumber = [0..7];
+
+(************************************************************************)
+(*									*)
+(*  In the "notes" argument to each of the next three procedures,	*)
+(*  the following options are accepted:					*)
+(*	C D E F G A B	the usual notation for a note.			*)
+(*	b #		flat or sharp, modifying the previously given	*)
+(*			 note.  There is no legality checking; for	*)
+(*			 example, B# is illegal but the software does	*)
+(*			 check for this.				*)
+(*	R		a rest.						*)
+(*	*n   (n=0..9)	multiply the duration of the following notes	*)
+(*			 by n.						*)
+(*	*		a shorthand notation for *2.			*)
+(*	/n   (n=0..9)	divide the duration of the following notes	*)
+(*			 by n.						*)
+(*	/		a shorthand notation for /2.			*)
+(*	3		a shorthand notation for /3.			*)
+(*			The *, /, and 3 options take effect for		*)
+(*			 all following notes, until the duration is	*)
+(*			 modified again by one of these options.	*)
+(*	u		go up one octave.				*)
+(*	d		go down one octave.  In many cases the u and d	*)
+(*			 options are not needed because this module	*)
+(*			 chooses the appropriate octave based on the	*)
+(*			 assumption that successive notes will be	*)
+(*			 close to each other; but u and d can override	*)
+(*			 this assumption.				*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE Voice1 (notes: ARRAY OF CHAR);
+PROCEDURE Voice2 (notes: ARRAY OF CHAR);
+PROCEDURE Voice3 (notes: ARRAY OF CHAR);
+
+    (* Appends more notes to the music array kept internally by this	*)
+    (* module.  Initially the array is empty.  The three voices can be	*)
+    (* added in any order.						*)
+
+PROCEDURE EnableVoice (V: VoiceNumber;  enable: BOOLEAN);
+
+    (* If enable is FALSE then the following data for voice V are	*)
+    (* ignored.  (This is for testing, when you want to suppress a	*)
+    (* voice in order to listen to the others more closely.)  The	*)
+    (* default condition is that all voices are enabled.		*)
+
+PROCEDURE SetWaveform (V: VoiceNumber;  N: WaveformNumber);
+
+    (* Changes the waveform for voice V. *)
+
+PROCEDURE SetEnvelope (V: VoiceNumber;  attack, decay, sustain: CARDINAL);
+
+    (* Use this to simulate different instruments.  Parameters attack	*)
+    (* and decay are in effect rates of change.  The sustain parameter	*)
+    (* is a steady-state amplitude (range [0..65535]) after the		*)
+    (* "decay" phase.							*)
+
+PROCEDURE SetInstrument (N: WaveformNumber;
+				attack, decay, sustain: CARDINAL);
+
+    (* Like SetEnvelope and SetWaveform, but affects all voices. *)
+
+PROCEDURE SetDuration (value: CARDINAL);
+
+    (* Sets the duration for the following notes (all voices).	*)
+
+PROCEDURE PlayTheMusic;
+
+    (* Plays the music that has been stored so far. *)
+
+END Music3.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/music3.mod b/examples/Modula-2_Libraries/PMOS/sources/general/music3.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/music3.mod
@@ -0,0 +1,656 @@
+IMPLEMENTATION MODULE Music3;
+
+	(********************************************************)
+	(*							*)
+	(*		Translates 3-part music from		*)
+	(*		musical notation to the form		*)
+	(*		expected by module Play3B.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan, T Channon		*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Changes:            Signed wavetables.		*)
+	(*                      Precomputed amplitudes		*)
+	(*                      Precomputed envelopes		*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	This version is TC's version of Midsummer's	*)
+	(*	Day (i.e. the winter solstice), with some	*)
+	(*	modifications by PJM.				*)
+	(*							*)
+	(*	Latest modifications:				*)
+	(*	    Precomputed scaling factors			*)
+	(*	    Slight change in the way gains are		*)
+	(*		calculated				*)
+	(*	    Integer rather than shortint wave tables	*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(*			IMPLEMENTATION NOTES				*)
+(*									*)
+(* The work done by this module falls into two distinct phases.  In the	*)
+(* first phase we are receiving data, in more-or-less standard musical	*)
+(* notation, from the caller for the three voices separately.  We do	*)
+(* a little processing of this data, to simplify the job of the second	*)
+(* phase, but basically we are just storing the caller's data in three	*)
+(* big arrays.  The amount of pre-processing we can do is limited by	*)
+(* the fact that full processing (to produce a result in the form of an	*)
+(* actual waveform) would require arrays that would overflow the	*)
+(* 64 Kbyte segment size limit.						*)
+(*									*)
+(* The second phase starts when procedure PlayTheMusic is called.  We	*)
+(* handle this in the separate module Play3B.				*)
+(*									*)
+(************************************************************************)
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+
+FROM Play3 IMPORT
+    (* const*)	CycleCount,
+    (* type *)	WaveNumber, EnvelopeNumber, EnvelopePtr,
+		EnvelopeArrayIndex, GainType, WaveGroup,
+    (* proc *)	DefineWaveform, DefineEnvelope, Play;
+
+FROM MATHLIB IMPORT
+    (* proc *)	Sin;
+
+(************************************************************************)
+
+CONST
+    (* The constant LowestInterval is a scaling factor for note		*)
+    (* frequencies.  In the present we've set it rather arbitrarily.	*)
+    (* It could be adjusted more precisely to give an A440 tuning or	*)
+    (* similar, but so far I haven't done the necessary calculations.	*)
+
+    LowestInterval = 4.375*LONGREAL(CycleCount);
+
+    irrelevantnote = 0;		(* used when remembering last note	*)
+    DefaultDuration = 200;
+
+TYPE
+    ZeroToTwelve = SHORTCARD [0..12];
+    Octave = SHORTCARD [0..8];
+    Note = SHORTCARD [0..63];
+    CodeSubscript = [0..4000];
+
+VAR
+
+    (* Waveform tables. *)
+
+    Wave: ARRAY WaveNumber OF WaveGroup;
+
+    (* NoteToIntervalMap takes a note code and translates it to the	*)
+    (* step amount to be used in stepping through a WaveForm array.	*)
+
+    NoteToIntervalMap: ARRAY Note OF CARDINAL;
+
+    (* NoteTable performs the mapping C -> 1, D -> 3, E -> 5, F -> 6,	*)
+    (* etc.  The gaps in this sequence are accounted for by sharps and	*)
+    (* flats, which are handled elsewhere.				*)
+
+    NoteTable: ARRAY ["A".."G"] OF ZeroToTwelve;
+
+    (* We define a number of different attack/decay envelopes.		*)
+
+    EnvelopeData: ARRAY EnvelopeNumber OF
+		    RECORD
+			Attack, Decay, Sustain: CARDINAL;
+			shapeptr: EnvelopePtr;
+		    END (*RECORD*);
+
+    (* VoiceData keeps information about where we are up to in the	*)
+    (* translation of each voice.  It is needed because the caller	*)
+    (* is allowed to specify a few notes for one voice, then a few	*)
+    (* notes for a second voice, and then perhaps to switch back to	*)
+    (* the first voice, etc.						*)
+
+    VoiceData: ARRAY VoiceNumber OF
+		    RECORD
+			position: CARDINAL;
+			LastDuration, NextDuration: CARDINAL;
+			CurrentOctave: Octave;
+			LastNote: ZeroToTwelve;
+			Enabled: BOOLEAN;
+			Code: ARRAY CodeSubscript OF CARDINAL;
+		    END (*RECORD*);
+
+(************************************************************************)
+(*			APPENDING DATA TO THE BUFFERS			*)
+(************************************************************************)
+
+PROCEDURE DurationSetting (V: VoiceNumber;  newduration: CARDINAL);
+
+    (* Sets a new absolute duration for voice V.  *)
+
+    BEGIN
+	WITH VoiceData[V] DO
+	    Code[position] := 65534;  INC (position);
+	    Code[position] := newduration;  INC (position);
+	    LastDuration := newduration;
+	    NextDuration := newduration;
+	END (*WITH*);
+    END DurationSetting;
+
+(************************************************************************)
+
+PROCEDURE AddNote (V: VoiceNumber;  note: Note;  duration: CARDINAL);
+
+    (* Appends a new note to the stored data for voice V.	*)
+
+    BEGIN
+	WITH VoiceData[V] DO
+	    IF duration <> LastDuration THEN
+		DurationSetting (V, duration);
+	    END (*IF*);
+	    Code[position] := NoteToIntervalMap[note];
+	    INC (position);
+	END (*WITH*);
+    END AddNote;
+
+(************************************************************************)
+(*			INTERPRETING MUSICAL NOTATION			*)
+(************************************************************************)
+
+PROCEDURE Translate (VAR (*IN*) notes: ARRAY OF CHAR;
+			VAR (*INOUT*) place: CARDINAL): ZeroToTwelve;
+
+    (* Translates a note code in the conventional notation (C,D,etc.),	*)
+    (* as stored in notes[place], into the numeric code expected by	*)
+    (* module Play3.  Parameter place is updated, so that on return	*)
+    (* notes[place] is the first character not yet processed.		*)
+
+    VAR result: ZeroToTwelve;
+
+    BEGIN
+	IF notes[place] = "R" THEN
+	    result := 0;  INC (place);
+	ELSE
+	    result := NoteTable[notes[place]];
+	    INC (place);
+	    IF place <= HIGH(notes) THEN
+
+		(* Check for sharp or flat. *)
+
+		IF notes[place] = "#" THEN
+	    	    INC(result);  INC(place);
+		ELSIF notes[place] = "b" THEN
+	    	    DEC(result);  INC(place);
+		END (*IF*);
+
+	    END (*IF*);
+	END (*IF*);
+
+	RETURN result;
+
+    END Translate;
+
+(************************************************************************)
+
+PROCEDURE Convert (voice: VoiceNumber;  notes: ARRAY OF CHAR);
+
+    (* Converts the notes specified in array "notes".  The result is	*)
+    (* appended to the global coded note data.				*)
+
+    TYPE CharSet = SET OF CHAR;
+
+    CONST Digits = CharSet {'0'..'9'};
+
+    VAR	inplace: CARDINAL;
+	CurrentDuration, factor: CARDINAL;
+	CurrentOctave: Octave;
+	note, LastNote: Note;
+
+    BEGIN
+	CurrentDuration := VoiceData[voice].NextDuration;
+	CurrentOctave := VoiceData[voice].CurrentOctave;
+	LastNote := VoiceData[voice].LastNote;
+
+	inplace := 0;
+
+	(* The following loop translates from letter codes in array	*)
+	(* "notes" to numeric codes in array VoiceData[voice].Code.	*)
+
+	REPEAT
+
+	    IF notes[inplace] = " " THEN INC(inplace)	(* ignore spaces *)
+
+	    (* Check for duration changes.	*)
+
+	    ELSIF notes[inplace] = "*" THEN
+		INC(inplace);
+		factor := 2;
+		IF notes[inplace] IN Digits THEN
+		    factor := ORD(notes[inplace]) - ORD("0");
+		    INC (inplace);
+		END (*IF*);
+		CurrentDuration := CurrentDuration*factor;
+	    ELSIF notes[inplace] = "/" THEN
+		INC(inplace);
+		factor := 2;
+		IF notes[inplace] IN Digits THEN
+		    factor := ORD(notes[inplace]) - ORD("0");
+		    INC (inplace);
+		END (*IF*);
+		CurrentDuration := CurrentDuration DIV factor;
+	    ELSIF notes[inplace] = "3" THEN
+		CurrentDuration := CurrentDuration DIV 3;
+		INC(inplace);
+
+	    (* Check for octave changes.	*)
+
+	    ELSIF notes[inplace] = "u" THEN
+		IF CurrentOctave < MAX(Octave) THEN
+		    INC(CurrentOctave);
+		END (*IF*);
+		INC (inplace);
+	    ELSIF notes[inplace] = "d" THEN
+		IF CurrentOctave > 0 THEN DEC(CurrentOctave) END(*IF*);
+		INC (inplace);
+	    ELSE
+
+		(* We have a note to translate.			*)
+		(* N.B. procedure Translate updates inplace.	*)
+
+		note := Translate (notes, inplace);
+
+		IF note = 0 THEN
+		    AddNote (voice, 0, CurrentDuration);
+		ELSE
+
+		    (* We now have the note in the form of a		*)
+		    (* ZeroToTwelve code, but we still have to decide	*)
+		    (* the octave.  The criterion we use is to minimise	*)
+		    (* the distance from the last note played.  This	*)
+		    (* can be overridden by the "u" and "d" codes.	*)
+
+		    IF LastNote <> irrelevantnote THEN
+			IF INTEGER(note)-INTEGER(LastNote) > 6 THEN
+			    IF CurrentOctave > 0 THEN
+				DEC(CurrentOctave);
+			    END(*IF*);
+			ELSIF INTEGER(LastNote) - INTEGER(note) > 6 THEN
+			    IF CurrentOctave < MAX(Octave) THEN
+				INC(CurrentOctave)
+			    END (*IF*);
+			END (*IF*);
+		    END (*IF*);
+		    LastNote := note;
+		    AddNote (voice, VAL(Note, 12*CurrentOctave + note),
+						CurrentDuration);
+		END (*IF*);
+
+	    END (*IF*);
+
+	UNTIL (inplace > HIGH(notes)) OR (notes[inplace] = CHR(0));
+
+	VoiceData[voice].NextDuration := CurrentDuration;
+	VoiceData[voice].CurrentOctave := CurrentOctave;
+	VoiceData[voice].LastNote := LastNote;
+
+    END Convert;
+
+(************************************************************************)
+
+PROCEDURE Voice1 (notes: ARRAY OF CHAR);
+
+    (* Appends more notes to Voice #1. *)
+
+    BEGIN
+	IF VoiceData[1].Enabled THEN
+	    Convert (1, notes);
+	END (*IF*);
+    END Voice1;
+
+(************************************************************************)
+
+PROCEDURE Voice2 (notes: ARRAY OF CHAR);
+
+    (* Appends more notes to Voice #2. *)
+
+    BEGIN
+	IF VoiceData[2].Enabled THEN
+	    Convert (2, notes);
+	END (*IF*);
+    END Voice2;
+
+(************************************************************************)
+
+PROCEDURE Voice3 (notes: ARRAY OF CHAR);
+
+    (* Appends more notes to Voice #3. *)
+
+    BEGIN
+	IF VoiceData[3].Enabled THEN
+	    Convert (3, notes);
+	END (*IF*);
+    END Voice3;
+
+(************************************************************************)
+
+PROCEDURE EnableVoice (V: VoiceNumber;  enable: BOOLEAN);
+
+    (* If enable is FALSE then the following data for voice V are	*)
+    (* ignored.  (This is for testing, when you want to suppress a	*)
+    (* voice in order to listen to the others more closely.)  The	*)
+    (* default condition is that all voices are enabled.		*)
+
+    BEGIN
+	VoiceData[V].Enabled := enable;
+    END EnableVoice;
+
+(************************************************************************)
+
+PROCEDURE SetWaveform (V: VoiceNumber;  N: WaveformNumber);
+
+    (* Changes the waveform for voice V. *)
+
+    BEGIN
+	WITH VoiceData[V] DO
+	    Code[position] := 65532;  INC (position);
+	    Code[position] := N;  INC (position);
+	END (*WITH*);
+    END SetWaveform;
+
+(************************************************************************)
+(*			ENVELOPE CALCULATIONS				*)
+(************************************************************************)
+
+PROCEDURE EnvelopeModel0 (p: EnvelopePtr;  Attack, Decay, Sustain: LONGREAL);
+
+    (* Calculates the envelope array using an attack/decay/sustain model.*)
+
+    CONST scaletogain = LONGREAL(MAX(GainType));
+
+    VAR level: LONGREAL;
+	phase: [0..1];  j: EnvelopeArrayIndex;
+
+    BEGIN
+	Decay := 1.0 - Decay;
+	phase := 0;  level := 0.0;
+	FOR j := 0 TO MAX(EnvelopeArrayIndex) DO
+	    IF phase = 0 THEN
+
+		(* Attack phase: ramp up linearly to maximum. *)
+
+		level := level + Attack;
+		IF level > 1.0 THEN
+		    level := 1.0;  INC(phase);
+		END(*IF*);
+
+	    ELSE
+
+		(* Decay phase: we're using an exponential decay. *)
+
+		level := Sustain + Decay*(level - Sustain);
+
+	    END (*IF*);
+
+	    p^[j] := VAL(GainType, scaletogain*level);
+
+	END (*FOR*);
+
+    END EnvelopeModel0;
+
+(************************************************************************)
+
+PROCEDURE CreateEnvelope (attack, decay, sustain: CARDINAL): EnvelopeNumber;
+
+    (* Returns the envelope number corresponding to the parameters, if	*)
+    (* such an envelope already exists; or creates a new envelope and	*)
+    (* returns its number.						*)
+
+    CONST scale = 1.0/LONGREAL(MAX(CARDINAL));
+
+    VAR E: EnvelopeNumber;
+
+    (********************************************************************)
+
+    PROCEDURE Match (E: EnvelopeNumber;
+			attack, decay, sustain: CARDINAL): BOOLEAN;
+
+	(* Returns TRUE iff envelope number E matches the parameters.	*)
+
+	BEGIN
+	    WITH EnvelopeData[E] DO
+		RETURN (Attack = attack) AND (Decay = decay)
+			AND (Sustain = sustain);
+	    END (*WITH*);
+	END Match;
+
+    (********************************************************************)
+
+    BEGIN
+	E := 0;
+	LOOP
+	    IF EnvelopeData[E].shapeptr = NIL THEN EXIT(*LOOP*)
+	    ELSIF Match (E, attack, decay, sustain) THEN RETURN E
+	    ELSIF E < MAX(EnvelopeNumber) THEN INC(E)
+	    ELSE
+		(* We've run out of envelopes, steam an old one open.	*)
+		DISPOSE(EnvelopeData[E].shapeptr);
+		EXIT(*LOOP*);
+	    END(*IF*);
+	END (*LOOP*);
+
+	(* If we reach this point, then we haven't found a match with	*)
+	(* an existing envelope and have to create a new one.		*)
+
+	(* This section is still experimental. *)
+
+	WITH EnvelopeData[E] DO
+	    Attack := attack;  Decay := decay;  Sustain := sustain;
+	    NEW (shapeptr);
+	    EnvelopeModel0 (shapeptr, scale*LONGREAL(attack),
+			scale*LONGREAL(decay), scale*LONGREAL(sustain));
+	    DefineEnvelope (E, shapeptr);
+	END (*WITH*);
+	RETURN E;
+
+    END CreateEnvelope;
+
+(************************************************************************)
+
+PROCEDURE SetEnvelope (V: VoiceNumber;  attack, decay, sustain: CARDINAL);
+
+    (* Use this to simulate different instruments.  Parameters attack	*)
+    (* and decay are in effect rates of change.  The sustain parameter	*)
+    (* is a steady-state amplitude (range [0..65535]) after the		*)
+    (* "decay" phase.							*)
+
+    VAR E: EnvelopeNumber;
+
+    BEGIN
+	E := CreateEnvelope (attack, decay, sustain);
+	WITH VoiceData[V] DO
+	    Code[position] := 65531;  INC (position);
+	    Code[position] := E;  INC (position);
+	END (*WITH*);
+    END SetEnvelope;
+
+(************************************************************************)
+
+PROCEDURE SetInstrument (N: WaveformNumber;
+				attack, decay, sustain: CARDINAL);
+
+    (* Like SetEnvelope and SetWaveform, but affects all voices. *)
+
+    VAR V: VoiceNumber;
+
+    BEGIN
+	FOR V := 1 TO MAX(VoiceNumber) DO
+	    SetWaveform (V, N);
+	    SetEnvelope (V, attack, decay, sustain);
+	END (*FOR*);
+    END SetInstrument;
+
+(************************************************************************)
+
+PROCEDURE SetDuration (value: CARDINAL);
+
+    (* Sets the duration for the following notes (all voices).	*)
+
+    VAR V: VoiceNumber;
+
+    BEGIN
+	FOR V := 1 TO MAX(VoiceNumber) DO
+	    DurationSetting (V, value);
+	END (*FOR*);
+    END SetDuration;
+
+(************************************************************************)
+
+PROCEDURE PlayTheMusic;
+
+    (* Plays the music that has been stored so far. *)
+
+    VAR V: VoiceNumber;
+
+    BEGIN
+	FOR V := 1 TO MAX(VoiceNumber) DO
+	    WITH VoiceData[V] DO
+		Code[position] := 65535;
+	    END (*WITH*);
+	END (*FOR*);
+	Play (VoiceData[1].Code, VoiceData[2].Code, VoiceData[3].Code);
+    END PlayTheMusic;
+
+(************************************************************************)
+(*			MODULE INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE Initialise;
+
+    (* Sets the initial duration and octave, and sets up the tables	*)
+    (* for translating from music notation to the output codes.		*)
+
+    CONST
+	PI = 3.141592653589793240;
+	freqstep = 1.057298094605;	(* 2^(1/12) *)
+	offset = LONGREAL(128*CycleCount-1) / 3.0;
+	bound = 2.0*offset;		(* limit on peak-to-peak value	*)
+
+    VAR step, scale: LONGREAL;
+	j, break: SHORTCARD;  note: Note;
+	voice: VoiceNumber;  w: WaveNumber;  E: EnvelopeNumber;
+	Gain: ARRAY GainType OF LONGREAL;
+	g: GainType;
+
+    (********************************************************************)
+
+    PROCEDURE WaveValue (w: WaveNumber;  pos: BYTE;  val: LONGREAL);
+
+	(* Is passed the value for maximum sound, fills in the tables	*)
+	(* with all the scaled values.					*)
+
+	VAR g: GainType;
+
+	BEGIN
+	    FOR g := 0 TO MAX(GainType) DO
+		Wave[w][g]^[pos] := VAL(INTEGER, val*Gain[g]);
+	    END;
+	END WaveValue;
+
+    (********************************************************************)
+
+    BEGIN
+
+	FOR g := 0 TO MAX(GainType) DO
+	    Gain[g] := LONGREAL(g)/LONGREAL(MAX(GainType));
+	    FOR w := 0 TO HIGH(Wave) DO
+		NEW (Wave[w][g]);
+	    END (*FOR*);
+	END (*FOR*);
+
+	(* NoteTable translates from letter codes into a numeric code	*)
+	(* consistent with a well-tempered tuning.			*)
+
+	NoteTable["C"] := 1;  NoteTable["D"] := 3;
+	NoteTable["E"] := 5;  NoteTable["F"] := 6;
+	NoteTable["G"] := 8;  NoteTable["A"] := 10;
+	NoteTable["B"] := 12;
+
+	(* Create the note-to-interval map. *)
+
+	step := LowestInterval;
+	NoteToIntervalMap[0] := 0;
+	FOR note := 1 TO MAX(Note) DO
+	    NoteToIntervalMap[note] := VAL(CARDINAL, step);
+	    step := step*freqstep;
+	END (*FOR*);
+
+	(* Create the waveform arrays. *)
+
+	(* Waveform #0: sine wave. *)
+	(* Waveform #1: sine wave + 3rd harmonic. *)
+
+	FOR j := 0 TO 255 DO
+	    WaveValue (0, j, 0.5*bound*Sin(VAL(LONGREAL,j)*PI/128.0));
+	    WaveValue (1, j, 0.56*bound*(Sin(VAL(LONGREAL,j)*PI/128.0)
+				+ 0.18*Sin(3.0*VAL(LONGREAL,j)*PI/128.0)));
+	END (*FOR*);
+
+	(* Waveforms #2, 3, 4: rectangular waves.	*)
+
+	FOR w := 2 TO 4 DO
+	    break := 56*SHORTCARD(w) + 16;
+	    FOR j := 0 TO break-1 DO
+		WaveValue (w, j, offset);
+	    END (*FOR*);
+	    FOR j := break TO 255 DO
+		WaveValue (w, j, -offset);
+	    END (*FOR*);
+	END (*FOR*);
+
+	(* Waveforms #5, 6, 7: triangular waves.	*)
+
+	FOR w := 5 TO 6 DO
+	    break := VAL(SHORTCARD, 64*w - 192);
+	    scale := bound/LONGREAL(break);
+	    FOR j := 0 TO break-1 DO
+		WaveValue (w,j, scale*LONGREAL(j)-offset);
+	    END (*FOR*);
+	    scale := bound/LONGREAL(256-CARDINAL(break));
+	    FOR j := break TO 255 DO
+		WaveValue (w, j, scale*LONGREAL(256-CARDINAL(j))-offset);
+	    END (*FOR*);
+	END (*FOR*);
+	FOR j := 0 TO 255 DO
+	    WaveValue (7, j, bound*LONGREAL(j)/256.0-offset);
+	END (*FOR*);
+
+	(* Pass the waveforms to the subsidiary module. *)
+
+	FOR w := 0 TO MAX(WaveNumber) DO
+	    DefineWaveform (w, Wave[w]);
+	END (*FOR*);
+
+	(* Initialise the EnvelopeData array. *)
+
+	FOR E := 0 TO MAX(EnvelopeNumber) DO
+	    WITH EnvelopeData[E] DO
+		Attack := 0;  Decay := 0;  Sustain := 0;
+		shapeptr := NIL;
+	    END (*WITH*);
+	END (*FOR*);
+
+	(* Set initial conditions for the voice data. *)
+
+	FOR voice := 1 TO MAX(VoiceNumber) DO
+	    WITH VoiceData[voice] DO
+		position := 0;
+		LastDuration := DefaultDuration;
+		NextDuration := DefaultDuration;
+		CurrentOctave := 3;
+		LastNote := irrelevantnote;
+		Enabled := TRUE;
+	    END (*WITH*);
+	END (*FOR*);
+
+    END Initialise;
+
+(************************************************************************)
+
+BEGIN
+    Initialise;
+END Music3.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/music3s.def b/examples/Modula-2_Libraries/PMOS/sources/general/music3s.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/music3s.def
@@ -0,0 +1,92 @@
+DEFINITION MODULE Music3S;
+
+	(********************************************************)
+	(*							*)
+	(*		Translates 3-part music from		*)
+	(*		musical notation to the form		*)
+	(*		expected by module Play3S.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+TYPE
+    VoiceNumber = [1..3];
+    WaveformNumber = [0..7];
+
+(************************************************************************)
+(*									*)
+(*  In the "notes" argument to each of the next three procedures,	*)
+(*  the following options are accepted:					*)
+(*	C D E F G A B	the usual notation for a note.			*)
+(*	b #		flat or sharp, modifying the previously given	*)
+(*			 note.  There is no legality checking; for	*)
+(*			 example, B# is illegal but the software does	*)
+(*			 check for this.				*)
+(*	R		a rest.						*)
+(*	*n   (n=0..9)	multiply the duration of the following notes	*)
+(*			 by n.						*)
+(*	*		a shorthand notation for *2.			*)
+(*	/n   (n=0..9)	divide the duration of the following notes	*)
+(*			 by n.						*)
+(*	/		a shorthand notation for /2.			*)
+(*	3		a shorthand notation for /3.			*)
+(*			The *, /, and 3 options take effect for		*)
+(*			 all following notes, until the duration is	*)
+(*			 modified again by one of these options.	*)
+(*	u		go up one octave.				*)
+(*	d		go down one octave.  In many cases the u and d	*)
+(*			 options are not needed because this module	*)
+(*			 chooses the appropriate octave based on the	*)
+(*			 assumption that successive notes will be	*)
+(*			 close to each other; but u and d can override	*)
+(*			 this assumption.				*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE EnableVoice (V: VoiceNumber;  enable: BOOLEAN);
+
+    (* If enable is FALSE then the following data for voice V are	*)
+    (* ignored.  (This is for testing, when you want to suppress a	*)
+    (* voice in order to listen to the others more closely.)  The	*)
+    (* default condition is that all voices are enabled.		*)
+
+PROCEDURE SetWaveform (V: VoiceNumber;  N: WaveformNumber);
+
+    (* Changes the waveform for voice V. *)
+
+PROCEDURE SetEnvelope (V: VoiceNumber;  attack, decay, sustain: CARDINAL);
+
+    (* Does nothing - this procedure is present for compatibility with	*)
+    (* other versions, but the present version does not have the	*)
+    (* capability of controlling the waveform envelope.			*)
+
+PROCEDURE SetInstrument (N: WaveformNumber;
+				attack, decay, sustain: CARDINAL);
+
+    (* Changes the waveform for all voices.  The last four parameters	*)
+    (* are ignored.							*)
+
+PROCEDURE SetDuration (value: CARDINAL);
+
+    (* Sets the duration for the following notes (all voices).  The	*)
+    (* change takes place at the point immediately following all data	*)
+    (* entered so far - i.e. at the "current time" for the voice for	*)
+    (* which most data has been entered so far.				*)
+
+PROCEDURE Voice1 (notes: ARRAY OF CHAR);
+PROCEDURE Voice2 (notes: ARRAY OF CHAR);
+PROCEDURE Voice3 (notes: ARRAY OF CHAR);
+
+    (* Appends more notes to the music array kept internally by this	*)
+    (* module.  Initially the array is empty.  The three voices can be	*)
+    (* added in any order.						*)
+
+PROCEDURE PlayTheMusic;
+
+    (* Plays the music that has been stored so far. *)
+
+END Music3S.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/music3s.mod b/examples/Modula-2_Libraries/PMOS/sources/general/music3s.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/music3s.mod
@@ -0,0 +1,648 @@
+IMPLEMENTATION MODULE Music3S;
+
+	(********************************************************)
+	(*							*)
+	(*		Translates 3-part music from		*)
+	(*		musical notation to the form		*)
+	(*		expected by module Play3S.		*)
+	(*							*)
+	(*	This version is for slow processors.  The	*)
+	(*	version called Music3 is superior, but		*)
+	(*	requires a reasonably fast processor.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Status:		OK except for fault noted below	*)
+	(*							*)
+	(*	Fault: In procedure Insert, the timing		*)
+	(*	calculation goes wrong when we meet a "254"	*)
+	(*	code.  I'll need to re-think how to do this.	*)
+	(*							*)
+	(*	Minor puzzling fault: I'm getting a redundant	*)
+	(*	set of "252" codes inserted at the beginning	*)
+	(*	of the music array.  This doesn't cause any	*)
+	(*	problems, but it does suggest that I need to	*)
+	(*	ask why this is happening.			*)
+	(*							*)
+	(********************************************************)
+
+FROM Play3S IMPORT
+    (* proc *)	Play;
+
+FROM Rationals IMPORT
+    (* type *)	Rational,
+    (* proc *)	Zero, Unity, Subtract, Multiply, Divide, Compare;
+
+FROM LowLevel IMPORT
+    (* proc *)	HighByte, LowByte;
+
+(************************************************************************)
+
+CONST
+    irrelevantnote = 0;		(* used when remembering last note	*)
+
+TYPE
+    ZeroToTwelve = SHORTCARD [0..12];
+    Octave = SHORTCARD [0..8];
+    Triple = ARRAY VoiceNumber OF SHORTCARD;
+
+VAR
+
+    (* NoteTable performs the mapping C -> 1, D -> 3, E -> 5, F -> 6,	*)
+    (* etc.  The gaps in this sequence are accounted for by sharps and	*)
+    (* flats, which are handled elsewhere.				*)
+
+    NoteTable: ARRAY ["A".."G"] OF ZeroToTwelve;
+
+    (* MusicBuffer is where the result of the translation is kept.	*)
+
+    MusicBuffer: ARRAY [0..9000] OF Triple;
+
+    (* EndPointer is the position within MusicBuffer where the		*)
+    (* last triple - holding the "end of music" code - resides.		*)
+
+    EndPointer: CARDINAL;
+
+    (* VoiceData keeps information about where we are up to in the	*)
+    (* translation of each voice.  It is needed because the caller	*)
+    (* is allowed to specify a few notes for one voice, then a few	*)
+    (* notes for a second voice, and then perhaps to switch back to	*)
+    (* the first voice, etc.						*)
+
+    (* The distinction between the SrcDuration and the CodedDuration	*)
+    (* fields is that SrcDuration is the duration, as supplied by the	*)
+    (* caller, of the last note processed; whereas CodedDuration is	*)
+    (* the duration of the data at MusicBuffer[position]; there is no	*)
+    (* direct relationship between these two, because for example a	*)
+    (* single note specified by the caller might be split into two	*)
+    (* or more buffer entries of shorter duration.			*)
+
+    (* Notice, by the way, that these durations are in "relative" form,	*)
+    (* i.e. they are relative to the absolution duration as set by	*)
+    (* procedure SetDuration.						*)
+
+    VoiceData: ARRAY VoiceNumber OF
+		    RECORD
+			position: CARDINAL;
+			SrcDuration, CodedDuration: Rational;
+			CurrentOctave: Octave;
+			LastNote: ZeroToTwelve;
+			Enabled: BOOLEAN;
+		    END (*RECORD*);
+
+(************************************************************************)
+(*			DELETIONS FROM MusicBuffer			*)
+(************************************************************************)
+
+PROCEDURE Delete (place: CARDINAL);
+
+    (* Deletes the existing entry MusicBuffer[place], moving subsequent	*)
+    (* data backwards to fill the hole.					*)
+
+    VAR j: CARDINAL;  voice: VoiceNumber;
+
+    BEGIN
+	FOR j := place TO EndPointer-1 DO
+	    MusicBuffer[j] := MusicBuffer[j+1];
+	END (*FOR*);
+	DEC (EndPointer);
+	FOR voice := 1 TO MAX(VoiceNumber) DO
+	    WITH VoiceData[voice] DO
+		IF position > place THEN
+		    DEC(position);
+		END (*IF*);
+	    END (*WITH*);
+	END (*FOR*);
+    END Delete;
+
+(************************************************************************)
+
+PROCEDURE Compactify (place: CARDINAL);
+
+    (* Scans the MusicBuffer array from "place" onwards, combining	*)
+    (* adjacent "change duration" codes where possible.  (It's possible	*)
+    (* in principle to avoid these redundancies while doing the		*)
+    (* translation, but permitting them reduces some of the translation	*)
+    (* complexity, so we gain some simplicity by stripping out the	*)
+    (* rubbish in a separate pass.  The array rarely gets so large that	*)
+    (* we need to be concerned about the execution time overhead.)	*)
+
+    VAR f1, f2, product: Rational;
+
+    BEGIN
+	WHILE MusicBuffer[place][1] <> 255 DO
+	    IF (MusicBuffer[place][1] = 253)
+			AND (MusicBuffer[place+1][1] = 253) THEN
+		f1.num := INTEGER(MusicBuffer[place][2]);
+		f1.denom := CARDINAL(MusicBuffer[place][3]);
+		f2.num := INTEGER(MusicBuffer[place+1][2]);
+		f2.denom := CARDINAL(MusicBuffer[place+1][3]);
+		Delete (place+1);
+		product := Multiply (f1, f2);
+		IF Compare (product, Unity()) <> 0 THEN
+		    MusicBuffer[place][2] := SHORTCARD(product.num);
+		    MusicBuffer[place][3] := SHORTCARD(product.denom);
+		ELSE
+		    Delete (place);
+		END (*IF*);
+	    ELSE
+		INC (place);
+	    END (*IF*)
+	END (*WHILE*);
+    END Compactify;
+
+(************************************************************************)
+(*			INSERTIONS INTO MusicBuffer			*)
+(************************************************************************)
+
+PROCEDURE CreateInsertionPoint (place: CARDINAL);
+
+    (* Inserts an empty element at MusicBuffer[place]. *)
+
+    VAR j: CARDINAL;  voice: VoiceNumber;
+
+    BEGIN
+	INC (EndPointer);
+	FOR j := EndPointer TO place+1 BY -1 DO
+	    MusicBuffer[j] := MusicBuffer[j-1]
+	END (*FOR*);
+	FOR voice := 1 TO MAX(VoiceNumber) DO
+	    MusicBuffer[place][voice] := 0;
+	    WITH VoiceData[voice] DO
+		IF position > place THEN
+		    INC(position);
+		END (*IF*);
+	    END (*WITH*);
+	END (*FOR*);
+    END CreateInsertionPoint;
+
+(************************************************************************)
+
+PROCEDURE NewDurationSetting (place: CARDINAL;
+			oldduration, newduration: Rational): BOOLEAN;
+
+    (* Inserts the code for a new note duration at MusicBuffer[place].	*)
+    (* The function result is TRUE iff we had to actually insert a new	*)
+    (* array element, as distinct from updating an existing one.	*)
+
+    VAR change: Rational;  inserted: BOOLEAN;
+
+    BEGIN
+	change := Divide (newduration, oldduration);
+	IF Compare (change, Unity()) = 0 THEN RETURN FALSE
+	ELSIF MusicBuffer[place][1] = 253 THEN
+	    oldduration.num := INTEGER(MusicBuffer[place][2]);
+	    oldduration.denom := CARDINAL(MusicBuffer[place][3]);
+	    change := Multiply (change, oldduration);
+	    inserted := FALSE;
+	ELSE
+	    CreateInsertionPoint (place);
+	    MusicBuffer[place][1] := 253;
+	    inserted := TRUE;
+	END (*IF*);
+	MusicBuffer[place][2] := SHORTCARD(change.num);
+	MusicBuffer[place][3] := SHORTCARD(change.denom);
+	RETURN inserted;
+    END NewDurationSetting;
+
+(************************************************************************)
+
+PROCEDURE Split (place: CARDINAL;  d1, d2: Rational);
+
+    (* This procedure is called when the existing data at		*)
+    (* MusicBuffer[place] has a duration of d2, and we want to add a	*)
+    (* note in a new voice with duration d1 < d2.  The existing entry	*)
+    (* is split into two portions of duration d1 and (d2-d1).		*)
+
+    (* To avoid confusing the timing for data already present, it's	*)
+    (* important to do insertions ahead of the existing data rather	*)
+    (* than letting place catch up to the position for new insertions	*)
+    (* after existing data.  This explains the slightly non-obvious	*)
+    (* order in which we make the insertions.				*)
+
+    VAR diff, lastchange: Rational;  dummy: BOOLEAN;
+
+    BEGIN
+	IF NewDurationSetting (place, d2, d1) THEN INC (place) END(*IF*);
+	CreateInsertionPoint (place);
+	CreateInsertionPoint (place);
+	MusicBuffer[place] := MusicBuffer[place+2];  INC (place);
+	MusicBuffer[place] := MusicBuffer[place+1];  INC (place);
+	diff := Subtract (d2, d1);
+	lastchange := Divide (d2, diff);
+	MusicBuffer[place][1] := 253;
+	MusicBuffer[place][2] := SHORTCARD(lastchange.num);
+	MusicBuffer[place][3] := SHORTCARD(lastchange.denom);
+	dummy := NewDurationSetting (place-1, d1, diff);
+    END Split;
+
+(************************************************************************)
+
+PROCEDURE Insert (V: VoiceNumber;  note: SHORTCARD;  duration: Rational);
+
+    (* Inserts a new note for voice V into the MusicBuffer array.	*)
+
+    VAR place: CARDINAL;  ExpectedDuration, factor: Rational;
+
+    BEGIN
+	WITH VoiceData[V] DO
+	    place := position;
+	    ExpectedDuration := CodedDuration;
+	END (*WITH*);
+	WHILE duration.num > 0 DO
+	    IF place = EndPointer THEN
+
+		(* Insertion at the end of the array. *)
+
+		IF ExpectedDuration <> duration THEN
+		    IF NewDurationSetting (place, ExpectedDuration, duration)
+					THEN INC (place) END(*IF*);
+		    ExpectedDuration := duration;
+		END (*IF*);
+		CreateInsertionPoint(place);
+		MusicBuffer[place][V] := note;
+		INC (place);
+		duration := Zero();
+
+	    ELSIF MusicBuffer[place][1] = 252 THEN
+
+		(* Skip over any "change waveform" commands. *)
+
+		INC (place);
+
+	    ELSIF MusicBuffer[place][1] = 253 THEN
+
+		(* "Change relative duration" code found.  We take note	*)
+		(* of it and step past it.  This could lead to		*)
+		(* redundant strings of "change duration" entries, but	*)
+		(* I can live with that for the sake of clearer code.	*)
+
+		factor.num := INTEGER(MusicBuffer[place][2]);
+		factor.denom := CARDINAL(MusicBuffer[place][3]);
+		ExpectedDuration := Multiply (ExpectedDuration, factor);
+		INC (place);
+
+	    ELSIF MusicBuffer[place][1] = 254 THEN
+
+		(* "Change absolute duration" code found.  Since this	*)
+		(* module deals only with the "relative duration" part	*)
+		(* of the timing, the only effect here is that we need	*)
+		(* to start with a new "relative duration" base.	*)
+
+		duration := Unity();
+		ExpectedDuration := duration;
+		VoiceData[V].SrcDuration := duration;
+		INC (place);
+
+	    ELSIF Compare (duration, ExpectedDuration) >= 0 THEN
+
+		MusicBuffer[place][V] := note;
+		INC (place);
+		duration := Subtract (duration, ExpectedDuration);
+
+	    ELSE
+
+		(* The new note is shorter than notes already there for	*)
+		(* the other voices.  We have to split up the existing	*)
+		(* data.						*)
+
+		Split (place, duration, ExpectedDuration);
+
+	    END (*IF*);
+	END (*WHILE*);
+
+	WITH VoiceData[V] DO
+	    position := place;
+	    CodedDuration := ExpectedDuration;
+	END (*WITH*);
+
+    END Insert;
+
+(************************************************************************)
+(*			INTERPRETING MUSICAL NOTATION			*)
+(************************************************************************)
+
+PROCEDURE Translate (VAR (*IN*) notes: ARRAY OF CHAR;
+			VAR (*INOUT*) place: CARDINAL): ZeroToTwelve;
+
+    (* Translates a note code in the conventional notation (C,D,etc.),	*)
+    (* as stored in notes[place], into the numeric code expected by	*)
+    (* module Play3.  Parameter place is updated, so that on return	*)
+    (* notes[place] is the first character not yet processed.		*)
+
+    VAR result: ZeroToTwelve;
+
+    BEGIN
+	IF notes[place] = "R" THEN
+	    result := 0;  INC (place);
+	ELSE
+	    result := NoteTable[notes[place]];
+	    INC (place);
+	    IF place <= HIGH(notes) THEN
+
+		(* Check for sharp or flat. *)
+
+		IF notes[place] = "#" THEN
+	    	    INC(result);  INC(place);
+		ELSIF notes[place] = "b" THEN
+	    	    DEC(result);  INC(place);
+		END (*IF*);
+
+	    END (*IF*);
+	END (*IF*);
+
+	RETURN result;
+
+    END Translate;
+
+(************************************************************************)
+
+PROCEDURE Convert (voice: VoiceNumber;  notes: ARRAY OF CHAR);
+
+    (* Converts the notes specified in array "notes".  The result is	*)
+    (* inserted into global variable MusicBuffer.			*)
+
+    TYPE CharSet = SET OF CHAR;
+
+    CONST Two = Rational (2, 1);  Three = Rational (3, 1);
+	Digits = CharSet {'0'..'9'};
+
+    VAR	inplace, start: CARDINAL;
+	CurrentDuration, factor: Rational;
+	CurrentOctave: Octave;
+	note, LastNote: SHORTCARD;
+
+    BEGIN
+	start := VoiceData[voice].position;
+	CurrentDuration := VoiceData[voice].SrcDuration;
+	CurrentOctave := VoiceData[voice].CurrentOctave;
+	LastNote := VoiceData[voice].LastNote;
+
+	inplace := 0;
+
+	(* The following loop translates from letter codes in array	*)
+	(* "notes" to numeric codes in array MusicBuffer.		*)
+
+	REPEAT
+
+	    IF notes[inplace] = " " THEN INC(inplace)	(* ignore spaces *)
+
+	    (* Check for duration changes.	*)
+
+	    ELSIF notes[inplace] = "*" THEN
+		INC(inplace);
+		factor := Two;
+		IF notes[inplace] IN Digits THEN
+		    factor.num := ORD(notes[inplace]) - ORD("0");
+		    INC (inplace);
+		END (*IF*);
+		CurrentDuration := Multiply (factor, CurrentDuration);
+	    ELSIF notes[inplace] = "/" THEN
+		INC(inplace);
+		factor := Two;
+		IF notes[inplace] IN Digits THEN
+		    factor.num := ORD(notes[inplace]) - ORD("0");
+		    INC (inplace);
+		END (*IF*);
+		CurrentDuration := Divide (CurrentDuration, factor);
+	    ELSIF notes[inplace] = "3" THEN
+		CurrentDuration := Divide (CurrentDuration, Three);
+		INC(inplace);
+
+	    (* Check for octave changes.	*)
+
+	    ELSIF notes[inplace] = "u" THEN
+		IF CurrentOctave < MAX(Octave) THEN
+		    INC(CurrentOctave);
+		END (*IF*);
+		INC (inplace);
+	    ELSIF notes[inplace] = "d" THEN
+		IF CurrentOctave > 0 THEN DEC(CurrentOctave) END(*IF*);
+		INC (inplace);
+	    ELSE
+
+		(* We have a note to translate.			*)
+		(* N.B. procedure Translate updates inplace.	*)
+
+		note := Translate (notes, inplace);
+
+		IF note = 0 THEN
+		    Insert (voice, 0, CurrentDuration);
+		ELSE
+
+		    (* We now have the note in the form of a		*)
+		    (* ZeroToTwelve code, but we still have to decide	*)
+		    (* the octave.  The criterion we use is to minimise	*)
+		    (* the distance from the last note played.  This	*)
+		    (* can be overridden by the "u" and "d" codes.	*)
+
+		    IF LastNote <> irrelevantnote THEN
+			IF INTEGER(note)-INTEGER(LastNote) > 6 THEN
+			    IF CurrentOctave > 0 THEN
+				DEC(CurrentOctave);
+			    END(*IF*);
+			ELSIF INTEGER(LastNote) - INTEGER(note) > 6 THEN
+			    IF CurrentOctave < MAX(Octave) THEN
+				INC(CurrentOctave)
+			    END (*IF*);
+			END (*IF*);
+		    END (*IF*);
+		    LastNote := note;
+		    Insert (voice, VAL(SHORTCARD, 12*CurrentOctave + note),
+						CurrentDuration);
+		END (*IF*);
+
+	    END (*IF*);
+
+	UNTIL (inplace > HIGH(notes)) OR (notes[inplace] = CHR(0));
+
+	VoiceData[voice].SrcDuration := CurrentDuration;
+	VoiceData[voice].CurrentOctave := CurrentOctave;
+	VoiceData[voice].LastNote := LastNote;
+	Compactify (start);
+
+    END Convert;
+
+(************************************************************************)
+
+PROCEDURE Voice1 (notes: ARRAY OF CHAR);
+
+    (* Appends more notes to Voice #1. *)
+
+    BEGIN
+	IF VoiceData[1].Enabled THEN
+	    Convert (1, notes);
+	END (*IF*);
+    END Voice1;
+
+(************************************************************************)
+
+PROCEDURE Voice2 (notes: ARRAY OF CHAR);
+
+    (* Appends more notes to Voice #2. *)
+
+    BEGIN
+	IF VoiceData[2].Enabled THEN
+	    Convert (2, notes);
+	END (*IF*);
+    END Voice2;
+
+(************************************************************************)
+
+PROCEDURE Voice3 (notes: ARRAY OF CHAR);
+
+    (* Appends more notes to Voice #3. *)
+
+    BEGIN
+	IF VoiceData[3].Enabled THEN
+	    Convert (3, notes);
+	END (*IF*);
+    END Voice3;
+
+(************************************************************************)
+
+PROCEDURE EnableVoice (V: VoiceNumber;  enable: BOOLEAN);
+
+    (* If enable is FALSE then the following data for voice V are	*)
+    (* ignored.  (This is for testing, when you want to suppress a	*)
+    (* voice in order to listen to the others more closely.)  The	*)
+    (* default condition is that all voices are enabled.		*)
+
+    BEGIN
+	VoiceData[V].Enabled := enable;
+    END EnableVoice;
+
+(************************************************************************)
+
+PROCEDURE SetWaveform (V: VoiceNumber;  N: WaveformNumber);
+
+    (* Changes the waveform for voice V. *)
+
+    VAR place: CARDINAL;
+
+    BEGIN
+	place := VoiceData[V].position;
+	CreateInsertionPoint (place);
+	MusicBuffer[place][1] := 252;
+	MusicBuffer[place][2] := BYTE(V);
+	MusicBuffer[place][3] := BYTE(N);
+    END SetWaveform;
+
+(************************************************************************)
+
+PROCEDURE SetEnvelope (V: VoiceNumber;  attack, decay, sustain: CARDINAL);
+
+    (* Does nothing - this procedure is present for compatibility with	*)
+    (* other versions, but the present version does not have the	*)
+    (* capability of controlling the waveform envelope.			*)
+
+    BEGIN
+    END SetEnvelope;
+
+(************************************************************************)
+
+PROCEDURE SetInstrument (N: WaveformNumber;
+				attack, decay, sustain: CARDINAL);
+
+    (* Changes the waveform for all voices.  The last four parameters	*)
+    (* are ignored.							*)
+
+    VAR V: VoiceNumber;
+
+    BEGIN
+	FOR V := 1 TO MAX(VoiceNumber) DO
+	    SetWaveform (V, N);
+	END (*FOR*);
+    END SetInstrument;
+
+(************************************************************************)
+
+PROCEDURE SetDuration (value: CARDINAL);
+
+    (* Sets the duration for the following notes (all voices).  The	*)
+    (* change takes place at the point immediately following all data	*)
+    (* entered so far - i.e. at the "current time" for the voice for	*)
+    (* which most data has been entered so far.				*)
+
+    VAR voice: VoiceNumber;  place: CARDINAL;
+
+    BEGIN
+	(* Work out where to put the "set duration" code.	*)
+
+	place := 0;
+	FOR voice := 1 TO MAX(VoiceNumber) DO
+	    WITH VoiceData[voice] DO
+		IF position > place THEN
+		    place := position;
+		END (*IF*);
+	    END (*WITH*);
+	END (*FOR*);
+
+	(* Insert the code. *)
+
+	IF MusicBuffer[place][1] <> 254 THEN
+	    CreateInsertionPoint (place);
+	    MusicBuffer[place][1] := 254;
+	END (*IF*);
+	MusicBuffer[place][2] := LowByte(value);
+	MusicBuffer[place][3] := HighByte(value);
+
+    END SetDuration;
+
+(************************************************************************)
+
+PROCEDURE PlayTheMusic;
+
+    (* Plays the music that has been stored so far. *)
+
+    BEGIN
+	Play (MusicBuffer);
+    END PlayTheMusic;
+
+(************************************************************************)
+(*			MODULE INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE Initialise;
+
+    (* Sets the initial duration and octave, and sets up the tables	*)
+    (* for translating from music notation to the output codes.		*)
+
+    VAR voice: VoiceNumber;
+
+    BEGIN
+	(* MusicBuffer is where our final result goes.  Initially we	*)
+	(* fill it with the "end of music" code.			*)
+
+	MusicBuffer[0][1] := 255;
+	MusicBuffer[0][2] := 0;
+	MusicBuffer[0][3] := 0;
+	EndPointer := 0;
+
+	FOR voice := 1 TO MAX(VoiceNumber) DO
+	    WITH VoiceData[voice] DO
+		position := 0;
+		SrcDuration := Unity();
+		CodedDuration := Unity();
+		CurrentOctave := 3;
+		LastNote := irrelevantnote;
+		Enabled := TRUE;
+	    END (*WITH*);
+	END (*FOR*);
+
+	(* NoteTable translates from letter codes into a numeric code	*)
+	(* consistent with a well-tempered tuning.			*)
+
+	NoteTable["C"] := 1;  NoteTable["D"] := 3;
+	NoteTable["E"] := 5;  NoteTable["F"] := 6;
+	NoteTable["G"] := 8;  NoteTable["A"] := 10;
+	NoteTable["B"] := 12;
+
+    END Initialise;
+
+(************************************************************************)
+
+BEGIN
+    Initialise;
+END Music3S.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/musicdem.def b/examples/Modula-2_Libraries/PMOS/sources/general/musicdem.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/musicdem.def
@@ -0,0 +1,22 @@
+DEFINITION MODULE MusicDemonstration;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of module Music.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	24 June 1989			*)
+	(*  Status:						*)
+	(*	Working.  Musically, it could be polished up a	*)
+	(*	little, but from the software development	*)
+	(*	viewpoint it is complete - module Music does	*)
+	(*	indeed work as desired.				*)
+	(*							*)
+	(********************************************************)
+
+PROCEDURE WaitForEndOfMusic;
+
+    (* Synchronization procedure: does not return until the music	*)
+    (* demonstration is over.						*)
+
+END MusicDemonstration.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/musicdem.mod b/examples/Modula-2_Libraries/PMOS/sources/general/musicdem.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/musicdem.mod
@@ -0,0 +1,137 @@
+IMPLEMENTATION MODULE MusicDemonstration;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of module Music.			*)
+	(*							*)
+	(*	J.S. Bach: Prelude from Cello Suite No. 1	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	16 August 1993			*)
+	(*  Status:						*)
+	(*	Working.  Musically, it could be polished up a	*)
+	(*	little, but from the software development	*)
+	(*	viewpoint it is complete - module Music does	*)
+	(*	indeed work as desired.				*)
+	(*							*)
+	(*	Some notes possibly still wrong.		*)
+	(*							*)
+	(********************************************************)
+
+FROM TaskControl IMPORT
+    (* proc *)	CreateTask;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM Music IMPORT
+    (* proc *)	SetNoteDuration, PlayMusic, WaitForMusicFinished;
+
+(************************************************************************)
+
+VAR
+
+    (* The MusicFinished semaphore is used to signal the end of the	*)
+    (* demonstration.							*)
+
+    MusicFinished: Semaphore;
+
+(************************************************************************)
+
+PROCEDURE PlayATune;
+
+    (* Plays a piece of music.  This procedure runs as a separate task,	*)
+    (* which does not exit until the playing is over.			*)
+
+    BEGIN	(* PlayATune *)
+
+	(********************************************************)
+	(* Opening of J.S. Bach, Cello Suite No. 1, Prelude.	*)
+	(********************************************************)
+
+	SetNoteDuration (200);
+
+	PlayMusic ("dDuAuF#EF#dAuF#dAddDuuAuF#EF#dAuF#dA");
+	PlayMusic ("dDuBuGF#GdBuGdBddDuuBuGF#GdBuGdB");
+	PlayMusic ("DC#GF#GC#GC#ddDuuC#GF#GC#GC#");
+	PlayMusic ("dDuDF#EF#DF#DddDuuDF#EF#DF#C#");
+	PlayMusic ("dDuBuF#EF#DC#DBDC#DdF#AG#F#");
+	PlayMusic ("G#uDEDEDEDdG#uDEDEDED");
+	PlayMusic ("C#EAG#AEDEC#EDEdAC#BA");
+	PlayMusic ("dBuF#uDC#DdF#uDdF#dBuF#uDC#DdF#uDdF#");
+	PlayMusic ("dBuG#ABAG#F#EuDC#BuAG#F#ED");
+	PlayMusic ("C#BAuAEAdC#EdABC#EDC#BA");
+	PlayMusic ("uD#dACBCAuD#dAuF#dACBCAuD#dA");
+	PlayMusic ("GBEF#GEBAGBEF#GEC#B");
+	PlayMusic ("A#C#A#C#EC#EC#A#C#A#C#EC#EC#");
+	PlayMusic ("DC#BDC#DEC#DC#BAGF#ED");
+
+	(* Page 2. *)
+
+	PlayMusic ("C#GAGAGAGC#GAGAGAG");
+	PlayMusic ("DF#uCBCdF#uCdF#DF#uCBCdF#uCdF#");
+	PlayMusic ("DGBABGBGDGBABGBG");
+	PlayMusic ("DuC#GF#GC#GC#dDuC#GF#GC#GC#d");
+	PlayMusic ("DuAuF#EF#DC#BAGF#EDC#BA");
+	PlayMusic ("G#uEuBC#DBC#DddG#uEuBC#DBC#D");
+	PlayMusic ("ddGuEABC#ABC#ddGuEABC#ABC#");
+	PlayMusic ("ddGuEAC#EG#*A/AdEF#GABC#D");
+	PlayMusic ("EC#ABC#DEF#GEC#DEF#GA");
+	PlayMusic ("BbAG#AAGF#GGEC#BAEF#G");
+	PlayMusic ("dAuEAC#EF#GEF#DAGF#DEF#");
+	PlayMusic ("dADF#ADEF#DG#FEFFED#E");
+	PlayMusic ("EDC#DDBG#F#EG#BDEG#AG#");
+	PlayMusic ("AEC#BC#EdAC#dEAG#F#EDC#B");
+
+	(* Page 3. *)
+
+	PlayMusic ("*A/uuGF#EDC#BAuGF#EDC#BA");
+	PlayMusic ("GuF#EDC#BAGF#uEDC#BAGF#");
+	PlayMusic ("EuDC#BC#EdAuEBEC#EDEBE");
+	PlayMusic ("C#EdAuEDEBEC#EdAuEDEBE");
+	PlayMusic ("C#EdAuEBEC#EDdEuEdEuF#EddAuEu");
+	PlayMusic ("EdEuF#EGEddAuuEF#EGEAEF#E");
+	PlayMusic ("GEF#EGEdEuEF#EdEuEF#EDE");
+	PlayMusic ("EdEuDEdEuEC#EDEC#EDEBE");
+	PlayMusic ("C#EdABCdAuC#dAuDdAuuD#ddAuuEddAuuFddA");
+	PlayMusic ("uuF#ddAuuGddAuuG#ddAuuAddAuuBbddAuuBddAuuCddAuuC#ddA");
+	PlayMusic ("uuDdF#dAuF#uDdF#uDdF#uDdF#dAuF#uDdF#uDdF#");
+	PlayMusic ("uDdEdAuEuDdEuDdEuDdEdAuEuDdEuDdE");
+	PlayMusic ("uC#dGdAuGuC#dGuC#dGuC#dGdAuGuC#dGuC#dG");
+	PlayMusic ("u***D");
+
+	WaitForMusicFinished;
+	Signal (MusicFinished);
+    END PlayATune;
+
+(************************************************************************)
+
+PROCEDURE WaitForEndOfMusic;
+
+    (* Synchronization procedure: does not return until the music	*)
+    (* demonstration is over.						*)
+
+    BEGIN
+	Wait (MusicFinished);
+    END WaitForEndOfMusic;
+
+(************************************************************************)
+
+PROCEDURE StartTheMusic;
+
+    (* Creates the player task, after which it will run autonomously.	*)
+
+    CONST PlayerPriority = 12;
+
+    BEGIN
+	CreateSemaphore (MusicFinished, 0);
+	CreateTask (PlayATune, PlayerPriority, "Music demo");
+    END StartTheMusic;
+
+(************************************************************************)
+
+BEGIN
+    StartTheMusic;
+END MusicDemonstration.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/newcalc.def b/examples/Modula-2_Libraries/PMOS/sources/general/newcalc.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/newcalc.def
@@ -0,0 +1,22 @@
+DEFINITION MODULE NewCalc;
+
+	(****************************************************************)
+	(*								*)
+	(*			Simple calculator			*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	1 September 1993			*)
+	(*  Status:							*)
+	(*	Now trying to add prefix unary functions.		*)
+	(*								*)
+	(****************************************************************)
+
+PROCEDURE RunCalculator;
+
+    (* Displays a calculator window on the screen; this can be operated	*)
+    (* from the numeric keypad.  On exit, the calculator window is	*)
+    (* closed.  However, calculation results are saved between		*)
+    (* invocations of this procedure.					*)
+
+END NewCalc.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/numerici.def b/examples/Modula-2_Libraries/PMOS/sources/general/numerici.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/numerici.def
@@ -0,0 +1,96 @@
+DEFINITION MODULE NumericIO;
+
+	(****************************************************************)
+	(*								*)
+	(*		Numeric I/O using windows.			*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	18 February 1994			*)
+	(*  Status:		OK					*)
+	(*								*)
+	(****************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE, ADDRESS;
+
+FROM Windows IMPORT
+    (* type *)	Window;
+
+PROCEDURE WriteHexByte (w: Window;  number: BYTE);
+
+    (* Writes the second argument as a two-digit hexadecimal number.	*)
+
+PROCEDURE WriteHexWord (w: Window;  number: CARDINAL);
+
+    (* Writes the second argument as a four-digit hexadecimal number.	*)
+
+PROCEDURE WriteHexLongword (w: Window;  number: LONGCARD);
+
+    (* Writes the second argument as an eight-digit hexadecimal number.	*)
+
+PROCEDURE EditHexByte (w: Window;  VAR (*INOUT*) value: BYTE);
+
+    (* Screen editing of a 2-digit hexadecimal value *)
+
+PROCEDURE EditHexWord (w: Window;  VAR (*INOUT*) value: CARDINAL);
+
+    (* Screen editing of a 4-digit hexadecimal value *)
+
+PROCEDURE EditHexLongword (w: Window;  VAR (*INOUT*) value: LONGCARD);
+
+    (* Screen editing of an 8-digit hexadecimal value *)
+
+PROCEDURE WriteAddress (w: Window;  addr: ADDRESS);
+
+    (* Writes a segmented address to the screen.	*)
+
+PROCEDURE WriteCard (w: Window;  number: CARDINAL);
+
+    (* Writes the second argument as a decimal number.	*)
+
+PROCEDURE WriteShortCard (w: Window;  number: SHORTCARD);
+
+    (* Writes the second argument as a decimal number.	*)
+
+PROCEDURE WriteLongCard (w: Window;  number: LONGCARD);
+
+    (* Writes the second argument as a decimal number.	*)
+
+PROCEDURE WriteInt (w: Window;  number: INTEGER);
+
+    (* Writes the second argument as a decimal number.	*)
+
+PROCEDURE WriteRJCard (w: Window;  number, fieldsize: CARDINAL);
+
+    (* Like WriteCard, but the result is right justified in a field	*)
+    (* of fieldsize characters.						*)
+
+PROCEDURE WriteRJShortCard (w: Window;  number: SHORTCARD;
+					fieldsize: CARDINAL);
+
+    (* Like WriteShortCard, but the result is right justified in a	*)
+    (* field of fieldsize characters.					*)
+
+PROCEDURE WriteRJLongCard (w: Window;  number: LONGCARD; fieldsize: CARDINAL);
+
+    (* Like WriteLongCard, but the result is right justified in a field	*)
+    (* of fieldsize characters.						*)
+
+PROCEDURE ReadCard (w: Window;  VAR (*OUT*) number: CARDINAL);
+
+    (* Reads a decimal number.	*)
+
+PROCEDURE ReadBufferedCardinal (w: Window;  fieldsize: CARDINAL): CARDINAL;
+
+    (* Reads a decimal number.  The difference between this and		*)
+    (* ReadCard is that the user is given a reverse-video field of a	*)
+    (* fixed width to work in, and is able to use the cursor control	*)
+    (* keys to edit within that field.					*)
+
+PROCEDURE EditCardinal (w: Window;  VAR (*INOUT*) value: CARDINAL;
+						fieldsize: CARDINAL);
+
+    (* Screen editing of a decimal number. *)
+
+END NumericIO.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/numerici.mod b/examples/Modula-2_Libraries/PMOS/sources/general/numerici.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/numerici.mod
@@ -0,0 +1,329 @@
+IMPLEMENTATION MODULE NumericIO;
+
+	(****************************************************************)
+	(*								*)
+	(*		Numeric I/O using windows.			*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	18 February 1994			*)
+	(*  Status:		OK					*)
+	(*								*)
+	(****************************************************************)
+
+FROM Windows IMPORT
+    (* type *)	ColumnRange,
+    (* proc *)	WriteChar, WriteString, ReadChar, LookaheadChar,
+		ReadCharWithoutEcho, EditString, SaveCursor, SetCursor;
+
+FROM Conversions IMPORT
+    (* type *)	HexDigit, EightChar,
+    (* proc *)	CardinalToString, StringToCardinal, StringToHex,
+		LongCardToString, HexToChar, HexToString, LongHexToString;
+
+FROM LowLevel IMPORT
+    (* proc *)	SEGMENT, OFFSET,
+		HighByte, LowByte, HighWord, LowWord,
+		IANDB, RSB;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey, PutBack;
+
+(************************************************************************)
+
+TYPE CharSet = SET OF CHAR;
+
+CONST Digits = CharSet {"0".."9"};
+
+(************************************************************************)
+(*				OUTPUT					*)
+(************************************************************************)
+
+PROCEDURE WriteHexDigit (w: Window;  number: BYTE);
+
+    (* Writes a one-digit hexadecimal number.	*)
+
+    BEGIN
+	WriteChar (w, HexToChar(VAL(HexDigit, number)));
+    END WriteHexDigit;
+
+(************************************************************************)
+
+PROCEDURE WriteHexByte (w: Window;  number: BYTE);
+
+    (* Writes the second argument as a two-digit hexadecimal number.	*)
+
+    BEGIN
+
+	(* The obscure function names from LowLevel are:	*)
+	(*	RSB = right shift	IANDB = logical AND	*)
+
+	WriteHexDigit (w, RSB(number, 4));
+	WriteHexDigit (w, IANDB(number,15));
+
+    END WriteHexByte;
+
+(************************************************************************)
+
+PROCEDURE WriteHexWord (w: Window;  number: CARDINAL);
+
+    (* Writes the second argument as a four-digit hexadecimal number.	*)
+
+    BEGIN
+	WriteHexByte (w, HighByte(number));
+	WriteHexByte (w, LowByte(number));
+    END WriteHexWord;
+
+(************************************************************************)
+
+PROCEDURE WriteHexLongword (w: Window;  number: LONGCARD);
+
+    (* Writes the second argument as an eight-digit hexadecimal number.	*)
+
+    BEGIN
+	WriteHexWord (w, HighWord(number));
+	WriteHexWord (w, LowWord(number));
+    END WriteHexLongword;
+
+(************************************************************************)
+
+PROCEDURE WriteAddress (w: Window;  addr: ADDRESS);
+
+    (* Writes a segmented address to the screen.	*)
+
+    BEGIN
+	WriteHexWord (w, SEGMENT(addr));  WriteChar (w, ":");
+	WriteHexWord (w, OFFSET(addr));
+    END WriteAddress;
+
+(************************************************************************)
+
+PROCEDURE WriteLongCard (w: Window;  number: LONGCARD);
+
+    (* Writes the second argument as a decimal number.	*)
+
+    VAR remainder: CARDINAL;
+
+    BEGIN
+	IF number > 9 THEN
+	    WriteLongCard (w, number DIV 10);
+	END (*IF*);
+	remainder := CARDINAL(number MOD 10);
+	WriteChar (w, CHR(remainder + ORD("0")));
+    END WriteLongCard;
+
+(************************************************************************)
+
+PROCEDURE WriteCard (w: Window;  number: CARDINAL);
+
+    (* Writes the second argument as a decimal number.	*)
+
+    BEGIN
+	WriteLongCard (w, VAL(LONGCARD,number));
+    END WriteCard;
+
+(************************************************************************)
+
+PROCEDURE WriteShortCard (w: Window;  number: SHORTCARD);
+
+    (* Writes the second argument as a decimal number.	*)
+
+    BEGIN
+	WriteLongCard (w, VAL(LONGCARD,number));
+    END WriteShortCard;
+
+(************************************************************************)
+
+PROCEDURE WriteInt (w: Window;  number: INTEGER);
+
+    (* Writes the second argument as a decimal number.	*)
+
+    BEGIN
+	IF number < 0 THEN
+	    WriteChar (w, '-');  number := -number;
+	END (*IF*);
+	WriteCard (w, number);
+    END WriteInt;
+
+(************************************************************************)
+
+PROCEDURE WriteRJLongCard (w: Window;  number: LONGCARD; fieldsize: CARDINAL);
+
+    (* Like WriteLongCard, but the result is right justified in a field	*)
+    (* of fieldsize characters.						*)
+
+    VAR buffer: ARRAY [0..79] OF CHAR;
+
+    BEGIN
+	LongCardToString (number, buffer, fieldsize);
+	buffer[fieldsize] := CHR(0);
+	WriteString (w, buffer);
+    END WriteRJLongCard;
+
+(************************************************************************)
+
+PROCEDURE WriteRJCard (w: Window;  number, fieldsize: CARDINAL);
+
+    (* Like WriteCard, but the result is right justified in a field	*)
+    (* of fieldsize characters.						*)
+
+    VAR buffer: ARRAY [0..79] OF CHAR;
+
+    BEGIN
+	CardinalToString (number, buffer, fieldsize);
+	buffer[fieldsize] := CHR(0);
+	WriteString (w, buffer);
+    END WriteRJCard;
+
+(************************************************************************)
+
+PROCEDURE WriteRJShortCard (w: Window;  number: SHORTCARD;
+					fieldsize: CARDINAL);
+
+    (* Like WriteShortCard, but the result is right justified in a	*)
+    (* field of fieldsize characters.					*)
+
+    BEGIN
+	WriteRJCard (w, CARDINAL(number), fieldsize);
+    END WriteRJShortCard;
+
+(************************************************************************)
+(*			CHECK FOR Esc KEY				*)
+(************************************************************************)
+
+PROCEDURE EditOK (): BOOLEAN;
+
+    (* Returns TRUE unless the Esc key was pressed.	*)
+
+    CONST Esc = CHR(27);
+
+    VAR ch: CHAR;
+
+    BEGIN
+	ch := InKey();  PutBack(ch);
+	RETURN ch <> Esc;
+    END EditOK;
+
+(************************************************************************)
+(*			  HEXADECIMAL INPUT				*)
+(************************************************************************)
+
+PROCEDURE EditHexByte (w: Window;  VAR (*INOUT*) value: BYTE);
+
+    (* Screen editing of a 2-digit hexadecimal value *)
+
+    VAR buffer: ARRAY [0..1] OF CHAR;
+
+    BEGIN
+	HexToString (CARDINAL(value), buffer);
+	EditString (w, buffer, 2);
+	IF EditOK() THEN
+	    value := BYTE (StringToHex (buffer));
+	END (*IF*);
+    END EditHexByte;
+
+(************************************************************************)
+
+PROCEDURE EditHexWord (w: Window;  VAR (*INOUT*) value: CARDINAL);
+
+    (* Screen editing of a 4-digit hexadecimal value *)
+
+    VAR buffer: ARRAY [0..3] OF CHAR;
+
+    BEGIN
+	HexToString (value, buffer);
+	EditString (w, buffer, 4);
+	IF EditOK() THEN
+	    value := CARDINAL (StringToHex (buffer));
+	END (*IF*);
+    END EditHexWord;
+
+(************************************************************************)
+
+PROCEDURE EditHexLongword (w: Window;  VAR (*INOUT*) value: LONGCARD);
+
+    (* Screen editing of an 8-digit hexadecimal value *)
+
+    VAR buffer: EightChar;
+
+    BEGIN
+	LongHexToString (value, buffer);
+	EditString (w, buffer, 8);
+	IF EditOK() THEN
+	    value := StringToHex (buffer);
+	END (*IF*);
+    END EditHexLongword;
+
+(************************************************************************)
+(*			    DECIMAL INPUT				*)
+(************************************************************************)
+
+PROCEDURE ReadCard (w: Window;  VAR (*OUT*) number: CARDINAL);
+
+    (* Reads a decimal number, skipping over all non-numeric input.	*)
+
+    VAR ch: CHAR;
+
+    BEGIN
+	number := 0;
+
+	(* Skip over any leading non-numeric input.	*)
+
+	WHILE NOT (LookaheadChar(w) IN Digits) DO
+	    ReadCharWithoutEcho (w, ch);
+	END (*WHILE*);
+
+	(* Now read and convert the desired input.	*)
+
+	WHILE LookaheadChar(w) IN Digits DO
+	    ReadChar (w, ch);
+	    number := 10*number + ORD(ch) - ORD("0");
+	END (*WHILE*);
+    END ReadCard;
+
+(*************************************************************************)
+
+PROCEDURE ReadBufferedCardinal (w: Window;  fieldsize: CARDINAL): CARDINAL;
+
+    (* Reads a decimal number.  The difference between this and		*)
+    (* ReadCard is that the user is given a reverse-video field of a	*)
+    (* fixed width to work in, and is able to use the cursor control	*)
+    (* keys to edit within that field.					*)
+
+    VAR buffer: ARRAY ColumnRange OF CHAR;
+	result: CARDINAL;  row, column: CARDINAL;
+
+    BEGIN
+	SaveCursor (w, row, column);
+	buffer := "";
+	EditString (w, buffer, fieldsize);
+	result := StringToCardinal (buffer);
+	SetCursor (w, row, column);
+	WriteRJCard (w, result, fieldsize);
+	RETURN result;
+    END ReadBufferedCardinal;
+
+(*************************************************************************)
+
+PROCEDURE EditCardinal (w: Window;  VAR (*INOUT*) value: CARDINAL;
+						fieldsize: CARDINAL);
+
+    (* Screen editing of a decimal number. *)
+
+    VAR buffer: ARRAY ColumnRange OF CHAR;
+	row, column: CARDINAL;
+
+    BEGIN
+	SaveCursor (w, row, column);
+	CardinalToString (value, buffer, fieldsize);
+	EditString (w, buffer, fieldsize);
+	IF EditOK() THEN
+	    value := StringToCardinal (buffer);
+	END (*IF*);
+	SetCursor (w, row, column);
+	WriteRJCard (w, value, fieldsize);
+    END EditCardinal;
+
+(*************************************************************************)
+
+END NumericIO.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/oldcalc.def b/examples/Modula-2_Libraries/PMOS/sources/general/oldcalc.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/oldcalc.def
@@ -0,0 +1,21 @@
+DEFINITION MODULE Calculator;
+
+	(****************************************************************)
+	(*								*)
+	(*			Simple calculator			*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	4 September 1993			*)
+	(*  Status:		OK					*)
+	(*								*)
+	(****************************************************************)
+
+PROCEDURE RunCalculator;
+
+    (* Displays a calculator window on the screen; this can be operated	*)
+    (* from the numeric keypad.  On exit, the calculator window is	*)
+    (* closed.  However, calculation results are saved between		*)
+    (* invocations of this procedure.					*)
+
+END Calculator.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/piano.def b/examples/Modula-2_Libraries/PMOS/sources/general/piano.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/piano.def
@@ -0,0 +1,21 @@
+DEFINITION MODULE Piano;
+
+	(********************************************************)
+	(*							*)
+	(*		Play notes from the keyboard		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	5 October 1992			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+
+PROCEDURE PlayPiano;
+
+    (* Turns the home row of the keyboard into a music keyboard, with	*)
+    (* the row above being the black keys.  Type Esc to exit.		*)
+
+END Piano.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/piano.mod b/examples/Modula-2_Libraries/PMOS/sources/general/piano.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/piano.mod
@@ -0,0 +1,98 @@
+IMPLEMENTATION MODULE Piano;
+
+	(********************************************************)
+	(*							*)
+	(*		Play notes from the keyboard		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	15 March 1993			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey;
+
+FROM Music IMPORT
+    (* proc *)	SetNoteDuration, PlayMusic;
+
+FROM Windows IMPORT
+    (* type *)	Window,
+    (* proc *)	OpenSimpleWindow, CloseWindow, WriteString, WriteLn;
+
+(************************************************************************)
+
+TYPE ZeroToTwenty = [0..20];
+     KeyTable = ARRAY ["a".."z"] OF ZeroToTwenty;
+     NoteTable = ARRAY ZeroToTwenty OF ARRAY [0..1] OF CHAR;
+
+CONST
+    CodeTable = KeyTable (
+			(* ABCDEFGH *)		2, 0, 0, 5, 0, 7, 9, 11,
+			(* IJKLMNOP *)		13, 12, 14, 16, 0, 0, 15, 0,
+			(* QRSTUVWX *)		1, 6, 4, 8, 0, 0, 3, 0,
+			(* YZ       *)		10, 0);
+
+    OutTable = NoteTable (  "R ", "C#", "D ", "D#", "E ", "F ", "F#", "G ",
+			    "G#", "A ", "A#", "B ", "C ", "C#", "D ", "D#",
+			    "E ", "F ", "F#", "G ", "G#" );
+
+(************************************************************************)
+
+PROCEDURE Code (ch: CHAR): ZeroToTwenty;
+
+    (* Translates a keyboard character into a ZeroToTwenty code. *)
+
+    TYPE CharSet = SET OF CHAR;
+
+    BEGIN
+	IF ch IN CharSet {"a".."z"} THEN RETURN CodeTable[ch]
+	ELSIF ch = ";" THEN RETURN 17
+	ELSIF ch = "[" THEN RETURN 18
+	ELSIF ch = "'" THEN RETURN 19
+	ELSIF ch = "]" THEN RETURN 20
+	ELSE RETURN 0;
+	END (*IF*);
+    END Code;
+
+(************************************************************************)
+
+PROCEDURE PlayPiano;
+
+    CONST Esc = CHR(27);
+
+    VAR ch: CHAR;  note, lastnote: ZeroToTwenty;  w: Window;
+
+    BEGIN
+	lastnote := 12;
+	SetNoteDuration (150);
+	OpenSimpleWindow (w, 0, 3, 49, 79);
+	WriteString (w, "Use the Esc key to return the");  WriteLn (w);
+	WriteString (w, "keyboard to normal operation.");
+	LOOP
+	    ch := InKey();
+	    IF ch = Esc THEN EXIT(*LOOP*);
+	    ELSIF ch = "b" THEN PlayMusic ("d")
+	    ELSIF ch = "n" THEN PlayMusic ("u")
+	    ELSE
+		note := Code (ch);
+		IF note <> 0 THEN
+
+		    IF INTEGER (note) - INTEGER(lastnote) > 6 THEN
+			PlayMusic ("u");
+		    ELSIF INTEGER(lastnote) - INTEGER(note) > 6 THEN
+			PlayMusic ("d");
+		    END (*IF*);
+
+		    PlayMusic (OutTable[note]);
+		    lastnote := note;
+		END (*IF*);
+	    END (*IF*);
+	END (*LOOP*);
+	CloseWindow (w);
+    END PlayPiano;
+
+(************************************************************************)
+
+END Piano.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/play3.def b/examples/Modula-2_Libraries/PMOS/sources/general/play3.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/play3.def
@@ -0,0 +1,113 @@
+DEFINITION MODULE Play3;
+
+	(********************************************************)
+	(*							*)
+	(*		    3-part music			*)
+	(*							*)
+	(*  Programmer:		P. Moylan, T. Channon		*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	This is a version that does waveform shaping.	*)
+	(*	Note that the caller's data format is different	*)
+	(*	from that used by module Play3S.		*)
+	(*							*)
+	(*	Requires a fast processor, because the timing	*)
+	(*	constraints are fairly tight.			*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(*			THE FORMAT OF THE USER DATA			*)
+(************************************************************************)
+(*									*)
+(* The music to be played is specified in the form of three arrays,	*)
+(* one for each voice.  Each of the words specifies a time scale for	*)
+(* stepping through a waveform (higher values give higher frequencies).	*)
+(* A value of 0 indicates a rest.					*)
+(*									*)
+(* The largest possible data values are reserved as special codes:	*)
+(*									*)
+(*	CODE	    MEANING		    EXTRA WORDS			*)
+(*									*)
+(*	65531	Set envelope		new envelope number (one word)	*)
+(*	65532	Set waveform		new wave number (one word)	*)
+(*	65533	obsolete, do not use	(none)				*)
+(*	65534	Set note duration	new duration (one word)		*)
+(*	65535	End of data		(none)				*)
+(*									*)
+(************************************************************************)
+
+FROM SYSTEM IMPORT BYTE;
+
+CONST
+    (* CycleCount defines the sampling rate.  It has to be low enough	*)
+    (* to avoid problems with frequency aliasing, but not so low that	*)
+    (* the processor has trouble keeping up.				*)
+
+    (* Note that a change to CycleCount would require the caller to	*)
+    (* re-scale the frequency specifications in the input data.  This	*)
+    (* module adjusts note durations to compensate for changes in	*)
+    (* CycleCount, but it does not adjust the frequencies.		*)
+
+    CycleCount = 64;
+
+TYPE
+    VoiceNumber = [1..3];
+
+    (* In the attack/decay envelope shaping is defined by an array of	*)
+    (* gains (see below).  The next declaration defines the possible	*)
+    (* gain values.							*)
+
+    GainType = [0..31];
+
+    (* We allow the caller to define up to eight different waveforms.	*)
+
+    WaveNumber = [0..7];
+
+    (* A wave table is a set of values for one complete cycle.  To	*)
+    (* avoid overflow, values in a wave table should not normally	*)
+    (* exceed (CycleCount DIV 6) in magnitude, although it's possible	*)
+    (* to go higher by trading off the amplitude of the different	*)
+    (* voices.								*)
+    (*									*)
+    (* Recent change: the above needs to be scaled up, because I'm	*)
+    (* now using INTEGER rather than SHORTINT values in the tables.	*)
+    (*									*)
+    (* To speed up execution, we require the user to supply a complete	*)
+    (* set of wave tables, one for each gain level, for each waveform.	*)
+    (* This means that the scaling is done ahead of time rather than	*)
+    (* having to be done while the music is playing.			*)
+
+    WaveTablePointer = POINTER TO ARRAY BYTE OF INTEGER;
+    WaveGroup = ARRAY GainType OF WaveTablePointer;
+
+    (* We allow the caller to define several different attack/decay	*)
+    (* envelopes.							*)
+
+    EnvelopeNumber = [0..7];
+
+    (* The main body of an envelope is defined by a time sequence	*)
+    (* of gains.							*)
+
+    EnvelopeArrayIndex = [0..63];
+    EnvelopePtr = POINTER TO ARRAY EnvelopeArrayIndex OF GainType;
+
+PROCEDURE DefineWaveform (N: WaveNumber;  VAR (*IN*) data: WaveGroup);
+
+    (* Defines a new waveform for wave number N. *)
+
+PROCEDURE DefineEnvelope (E: EnvelopeNumber;  shapeptr: EnvelopePtr);
+
+    (* Defines one of the attack/decay envelopes. *)
+
+PROCEDURE Play (VAR (*IN*) A1, A2, A3: ARRAY OF CARDINAL);
+
+    (* Plays the music encoded in arrays A1, A2, A3.  The encoding is	*)
+    (* explained in the comments above.  Assumption: DefineWaveform and	*)
+    (* DefineEnvelope have already been called for any waveform and	*)
+    (* envelope that will be used.  In the absence of any specification	*)
+    (* in the data, waveform 0 and envelope 0 are used.			*)
+
+END Play3.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/play3.mod b/examples/Modula-2_Libraries/PMOS/sources/general/play3.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/play3.mod
@@ -0,0 +1,376 @@
+IMPLEMENTATION MODULE Play3;
+
+	(********************************************************)
+	(*							*)
+	(*		    3-part music			*)
+	(*							*)
+	(*  Programmer:		P. Moylan, T. Channon		*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	This is the version that uses a precomputed	*)
+	(*	envelope and precomputed amplitude.		*)
+	(*							*)
+	(*	This is the module that deals with the data	*)
+	(*	format used by Music3.  It takes three data	*)
+	(*	arrays produced by Music3, and converts the	*)
+	(*	data in real time to sample values which are	*)
+	(*	then sent to the speaker by the subsidiary	*)
+	(*	module PlayBuff.				*)
+	(*							*)
+	(********************************************************)
+
+FROM PlayBuff IMPORT
+    (* const *)	OutputBufferSize,
+    (* proc *)	BufferAddress, SetCycleCount, StartPlaying,
+		Synch0, Synch1, StopPlaying;
+
+FROM IO IMPORT
+    (* proc *)	KeyPressed;
+
+FROM LowLevel IMPORT
+    (* proc *)	AddOffset, SubtractOffset, FarAddOffset;
+
+(************************************************************************)
+(*				GLOBAL DATA				*)
+(************************************************************************)
+
+CONST
+    (* TimeScale is an overall scaling factor for note durations.	*)
+    (* This saves the caller the trouble of re-scaling for different	*)
+    (* versions of this module.  It also contains an adjustment for	*)
+    (* changes in CycleCount.						*)
+
+    TimeScale = 1664 DIV CycleCount;
+
+    (* DefaultDuration is the initial note duration.  Its value is	*)
+    (* not particularly important, since typically this will be		*)
+    (* overridden by a duration specification by the caller.		*)
+
+    DefaultDuration = 200;
+
+TYPE
+    OutputBufferSubscript = [0..OutputBufferSize-1];
+    (*# save, data(near_ptr=>off) *)
+    OutputBufferPointer = POINTER TO ARRAY OutputBufferSubscript OF SHORTINT;
+    (*# restore *)
+    VoiceSet = SET OF VoiceNumber;
+    WaveGroupPointer = POINTER TO WaveGroup;
+
+VAR
+
+    (* We have two output buffers, which we fill alternately.  The	*)
+    (* following two pointers point to the two buffers.			*)
+
+    OutPtr0, OutPtr1: OutputBufferPointer;
+
+    (* Flag to say that playing should stop. *)
+
+    ExitFlag: BOOLEAN;
+
+    (* Pointers to tables defining one period of the waveform to be played.*)
+
+    WaveTable: ARRAY WaveNumber OF WaveGroup;
+
+    (* Pointers to tables defining the attack/decay envelopes. *)
+
+    EnvelopePointer: ARRAY EnvelopeNumber OF EnvelopePtr;
+
+    (* Tables defining the current state of each voice.  The fields	*)
+    (* have the following meanings.					*)
+    (*	Duration	The time duration of a note.  This must be	*)
+    (*			multiplied by TimeScale to get a value in units	*)
+    (*			of sampling instants.				*)
+    (*	SamplesLeft	The number of sampling instants remaining for	*)
+    (*			the note that is currently playing.		*)
+    (*	Step		The high-order byte of this variable gives the	*)
+    (*			step size when stepping through the waveform	*)
+    (*			table.  (The low-order byte is in effect the	*)
+    (*			fractional part.)  This defines the frequency	*)
+    (*			of the note.					*)
+    (*	EnvIndex	Where we're up to in the envelope array.	*)
+    (*	EnvPtr		A pointer to the envelope array.		*)
+    (*	SamplePos	Where we're up to in the waveform table.	*)
+    (*	WaveGroupPtr	Points to a set of waveform tables.		*)
+    (*	WavePtr		Pointer to the current waveform table.		*)
+    (*	InPtr		Where we're up to in the input data.		*)
+
+    VoiceData: ARRAY VoiceNumber OF
+		    RECORD
+
+			(* Information about the current state of play. *)
+
+			Duration: CARDINAL;
+			SamplesLeft: CARDINAL;
+			Step: CARDINAL;
+
+			(* Attack/decay shaping. *)
+
+			EnvIndex: EnvelopeArrayIndex;
+			EnvPtr: EnvelopePtr;
+
+			(* References to the waveform tables. *)
+
+			SamplePos:  RECORD
+					CASE :BOOLEAN OF
+					   | FALSE:	w: CARDINAL;
+					   | TRUE:	lo, hi: BYTE;
+					END (*CASE*);
+				    END (*RECORD*);
+			WaveGroupPtr: WaveGroupPointer;
+			WavePtr: WaveTablePointer;
+
+			(* The "source" from which we're working. *)
+
+			InPtr: POINTER TO CARDINAL;
+
+		    END (*RECORD*);
+
+    (* The set of voices which have finished playing. *)
+
+    VoicesFinished: VoiceSet;
+
+(************************************************************************)
+(*			STARTING A NEW NOTE				*)
+(************************************************************************)
+
+PROCEDURE LoadNewNote (V: VoiceNumber);
+
+    (* Sets up the conditions needed to start playing a new note for	*)
+    (* voice V.								*)
+
+    BEGIN
+	ExitFlag := KeyPressed();
+	WITH VoiceData[V] DO
+	    Step := InPtr^;  InPtr := AddOffset (InPtr, 2);
+	    WHILE Step >= 65531 DO
+		CASE Step OF
+		  | 65531:	(* Set new envelope number. *)
+				EnvPtr := EnvelopePointer[InPtr^];
+				InPtr := AddOffset (InPtr, 2);
+				Step := InPtr^;  InPtr := AddOffset (InPtr, 2);
+
+		  | 65532:	(* Set new waveform. *)
+				WaveGroupPtr := ADR(WaveTable[InPtr^]);
+				InPtr := AddOffset (InPtr, 2);
+				Step := InPtr^;  InPtr := AddOffset (InPtr, 2);
+
+		  | 65533:	(* Obsolete, should not occur. *)
+				Step := InPtr^;  InPtr := AddOffset (InPtr, 2);
+
+		  | 65534:	(* New duration. *)
+				Duration := InPtr^;
+				InPtr := AddOffset (InPtr, 2);
+				Step := InPtr^;  InPtr := AddOffset (InPtr, 2);
+
+		  | 65535:	(* End of data. *)
+				INCL (VoicesFinished, V);
+				ExitFlag := ExitFlag OR
+				  (VoicesFinished = VoiceSet{1..MAX(VoiceNumber)});
+				Step := 0;
+				InPtr := SubtractOffset (InPtr, 2);
+
+		END (*CASE*);
+
+	    END (*WHILE*);
+
+	    SamplesLeft := TimeScale*Duration;
+	    WavePtr := WaveGroupPtr^[0];
+	    EnvIndex := 0;
+
+	END (*WITH*);
+
+    END LoadNewNote;
+
+(************************************************************************)
+(*		   LOADING DATA INTO THE OUTPUT BUFFER			*)
+(************************************************************************)
+
+PROCEDURE FillBuffer (p: OutputBufferPointer);
+
+    (* Produces the next N bytes of output data. *)
+
+    CONST bias = 128*CycleCount+255;
+
+    TYPE cast = RECORD
+		    CASE :BOOLEAN OF
+		      | FALSE:	int: INTEGER;
+		      | TRUE:	lo, hi: SHORTINT;
+		    END (*CASE*);
+		END (*RECORD*);
+
+    VAR place: OutputBufferSubscript;  sum: cast;
+
+    BEGIN
+	FOR place := 0 TO MAX(OutputBufferSubscript) DO
+
+	    (* If we've come to the end of the current note	*)
+	    (* for any voice, set up a new one.			*)
+
+	    IF VoiceData[1].SamplesLeft = 0 THEN
+		LoadNewNote (1);
+	    END (*IF*);
+	    IF VoiceData[2].SamplesLeft = 0 THEN
+		LoadNewNote (2);
+	    END (*IF*);
+	    IF VoiceData[3].SamplesLeft = 0 THEN
+		LoadNewNote (3);
+	    END (*IF*);
+
+	    (* Pick up new levels from the waveform tables,	*)
+	    (* and add them to the value in the output buffer.	*)
+	    (* Note that SamplePos must be permitted to wrap.	*)
+
+	    (*# save, check(overflow => off) *)
+	    INC (VoiceData[1].SamplePos.w, VoiceData[1].Step);
+	    INC (VoiceData[2].SamplePos.w, VoiceData[2].Step);
+	    INC (VoiceData[3].SamplePos.w, VoiceData[3].Step);
+	    (*# restore *)
+
+	    DEC (VoiceData[1].SamplesLeft);
+	    DEC (VoiceData[2].SamplesLeft);
+	    DEC (VoiceData[3].SamplesLeft);
+
+            sum.int := VoiceData[1].WavePtr^[VoiceData[1].SamplePos.hi]
+		+ VoiceData[2].WavePtr^[VoiceData[2].SamplePos.hi]
+		+ VoiceData[3].WavePtr^[VoiceData[3].SamplePos.hi] + bias;
+	    p^[place] := sum.hi;
+
+	END (*FOR*);
+	
+	(* To save on processor time, we do envelope updating only	*)
+	(* once per buffer.  This version uses a precomputed envelope.	*)
+	(* Note that WaveGroupPtr points to a collection of waveform	*)
+	(* tables, one for each gain level.  What we are doing here, in	*)
+	(* effect, is updating the gain.				*)
+
+	WITH VoiceData[1] DO
+	    WavePtr := WaveGroupPtr^[EnvPtr^[EnvIndex]];
+	    IF EnvIndex < MAX(EnvelopeArrayIndex) THEN
+		INC (EnvIndex);
+	    END (*IF*);
+	END (*WITH*);
+	WITH VoiceData[2] DO
+	    WavePtr := WaveGroupPtr^[EnvPtr^[EnvIndex]];
+	    IF EnvIndex < MAX(EnvelopeArrayIndex) THEN
+		INC (EnvIndex);
+	    END (*IF*);
+	END (*WITH*);
+	WITH VoiceData[3] DO
+	    WavePtr := WaveGroupPtr^[EnvPtr^[EnvIndex]];
+	    IF EnvIndex < MAX(EnvelopeArrayIndex) THEN
+		INC (EnvIndex);
+	    END (*IF*);
+	END (*WITH*);
+
+    END FillBuffer;
+
+(************************************************************************)
+(*	   THE EXTERNALLY CALLABLE PROCEDURES FOR PLAYING MUSIC		*)
+(************************************************************************)
+
+PROCEDURE DefineWaveform (N: WaveNumber;  VAR (*IN*) data: WaveGroup);
+
+    (* Defines a new waveform for wave number N. *)
+
+    BEGIN
+	WaveTable[N] := data;
+    END DefineWaveform;
+
+(************************************************************************)
+
+PROCEDURE DefineEnvelope (E: EnvelopeNumber;  shapeptr: EnvelopePtr);
+
+    (* Defines one of the attack/decay envelopes. *)
+
+    BEGIN
+	EnvelopePointer[E] := shapeptr;
+    END DefineEnvelope;
+
+(************************************************************************)
+
+PROCEDURE Play (VAR (*IN*) A1, A2, A3: ARRAY OF CARDINAL);
+
+    (* Plays the music encoded in arrays A1, A2, A3.  The encoding is	*)
+    (* explained in the comments in the definition module.		*)
+
+    VAR voice: VoiceNumber;  p: OutputBufferPointer;
+        i : CARDINAL;
+
+    BEGIN
+	(* Set up pointers to the user data.	*)
+
+	VoiceData[1].InPtr := ADR(A1);
+	VoiceData[2].InPtr := ADR(A2);
+	VoiceData[3].InPtr := ADR(A3);
+
+	(* Set the state of all voices to suitable initial conditions.	*)
+
+	FOR voice := 1 TO MAX(VoiceNumber) DO
+	    WITH VoiceData[voice] DO
+		Duration := DefaultDuration;
+		SamplesLeft := 0;
+		Step := 0;
+		EnvPtr := EnvelopePointer[0];
+		SamplePos.w := 0;
+		WaveGroupPtr := ADR(WaveTable[0]);
+		WavePtr := WaveGroupPtr^[0];
+	    END (*WITH*);
+	END (*FOR*);
+	VoicesFinished := VoiceSet{};
+	ExitFlag := FALSE;
+
+	(* Now for the actual playing. *)
+
+	FillBuffer(OutPtr0);
+	StartPlaying;
+	WHILE NOT ExitFlag DO
+	    Synch1;
+	    FillBuffer(OutPtr1);
+	    Synch0;
+	    FillBuffer(OutPtr0);
+	END (*WHILE*);
+	StopPlaying;
+
+    END Play;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE SetDefaults;
+
+    (* Gives initial conditions to some of the global variables.  Note	*)
+    (* that a lot of the initialisation is done in procedure Play, and	*)
+    (* various variables are given values by commands embedded in the	*)
+    (* user data.  We do however have to cover the possibility that	*)
+    (* the caller neglects to specify some options.			*)
+
+    VAR w: WaveNumber;  E: EnvelopeNumber;
+	NilGroup: WaveGroup;  g: GainType;
+
+    BEGIN
+
+	FOR g := 0 TO MAX(GainType) DO
+	    NilGroup[g] := NIL;
+	END (*FOR*);
+
+	FOR w := 0 TO MAX(WaveNumber) DO
+	    WaveTable[w] := NilGroup;
+	END (*FOR*);
+
+	FOR E := 0 TO MAX(EnvelopeNumber) DO
+	    EnvelopePointer[E] := NIL;
+	END (*FOR*);
+
+    END SetDefaults;
+
+(************************************************************************)
+
+BEGIN
+    OutPtr0 := BufferAddress();
+    OutPtr1 := FarAddOffset (OutPtr0, OutputBufferSize);
+    SetCycleCount (CycleCount);
+    SetDefaults;
+END Play3.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/play3s.def b/examples/Modula-2_Libraries/PMOS/sources/general/play3s.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/play3s.def
@@ -0,0 +1,58 @@
+DEFINITION MODULE Play3S;
+
+	(********************************************************)
+	(*							*)
+	(*		    3-part music			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	10 June 1994			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	See the notes in the implementation module	*)
+	(*	for details of how to adjust the note		*)
+	(*	frequencies and durations to compensate		*)
+	(*	for different processor speeds.			*)
+	(*							*)
+	(********************************************************)
+
+IMPORT Keyboard;	(* forces keyboard handler to be linked *)
+
+(************************************************************************)
+(*			THE FORMAT OF THE USER DATA			*)
+(************************************************************************)
+(*									*)
+(* The music to be played is specified as an array of entries, each of	*)
+(* which is three bytes long.  Each of the bytes specifies a note, so	*)
+(* the triplet of bytes specifies three notes to be played		*)
+(* simultaneously.  A value of 0 indicates a rest.			*)
+(*									*)
+(* Note values are in the range 1..63, and a standard 12 notes/octave	*)
+(* scale is used.  (The main limit on the allowable range arises from	*)
+(* aliasing effects due to the way we do the sampling.)  Note that the	*)
+(* absolute note frequencies depend on the processor speed, although	*)
+(* relative frequencies are processor-independent.			*)
+(*									*)
+(* Values greater than 63 in the first byte are interpreted as follows.	*)
+(*									*)
+(*	BYTE 1	    MEANING		    BYTES 2 AND 3		*)
+(*									*)
+(*	64..251	Currently not used	no meaning assigned		*)
+(*	 252	No meaning assigned	ignored; this option is present	*)
+(*					only for compatibility with	*)
+(*					other versions of this module.	*)
+(*	 253	Change note duration	the current duration is		*)
+(*					multiplied by the value in	*)
+(*					byte 2 and then divided by the	*)
+(*					value in byte 3			*)
+(*	 254	Set note duration	new duration (16 bits)		*)
+(*	 255	End of data		not needed			*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE Play (VAR (*IN*) A: ARRAY OF BYTE);
+
+    (* Plays the music encoded in array A.  The encoding is explained	*)
+    (* in the comments above.						*)
+
+END Play3S.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/playbuff.def b/examples/Modula-2_Libraries/PMOS/sources/general/playbuff.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/playbuff.def
@@ -0,0 +1,95 @@
+DEFINITION MODULE PlayBuff;
+
+	(********************************************************)
+	(*							*)
+	(*		Playing buffered sounds			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	25 February 1995		*)
+	(*  Status:		OK				*)
+	(*							*)
+	(*	This module consists mainly of a timer		*)
+	(*	interrupt routine which continuously sends	*)
+	(*	data from a memory buffer to the speaker.	*)
+	(*	Higher-level modules can produce sound by	*)
+	(*	computing the desired waveform and stuffing	*)
+	(*	it into the buffer (using synchronisation	*)
+	(*	calls to ensure that they don't overwrite	*)
+	(*	data that haven't yet been sent to the		*)
+	(*	speaker).					*)
+	(*							*)
+	(*	Note that synchronisation will be lost,		*)
+	(*	resulting in a distorted sound, if the caller	*)
+	(*	is unable to supply data fast enough.		*)
+	(*	Programs using this module are not necessarily	*)
+	(*	portable to slower processors.			*)
+	(*							*)
+	(********************************************************)
+
+(*# module (init_code => off) *)
+
+FROM Types IMPORT
+    (* proc *)	FarPointer;
+
+(************************************************************************)
+(*			THE FORMAT OF THE USER DATA			*)
+(************************************************************************)
+(*									*)
+(* The waveform to be played is specified as an array of bytes, each of	*)
+(* which specifies a desired output level at one sample time.  We're	*)
+(* operating under some very tight time constraints, so to gain speed	*)
+(* the caller writes directly into the memory buffer from which the	*)
+(* timer interrupt routine in this module is taking the values.  It's	*)
+(* a single circular buffer internally, but the caller is expected to	*)
+(* treat it as two half-buffers, each of size OutputBufferSize.  As the	*)
+(* interrupt routine is working on one half, the caller is expected to	*)
+(* fill the other.  The interrupt routine never waits for the caller to	*)
+(* supply data, so it's up to the caller to supply new data as quickly	*)
+(* as possible, using procedures Synch0 and Synch1 to avoid overtaking	*)
+(* the interrupt routine.						*)
+(*									*)
+(************************************************************************)
+
+CONST OutputBufferSize = 128;
+
+    (* OutputBufferSize is the size of a half-buffer.  Do not alter	*)
+    (* this constant unless you are prepared to make consequential	*)
+    (* changes in the implementation module.				*)
+
+PROCEDURE BufferAddress (): FarPointer;
+
+    (* Returns the address of the first half-buffer. *)
+
+PROCEDURE SetCycleCount (count: BYTE);
+
+    (* Sets the cycle count which determines the sampling frequency.	*)
+    (* The default value is 64, giving an 18.643 kHz sampling rate.	*)
+
+PROCEDURE StartPlaying;
+
+    (* Call this just after the first half-buffer has been filled. *)
+
+(*# save, call(near_call=>off, seg_name=>PlayBuff) *)
+
+PROCEDURE Synch0;
+
+    (* Call this when you've just finished filling the second half of	*)
+    (* the buffer and want to move back to the first half.  On return	*)
+    (* from this procedure, the caller is permitted to start filling	*)
+    (* the first half.							*)
+
+PROCEDURE Synch1;
+
+    (* Call this when you've just finished filling the first half of	*)
+    (* the buffer and want to move on to the second half.  On return	*)
+    (* from this procedure, the caller is permitted to start filling	*)
+    (* the second half.							*)
+
+(*# restore *)
+
+PROCEDURE StopPlaying;
+
+    (* Stops the music and cleans up. *)
+
+END PlayBuff.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/playlist.def b/examples/Modula-2_Libraries/PMOS/sources/general/playlist.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/playlist.def
@@ -0,0 +1,43 @@
+DEFINITION MODULE PlayList;
+
+	(********************************************************)
+	(*							*)
+	(*	Playing sounds from a list of buffers		*)
+	(*							*)
+	(*  Programmer:		P. Moylan, T. Channon		*)
+	(*  Last edited:	26 February 1995		*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	Requires a fast processor, because the timing	*)
+	(*	constraints are fairly tight.			*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT BYTE;
+
+FROM PlayBuff IMPORT
+    (* const*)	OutputBufferSize;
+
+TYPE
+    BufferList;		(* is private *)
+    OutputBufferSubscript = [0..OutputBufferSize-1];
+    OutputBufferPointer = POINTER TO ARRAY OutputBufferSubscript OF BYTE;
+
+PROCEDURE CreateList (VAR (*OUT*) L: BufferList);
+
+    (* Creates an empty list. *)
+
+PROCEDURE AddToList (VAR (*INOUT*) L: BufferList;  p: OutputBufferPointer);
+
+    (* Appends p^ to L. *)
+
+PROCEDURE PlayFromList (L: BufferList);
+
+    (* Real sound play. *)
+
+PROCEDURE DiscardList (VAR (*INOUT*) L: BufferList);
+
+    (* Returns the whole of L to free storage. *)
+
+END PlayList.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/playlist.mod b/examples/Modula-2_Libraries/PMOS/sources/general/playlist.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/playlist.mod
@@ -0,0 +1,148 @@
+IMPLEMENTATION MODULE PlayList;
+
+	(********************************************************)
+	(*							*)
+	(*	Playing sounds from a list of buffers		*)
+	(*							*)
+	(*  Programmer:		P. Moylan, based on ideas	*)
+	(*			developed by T. Channon		*)
+	(*  Last edited:	27 February 1995		*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE;
+
+FROM Types IMPORT
+    (* type *)	FarPointer;
+
+FROM PlayBuff IMPORT
+    (* proc *)	BufferAddress, StartPlaying, Synch0, Synch1, StopPlaying;
+
+FROM Keyboard IMPORT
+    (* proc *)	KeyPressed;
+
+FROM LowLevel IMPORT
+    (* proc *)	FarAddOffset, FarCopy, Far;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+(************************************************************************)
+(*			    TYPE DEFINITIONS				*)
+(************************************************************************)
+
+TYPE
+    (* A BufferList is a linked list of buffers. *)
+
+    ListPointer = POINTER TO BlockHeader;
+    BlockHeader =   RECORD
+			next: ListPointer;
+			dataptr: OutputBufferPointer;
+		    END (*RECORD*);
+
+    BufferList = POINTER TO RECORD
+		     head, tail: ListPointer;
+		 END (*RECORD*);
+
+(************************************************************************)
+(*			  LIST MANIPULATION				*)
+(************************************************************************)
+
+PROCEDURE CreateList (VAR (*OUT*) L: BufferList);
+
+    (* Creates an empty list. *)
+
+    BEGIN
+	NEW (L);
+	WITH L^ DO
+	    head := NIL;  tail := NIL;
+	END (*WITH*);
+    END CreateList;
+
+(************************************************************************)
+
+PROCEDURE AddToList (VAR (*INOUT*) L: BufferList;  p: OutputBufferPointer);
+
+    (* Appends p^ to L. *)
+
+    VAR elt: ListPointer;
+
+    BEGIN
+	NEW (elt);  elt^.next := NIL;  elt^.dataptr := p;
+	IF L^.head = NIL THEN L^.head := elt
+	ELSE L^.tail^.next := elt
+	END (*IF*);
+	L^.tail := elt;
+    END AddToList;
+
+(************************************************************************)
+
+PROCEDURE DiscardList (VAR (*INOUT*) L: BufferList);
+
+    (* Returns the whole of L to free storage. *)
+
+    VAR next: ListPointer;
+
+    BEGIN
+	WHILE L^.head <> NIL DO
+	    DISPOSE (L^.head^.dataptr);
+	    next := L^.head^.next;
+	    DISPOSE (L^.head);
+	    L^.head := next;
+	END (*WHILE*);
+	DISPOSE (L);
+    END DiscardList;
+
+(************************************************************************)
+(*		    PLAYING FROM A LIST OF BUFFERS			*)
+(************************************************************************)
+
+PROCEDURE PlayFromList (L: BufferList);
+
+    (* Real sound play. *)
+
+    VAR LP: ListPointer;
+	OutPtr0, OutPtr1: FarPointer;
+
+    BEGIN
+	(* We have two output buffers, which we fill alternately.  The	*)
+	(* following two pointers point to the two buffers.		*)
+
+	OutPtr0 := BufferAddress();
+	OutPtr1 := FarAddOffset (OutPtr0, OutputBufferSize);
+
+	(* Copy the first data block to buffer 0, then start playing.	*)
+
+	LP := L^.head;
+	IF LP = NIL THEN RETURN END(*IF*);
+	FarCopy (Far(LP^.dataptr), OutPtr0, OutputBufferSize);
+	LP := LP^.next;
+	StartPlaying;
+
+	LOOP
+	    (* Wait for buffer 1 to become available, then fill it.	*)
+
+	    Synch1;
+	    IF LP = NIL THEN EXIT END(*IF*);
+	    FarCopy (Far(LP^.dataptr), OutPtr1, OutputBufferSize);
+	    LP := LP^.next;
+
+	    (* Wait for buffer 0 to become available, then fill it.	*)
+
+	    Synch0;
+	    IF (LP = NIL) OR KeyPressed() THEN EXIT END(*IF*);
+	    FarCopy (Far(LP^.dataptr), OutPtr0, OutputBufferSize);
+	    LP := LP^.next;
+
+	END (*LOOP*);
+
+	StopPlaying;
+
+    END PlayFromList;
+
+(************************************************************************)
+
+END PlayList.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/printer.def b/examples/Modula-2_Libraries/PMOS/sources/general/printer.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/printer.def
@@ -0,0 +1,21 @@
+DEFINITION MODULE Printer;
+
+	(********************************************************)
+	(*							*)
+	(*	    Device driver for the printer.		*)
+	(*							*)
+	(*	Author:		P. Moylan			*)
+	(*	Last edited:	21 August 1989			*)
+	(*							*)
+	(*	Status:		Working.			*)
+	(*							*)
+	(********************************************************)
+
+PROCEDURE PrintChar (ch: CHAR);
+
+    (* Sends one character to the printer.  NOTE: Many printers have	*)
+    (* an internal buffer which saves characters until a whole line of	*)
+    (* characters has been received.  Thus, the printing of the current	*)
+    (* character might be delayed until a carriage return is received.	*)
+
+END Printer.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/printer.mod b/examples/Modula-2_Libraries/PMOS/sources/general/printer.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/printer.mod
@@ -0,0 +1,324 @@
+IMPLEMENTATION MODULE Printer;
+
+	(********************************************************)
+	(*							*)
+	(*	    Device driver for the printer.		*)
+	(*							*)
+	(*	Author:		P. Moylan			*)
+	(*	Last edited:	6 March 1995			*)
+	(*	Status:		Partly working			*)
+	(*							*)
+	(*	More precisely: it was working with my earlier	*)
+	(*	Epson printer, but is leaving the DeskJet in	*)
+	(*	a "busy" state at the completion of printing.	*)
+	(*	I haven't yet tracked down the reason.		*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(*									*)
+(*  The printer interface is addressed through three consecutive I/O	*)
+(*  ports: the data register, the status register, and the control	*)
+(*  register, in that order.  An unusual feature of the interface is	*)
+(*  that putting a character into the data register does not in itself	*)
+(*  cause the character to be printed - it is also necessary to		*)
+(*  manipulate a "strobe" bit in the control register.			*)
+(*									*)
+(*  The status register is almost unused by this module, but for	*)
+(*  interest's sake here are the bit assignments:			*)
+(*	   bit	7	1=not busy, i.e. ready				*)
+(*		6	1=acknowledge (not sure what is acknowledged)	*)
+(*		5	1=out of paper					*)
+(*		4	1=selected					*)
+(*		3	1=I/O error					*)
+(*		2-0	unused						*)
+(*									*)
+(*  The bit assignments for the control register, deduced from tests	*)
+(*  and from some very sketchy documentation, appear to	be:		*)
+(*	   bit	7-5	unknown (unused?)				*)
+(*		4	1 = interrupt enable				*)
+(*		3	should be 1, not sure why			*)
+(*		2	1=normal operation, 0=init			*)
+(*		1	1=automatic line feed after carriage return	*)
+(*		0	1=output strobe					*)
+(*									*)
+(*  For normal operation, we use a value of 1CH, which specifies	*)
+(*  interrupt enable, no initialisation, no auto line feed.  When we	*)
+(*  actually send a character, we also have to set the strobe bit.	*)
+(*									*)
+(*  Bit 3 is still a mystery to me.  The tests I have done so far	*)
+(*  suggest that this bit has no effect.				*)
+(*									*)
+(************************************************************************)
+
+FROM LowLevel IMPORT
+    (* proc *)	IANDB, IORB, InByte, OutByte;
+
+FROM TaskControl IMPORT
+    (* proc *)	CreateInterruptTask, WaitForInterrupt;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+(************************************************************************)
+
+CONST
+    IntMaskRegister = 21H;
+
+    PrinterDataPort = 278H;
+    PrinterInterruptNumber = 15;
+    InterruptMask = 80H;
+
+    (********************************************************************)
+    (*									*)
+    (*  Note: the "official" values of these constants are:		*)
+    (*					port #1		port #2		*)
+    (*		PrinterDataPort          378H		 278H		*)
+    (*		PrinterInterruptNumber	  15		  13		*)
+    (*		InterruptMask		  80H             20H		*)
+    (*									*)
+    (*  For some reason, my printer seems to be using the interrupt	*)
+    (*  belonging to printer port #1, but the port number of printer	*)
+    (*  port #2.							*)
+    (*									*)
+    (********************************************************************)
+
+    PrinterStatusPort = PrinterDataPort + 1;
+    PrinterControlPort = PrinterDataPort + 2;
+    ControlByte = 1CH;
+    MaxBufferSubscript = 7;
+
+TYPE
+    BufferSubscript = [0..MaxBufferSubscript];
+
+VAR
+
+    (* OutputBuffer is a circular buffer holding characters to be sent	*)
+    (* to the printer.  The SpaceAvailable semaphore is a counting	*)
+    (* semaphore which keeps track of how many unused character slots	*)
+    (* remain in the buffer.  OutPlace points to the next character	*)
+    (* which will be sent to the printer.  PutPlace is the place where	*)
+    (* the next user output character will be put.  The condition	*)
+    (* OutPlace=PutPlace could mean either that the buffer is		*)
+    (* completely empty or that it is completely full.  We can tell the	*)
+    (* difference by knowing whether we have just put something in the	*)
+    (* buffer or removed something from it.				*)
+
+    OutputBuffer:   RECORD
+			SpaceAvailable: Semaphore;
+			OutPlace, PutPlace: BufferSubscript;
+			data: ARRAY BufferSubscript OF CHAR
+		    END;
+
+(************************************************************************)
+
+PROCEDURE EnablePrinterInterrupts;
+
+    (* Allows printer interrupts to reach the processor, by clearing	*)
+    (* the appropriate bit in the interrupt mask register.  This works	*)
+    (* provided that there are no other devices sharing the same	*)
+    (* interrupt request.  If interrupt lines were shared, then		*)
+    (* interrupts would have to be turned on and off at the printer	*)
+    (* interface itself.						*)
+
+    BEGIN
+	OutByte (IntMaskRegister,
+		IANDB (InByte(IntMaskRegister), 0FFH - InterruptMask));
+    END EnablePrinterInterrupts;
+
+(************************************************************************)
+
+PROCEDURE DisablePrinterInterrupts;
+
+    BEGIN
+	OutByte (IntMaskRegister,
+			IORB (InByte(IntMaskRegister), InterruptMask));
+    END DisablePrinterInterrupts;
+
+(************************************************************************)
+
+PROCEDURE PrinterInterruptTask;
+
+    (* This task spends most of its time idle in the WaitForInterrupt	*)
+    (* call, and is resumed by an interrupt from the printer.  It then	*)
+    (* takes the first available character from the circular buffer	*)
+    (* OutputBuffer, and performs a semaphore Signal to indicate that	*)
+    (* there is extra free space in the buffer.  If the buffer is empty	*)
+    (* after this operation, further printer interrupts are disabled.	*)
+    (* Procedure PrintChar (see below) re-enables printer interrupts	*)
+    (* when it puts a new character in the buffer.			*)
+
+    CONST strobe = 1;
+
+    BEGIN
+	LOOP (*FOREVER*)
+	    WaitForInterrupt;
+	    WITH OutputBuffer DO
+
+		OutByte (PrinterDataPort, data[OutPlace]);
+
+		(* With this particular printer interface, writing to	*)
+		(* the printer data port does not strobe the data out	*)
+		(* to the printer.  (Why not?  No obvious reason, but	*)
+		(* perhaps the hardware designer just had had a bad	*)
+		(* day).  Instead, we must explicitly create a strobe	*)
+		(* pulse by setting the low order bit of the control	*)
+		(* port, and then clearing it.				*)
+
+		OutByte (PrinterControlPort, ControlByte + strobe);
+		OutByte (PrinterControlPort, ControlByte);
+
+		IF OutPlace = MaxBufferSubscript THEN OutPlace := 0
+		ELSE INC (OutPlace);
+		END (*IF*);
+
+		(* If now OutPlace=PutPlace, the buffer is empty, so	*)
+		(* the printer must be disabled until the buffer again	*)
+		(* contains something to print.				*)
+
+		IF OutPlace = PutPlace THEN
+		    DisablePrinterInterrupts;
+		END (*IF*);
+
+		Signal (SpaceAvailable);
+
+	    END (*WITH*);
+	END (*LOOP*);
+    END PrinterInterruptTask;
+
+(************************************************************************)
+
+PROCEDURE PrintChar (ch: CHAR);
+
+    (* Puts one character into the output buffer.  This procedure	*)
+    (* contains a somewhat subtle critical section, which can be	*)
+    (* explained as follows.  When the buffer is empty, printer		*)
+    (* interrupts need to be disabled, since otherwise the interrupt	*)
+    (* routine will print rubbish.  Thus, we should re-enable the	*)
+    (* printer after putting a new character in the buffer.  However,	*)
+    (* there is a possible sequence of events in which we put a new	*)
+    (* character in the buffer, and then the interrupt routine prints	*)
+    (* that character before we have updated the buffer pointer		*)
+    (* PutPlace.  In that case the interrupt routine could make a wrong	*)
+    (* decision about whether the buffer is empty.  The detailed	*)
+    (* consequences depend on whether we enable interrupts before or	*)
+    (* after updating PutPlace, but in either case we could end up with	*)
+    (* printer interrupts disabled when they should be enabled, or vice	*)
+    (* versa.  The solution is to make the combination of updating	*)
+    (* PutPlace and enabling printer interrupts indivisible.  We do	*)
+    (* this by disabling printer interrupts (whether or not they were	*)
+    (* already disabled) before modifying PutPlace.			*)
+
+    BEGIN
+	WITH OutputBuffer DO
+	    Wait (SpaceAvailable);
+	    data[PutPlace] := ch;
+
+	    (* Since it is possible that the buffer was empty before	*)
+	    (* adding this new character, printer interrupts might be	*)
+	    (* currently disabled, and we should enable them.  The	*)
+	    (* combined operations of updating PutPlace and enabling	*)
+	    (* the printer creates a critical section, which we protect	*)
+	    (* by disabling the printer in case it was already enabled.	*)
+
+	    DisablePrinterInterrupts;
+	    IF PutPlace = MaxBufferSubscript THEN PutPlace := 0
+	    ELSE INC (PutPlace);
+	    END (*IF*);
+	    EnablePrinterInterrupts;
+
+	END (*WITH*);
+    END PrintChar;
+
+(************************************************************************)
+
+PROCEDURE WaitForPrinterIdle;
+
+    (* Does not return until the printer buffer is empty.  Of course,	*)
+    (* the caller should also ensure that there are no future calls to	*)
+    (* PrintChar; otherwise there is little point in calling this	*)
+    (* procedure.							*)
+
+    BEGIN
+	WITH OutputBuffer DO
+	    REPEAT
+		Wait (SpaceAvailable);  Signal (SpaceAvailable);
+	    UNTIL OutPlace = PutPlace;
+	END (*WITH*);
+    END WaitForPrinterIdle;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE InitialisePrinter;
+
+    (* Performs the appropriate hardware initialisation to install the	*)
+    (* printer interrupt task and make the printer ready for use.	*)
+
+    BEGIN
+
+	CreateInterruptTask (PrinterInterruptNumber, PrinterInterruptTask,
+						"Printer int task");
+
+	(* Initialise printer by driving bit 2 low while keeping bit 3	*)
+	(* high.							*)
+
+	OutByte (PrinterControlPort, 8);
+
+	(* Disable interrupts on IRQ 7 of 8259.  The time taken by this	*)
+	(* operation seems to be about right for the time we need to	*)
+	(* kill while keeping the initialisation bit low.		*)
+
+	DisablePrinterInterrupts;
+
+	(* Now send bit 2 high to finish initialisation operation, and	*)
+	(* set bit 4 to enable interrupts.  Meanwhile bit 3 remains	*)
+	(* high, I don't know why but that's how I got it to work.	*)
+	(* From the documentation, I know I am setting non auto LF, not	*)
+	(* sure what else.						*)
+
+	OutByte (PrinterControlPort, ControlByte);
+
+	(* Wait for the printer "ready" bit to be set, to ensure that	*)
+	(* hardware initialisation is complete.				*)
+(*
+	REPEAT
+	    (* do nothing *)
+	UNTIL ORD(IANDB (InByte (PrinterStatusPort), 80H)) <> 0;
+*)
+	(* At this stage the printer interrupt task exists, the printer	*)
+	(* interface has been initialised and its "interrupt enable"	*)
+	(* bit has been set, but the interrupt mask register of the	*)
+	(* 8259A interrupt controller has been set up so that it will	*)
+	(* not yet pass on printer interrupts to the processor.  Thus,	*)
+	(* the first interrupt will not occur until there is something	*)
+	(* waiting to be printed.					*)
+
+    END InitialisePrinter;
+
+(************************************************************************)
+
+BEGIN
+
+    (* Initialize the character buffer.	*)
+
+    WITH OutputBuffer DO
+	CreateSemaphore (SpaceAvailable, MaxBufferSubscript+1);
+	OutPlace := 0;  PutPlace := 0;
+    END (*WITH*);
+
+    (* Install the printer interrupt routine.	*)
+
+    InitialisePrinter;
+
+    (* Provide for an orderly shutdown.	*)
+
+    SetTerminationProcedure (WaitForPrinterIdle);
+
+END Printer.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/queues.def b/examples/Modula-2_Libraries/PMOS/sources/general/queues.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/queues.def
@@ -0,0 +1,81 @@
+DEFINITION MODULE Queues;
+
+	(********************************************************)
+	(*							*)
+	(*		Generic queue module.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	12 November 1991		*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(*									*)
+(*  A non-obvious decision to be made in the design of a module like	*)
+(*  this is whether to work directly with the caller's data, or with	*)
+(*  pointers to the data.  In the present case, this means deciding	*)
+(*  whether to implement queues of user data or queues of pointers.	*)
+(*  The former choice is superior in terms of clarity and ease of use,	*)
+(*  but requires the physical copying of data between the queue and	*)
+(*  the caller's data structure.  The latter choice is more efficient,	*)
+(*  but requires the caller to be concerned with allocation and		*)
+(*  deallocation of data space.  With some languages we would not be	*)
+(*  faced with this delicate choice, but Modula-2 has relatively poor	*)
+(*  support for generic data structures.				*)
+(*									*)
+(*  For this module, the decision has been to support the more		*)
+(*  efficient but less elegant arrangement: to add something to the	*)
+(*  queue, the caller supplies a pointer to the data, which might	*)
+(*  require that the caller allocate some space for that data.  When	*)
+(*  an item is removed from the queue, what is returned is again a	*)
+(*  pointer to the data.  That is, the actual data live in a data	*)
+(*  space which is under the control of the user.  This implies that	*)
+(*  the caller can - but should not - modify queued data.  This		*)
+(*  solution is not as clean as it might have been, but is justified	*)
+(*  by the need of some callers of this module for a low-overhead	*)
+(*  solution.								*)
+(*									*)
+(*  Note, however, that the caller is not required to supply space for	*)
+(*  the "bookkeeping" information such as the pointers which link the	*)
+(*  queue elements together.  That level of detail is hidden inside	*)
+(*  this module, as it should be.					*)
+(*									*)
+(*  Critical section protection is also provided; that is, a queue	*)
+(*  may safely be used by multiple tasks.				*)
+(*									*)
+(************************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	ADDRESS;
+
+TYPE Queue;	(* is private *)
+
+PROCEDURE CreateQueue (VAR (*OUT*) Q: Queue);
+
+    (* Creates a new queue, initially empty.	*)
+
+PROCEDURE DestroyQueue (Q: Queue);
+
+    (* Destroys queue Q, thus freeing up the space it occupied.  Any	*)
+    (* data still on the queue are lost.  After this call, no further	*)
+    (* operations should be performed on the queue.			*)
+
+PROCEDURE AddToQueue (Q: Queue;  DataPointer: ADDRESS);
+
+    (* Places a new element at the tail of queue Q.  The caller has an	*)
+    (* obligation to ensure that DataPointer^ remains in existence	*)
+    (* for as long as it remains on the queue.				*)
+
+PROCEDURE TakeFromQueue (Q: Queue): ADDRESS;
+
+    (* Removes and returns a pointer to the datum at the head of the	*)
+    (* queue.  If the queue is empty, waits until data available.	*)
+
+PROCEDURE Empty (Q: Queue): BOOLEAN;
+
+    (* Returns TRUE iff Q is empty.  Warning: if more than one task is	*)
+    (* using this queue, there is no guarantee as to how long the queue	*)
+    (* will remain empty.						*)
+
+END Queues.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/queues.mod b/examples/Modula-2_Libraries/PMOS/sources/general/queues.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/queues.mod
@@ -0,0 +1,167 @@
+IMPLEMENTATION MODULE Queues;
+
+	(********************************************************)
+	(*							*)
+	(*		Generic queue module.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 February 1995		*)
+	(*  Status:		Working.			*)
+	(*							*)
+	(********************************************************)
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, DestroySemaphore, Wait, Signal;
+
+FROM TaskControl IMPORT
+    (* type *)	Lock,
+    (* proc *)	CreateLock, DestroyLock, Obtain, Release;
+
+(************************************************************************)
+
+TYPE
+
+    (* A QueueLink is a pointer from one queue element to the next.	*)
+
+    QueueLink = POINTER TO QueueElement;
+
+    (* The actual queue element contains a pointer to the next queue	*)
+    (* element, and a pointer to the enqueued data.			*)
+
+    QueueElement =  RECORD
+			next: QueueLink;
+			DataPtr: ADDRESS;
+		    END (*RECORD*);
+
+    (* Every queue has a header, which contains pointers to the head	*)
+    (* and tail of the queue; an access lock for critical section	*)
+    (* protection; and a counting semaphore which keeps track of the	*)
+    (* size of the queue.						*)
+
+    QueueHeader =   RECORD
+			head, tail: QueueLink;
+			access: Lock;
+			count: Semaphore;
+		    END (*RECORD*);
+
+    (* Finally, a Queue is defined via a pointer to its header.		*)
+
+    Queue = POINTER TO QueueHeader;
+
+(************************************************************************)
+
+PROCEDURE CreateQueue (VAR (*OUT*) Q: Queue);
+
+    (* Creates a new queue, initially empty.	*)
+
+    BEGIN
+	NEW (Q);
+	WITH Q^ DO
+	    head := NIL;  tail := NIL;
+	    CreateLock (access);
+	    CreateSemaphore (count, 0);
+	END (*WITH*);
+    END CreateQueue;
+
+(************************************************************************)
+
+PROCEDURE DestroyQueue (Q: Queue);
+
+    (* Destroys queue Q, thus freeing up the space it occupied.  Any	*)
+    (* data still on the queue are lost.  After this call, no further	*)
+    (* operations should be performed on the queue.			*)
+
+    VAR following: QueueLink;
+
+    BEGIN
+	WITH Q^ DO
+	    Obtain (access);
+	    WHILE head <> NIL DO
+		following := head^.next;
+		DISPOSE (head);
+		head := following;
+	    END (*WHILE*);
+	    DestroyLock (access);
+	    DestroySemaphore (count);
+	END (*WITH*);
+	DISPOSE (Q);
+    END DestroyQueue;
+
+(************************************************************************)
+
+PROCEDURE AddToQueue (Q: Queue;  DataPointer: ADDRESS);
+
+    (* Places a new element at the tail of queue Q.  The caller has an	*)
+    (* obligation to ensure that DataPointer^ remains in existence	*)
+    (* for as long as it remains on the queue.				*)
+
+    VAR element: QueueLink;
+
+    BEGIN
+	NEW (element);
+	WITH element^ DO
+	    next := NIL;  DataPtr := DataPointer;
+	END (*WITH*);
+	WITH Q^ DO
+	    Obtain (access);
+	    IF head = NIL THEN
+		head := element;
+	    ELSE
+		tail^.next := element;
+	    END (*IF*);
+	    tail := element;
+	    Release (access);
+	    Signal (count);
+	END (*WITH*);
+    END AddToQueue;
+
+(************************************************************************)
+
+PROCEDURE TakeFromQueue (Q: Queue): ADDRESS;
+
+    (* Removes and returns a pointer to the datum at the head of the	*)
+    (* queue.								*)
+
+    VAR result: ADDRESS;
+	second: QueueLink;
+
+    BEGIN
+	WITH Q^ DO
+	    Wait (count);
+	    Obtain (access);
+	    second := head^.next;  result := head^.DataPtr;
+	    DISPOSE (head);
+	    head := second;
+	    IF head = NIL THEN
+		tail := NIL;
+	    END (*IF*);
+	    Release (access);
+	END (*WITH*);
+	RETURN result;
+    END TakeFromQueue;
+
+(************************************************************************)
+
+PROCEDURE Empty (Q: Queue): BOOLEAN;
+
+    (* Returns TRUE iff Q is empty.	*)
+
+    VAR result: BOOLEAN;
+
+    BEGIN
+	WITH Q^ DO
+	    Obtain (access);
+	    result := head = NIL;
+	    Release (access);
+	END (*WITH*);
+	RETURN result;
+    END Empty;
+
+(************************************************************************)
+
+END Queues.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/quicksor.def b/examples/Modula-2_Libraries/PMOS/sources/general/quicksor.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/quicksor.def
@@ -0,0 +1,31 @@
+DEFINITION MODULE QuickSortModule;
+
+	(********************************************************)
+	(*							*)
+	(*	In-memory sort using the QuickSort method	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	4 August 1993			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE, ADDRESS;
+
+TYPE CompareProc = PROCEDURE (ADDRESS, ADDRESS): BOOLEAN;
+
+    (* A "CompareProc" procedure accepts the addresses of two data	*)
+    (* elements, and returns TRUE iff the first is greater than or	*)
+    (* equal to the second.  It is at the caller's discretion to define	*)
+    (* the meaning of "greater or equal" for his or her application.	*)
+
+PROCEDURE QuickSort (VAR (*INOUT*) data: ARRAY OF BYTE;
+				N, EltSize: CARDINAL;  GE: CompareProc);
+
+    (* In-place sort of array data[0..N].  EltSize is the element size,	*)
+    (* and GE is a user-supplied function to compare elements at two	*)
+    (* specified addresses.						*)
+
+END QuickSortModule.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/quicksor.mod b/examples/Modula-2_Libraries/PMOS/sources/general/quicksor.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/quicksor.mod
@@ -0,0 +1,204 @@
+IMPLEMENTATION MODULE QuickSortModule;
+
+	(********************************************************)
+	(*							*)
+	(*	In-memory sort using the QuickSort method	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	27 February 1995		*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* proc *)	ADR;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM LowLevel IMPORT
+    (* proc *)	Copy,
+    (* proc *)	AddOffset, SubtractOffset, Physical;
+
+(************************************************************************)
+
+TYPE
+    EltPointer = ADDRESS;
+    Array = RECORD
+		location: ADDRESS;
+		eltsize: CARDINAL;
+		greaterorequal: CompareProc;
+	    END (*RECORD*);
+
+(************************************************************************)
+
+PROCEDURE CmpPtr (pa, pb: EltPointer): INTEGER;
+
+    (* Returns -1 if pa<pb, 0 if pa=pb, +1 if pa>pb.	*)
+
+    VAR na, nb: LONGCARD;
+
+    BEGIN
+	na := Physical (pa);
+	nb := Physical (pb);
+	IF na < nb THEN RETURN -1;
+	ELSIF na > nb THEN RETURN +1;
+	ELSE RETURN 0;
+	END (*IF*);
+    END CmpPtr;
+
+(************************************************************************)
+
+PROCEDURE PtrDiff (high, low: ADDRESS): LONGCARD;
+
+    (* Returns Physical(high) - Physical(low)	*)
+
+    BEGIN
+	RETURN Physical (high) - Physical (low);
+    END PtrDiff;
+
+(************************************************************************)
+
+PROCEDURE Partition ( VAR (*INOUT*) A: Array;  low: EltPointer;
+			VAR (*OUT*) mid: EltPointer;  high: EltPointer);
+
+    (* By shuffling elements of A as necessary, ensures the property	*)
+    (*		A[j] <= v	for low <= j < mid			*)
+    (*		A[mid] = v						*)
+    (*		A[j] >= v	for mid < j <= high			*)
+    (* where v is some unspecified value chosen by the procedure.	*)
+    (* Input assumption: high > low, i.e. more than one element.	*)
+    (* Remark: for an array of <=3 elements, this procedure completely	*)
+    (* sorts the array.							*)
+
+    VAR up, down, temp: EltPointer;  N: CARDINAL;
+
+    BEGIN
+	down := low;  up := high;
+	N := VAL(CARDINAL, PtrDiff (high, low) DIV VAL(LONGCARD,A.eltsize)) + 1;
+	mid := AddOffset (low, A.eltsize * (N DIV 2));
+
+	ALLOCATE (temp, A.eltsize);
+
+	(* Pre-sort: first we put the first, middle and last elements	*)
+	(* in their correct relative order.				*)
+	(* To begin with, ensure that high^ >= low^.			*)
+
+	IF NOT A.greaterorequal(high, low) THEN
+	    Copy (low, temp, A.eltsize);
+	    Copy (high, low, A.eltsize);
+	    Copy (temp, high, A.eltsize);
+	END (*IF*);
+	IF N = 2 THEN
+	    DEALLOCATE (temp, A.eltsize);  RETURN;
+	END (*IF*);
+
+	(* Load the middle element into temp^.  By swapping elements as	*)
+	(* necessary, ensure that high^ >= temp^ >= low^.		*)
+
+	Copy (mid, temp, A.eltsize);
+	IF NOT A.greaterorequal (mid, low) THEN
+	    Copy (low, temp, A.eltsize);
+	    Copy (mid, low, A.eltsize);
+	ELSIF NOT A.greaterorequal (high, mid) THEN
+	    Copy (high, temp, A.eltsize);
+	    Copy (mid, high, A.eltsize);
+	END (*IF*);
+
+	(* For an array of <=3 elements, the above pre-sort is actually	*)
+	(* a complete sort.						*)
+
+	IF N <= 3 THEN
+	    Copy (temp, mid, A.eltsize);
+	    DEALLOCATE (temp, A.eltsize);  RETURN;
+	END (*IF*);
+
+	(* v = temp^ *)
+
+	LOOP
+	    WHILE (CmpPtr (down, mid) < 0) AND A.greaterorequal (temp, down) DO
+		down := AddOffset (down, A.eltsize);
+	    END (*WHILE*);
+
+	    (* All elements below down^ <= a			*)
+	    (* ((down^ > v) AND (down < mid)) OR down >= mid	*)
+
+	    IF CmpPtr (down, mid) < 0 THEN
+
+		(* All elements below down^ <= v	*)
+		(* (down^ > v) AND (down < mid)		*)
+
+		Copy (down, mid, A.eltsize);
+		mid := down;
+		down := AddOffset (down, A.eltsize);
+
+		(* hole at mid < down	*)
+
+	    END (*IF*);
+
+	    (* Note that down >= mid at this point.	*)
+
+	    WHILE (CmpPtr (up, mid) > 0) AND A.greaterorequal (up, temp) DO
+		up := SubtractOffset (up, A.eltsize);
+	    END (*WHILE*);
+
+	    (* All elements above up^ >= v			*)
+	    (* ((up^ < v) AND (up > mid)) OR up <= mid		*)
+
+	    IF CmpPtr (up, mid) <= 0 THEN EXIT(*LOOP*) END(*IF*);
+
+	    Copy (up, mid, A.eltsize);
+	    mid := up;
+	    up := SubtractOffset (up, A.eltsize);
+
+	    (* hole at mid > up *)
+
+	END (*LOOP*);
+	Copy (temp, mid, A.eltsize);
+	DEALLOCATE (temp, A.eltsize);
+    END Partition;
+
+(************************************************************************)
+
+PROCEDURE Sort ( VAR (*INOUT*) A: Array;  low, high: EltPointer);
+
+    (* Sorts the subarray A[low..high] inclusive.	*)
+
+    VAR mid: EltPointer;
+
+    BEGIN
+	WHILE CmpPtr (high, low) > 0 DO
+	    Partition (A, low, mid, high);
+	    IF CmpPtr (mid, low) > 0 THEN
+		Sort (A, low, SubtractOffset (mid, A.eltsize));
+	    END (*IF*);
+	    low := AddOffset (mid, A.eltsize);
+	END (*WHILE*);
+    END Sort;
+
+(************************************************************************)
+(*			   THE END-USER VERSION				*)
+(************************************************************************)
+
+PROCEDURE QuickSort (VAR (*INOUT*) data: ARRAY OF BYTE;
+				N, EltSize: CARDINAL;  GE: CompareProc);
+
+    (* In-place sort of array data[0..N].  EltSize is the element size,	*)
+    (* and GE is a user-supplied function to compare elements at two	*)
+    (* specified addresses.						*)
+
+    VAR A: Array;
+
+    BEGIN
+	WITH A DO
+	    location := ADR (data);
+	    eltsize := EltSize;
+	    greaterorequal := GE;
+	    Sort (A, location, AddOffset (location, N*EltSize));
+	END (*WITH*);
+    END QuickSort;
+
+(************************************************************************)
+
+END QuickSortModule.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/randcard.def b/examples/Modula-2_Libraries/PMOS/sources/general/randcard.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/randcard.def
@@ -0,0 +1,23 @@
+DEFINITION MODULE RandCard;
+
+	(********************************************************)
+	(*							*)
+	(*	   	Random number generator			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	12 February 1993		*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+CONST modulus = 2147483647;	(*  2^31 - 1  *)
+
+VAR seed: LONGCARD;	(*   visible in case you want to re-randomize	*)
+
+PROCEDURE RandCardinal (): LONGCARD;
+
+    (* Returns a random number in the range [1..modulus-1], with a	*)
+    (* uniform distribution over that range.				*)
+
+END RandCard.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/randcard.mod b/examples/Modula-2_Libraries/PMOS/sources/general/randcard.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/randcard.mod
@@ -0,0 +1,102 @@
+IMPLEMENTATION MODULE RandCard;
+
+	(********************************************************)
+	(*							*)
+	(*		Random number generator			*)
+	(*							*)
+	(*	This version is a more portable (but slightly	*)
+	(*	slower) version of the assembly language	*)
+	(*	module of the same name.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	18 March 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(*									*)
+(* The algorithm used is Schrage's method, as described in		*)
+(*	Stephen K. Park and Keith W. Miller, "Random Number Generators:	*)
+(*	Good ones are hard to find", CACM 31(10), Oct 1988, 1192-1201.	*)
+(* A basic property of this particular implementation is that all	*)
+(* intermediate results fit into 32 bits (including sign).		*)
+(*									*)
+(************************************************************************)
+
+FROM LowLevel IMPORT
+    (* proc *)	HighWord, MakeLongword, Mul;
+
+(************************************************************************)
+
+CONST
+    a = 16807;			(* 7^5 *)
+    divisor = modulus DIV a;	(* = 127773 *)
+    divisorL = divisor - 65536;	(* low order 16 bits of divisor *)
+
+(************************************************************************)
+
+PROCEDURE Divide (number: LONGCARD;
+			VAR (*OUT*) quotient: CARDINAL;
+			VAR (*OUT*) remainder: LONGCARD);
+
+    (* Special-purpose division procedure - be careful about using	*)
+    (* this in other applications, because it takes advantage of some	*)
+    (* foreknowledge of the numbers which arise in this application.	*)
+    (* Divides number by divisor=127773.				*)
+
+    VAR step: CARDINAL;
+
+    BEGIN
+	remainder := number;
+	quotient := 0;
+	WHILE remainder >= divisor DO
+	    step := ORD(HighWord(remainder)) DIV 2;
+	    IF step = 0 THEN step := 1 END(*IF*);
+	    INC (quotient, step);
+
+	    (* Here, we take advantage of the fact that	*)
+	    (*	divisor := 2^16 + divisorL		*)
+
+	    remainder := remainder - MakeLongword(step, 0)
+					- Mul(divisorL,step);
+	END (*WHILE*);
+    END Divide;
+
+(************************************************************************)
+
+PROCEDURE RandCardinal (): LONGCARD;
+
+    (* Let a = 7^5 = 16807, q = modulus DIV a = 127773, and		*)
+    (* r = modulus MOD a = 2836.					*)
+    (* We perform the sequence of calculations:				*)
+    (*		high := SHORT(seed DIV q);  low := seed MOD q;		*)
+    (* 		test := a*low - r*LONG(high);				*)
+    (*		IF test > 0 THEN seed := test				*)
+    (*		ELSE seed := test + modulus;				*)
+    (*		ENDIF;							*)
+    (*		RETURN seed;						*)
+    (* The division in the first step is complicated by the fact that	*)
+    (* our processor does not provide a 32-bit division operation.	*)
+
+    CONST r = modulus MOD a;	(* 2836 *)
+
+    VAR high: CARDINAL;  low: LONGCARD;  test: LONGINT;
+
+    BEGIN
+	Divide (seed, high, low);
+	test := VAL(LONGINT,a*low) - VAL(LONGINT,Mul(r, high));
+	IF test > 0 THEN seed := test
+	ELSE seed := test + modulus;
+	END (*IF*);
+	RETURN seed;
+    END RandCardinal;
+
+(****************************************************************)
+(*			MODULE INITIALISATION			*)
+(****************************************************************)
+
+BEGIN
+    seed := 1;
+END RandCard.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/random.def b/examples/Modula-2_Libraries/PMOS/sources/general/random.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/random.def
@@ -0,0 +1,25 @@
+DEFINITION MODULE Random;
+
+	(********************************************************)
+	(*							*)
+	(*		Random number generator			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	12 February 1993		*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+PROCEDURE RANDOM(): REAL;
+
+    (* Returns a random number from a uniform (0.0, 1.0) distribution.	*)
+
+PROCEDURE Randomize (newseed: LONGCARD);
+
+    (* Resets the seed of the random number generator.  Optional, but	*)
+    (* useful for either (a) obtaining a different random number	*)
+    (* sequence on each run of a program, or (b) conversely, obtaining	*)
+    (* a repeatable experiment.						*)
+
+END Random.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/random.mod b/examples/Modula-2_Libraries/PMOS/sources/general/random.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/random.mod
@@ -0,0 +1,56 @@
+IMPLEMENTATION MODULE Random;
+
+	(********************************************************)
+	(*							*)
+	(*		Random number generator			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	12 February 1993		*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM RandCard IMPORT
+    (* const*)	modulus,
+    (* var  *)	seed,
+    (* proc *)	RandCardinal;
+
+VAR scale: REAL;
+
+(************************************************************************)
+
+PROCEDURE RANDOM(): REAL;
+
+    (* Returns a random number from a uniform (0.0, 1.0) distribution.	*)
+    (* This version relies on procedure RandCardinal to do the random	*)
+    (* number generation; all that we do is the scaling.		*)
+
+    BEGIN
+	RETURN scale*FLOAT(RandCardinal());
+    END RANDOM;
+
+(************************************************************************)
+
+PROCEDURE Randomize (newseed: LONGCARD);
+
+    (* Resets the seed of the random number generator.	*)
+
+    BEGIN
+	IF newseed = 0 THEN newseed := 1
+	ELSIF newseed >= modulus THEN newseed := modulus-1
+	END (*IF*);
+	seed := newseed;
+    END Randomize;
+
+(************************************************************************)
+
+BEGIN
+
+    (* The construct FLOAT(LONGCARD(modulus)) below looks redundant,	*)
+    (* but it's there because a plain FLOAT(modulus) causes strange	*)
+    (* things to happen.  Compiler bug?					*)
+
+    scale := 1.0/FLOAT(LONGCARD(modulus));
+
+END Random.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/rational.def b/examples/Modula-2_Libraries/PMOS/sources/general/rational.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/rational.def
@@ -0,0 +1,51 @@
+DEFINITION MODULE Rationals;
+
+	(********************************************************)
+	(*							*)
+	(*		Arithmetic on rational numbers		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	2 May 1994			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+TYPE Rational = RECORD
+		    num: INTEGER;
+		    denom: CARDINAL;
+		END (*RECORD*);
+
+PROCEDURE Zero (): Rational;
+
+    (* Returns a representation of zero. *)
+
+PROCEDURE Unity (): Rational;
+
+    (* Returns a representation of the number 1. *)
+
+PROCEDURE Add (x, y: Rational): Rational;
+
+    (* Returns x+y. *)
+
+PROCEDURE Subtract (x, y: Rational): Rational;
+
+    (* Returns x-y. *)
+
+PROCEDURE Multiply (x, y: Rational): Rational;
+
+    (* Returns x*y. *)
+
+PROCEDURE Divide (x, y: Rational): Rational;
+
+    (* Returns x/y. *)
+
+PROCEDURE Reciprocal (x: Rational): Rational;
+
+    (* Returns 1/x. *)
+
+PROCEDURE Compare (x, y: Rational): INTEGER;
+
+    (* Returns 0 if x=y, <0 if x<y, and >0 if x>y. *)
+
+END Rationals.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/rational.mod b/examples/Modula-2_Libraries/PMOS/sources/general/rational.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/rational.mod
@@ -0,0 +1,166 @@
+IMPLEMENTATION MODULE Rationals;
+
+	(********************************************************)
+	(*							*)
+	(*		Arithmetic on rational numbers		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	2 May 1994			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+
+PROCEDURE gcd (x, y: CARDINAL): CARDINAL;
+
+    (* Returns the greatest common divisor of x and y. *)
+
+    VAR temp: CARDINAL;
+
+    BEGIN
+	IF x < y THEN
+	    temp := x;  x := y;  y := temp;
+	END (*IF*);
+	WHILE y <> 0 DO
+	    temp := x MOD y;  x := y;  y := temp;
+	END (*WHILE*);
+	RETURN x;
+    END gcd;
+
+(****************************************************************)
+
+PROCEDURE Reduce (VAR (*INOUT*) x: Rational);
+
+    (* Removes common factors between the numerator and the denominator. *)
+
+    VAR top, factor: CARDINAL;
+
+    BEGIN
+	top := ABS(x.num);
+	factor := gcd (top, x.denom);
+	x.num := x.num DIV INTEGER(factor);
+	x.denom := x.denom DIV factor;
+    END Reduce;
+
+(****************************************************************)
+
+PROCEDURE Zero (): Rational;
+
+    (* Returns a representation of zero. *)
+
+    VAR result: Rational;
+
+    BEGIN
+	result.num := 0;  result.denom := 1;
+	RETURN result;
+    END Zero;
+
+(****************************************************************)
+
+PROCEDURE Unity (): Rational;
+
+    (* Returns a representation of the number 1. *)
+
+    VAR result: Rational;
+
+    BEGIN
+	result.num := 1;  result.denom := 1;
+	RETURN result;
+    END Unity;
+
+(****************************************************************)
+
+PROCEDURE Add (x, y: Rational): Rational;
+
+    (* Returns x+y. *)
+
+    VAR result: Rational;
+
+    BEGIN
+	result.num := x.num*INTEGER(y.denom) + y.num*INTEGER(x.denom);
+	result.denom := x.denom * y.denom;
+	Reduce (result);
+	RETURN result;
+    END Add;
+
+(****************************************************************)
+
+PROCEDURE Subtract (x, y: Rational): Rational;
+
+    (* Returns x-y. *)
+
+    VAR result: Rational;
+
+    BEGIN
+	result.num := x.num*INTEGER(y.denom) - y.num*INTEGER(x.denom);
+	result.denom := x.denom * y.denom;
+	Reduce (result);
+	RETURN result;
+    END Subtract;
+
+(****************************************************************)
+
+PROCEDURE Compare (x, y: Rational): INTEGER;
+
+    (* Returns 0 if x=y, <0 if x<y, and >0 if x>y. *)
+
+    VAR test: INTEGER;
+
+    BEGIN
+	test := x.num*INTEGER(y.denom) - y.num*INTEGER(x.denom);
+	IF test > 0 THEN RETURN +1
+	ELSIF test = 0 THEN RETURN 0
+	ELSE RETURN -1
+	END (*IF*);
+    END Compare;
+
+(****************************************************************)
+
+PROCEDURE Multiply (x, y: Rational): Rational;
+
+    (* Returns x*y. *)
+
+    VAR result: Rational;  temp: CARDINAL;
+
+    BEGIN
+	(* To reduce the chance of overflow, do the reductions	*)
+	(* before the multiplication.				*)
+
+	temp := x.denom;  x.denom := y.denom;  y.denom := temp;
+	Reduce (x);  Reduce(y);
+	result.num := x.num * y.num;
+	result.denom := x.denom * y.denom;
+	RETURN result;
+    END Multiply;
+
+(****************************************************************)
+
+PROCEDURE Divide (x, y: Rational): Rational;
+
+    (* Returns x/y. *)
+
+    BEGIN
+	RETURN Multiply (x, Reciprocal(y));
+    END Divide;
+
+(****************************************************************)
+
+PROCEDURE Reciprocal (x: Rational): Rational;
+
+    (* Returns 1/x. *)
+
+    VAR result: Rational;
+
+    BEGIN
+	IF x.num < 0 THEN
+	    result.num := -INTEGER(x.denom);  result.denom := -x.num;
+	ELSE
+	    result.num := x.denom;  result.denom := x.num;
+	END (*IF*);
+	RETURN result;
+    END Reciprocal;
+
+(****************************************************************)
+
+END Rationals.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/realarit.def b/examples/Modula-2_Libraries/PMOS/sources/general/realarit.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/realarit.def
@@ -0,0 +1,87 @@
+DEFINITION MODULE RealArithmetic;
+
+	(********************************************************)
+	(*							*)
+	(*	Procedures to perform addition, subtraction,	*)
+	(*		etc., on real numbers.			*)
+	(*							*)
+	(*	This module was originally introduced to	*)
+	(*	get around a bug in FTL real arithmetic:	*)
+	(*	the lack of re-entrancy.  The module is now	*)
+	(*	obsolescent, and should not be used in new	*)
+	(*	programs.					*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	20 March 1993			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(*									*)
+(*  In principle, all of the features provided by this module are	*)
+(*  unnecessary, because they duplicate built-in features of Modula-2.	*)
+(*  The reason for providing this module is (a) to compensate for the	*)
+(*  fault in TRUNC in TopSpeed Modula-2; (b) to provide the missing	*)
+(*  LongTrunc operation; (c) to ease code portability: the original	*)
+(*  motivation for writing this module was because of a major bug in	*)
+(*  the real arithmetic of FTL Modula-2.				*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE Add (VAR (*INOUT*) x: LONGREAL;  y: LONGREAL);
+
+    (* Computes  x := x+y	*)
+
+PROCEDURE Subtract (VAR (*INOUT*) x: LONGREAL;  y: LONGREAL);
+
+    (* Computes  x := x-y	*)
+
+PROCEDURE Multiply (VAR (*INOUT*) x: LONGREAL;  y: LONGREAL);
+
+    (* Computes  x := x*y	*)
+
+PROCEDURE Divide (VAR (*INOUT*) x: LONGREAL;  y: LONGREAL);
+
+    (* Computes  x := x/y	*)
+
+PROCEDURE Float (j: LONGCARD): LONGREAL;
+
+    (* Converts cardinal to real.	*)
+
+PROCEDURE Negate (VAR (*INOUT*) x: LONGREAL);
+
+    (* Computes  x := -x	*)
+
+PROCEDURE Square (a: LONGREAL): LONGREAL;
+
+    (* Returns  a*a	*)
+
+PROCEDURE Equal (x, y: LONGREAL): BOOLEAN;
+
+    (* Tests the condition  x = y	*)
+
+PROCEDURE Greater (x, y: LONGREAL): BOOLEAN;
+
+    (* Tests the condition  x > y	*)
+
+PROCEDURE GreaterOrEqual (x, y: LONGREAL): BOOLEAN;
+
+    (* Tests the condition  x >= y	*)
+
+PROCEDURE LessThan (x, y: LONGREAL): BOOLEAN;
+
+    (* Tests the condition  x < y	*)
+
+(************************************************************************)
+(* The above procedures place protection on individual operations.  If	*)
+(* instead you want to place critical section protection around a whole	*)
+(* group of real operations, use the following two procedures.		*)
+(************************************************************************)
+
+PROCEDURE ProtectReal;
+
+PROCEDURE UnProtectReal;
+
+END RealArithmetic.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/realarit.mod b/examples/Modula-2_Libraries/PMOS/sources/general/realarit.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/realarit.mod
@@ -0,0 +1,201 @@
+IMPLEMENTATION MODULE RealArithmetic;
+
+	(********************************************************)
+	(*							*)
+	(*	Procedures to perform addition, subtraction,	*)
+	(*		etc., on real numbers.			*)
+	(*							*)
+	(*	This module was originally introduced to	*)
+	(*	get around a bug in FTL real arithmetic:	*)
+	(*	the lack of re-entrancy.  The present version	*)
+	(*	is for TopSpeed Modula-2, which doesn't have	*)
+	(*	that bug but which has a fault in TRUNC.	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	10 October 1992			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+VAR mutex: Semaphore;
+
+(************************************************************************)
+
+PROCEDURE Add (VAR (*INOUT*) x: LONGREAL;  y: LONGREAL);
+
+    (* Computes  x := x+y	*)
+
+    BEGIN
+	x := x + y;
+    END Add;
+
+(************************************************************************)
+
+PROCEDURE Subtract (VAR (*INOUT*) x: LONGREAL;  y: LONGREAL);
+
+    (* Computes  x := x-y	*)
+
+    BEGIN
+	x := x - y;
+    END Subtract;
+
+(************************************************************************)
+
+PROCEDURE Multiply (VAR (*INOUT*) x: LONGREAL;  y: LONGREAL);
+
+    (* Computes  x := x*y	*)
+
+    BEGIN
+	x := x*y;
+    END Multiply;
+
+(************************************************************************)
+
+PROCEDURE Divide (VAR (*INOUT*) x: LONGREAL;  y: LONGREAL);
+
+    (* Computes  x := x/y	*)
+
+    BEGIN
+	x := x/y;
+    END Divide;
+
+(************************************************************************)
+
+PROCEDURE Trunc (x: LONGREAL): CARDINAL;
+
+    (* Returns the integer part of a nonnegative real number.	*)
+
+    VAR result: CARDINAL;
+
+    BEGIN
+	result := TRUNC(x);
+	IF LONGREAL(result) > x THEN DEC(result) END(*IF*);
+	RETURN result;
+    END Trunc;
+
+(************************************************************************)
+
+PROCEDURE LongTrunc (x: LONGREAL): LONGCARD;
+
+    (* Like Trunc, but returns a long answer.	*)
+    (* N.B. This function needs more work, at present it's a very	*)
+    (* crude and inefficient implementation.				*)
+
+    VAR result: LONGCARD;
+	
+    BEGIN
+	result := LONGCARD(x);
+	IF LONGREAL(result) > x THEN DEC(result) END(*IF*);
+	RETURN result;
+    END LongTrunc;
+
+(************************************************************************)
+
+PROCEDURE Float (j: LONGCARD): LONGREAL;
+
+    (* Converts cardinal to real.	*)
+
+    VAR result: LONGREAL;
+
+    BEGIN
+	RETURN LONGREAL(j);
+    END Float;
+
+(************************************************************************)
+
+PROCEDURE Negate (VAR (*INOUT*) x: LONGREAL);
+
+    (* Computes  x := -x	*)
+
+    BEGIN
+	x := -x;
+    END Negate;
+
+(************************************************************************)
+
+PROCEDURE Square (a: LONGREAL): LONGREAL;
+
+    (* Returns  a*a	*)
+
+    VAR result: LONGREAL;
+
+    BEGIN
+	RETURN a*a;
+    END Square;
+
+(************************************************************************)
+
+PROCEDURE Equal (x, y: LONGREAL): BOOLEAN;
+
+    (* Tests the condition  x = y	*)
+
+    VAR result: BOOLEAN;
+
+    BEGIN
+	RETURN x = y;
+    END Equal;
+
+(************************************************************************)
+
+PROCEDURE Greater (x, y: LONGREAL): BOOLEAN;
+
+    (* Tests the condition  x > y	*)
+
+    VAR result: BOOLEAN;
+
+    BEGIN
+	RETURN x > y;
+    END Greater;
+
+(************************************************************************)
+
+PROCEDURE GreaterOrEqual (x, y: LONGREAL): BOOLEAN;
+
+    (* Tests the condition  x >= y	*)
+
+    VAR result: BOOLEAN;
+
+    BEGIN
+	RETURN x >= y;
+    END GreaterOrEqual;
+
+(************************************************************************)
+
+PROCEDURE LessThan (x, y: LONGREAL): BOOLEAN;
+
+    (* Tests the condition  x < y	*)
+
+    VAR result: BOOLEAN;
+
+    BEGIN
+	RETURN x < y;
+    END LessThan;
+
+(************************************************************************)
+(*		    PROTECTION OF A GROUP OF OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE ProtectReal;
+
+    BEGIN
+	Wait (mutex);
+    END ProtectReal;
+
+(************************************************************************)
+
+PROCEDURE UnProtectReal;
+
+    BEGIN
+	Signal (mutex);
+    END UnProtectReal;
+
+(************************************************************************)
+
+BEGIN
+    CreateSemaphore (mutex, 1);
+END RealArithmetic.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/realio.def b/examples/Modula-2_Libraries/PMOS/sources/general/realio.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/realio.def
@@ -0,0 +1,47 @@
+DEFINITION MODULE RealIO;
+
+	(********************************************************)
+	(*							*)
+	(*		Real I/O using windows.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	10 October 1992			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	NOTE: several procedures which used to be	*)
+	(*	in this module have now been moved to		*)
+	(*	module Conversions.				*)
+	(*							*)
+	(********************************************************)
+
+FROM Windows IMPORT
+    (* type *)	Window;
+
+PROCEDURE WriteReal (w: Window;  number: REAL;  places: CARDINAL);
+PROCEDURE WriteLongReal (w: Window;  number: LONGREAL;  places: CARDINAL);
+
+    (* Writes the second argument as a decimal number, right-justified	*)
+    (* in a field of "places" places.					*)
+
+PROCEDURE ReadReal (w: Window): REAL;
+PROCEDURE ReadLongReal (w: Window): LONGREAL;
+
+    (* Reads and converts a numeric string from the keyboard.	*)
+
+PROCEDURE ReadBufferedReal (w: Window;  fieldsize: CARDINAL): REAL;
+PROCEDURE ReadBufferedLongReal (w: Window;  fieldsize: CARDINAL): LONGREAL;
+
+    (* Like ReadReal, but allows the user to edit within a field of	*)
+    (* the specified size.						*)
+
+PROCEDURE EditReal (w: Window;  VAR (*INOUT*) variable: REAL;
+							width: CARDINAL);
+PROCEDURE EditLongReal (w: Window;  VAR (*INOUT*) variable: LONGREAL;
+							width: CARDINAL);
+
+    (* Displays the current value of "variable" at the current cursor	*)
+    (* position in window w, using a field width of "width" characters,	*)
+    (* and gives the user the option of altering the value.		*)
+
+END RealIO.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/realio.mod b/examples/Modula-2_Libraries/PMOS/sources/general/realio.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/realio.mod
@@ -0,0 +1,252 @@
+IMPLEMENTATION MODULE RealIO;
+
+	(********************************************************)
+	(*							*)
+	(*		Real I/O using windows.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 July 1993			*)
+	(*  Status:		Working				*)
+	(*	More care needed in handling the case where	*)
+	(*	 the field size is too small.			*)
+	(*	Seems to be a loss of accuracy when writing	*)
+	(*	 E-format numbers; for example 123.456E7 is	*)
+	(*	 written as 1234559999.  I'm not yet sure	*)
+	(*	 where this is happening, but suspect that it	*)
+	(*	 involves some deep error analysis.		*)
+	(*							*)
+	(********************************************************)
+
+FROM Windows IMPORT
+    (* type *)	ColumnRange,
+    (* proc *)	SaveCursor, SetCursor, EditString, ReadChar, LookaheadChar,
+		ReadCharWithoutEcho, WriteString;
+
+FROM Conversions IMPORT
+    (* proc *)	LongRealToString, StringToLongReal;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey, PutBack;
+
+(************************************************************************)
+
+CONST
+    EndMarker = CHR(0);  tab = CHR(9);  CR = CHR(13);
+
+TYPE
+    CharSet = SET OF CHAR;
+
+(************************************************************************)
+(*				REAL OUTPUT				*)
+(************************************************************************)
+
+PROCEDURE WriteLongReal (w: Window;  number: LONGREAL;  places: CARDINAL);
+
+    (* Writes the second argument as a decimal number, right-justified	*)
+    (* in a field of "places" places.					*)
+
+    VAR buffer: ARRAY [0..79] OF CHAR;
+
+    BEGIN
+	LongRealToString (number, buffer, places);
+	WriteString (w, buffer);
+    END WriteLongReal;
+
+(************************************************************************)
+
+PROCEDURE WriteReal (w: Window;  number: REAL;  places: CARDINAL);
+
+    (* Like WriteLongReal, except for argument type.	*)
+
+    BEGIN
+	WriteLongReal (w, LONGREAL(number), places);
+    END WriteReal;
+
+(************************************************************************)
+(*			REAL INPUT FROM KEYBOARD			*)
+(************************************************************************)
+
+PROCEDURE ReadRealString (w: Window;  VAR (*OUT*) string: ARRAY OF CHAR);
+
+    (* Reads in a character string from the keyboard, stopping at the	*)
+    (* first character which cannot form part of the external		*)
+    (* representation of an unsigned real number.  Leading blanks are	*)
+    (* skipped and not echoed.						*)
+
+    CONST Blanks = CharSet {" ", tab, CR};
+
+    VAR nextchar: CHAR;
+	position: CARDINAL;
+
+    (********************************************************************)
+
+    PROCEDURE GetNextChar;
+
+	(* Stores nextchar, reads new nextchar from keyboard.  Returns	*)
+	(* result = EndMarker if we run out of space.			*)
+
+	BEGIN
+	    IF position <= HIGH(string) THEN
+		ReadChar (w, nextchar);
+		string[position] := nextchar;  INC (position);
+		nextchar := LookaheadChar(w);
+	    ELSE
+		nextchar := EndMarker;
+	    END (*IF*);
+	END GetNextChar;
+
+    (********************************************************************)
+
+    BEGIN
+	position := 0;
+
+	(* Skip leading spaces and tabs.	*)
+
+	WHILE LookaheadChar(w) IN Blanks DO
+	    ReadCharWithoutEcho (w, nextchar);
+	END (*WHILE*);
+	nextchar := LookaheadChar(w);
+
+	(* Read the sign, if present.  We also permit spaces or tabs	*)
+	(* after the sign.						*)
+
+	IF (nextchar = '-') OR (nextchar = '+') THEN
+	    REPEAT
+		GetNextChar;
+	    UNTIL (nextchar <> " ") AND (nextchar <> tab);
+	END (*IF*);
+
+	(* Read the part before the decimal point.	*)
+
+	WHILE nextchar IN CharSet {"0".."9"} DO
+	    GetNextChar;
+	END (*WHILE*);
+
+	(* Now the part after the decimal point, if any.	*)
+
+	IF nextchar = "." THEN
+	    GetNextChar;
+	    WHILE nextchar IN CharSet {"0".."9"} DO
+		GetNextChar;
+	    END (*WHILE*);
+	END (*IF*);
+
+	(* Check for Ennn part.	*)
+
+	IF (nextchar = "E") OR (nextchar = "e") THEN
+	    GetNextChar;
+	    IF (nextchar = "+") OR (nextchar = "-") THEN
+		GetNextChar;
+	    END (*IF*);
+	    WHILE nextchar IN CharSet {"0".."9"} DO
+		GetNextChar;
+	    END (*WHILE*);
+	END (*IF*);
+
+	(* Ensure that string is properly terminated.  *)
+
+	IF position <= HIGH(string) THEN
+	    string[position] := EndMarker;
+	END (*IF*);
+
+    END ReadRealString;
+
+(************************************************************************)
+
+PROCEDURE ReadLongReal (w: Window): LONGREAL;
+
+    (* Reads and converts an unsigned numeric string from the keyboard.	*)
+
+    VAR InputString: ARRAY [0..79] OF CHAR;
+
+    BEGIN
+	ReadRealString (w, InputString);
+	RETURN StringToLongReal (InputString);
+    END ReadLongReal;
+
+(************************************************************************)
+
+PROCEDURE ReadReal (w: Window): REAL;
+
+    (* Like ReadLongReal, except for argument type.	*)
+
+    BEGIN
+	RETURN REAL(ReadLongReal (w));
+    END ReadReal;
+
+(************************************************************************)
+
+PROCEDURE ReadBufferedLongReal (w: Window;  fieldsize: CARDINAL): LONGREAL;
+
+    (* Like ReadLongReal, but allows the user to edit within a field of	*)
+    (* the specified size.						*)
+
+    VAR buffer: ARRAY ColumnRange OF CHAR;
+	row, column: CARDINAL;
+	value: LONGREAL;
+
+    BEGIN
+	SaveCursor (w, row, column);
+	buffer := "";
+	EditString (w, buffer, fieldsize);
+	value := StringToLongReal (buffer);
+	SetCursor (w, row, column);
+	WriteLongReal (w, value, fieldsize);
+	RETURN value;
+    END ReadBufferedLongReal;
+
+(************************************************************************)
+
+PROCEDURE ReadBufferedReal (w: Window;  fieldsize: CARDINAL): REAL;
+
+    (* Like ReadBufferedLongReal, except for argument type.	*)
+
+    BEGIN
+	RETURN REAL(ReadBufferedLongReal (w, fieldsize));
+    END ReadBufferedReal;
+
+(************************************************************************)
+
+PROCEDURE EditLongReal (w: Window;  VAR (*INOUT*) variable: LONGREAL;
+							width: CARDINAL);
+
+    (* Displays the current value of "variable" at the current cursor	*)
+    (* position in window w, using a field width of "width" characters,	*)
+    (* and gives the user the option of altering the value.		*)
+
+    CONST Esc = CHR(27);
+
+    VAR buffer: ARRAY ColumnRange OF CHAR;
+	row, column: CARDINAL;  ch: CHAR;
+
+    BEGIN
+	SaveCursor (w, row, column);
+	LongRealToString (variable, buffer, width);
+	EditString (w, buffer, width);
+	ch := InKey();  PutBack(ch);
+	IF ch <> Esc THEN
+	    variable := StringToLongReal (buffer);
+	END (*IF*);
+	SetCursor (w, row, column);
+	WriteLongReal (w, variable, width);
+    END EditLongReal;
+
+(************************************************************************)
+
+PROCEDURE EditReal (w: Window;  VAR (*INOUT*) variable: REAL;
+							width: CARDINAL);
+
+    (* Like EditLongReal, except for argument type.	*)
+
+    VAR temp: LONGREAL;
+
+    BEGIN
+	temp := LONGREAL(variable);
+	EditLongReal (w, temp, width);
+	variable := REAL(temp);
+    END EditReal;
+
+(************************************************************************)
+
+END RealIO.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/rowedito.def b/examples/Modula-2_Libraries/PMOS/sources/general/rowedito.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/rowedito.def
@@ -0,0 +1,111 @@
+DEFINITION MODULE RowEditor;
+
+	(********************************************************)
+	(*							*)
+	(*	  Screen data capture, for a single row		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	6 October 1990			*)
+	(*  Status:						*)
+	(*	Basic features working.  Known faults are:	*)
+	(*	  1.	(fixed)					*)
+	(*	  2.	The criterion for deciding in which	*)
+	(*		field to start editing could be better.	*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	ADDRESS;
+
+FROM Windows IMPORT
+    (* type *)	Window;
+
+FROM FieldEditor IMPORT
+    (* type *)	FieldType;
+
+FROM ListEditor IMPORT
+    (* type *)	List, ListFormat;
+
+FROM Menus IMPORT
+    (* type *)	Menu;
+
+(************************************************************************)
+
+TYPE
+    StructureRow;		(* is private *)
+
+(************************************************************************)
+(*			      SCREEN OUTPUT				*)
+(************************************************************************)
+
+PROCEDURE WriteRow (w: Window;  R: StructureRow;  line: CARDINAL);
+
+    (* Writes R on row "line" of window w.	*)
+
+PROCEDURE StartColumn (R: StructureRow): CARDINAL;
+
+    (* Returns the screen column of the first field in R.	*)
+
+PROCEDURE DumpRow (w: Window;  R: StructureRow);
+
+    (* For debugging: writes a representation of R to the screen.	*)
+
+(************************************************************************)
+(*		CREATING MULTI-FIELD EDITING STRUCTURES			*)
+(************************************************************************)
+
+PROCEDURE NewRow (VariableAddress: ADDRESS;  ftype: FieldType;
+			screencolumn, width: CARDINAL): StructureRow;
+
+    (* Creates a new row containing a single field.	*)
+
+PROCEDURE NewMenu (VAR (*IN*) variable: CARDINAL;  M: Menu;
+			screencolumn, rows, columns: CARDINAL): StructureRow;
+
+    (* Creates a new row containing a menu field.  The screencolumn	*)
+    (* field specifies the leftmost column within the screen window,	*)
+    (* the rows and columns fields give the size on the screen.		*)
+
+PROCEDURE NewList (VAR (*IN*) variable: List;  f: ListFormat;
+				screencolumn: CARDINAL): StructureRow;
+
+    (* Creates a new row containing a list field.	*)
+
+PROCEDURE CombineRows (VAR (*INOUT*) A: StructureRow;  B: StructureRow);
+
+    (* Strips all of the fields from B and adds them to the existing	*)
+    (* fields of A.  Note that B is destroyed in the process.		*)
+
+(************************************************************************)
+(*	The next few procedures are to support array operations.	*)
+(************************************************************************)
+
+PROCEDURE CopyOfRow (R: StructureRow): StructureRow;
+
+    (* Returns a duplicate copy of R.  Note that the variables to be	*)
+    (* edited are not duplicated - only the editor structure which	*)
+    (* keeps track of what is being edited.				*)
+
+PROCEDURE AdjustRow (R: StructureRow;  addroffset, columnoffset: CARDINAL);
+
+    (* Modifies every entry in R by adding addroffset to the variable	*)
+    (* address and columnoffset to the screen column.			*)
+
+PROCEDURE DeleteRow (R: StructureRow);
+
+    (* Deallocates the storage which was used in setting up row R.	*)
+    (* Note that this has nothing to do with the space used by		*)
+    (* variables to which R gives access; we delete only the overhead	*)
+    (* space which was originally allocated by this module.		*)
+
+(************************************************************************)
+(*				EDITING					*)
+(************************************************************************)
+
+PROCEDURE EditRow (w: Window;  R: StructureRow;  screenrow: CARDINAL);
+
+    (* Displays structure R in window w, and allows the keyboard user	*)
+    (* to edit the components of R.  It is assumed that w is already	*)
+    (* open and that R has already been fully defined.			*)
+
+END RowEditor.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/rowedito.mod b/examples/Modula-2_Libraries/PMOS/sources/general/rowedito.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/rowedito.mod
@@ -0,0 +1,542 @@
+IMPLEMENTATION MODULE RowEditor;
+
+	(********************************************************)
+	(*							*)
+	(*		Screen data capture			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 February 1995		*)
+	(*  Status:						*)
+	(*	Basic features working.  Known faults are:	*)
+	(*	  1.	(fixed)					*)
+	(*	  2.	The criterion for deciding in which	*)
+	(*		field to start editing could be better.	*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* proc *)	ADR;
+
+FROM Trace IMPORT
+    (* proc *)	InTrace, OutTrace, Pause;
+
+FROM Windows IMPORT
+    (* proc *)	SetCursor, SaveCursor,
+		(* and for debugging: *)
+    (* proc *)	OpenSimpleWindow, CloseWindow, WriteLn, WriteString;
+
+FROM NumericIO IMPORT				(* for debugging *)
+    (* proc *)	WriteAddress, WriteCard;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey, PutBack;
+
+FROM FieldEditor IMPORT
+    (* proc *)	WriteField, EditField, SameType, DefineFieldType;
+
+FROM Menus IMPORT
+    (* proc *)	DisplayMenu, SelectFromMenu;
+
+FROM ListEditor IMPORT
+    (* type *)	List, ListFormat,
+    (* proc *)	WriteList, EditList;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM LowLevel IMPORT
+    (* proc *)	AddOffset;
+
+(************************************************************************)
+
+CONST testing = FALSE;
+
+CONST Esc = CHR(27);
+
+TYPE
+    ListPtr = POINTER TO List;
+
+    (* The fields in a Field record are:				*)
+    (*		pointer:	address of the variable in this field	*)
+    (*		column:		screen position				*)
+    (*		size:		# of char positions to use on screen	*)
+    (*		type:		type of the variable			*)
+    (*		left, right:	pointers to adjacent fields		*)
+    (* Special case: if size=0 then it is up to the component editor to	*)
+    (* handle the cursor movement keys and to give the user feedback	*)
+    (* on where the cursor is.  This special case arises when the	*)
+    (* field has internal structure of its own.				*)
+
+    FieldPointer = POINTER TO FieldRecord;
+    FieldRecord =   RECORD
+			pointer: ADDRESS;
+			column: CARDINAL;
+			size: CARDINAL;
+			type: FieldType;
+			left, right: FieldPointer;
+		    END (*RECORD*);
+
+    StructureRow = FieldPointer;
+
+    (* For a menu, the pointer field in the Field record points at a	*)
+    (* "MenuHead" record rather than directly at the user variable.	*)
+    (* The MenuHead record contains the address of the user variable,	*)
+    (* the specification of which Menu to use, and the size of the	*)
+    (* space to allocate on the screen.					*)
+
+    MenuHead =  RECORD
+		    address: POINTER TO CARDINAL;
+		    menu: Menu;
+		    lines, width: CARDINAL;
+		END (*RECORD*);
+    MenuPointer = POINTER TO MenuHead;
+
+    (* For a linear list, the pointer field in the Field record points	*)
+    (* at a "ListHead" record rather than directly at the user		*)
+    (* variable.  The ListHead record contains the address of the user	*)
+    (* variable (which is itself a pointer to the head of the list),	*)
+    (* and the format to use when writing or editing the list.		*)
+
+    ListHead =  RECORD
+		    address: ListPtr;
+		    format: ListFormat;
+		END (*RECORD*);
+    ListHeadPtr = POINTER TO ListHead;
+
+VAR MenuType, ListType: FieldType;
+
+(************************************************************************)
+(*			      SCREEN OUTPUT				*)
+(************************************************************************)
+
+PROCEDURE WriteMenuField (w: Window;  headptr: MenuPointer;  dummy: CARDINAL);
+
+    BEGIN
+	WITH headptr^ DO
+	    DisplayMenu (w, menu, lines, width, address^);
+	END (*WITH*);
+    END WriteMenuField;
+
+(************************************************************************)
+
+PROCEDURE WriteListField (w: Window;  headptr: ListHeadPtr;  dummy: CARDINAL);
+
+    BEGIN
+	WriteList (w, headptr^.address^, headptr^.format);
+    END WriteListField;
+
+(************************************************************************)
+
+PROCEDURE WriteRow (w: Window;  R: StructureRow;  line: CARDINAL);
+
+    (* Writes R on row "line" of window w.	*)
+
+    BEGIN
+	WHILE R <> NIL DO
+	    WITH R^ DO
+		SetCursor (w, line, column);
+		WriteField (w, pointer, type, size);
+	    END (*WITH*);
+	    R := R^.right;
+	END (*WHILE*);
+    END WriteRow;
+
+(************************************************************************)
+
+PROCEDURE StartColumn (R: StructureRow): CARDINAL;
+
+    (* Returns the screen column of the first field in R.	*)
+
+    BEGIN
+	RETURN R^.column;
+    END StartColumn;
+
+(************************************************************************)
+(*			THE BUILT-IN FIELD EDITORS			*)
+(************************************************************************)
+
+PROCEDURE EditMenuField (w: Window;  VAR (*INOUT*) headptr: MenuPointer;
+							dummy: CARDINAL);
+
+    VAR result, row, col: CARDINAL;
+
+    BEGIN
+	SaveCursor (w, row, col);
+	WITH headptr^ DO
+	    result := SelectFromMenu (menu);
+	    IF result = 0 THEN
+		SetCursor (w, row, col);
+		DisplayMenu (w, menu, lines, width, address^);
+	    ELSE
+		address^ := result;
+	    END (*IF*);
+	END (*WITH*);
+    END EditMenuField;
+
+(************************************************************************)
+
+PROCEDURE EditListField (w: Window;  VAR (*INOUT*) headptr: ListHeadPtr;
+							dummy: CARDINAL);
+
+    BEGIN
+	EditList (w, headptr^.address^, headptr^.format);
+    END EditListField;
+
+(************************************************************************)
+(*		   INTRODUCING A NEW FIELD TO THE SYSTEM		*)
+(************************************************************************)
+
+PROCEDURE NewRow (VariableAddress: ADDRESS;  ftype: FieldType;
+			screencolumn, width: CARDINAL): StructureRow;
+
+    (* Creates a new row containing a single field.	*)
+
+    VAR result: StructureRow;
+
+    BEGIN
+	NEW (result);
+	WITH result^ DO
+	    pointer := VariableAddress;
+	    column := screencolumn;
+	    size := width;  type := ftype;
+	    left := NIL;  right := NIL;
+	END (*WITH*);
+	RETURN result;
+    END NewRow;
+
+(************************************************************************)
+
+PROCEDURE NewMenu (VAR (*IN*) variable: CARDINAL;  M: Menu;
+			screencolumn, rows, columns: CARDINAL): StructureRow;
+
+    (* Creates a new row containing a menu field.  The screencolumn	*)
+    (* field specifies the leftmost column within the screen window,	*)
+    (* the rows and columns fields give the size on the screen.		*)
+
+    VAR MP: MenuPointer;
+
+    BEGIN
+	NEW (MP);
+	WITH MP^ DO
+	    address := ADR (variable);  menu := M;
+	    lines := rows;  width := columns;
+	END (*WITH*);
+	RETURN NewRow (MP, MenuType, screencolumn, 0);
+    END NewMenu;
+
+(************************************************************************)
+
+PROCEDURE NewList (VAR (*IN*) variable: List;  f: ListFormat;
+				screencolumn: CARDINAL): StructureRow;
+
+    (* Creates a new row containing a list field.	*)
+
+    VAR listhead: ListHeadPtr;
+
+    BEGIN
+	NEW (listhead);
+	WITH listhead^ DO
+	    address := ADR (variable);  format := f;
+	END (*WITH*);
+	RETURN NewRow (listhead, ListType, screencolumn, 0);
+    END NewList;
+
+(************************************************************************)
+(*			    TEST PROCEDURES				*)
+(************************************************************************)
+
+PROCEDURE DumpField (w: Window;  F: FieldPointer);
+
+    (* For debugging: writes a representation of F^ to the screen.	*)
+
+    BEGIN
+	WriteLn (w);
+	WriteAddress (w, F);  WriteString (w, "> ");
+	WITH F^ DO
+	    WriteAddress (w, pointer);  WriteString (w, ", ");
+	    WriteCard (w, column);  WriteString (w, ", ");
+	    WriteCard (w, size);  WriteString (w, ", ");
+	    WriteAddress (w, left);  WriteString (w, ", ");
+	    WriteAddress (w, right);
+	END (*WITH*);
+    END DumpField;
+
+(************************************************************************)
+
+PROCEDURE DumpRow (w: Window;  R: StructureRow);
+
+    (* For debugging: writes a representation of R to the screen.	*)
+
+    BEGIN
+	IF R = NIL THEN
+	    WriteLn (w);  WriteString (w, "  <empty row>");
+	END (*IF*);
+	WHILE R <> NIL DO
+	    DumpField (w, R);  R := R^.right;
+	END (*WHILE*);
+    END DumpRow;
+
+(************************************************************************)
+
+PROCEDURE DebugDump (caller: ARRAY OF CHAR;  R: StructureRow);
+
+    (* For debugging: identifies the caller and dumps R.	*)
+
+    VAR w: Window;
+
+    BEGIN
+	OpenSimpleWindow (w, 0, 10, 0, 79);
+	WriteString (w, "DebugDump called from ");
+	WriteString (w, caller);
+	DumpRow (w, R);
+	Pause;
+	CloseWindow (w);
+    END DebugDump;
+
+(************************************************************************)
+(*		  CONSTRUCTING COMPLEX STRUCTURE TYPES			*)
+(************************************************************************)
+
+PROCEDURE CombineRows (VAR (*INOUT*) A: StructureRow;  B: StructureRow);
+
+    (* Merges the row to which B is pointing with the row to which A is	*)
+    (* pointing, leaving A pointing to the result.  (The structure of	*)
+    (* the B row is lost in the process of doing this).			*)
+
+    VAR previous, current: FieldPointer;
+
+    BEGIN
+	InTrace ("CombineRows");
+	previous := NIL;  current := A;
+	WHILE B <> NIL DO
+
+	    (* Find a place to insert the first element on the B list. *)
+
+	    LOOP
+		IF current = NIL THEN EXIT (*LOOP*) END (*IF*);
+		IF B^.column < current^.column THEN EXIT (*LOOP*) END (*IF*);
+		previous := current;  current := current^.right;
+	    END (*LOOP*);
+
+	    (* Take the whole of the B list, insert it after previous^,	*)
+	    (* then take what remains of the original destination list	*)
+	    (* and call it the B list.  Swapping lists like this is a	*)
+	    (* little unconventional, but it works, and in many cases	*)
+	    (* it speeds up the merge.					*)
+
+	    IF previous = NIL THEN
+		A := B;
+	    ELSE
+		previous^.right := B;
+	    END (*IF*);
+	    B^.left := previous;
+	    previous := B;  B := current;  current := previous^.right;
+
+	END (*WHILE*);
+	OutTrace ("CombineRows");
+    END CombineRows;
+
+(************************************************************************)
+
+PROCEDURE CopyOfRow (R: StructureRow): StructureRow;
+
+    (* Makes a duplicate copy of R.  The variables to be edited are not	*)
+    (* duplicated; we simply set up a duplicate set of pointers.	*)
+
+    VAR result: StructureRow;  newfield: FieldPointer;
+	oldheadptr, headptr: ListHeadPtr;
+	oldmenuheadptr, menuheadptr: MenuPointer;
+
+    BEGIN
+	InTrace ("CopyOfRow");
+	result := NIL;
+	WHILE R <> NIL DO
+	    NEW (newfield);
+	    WITH newfield^ DO
+		IF SameType (R^.type, MenuType) THEN
+		    oldmenuheadptr := R^.pointer;
+		    NEW (menuheadptr);  menuheadptr^ := oldmenuheadptr^;
+		    pointer := menuheadptr;
+		ELSIF SameType (R^.type, ListType) THEN
+		    oldheadptr := R^.pointer;
+		    NEW (headptr);  headptr^ := oldheadptr^;
+		    pointer := headptr;
+		ELSE
+		    pointer := R^.pointer;
+		END (*IF*);
+		column := R^.column;
+		size := R^.size;  type := R^.type;
+		left := NIL;  right := NIL;
+	    END (*WITH*);
+	    CombineRows (result, newfield);
+	    R := R^.right;
+	END (*WHILE*);
+	OutTrace ("CopyOfRow");
+	IF testing THEN
+	    DebugDump ("CopyOfRow", result);
+	END (*IF*);
+	RETURN result;
+    END CopyOfRow;
+
+(************************************************************************)
+
+PROCEDURE DeleteRow (R: StructureRow);
+
+    (* Deallocates the storage which was used in setting up row R.	*)
+    (* Note that this has nothing to do with the space used by		*)
+    (* variables to which R gives access; we delete only the overhead	*)
+    (* space which was originally allocated by this module.		*)
+
+    VAR temp: FieldPointer;
+
+    BEGIN
+	InTrace ("DeleteRow");
+	WHILE R <> NIL DO
+	    temp := R^.right;
+	    IF SameType (R^.type, MenuType) THEN
+		DEALLOCATE (R^.pointer, SIZE(MenuHead));
+	    ELSIF SameType (R^.type, ListType) THEN
+		DEALLOCATE (R^.pointer, SIZE(ListHead));
+	    END;
+	    DISPOSE (R);
+	    R := temp;
+	END (*WHILE*);
+	OutTrace ("DeleteRow");
+    END DeleteRow;
+
+(************************************************************************)
+
+PROCEDURE AdjustRow (R: StructureRow;  addroffset, columnoffset: CARDINAL);
+
+    (* Adjusts the pointer and column fields of all elements of R	*)
+    (* by adding the specified offsets to those fields.			*)
+
+    VAR headptr: ListHeadPtr;  menuheadptr: MenuPointer;
+
+    BEGIN
+	InTrace ("AdjustRow");
+	WHILE R <> NIL DO
+	    WITH R^ DO
+		IF SameType (type, MenuType) THEN
+		    menuheadptr := pointer;
+		    WITH menuheadptr^ DO
+			address := AddOffset (address, addroffset);
+		    END (*WITH*);
+		ELSIF SameType (type, ListType) THEN
+		    headptr := pointer;
+		    WITH headptr^ DO
+			address := AddOffset (address, addroffset);
+		    END (*WITH*);
+		ELSE
+		    pointer := AddOffset (pointer, addroffset);
+		END (*IF*);
+		INC (column, columnoffset);
+	    END (*WITH*);
+	    R := R^.right;
+	END (*WHILE*);
+	OutTrace ("AdjustRow");
+    END AdjustRow;
+
+(************************************************************************)
+(*			   EDITING A STRUCTURE				*)
+(************************************************************************)
+
+PROCEDURE SetStartingPoint (VAR (*INOUT*) R: FieldPointer;
+						screencolumn: CARDINAL);
+
+    (* On entry, R points to the first field in a row.  On exit, R	*)
+    (* points to the field in that row whose "column" field most	*)
+    (* closely matches the second argument to this procedure.		*)
+
+    VAR next: FieldPointer;
+
+    BEGIN
+	IF R = NIL THEN RETURN END (*IF*);
+	LOOP
+	    next := R^.right;
+	    IF next = NIL THEN EXIT(*LOOP*) END (*IF*);
+	    IF 2*screencolumn < R^.column + R^.size + next^.column THEN
+		EXIT (*LOOP*);
+	    END (*IF*);
+	    R := next;
+	END (*LOOP*);
+    END SetStartingPoint;
+
+(************************************************************************)
+
+PROCEDURE EditRow (w: Window;  R: StructureRow;  screenrow: CARDINAL);
+
+    (* Displays structure R in window w, and allows the keyboard user	*)
+    (* to edit the components of R.  It is assumed that w is already	*)
+    (* open and that R has already been fully defined.			*)
+    (* On return, the screen cursor is at the start of the field	*)
+    (* corresponding to the selected record of the structure.  The key	*)
+    (* which caused us to return remains available to the caller.	*)
+
+    CONST Return = CHR(13);
+
+    VAR dummy, screencolumn: CARDINAL;  nextchar: CHAR;
+
+    BEGIN
+	IF R = NIL THEN
+	    RETURN;
+	END (*IF*);
+	SaveCursor (w, dummy, screencolumn);
+	WriteRow (w, R, screenrow);
+	SetStartingPoint (R, screencolumn);
+
+	LOOP
+	    (* Call the field editor for the current component.	*)
+
+	    WITH R^ DO
+		SetCursor (w, screenrow, column);
+		EditField (w, pointer, type, size);
+		nextchar := InKey();
+	    END (*WITH*);
+
+	    (* The Return key has a special function: we interpret it	*)
+	    (* as "cursor right" if there is another field to the	*)
+	    (* right, and otherwise we return it to the caller.		*)
+
+	    IF nextchar = Return THEN
+		IF R^.right <> NIL THEN R := R^.right
+		ELSE EXIT (*LOOP*);
+		END (*IF*);
+	    ELSIF nextchar <> CHR(0) THEN
+		EXIT (*LOOP*);
+	    ELSE
+
+		(* Now check for "cursor left" and "cursor right".	*)
+		(* Any other key will be given back to the caller.	*)
+
+		nextchar := InKey();
+		IF nextchar = "K" THEN	(* cursor left *)
+		    IF R^.left <> NIL THEN
+			R := R^.left;
+		    END (*IF*);
+		ELSIF nextchar = "M" THEN	(* cursor right *)
+		    IF R^.right <> NIL THEN
+			R := R^.right;
+		    END (*IF*);
+		ELSE
+		    PutBack (nextchar);  nextchar := CHR(0);
+		    EXIT (*LOOP*)
+		END(*IF*);
+
+	    END (*IF*);
+
+	END (*LOOP*);
+
+	PutBack (nextchar);
+
+    END EditRow;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    MenuType := DefineFieldType (WriteMenuField, EditMenuField);
+    ListType := DefineFieldType (WriteListField, EditListField);
+END RowEditor.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/screen.def b/examples/Modula-2_Libraries/PMOS/sources/general/screen.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/screen.def
@@ -0,0 +1,134 @@
+DEFINITION MODULE Screen;
+
+	(********************************************************)
+	(*							*)
+	(*		Low-level screen functions		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	31 January 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(*									*)
+(*		WARNING		WARNING		WARNING			*)
+(*									*)
+(*  The operations performed by this module are among the rare examples	*)
+(*  where a programming error can cause physical damage to the		*)
+(*  hardware.  Do NOT attempt to modify anything in this module unless	*)
+(*  you have a detailed understanding of how the video adaptors work.	*)
+(*  In particular, beware of putting inappropriate values into the	*)
+(*  registers of the 6845 video controller.				*)
+(*									*)
+(*  It is normal for the screen picture to "bloom" or "bounce" after	*)
+(*  a mode change (e.g. changing from a text mode to a graphics mode).	*)
+(*  Some monitors are worse than others for this, but all should	*)
+(*  regain synchronism after a second or so.  A bright dot at the	*)
+(*  centre of the screen or a "tearing" effect are NOT normal; if the	*)
+(*  screen display goes crazy you should turn off the monitor and/or	*)
+(*  reset the computer immediately, since it probably means that the	*)
+(*  software is not compatible with your hardware.			*)
+(*									*)
+(*  The procedures in this module are for the use of other library	*)
+(*  modules such as Graphics and Windows.  They should not normally	*)
+(*  be called directly from applications programs.			*)
+(*									*)
+(*  DISCLAIMER: This software is supplied "as is" with no warranty as	*)
+(*  to its compatibility with your hardware.  It has been tested on a	*)
+(*  small sample of computers, but because of the wide variety of	*)
+(*  video adaptors on the market it is impossible to be certain that	*)
+(*  it will work correctly on all hardware configurations.		*)
+(*									*)
+(************************************************************************)
+
+CONST
+    HercGraphics = 128+7;
+
+TYPE
+    (* This is a list of all the adaptors this module can recognise.	*)
+    (* Note: the value "SVGA" means that we've found more modes beyond	*)
+    (* the standard VGA set (e.g. because we've found a VESA driver),	*)
+    (* but we haven't made a more specific hardware identification.	*)
+
+    VideoAdaptorType = (MDA, Hercules, CGA, EGA, VGA, SVGA, ATI, S3, Trident);
+
+    (* A record type for storing mode properties. *)
+
+    ModeInfoType = RECORD
+			MaxX, MaxY, MaxColour, LastCharRow: CARDINAL;
+			BitsPerPixel, BytesPerRow, FramesPerScreen: CARDINAL;
+			Planar, MultiBank, TextMode: BOOLEAN;
+		   END (*RECORD*);
+
+(************************************************************************)
+
+PROCEDURE VideoKind (): VideoAdaptorType;
+
+    (* Returns the display adaptor type.  This is a best guess, and it	*)
+    (* is possible that some adaptor types will be misclassified.	*)
+    (* In the present version, most SVGA adaptors will be reported as	*)
+    (* VGA or SVGA rather than something more specific; and no		*)
+    (* distinction is drawn between the "ordinary" Hercules adaptor and	*)
+    (* the Hercules Plus or Hercules InColor.				*)
+
+PROCEDURE VESAdriverPresent (): BOOLEAN;
+
+    (* Returns TRUE iff a VESA driver was detected. *)
+
+PROCEDURE Supported (mode: CARDINAL): BOOLEAN;
+
+    (* Returns TRUE iff the specified mode is a mode supported	*)
+    (* by the hardware and by this module.			*)
+
+PROCEDURE SetVideoMode (newmode: CARDINAL;  ClearScreen: BOOLEAN): BOOLEAN;
+
+    (* Sets the video mode.  The mode numbers are as defined in the	*)
+    (* BIOS, plus HercGraphics to denote the Hercules graphics mode,	*)
+    (* plus whatever the VESA BIOS (if present) will support.		*)
+    (* For VESA modes, GetModeInfo should subsequently be called to	*)
+    (* ensure that bank switching functions are correctly set up.	*)
+    (* Returns TRUE iff the mode change was successful.			*)
+
+    (* Warning: the option ClearScreen=FALSE sometimes produces some	*)
+    (* strange effects, apparently because of some aspect of the BIOS	*)
+    (* that I don't yet understand.					*)
+
+PROCEDURE GetModeInfo (mode: CARDINAL;  VAR (*OUT*) result: ModeInfoType);
+
+    (* Returns information about the given mode.  If the information	*)
+    (* is not available, the parameter values are left unchanged.	*)
+
+    (* Deliberate side-effect: for a VESA mode, this procedure also	*)
+    (* initialises the bank switching.					*)
+
+PROCEDURE RestoreOriginalMode;
+
+    (* Sets the video mode back to what it was before this program ran.	*)
+
+PROCEDURE SelectReadBank (bank: CARDINAL);
+
+    (* Switches to a new bank of screen memory for reading.  Should be	*)
+    (* used only with the adaptors which support the high-resolution	*)
+    (* modes using bank switching.					*)
+
+PROCEDURE SelectWriteBank (bank: CARDINAL);
+
+    (* Switches to a new bank of screen memory for writing.  Should be	*)
+    (* used only with the adaptors which support the high-resolution	*)
+    (* modes using bank switching.					*)
+
+PROCEDURE GetAddresses (VAR (*OUT*) ScreenSegment, IObase: CARDINAL);
+
+    (* Returns the segment of the screen memory and the port number	*)
+    (* of the video controller.  (Note that these could be different	*)
+    (* for different modes.)						*)
+
+PROCEDURE WaitForVerticalRetrace;
+
+    (* Busy wait until we reach the vertical retrace period.		*)
+    (* Warning: I wrote this quickly for one specific application, and	*)
+    (* haven't gotten around to checking it for the general case.	*)
+
+END Screen.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/screen.mod b/examples/Modula-2_Libraries/PMOS/sources/general/screen.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/screen.mod
@@ -0,0 +1,1246 @@
+IMPLEMENTATION MODULE Screen;
+
+	(********************************************************)
+	(*							*)
+	(*		Low-level screen functions		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	28 February 1995		*)
+	(*  Status:						*)
+	(*	Working for Hercules, CGA, EGA, VGA; and	*)
+	(*	supports SVGA for adaptors with VESA drivers.	*)
+	(*							*)
+	(*	Status of support for specific chips:		*)
+	(*	    ATI		working				*)
+	(*	    S3		partly working, but the VESA	*)
+	(*			BIOS seems to be failing for	*)
+	(*			many modes			*)
+	(*	    Trident	untested			*)
+	(*							*)
+	(*	Portability warning: this module contains	*)
+	(*	preprocessor directives, and might need to be	*)
+	(*	processed by the PP preprocessor before being	*)
+	(*	compiled.					*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(*									*)
+(*  A particular problem in supporting screen operations on PC or AT	*)
+(*  compatibles is that there are enormous differences between models	*)
+(*  in what sort of graphics interface is provided.  Because it is hard	*)
+(*  to predict what hardware will be present, this module uses ROM BIOS	*)
+(*  routines to do some of the low-level things.  Note however that the	*)
+(*  Hercules graphics cards are not supported by the BIOS, so we have	*)
+(*  to treat them as a special case.					*)
+(*									*)
+(*  Note that the modes available will depend on whether a VESA BIOS	*)
+(*  is present.								*)
+(*									*)
+(************************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE,
+    (* proc *)	ADR;
+
+FROM Types IMPORT
+    (* type *)	FarPointer, FarCharPointer, FarCardPointer;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM LowLevel IMPORT
+    (* proc *)	FarSEGMENT, SEGMENT, OFFSET, Virtual, MakePointer,
+		AddOffset, FarAddOffset,
+		InByte, OutByte, IAND, IANDB, IORB, IXORB, LSB, Div;
+
+FROM MiscPMOS IMPORT
+    (* type *)	RegisterPacket,
+    (* proc *)	BIOS,
+    (* proc *)	EnterCriticalSection, LeaveCriticalSection;
+
+FROM TerminationControl IMPORT
+    (* proc *)  SetTerminationProcedure;
+
+(************************************************************************)
+
+CONST
+    VideoInt = 16;		(* Interrupt number for BIOS calls	*)
+
+TYPE
+    ModeSet = SET OF [0..511];
+
+    (* Portability warning: the most direct form of VESA bank switching	*)
+    (* requires calling a procedure which expects its parameters to be	*)
+    (* in the BX and DX registers.  When porting to a compiler which	*)
+    (* doesn't let you specify which registers to use for parameter	*)
+    (* passing, we can't use this feature.  In this version, direct	*)
+    (* VESA bank switching is implemented only when the compiler is	*)
+    (* TopSpeed version 3; for other compilers, we use a procedure	*)
+    (* VESABankSwitch which works by making a BIOS call.  For non-VESA	*)
+    (* modes, we use yet another version of the bank switch procedure.	*)
+
+    (*<TopSpeed3*) (*# save, call(reg_param => (bx, dx)) *) (*>*)
+    BankSwitchProc = PROCEDURE (CARDINAL,CARDINAL);
+    (*<TopSpeed3*) (*# restore *) (*>*)
+
+    (* Format of the mode information record returned by a VESA driver.	*)
+
+    VESAInformationRecord1 =
+		    RECORD
+			mode_attributes: WORD;
+			window_a_attrib: BYTE;
+			window_b_attrib: BYTE;
+			window_granularity: WORD;
+			window_size: WORD;
+			window_a_segment_adr: WORD;
+			window_b_segment_adr: WORD;
+			bank_switch_function:
+				(*<TopSpeed3*) BankSwitchProc; (*>*)
+				(*<~TopSpeed3  ADDRESS; >*)
+			bytes_per_row: CARDINAL;
+	                x_res, y_res: CARDINAL;
+			x_character_size,
+			y_character_size: SHORTCARD;
+			number_of_planes: BYTE;
+			bits_per_pixel: BYTE;
+			number_of_banks: BYTE;
+			memory_model: SHORTCARD;
+			bank_size: BYTE;
+			number_of_image_pages: BYTE;
+			BIOS_reserved: BYTE;
+			red_mask_size: SHORTCARD;
+			red_field_position: SHORTCARD;
+			green_mask_size: SHORTCARD;
+			green_field_position: SHORTCARD;
+			blue_mask_size: SHORTCARD;
+			blue_field_position: SHORTCARD;
+			reserved_mask_size: SHORTCARD;
+			reserved_field_position: SHORTCARD;
+			direct_col_mode_info: BYTE;
+			unused: ARRAY [40..255] OF BYTE;
+		    END (*RECORD*);
+
+CONST
+    (* 'Monochrome' display modes supported by this module.  Note that	*)
+    (* this means modes supported by a monochrome adaptor.  There are	*)
+    (* some other single-colour modes which we don't classify as	*)
+    (* monochrome, simply because they are not MDA modes.		*)
+
+    MonochromeModes = ModeSet {0, 2, 7};
+
+VAR
+    (* Our opinion as to what type of adaptor is installed.	*)
+
+    AdaptorType: VideoAdaptorType;
+
+    (* BIOSsegment is a segment selector for the BIOS ROM at physical	*)
+    (* address 0C00000H.  We make it a variable in order to simplify	*)
+    (* the porting of code between real and protected modes.		*)
+
+    BIOSsegment: CARDINAL;
+
+    (* ScreenSeg is a segment selector for the hardware video buffer,	*)
+    (* and CRTCport is the port number to use when addressing the CRT	*)
+    (* controller chip.  They are variables, because the addresses	*)
+    (* depend on whether a colour or monochrome mode is in effect.	*)
+
+    ScreenSeg: CARDINAL;
+    CRTCport: CARDINAL;
+
+    (* OriginalMode and OriginalPage are the video mode and text page	*)
+    (* number in effect when the program first runs.  Procedure		*)
+    (* RestoreOriginalMode switches back to them.			*)
+
+    OriginalMode, CurrentMode: CARDINAL;
+    OriginalPage: SHORTCARD;
+
+    (* For the modes which use bank-switching, the hardware may allow	*)
+    (* two separate windows into the graphics memory.  The following	*)
+    (* two variables each have value 0 or 1.  Where two separate	*)
+    (* windows are not supported, we have ReadWindow = WriteWindow.	*)
+
+    ReadWindow, WriteWindow: CARDINAL;
+
+    (* For the modes which use bank-switching, CurrentReadBank and	*)
+    (* CurrentWriteBank are the currently selected banks.		*)
+    (* For all other modes, the two values are left at zero.		*)
+
+    CurrentReadBank, CurrentWriteBank: CARDINAL;
+
+    (* Set of all modes which we believe the hardware will support.	*)
+
+    SupportedModes: ModeSet;
+
+    (* Modes supported by the VESA driver, if present.  The first set	*)
+    (* is the set officially supported, and the second is a set of	*)
+    (* modes we've found by trial and error to be supported even though	*)
+    (* the VESA driver doesn't have them in its list of supported modes.*)
+
+    VesaModes, ExtraVesaModes: ModeSet;
+
+    (* The procedure which does bank switching.  See the definition of	*)
+    (* BankSwitchProc above for a comment about portability issues.	*)
+    (* DefaultBankSwitch is the (hardware-dependent) procedure that	*)
+    (* will normally be used, but a VESA driver might override this.	*)
+
+    BankSwitch, DefaultBankSwitch: BankSwitchProc;
+
+    (* EXTport is meaningful only for the ATI adaptor.  We work out its	*)
+    (* value after detecting the presence of an ATI.			*)
+
+    EXTport: CARDINAL;
+    		
+(************************************************************************)
+
+TYPE
+    (* Linked list of mode information records.  An unsorted list is	*)
+    (* adequate for this job since we only need to access it for mode	*)
+    (* changes; and mode setting is in any case a slow operation.	*)
+
+    ModeInfoList = POINTER TO ListNode;
+    ListNode = RECORD
+		   next: ModeInfoList;
+		   mode: CARDINAL;
+		   data: ModeInfoType;
+	       END (*RECORD*);
+
+VAR
+    (* Information about the non-VESA modes. *)
+
+    ModeInfo: ModeInfoList;
+		
+(************************************************************************)
+(*			    BANK SWITCHING				*)
+(************************************************************************)
+
+(*<~TopSpeed3
+PROCEDURE VESABankSwitch (WindowNumber, NewBank: CARDINAL);
+
+    (* This is the bank switching procedure that is used when a VESA	*)
+    (* driver is present, but we can't do direct bank switching because	*)
+    (* of compiler limitations.  It's not quite as fast as the direct	*)
+    (* method, but is more portable.					*)
+
+    VAR Registers: RegisterPacket;	
+
+    BEGIN
+	WITH Registers DO
+	    AX := 4F05H;
+	    BX := WindowNumber;
+	    DX := NewBank;
+	END (*WITH*);
+	BIOS(VideoInt, Registers);
+    END VESABankSwitch;
+>*)
+
+(************************************************************************)
+
+(*<TopSpeed3*) (*# save, call(reg_param => (bx, dx)) *) (*>*)
+
+PROCEDURE DummyBankSwitch (WindowNumber, NewBank: CARDINAL);
+
+    (* This is the bank switching procedure that is used when we don't	*)
+    (* expect to have to do any bank switching.  Its only function is	*)
+    (* to avoid the problem of an uninitialised variable.		*)
+
+    BEGIN
+    END DummyBankSwitch;
+
+(************************************************************************)
+
+PROCEDURE ATIBankSwitch (WindowNumber, NewBank: CARDINAL);
+
+    (* This is the bank switching procedure that is used when an ATI	*)
+    (* adaptor has been detected.  We use it for all modes including	*)
+    (* VESA modes, since the VESA driver doesn't seem to correctly	*)
+    (* handle the case of separate read and write banks.		*)
+
+    BEGIN
+	IF WindowNumber = 0 THEN CurrentReadBank := NewBank
+	ELSE CurrentWriteBank := NewBank
+	END (*IF*);
+	OutByte (EXTport, 0B2H);
+	OutByte (EXTport+1,
+		VAL (BYTE, 2*(16*CurrentReadBank + CurrentWriteBank)));
+    END ATIBankSwitch;
+
+(************************************************************************)
+
+PROCEDURE TridentBankSwitch (WindowNumber, NewBank: CARDINAL);
+
+    (* This is the bank switching procedure that is used, for non-VESA	*)
+    (* modes only, when a lower-model Trident adaptor has been detected.*)
+    (* A limitation of the current version is that there are no		*)
+    (* separate read and write banks.					*)
+
+    BEGIN
+	OutByte (3C4H, 0EH);
+	OutByte (3C5H, IXORB(VAL(BYTE,NewBank), 2));
+    END TridentBankSwitch;
+
+(************************************************************************)
+
+PROCEDURE Trident9200BankSwitch (WindowNumber, NewBank: CARDINAL);
+
+    (* This is the bank switching procedure that is used, for non-VESA	*)
+    (* modes only, when a Trident 9200 or better has been detected.	*)
+
+    BEGIN
+	IF WindowNumber = 0 THEN
+	    OutByte (3D9H, VAL(BYTE,NewBank));
+	ELSE
+	    OutByte (3D8H, VAL(BYTE,NewBank));
+	END (*IF*);
+    END Trident9200BankSwitch;
+
+(*<TopSpeed3*) (*# restore *) (*>*)
+
+(************************************************************************)
+(*		      OPERATIONS ON THE VIDEO MODE			*)
+(************************************************************************)
+
+PROCEDURE Supported (mode: CARDINAL): BOOLEAN;
+
+    (* Returns TRUE iff the specified mode is a mode supported	*)
+    (* by the hardware and by this module.			*)
+
+    BEGIN
+	RETURN (mode IN SupportedModes);
+    END Supported;
+
+(************************************************************************)
+
+PROCEDURE BugFixes (mode: CARDINAL;  VAR (*INOUT*) ModeData: ModeInfoType);
+
+    (* Called when a new mode is set: we compensate, if possible, for	*)
+    (* errors introduced by bugs in the BIOS.  (Obviously we're limited	*)
+    (* to the small number of cases where we know the bug and have	*)
+    (* worked out how to repair it - but every little bit helps.)	*)
+
+    (* Curiously, I have yet to find a bug-free VESA BIOS.  I can only	*)
+    (* conjecture that the equipment suppliers have a policy of giving	*)
+    (* the software jobs to their less-competent people.		*)
+
+    BEGIN
+	IF AdaptorType = ATI THEN
+
+	    (* Enable dual bank access mode. *)
+
+	    OutByte (EXTport, 0BEH);  OutByte (EXTport+1, 8);
+
+	    (* Fixes for known bugs in the ATI VESA BIOS.		*)
+	    (* Main known bug is that on some models mode 259 is not	*)
+	    (* set correctly; I haven't managed to find a fix for this.	*)
+
+        ELSIF AdaptorType = S3 THEN
+
+            (* The S3 VESA BIOS is a bit of a mystery to me.  There is	*)
+            (* a definite bug in the "character size" information that	*)
+            (* the BIOS returns, and the fix below corrects for this.	*)
+            (* However there's also a problem in setting many modes,	*)
+            (* and I don't know how to correct for that.		*)
+
+            ModeData.LastCharRow := 15;
+
+	ELSIF AdaptorType = Trident THEN
+
+	    (* Fixes for known bugs in the Trident VESA BIOS.	*)
+
+	    IF (mode = 272) OR (mode = 273) THEN
+		ModeData.BytesPerRow := 1280;
+	    END (*IF*);
+
+	    (* There are also bugs in modes 106,258,260 - being		*)
+	    (* problems with screen synch - but we don't yet know how	*)
+	    (* to fix those.						*)
+
+	END (*IF*);
+
+    END BugFixes;
+
+(************************************************************************)
+
+PROCEDURE DecodeWindows (attra, attrb: BYTE);
+
+    (* Works out which windows are to be used for reading and writing.	*)
+    (* This is for VESA modes, where there is a provision with some	*)
+    (* adaptors and some modes to allow different banks to be selected	*)
+    (* for reading and writing.						*)
+
+    BEGIN
+	ReadWindow := 0;  WriteWindow := 0;
+	IF IANDB (attra, 2) = BYTE(0) THEN
+	    ReadWindow := 1;
+	END (*IF*);
+	IF IANDB (attra, 4) = BYTE(0) THEN
+	    WriteWindow := 1;
+	END (*IF*);
+    END DecodeWindows;
+
+(************************************************************************)
+
+PROCEDURE SetHerculesMode (newmode: CARDINAL;  ClearScreen: BOOLEAN);
+
+    (* A version of procedure SetVideoMode (see below) to be used for	*)
+    (* Hercules adaptors only.						*)
+
+    TYPE ControlTable = ARRAY [0..11] OF BYTE;
+
+    CONST
+	(* Tables of values to put in the 6845 video controller.  These	*)
+	(* are details like character positions per row, sync		*)
+	(* positions, etc., and can be fiddled with only at great risk.	*)
+	(* HGtable gives values suitable for Hercules graphics, and	*)
+	(* MDAtable gives values suitable for MDA or Hercules text mode.*)
+
+	HGtable = ControlTable (53,45,46,07,91,02,87,87,02,03,00,00);
+	MDAtable= ControlTable (97,80,82,15,25,06,25,25,02,13,11,12);
+
+    VAR tableptr: POINTER TO ControlTable;
+	controlcode: SHORTCARD;
+	j, buffersize, fillcode, savedPS: CARDINAL;
+	p: FarCardPointer;
+
+    BEGIN
+	IF newmode = HercGraphics THEN
+	    tableptr := ADR(HGtable);  controlcode := 2;
+	    buffersize := 32768;	(* words in video page 0 *)
+	    fillcode := 0;
+
+	    (* For maximal compatibility with any other hardware	*)
+	    (* which might be present, we enable page 0 graphics only.	*)
+
+	    OutByte (CRTCport+11, 1);
+
+	ELSE
+	    newmode := 7;
+	    tableptr := ADR(MDAtable);  controlcode := 20H;
+	    buffersize := 2000;	(* words for text mode *)
+	    fillcode := 0720H;	(* space, attribute code 7 *)
+	END (*IF*);
+
+	(* Reprogram the 6845 video controller.  Warning: this part	*)
+	(* is quite critical; wrong values could damage the		*)
+	(* hardware.  We disable interrupts here to minimise the	*)
+	(* time for which the 6845 register values are changing.	*)
+	(* We also blank the screen during the operation, to avoid	*)
+	(* or reduce the disconcerting effects while the monitor	*)
+	(* regains synchronism.						*)
+	
+	savedPS := EnterCriticalSection();
+	OutByte (CRTCport+4, controlcode);
+	FOR j := 0 TO 11 DO
+	    OutByte (CRTCport, BYTE(j));
+	    OutByte (CRTCport+1, tableptr^[j]);
+	END (*FOR*);
+	LeaveCriticalSection (savedPS);
+
+	(* Finished reprogramming, clear the screen buffer and	*)
+	(* then enable video.					*)
+
+	IF ClearScreen THEN
+	    FOR j := 0 TO 2*(buffersize-1) BY 2 DO
+		p := MakePointer (ScreenSeg, j);
+		p^ := fillcode;
+	    END (*FOR*);
+	END (*IF*);
+
+	OutByte (CRTCport+4, controlcode+8);
+	CurrentReadBank := 0;  CurrentWriteBank := 0;
+	CurrentMode := newmode;
+
+    END SetHerculesMode;
+
+(************************************************************************)
+
+PROCEDURE SetVideoMode (newmode: CARDINAL;  ClearScreen: BOOLEAN): BOOLEAN;
+
+    (* Sets the video mode.  The mode numbers are as defined in the	*)
+    (* BIOS, plus HercGraphics to denote the Hercules graphics mode,	*)
+    (* plus whatever the VESA BIOS (if present) will support.		*)
+    (* Returns TRUE iff the mode change was successful.			*)
+
+    VAR Registers: RegisterPacket;	
+
+    BEGIN
+	IF (newmode = CurrentMode) AND NOT ClearScreen THEN
+	    RETURN TRUE;
+
+	ELSIF AdaptorType = Hercules THEN
+	    SetHerculesMode (newmode, ClearScreen);
+	    RETURN TRUE;
+
+	ELSIF newmode IN VesaModes+ExtraVesaModes THEN
+
+	    WITH Registers DO
+
+		(* Set a VESA mode. *);
+
+		AX := 4F02H;
+		BX := newmode;
+		IF NOT ClearScreen THEN
+		    INC (BX, 8000H);
+		END (*IF*);
+		BIOS(VideoInt, Registers);
+		IF AX <> 004FH THEN RETURN FALSE END(*IF*);
+
+	    END (*WITH*);
+
+	ELSIF newmode IN SupportedModes THEN
+
+	    (* For all the "standard" modes, let the BIOS do the job.	*)
+
+	    Registers.AX := newmode;
+	    IF NOT ClearScreen THEN
+		INC (Registers.AX, 80H);
+	    END (*IF*);
+	    BIOS (VideoInt, Registers);
+
+	ELSE
+	    (* Not a supported mode. *)
+
+	    RETURN FALSE;
+
+	END (*IF*);
+
+	CurrentMode := newmode;
+
+	(* Initialise the bank switching. *)
+
+	IF AdaptorType = ATI THEN
+	    (* Enable dual bank access mode. *)
+	    OutByte (EXTport, 0BEH);  OutByte (EXTport+1, 8);
+	END (*IF*);
+	BankSwitch := DefaultBankSwitch;
+	ReadWindow := 0;  WriteWindow := 1;
+	CurrentReadBank := 0;  CurrentWriteBank := 0;
+	BankSwitch (0, 0);  BankSwitch (1, 0);
+
+	(* ScreenSeg and CRTCport depend on whether we are using	*)
+	(* a monochrome or colour mode.					*)
+
+	IF newmode IN MonochromeModes THEN
+	    ScreenSeg := FarSEGMENT(Virtual(0B0000H));
+	    CRTCport := 03B4H;
+	ELSE
+	    ScreenSeg := FarSEGMENT(Virtual(0B8000H));
+	    CRTCport := 03D4H;
+	END (*IF*);
+
+	(* For an EGA or better adaptor, ScreenSeg depends on	*)
+	(* whether we are emulating a CGA mode.			*)
+
+	IF newmode >= 13 THEN
+	    ScreenSeg:= FarSEGMENT (Virtual(0A0000H));
+	END (*IF*);
+
+	RETURN TRUE;
+
+    END SetVideoMode;
+
+(************************************************************************)
+
+PROCEDURE RestoreOriginalMode;
+
+    (* Sets the video mode back to what it was before this program ran.	*)
+    (* Also restores the original text page.				*)
+
+    VAR Registers: RegisterPacket;  dummy: BOOLEAN;
+
+    BEGIN
+	dummy := SetVideoMode (OriginalMode, TRUE);
+	Registers.AH := 5;  Registers.AL := OriginalPage;
+	BIOS (VideoInt, Registers);
+    END RestoreOriginalMode;
+
+(************************************************************************)
+(*			MISCELLANEOUS OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE SelectReadBank (bank: CARDINAL);
+
+    (* Switches to a new bank of screen memory for reading.  Should be	*)
+    (* used only with the adaptors which support the high-resolution	*)
+    (* modes using bank switching.					*)
+
+    BEGIN
+	IF bank <> CurrentReadBank THEN
+	    BankSwitch (ReadWindow, bank);
+	    CurrentReadBank := bank;
+	    IF ReadWindow = WriteWindow THEN
+		CurrentWriteBank := bank;
+	    END (*IF*);
+	END (*IF*);
+    END SelectReadBank;
+
+(************************************************************************)
+
+PROCEDURE SelectWriteBank (bank: CARDINAL);
+
+    (* Switches to a new bank of screen memory for writing.  Should be	*)
+    (* used only with the adaptors which support the high-resolution	*)
+    (* modes using bank switching.					*)
+
+    BEGIN
+	IF bank <> CurrentWriteBank THEN
+	    BankSwitch (WriteWindow, bank);
+	    CurrentWriteBank := bank;
+	    IF ReadWindow = WriteWindow THEN
+		CurrentReadBank := bank;
+	    END (*IF*);
+	END (*IF*);
+    END SelectWriteBank;
+
+(************************************************************************)
+
+PROCEDURE WaitForVerticalRetrace;
+
+    (* Busy wait until we reach the vertical retrace period.		*)
+    (* Warning: I wrote this quickly for one specific application, and	*)
+    (* haven't gotten around to getting it right for the general case.	*)
+
+    CONST CGAStatusReg = 3DAH;
+
+    BEGIN
+	WHILE IANDB(InByte(CGAStatusReg),8) = BYTE(0) DO
+	    (* nothing *)
+	END (*WHILE*);
+    END WaitForVerticalRetrace;
+
+(************************************************************************)
+(*		    INFORMATION ABOUT CURRENT MODE			*)
+(************************************************************************)
+
+PROCEDURE GetAddresses (VAR (*OUT*) ScreenSegment, IObase: CARDINAL);
+
+    (* Returns the segment of the screen memory and the port number	*)
+    (* of the video controller.						*)
+
+    BEGIN
+	ScreenSegment := ScreenSeg;  IObase := CRTCport;
+    END GetAddresses;
+
+(************************************************************************)
+
+PROCEDURE GetVESAModeInfo (mode: CARDINAL;  VAR (*OUT*) result: ModeInfoType);
+
+    (* Returns information about a VESA mode.  If the information	*)
+    (* is not available, the parameter values are left unchanged.	*)
+
+    VAR VesaInfo: POINTER TO VESAInformationRecord1;
+	Registers: RegisterPacket;
+
+    BEGIN
+	NEW (VesaInfo);
+	WITH Registers DO
+	    AX := 4F01H;
+	    CX := mode;
+	    DI := OFFSET (VesaInfo);
+	    ES := SEGMENT (VesaInfo);
+	    BIOS (VideoInt, Registers);
+	    IF AX <> 004FH THEN
+		DISPOSE (VesaInfo);  RETURN;
+	    END(*IF*);
+	END (*WITH*);
+
+	WITH VesaInfo^ DO
+	    IF (mode = CurrentMode) AND (AdaptorType <> ATI) THEN
+		DecodeWindows (window_a_attrib, window_b_attrib);
+		(*<TopSpeed3*) BankSwitch := bank_switch_function; (*>*)
+		(*<~TopSpeed3 BankSwitch := VESABankSwitch; >*)
+	    END (*IF*);
+	
+	    result.MaxX := x_res - 1;
+	    result.MaxY := y_res - 1;
+	    result.LastCharRow := VAL(CARDINAL,y_character_size) - 1;
+	    result.BitsPerPixel :=
+			ORD(bits_per_pixel) DIV ORD(number_of_planes);
+	    result.BytesPerRow := bytes_per_row;
+	    result.FramesPerScreen := 1;
+	    result.Planar := FALSE;
+	    CASE memory_model OF
+		  0, 2:	result.MaxColour := 1;
+		|
+		  1:	result.MaxColour := 3;
+		|
+		  3:	result.MaxColour := 15;  result.Planar := TRUE;
+		|
+		  4, 5:	result.MaxColour := 255;
+		|
+		  6:	IF reserved_mask_size > 0 THEN
+			    result.MaxColour := 32767;
+			ELSE
+			    result.MaxColour := 65535;
+			END (*IF*);
+		|
+		  ELSE	result.MaxColour := 1;
+	    END (*CASE*);
+	    result.MultiBank := y_res > Div(10000H, bytes_per_row);
+	    result.TextMode := (memory_model = 0);
+
+	END (*WITH*);
+
+	DISPOSE (VesaInfo);
+	BugFixes (mode, result);
+
+    END GetVESAModeInfo;
+
+(************************************************************************)
+
+PROCEDURE GetModeInfo (mode: CARDINAL;  VAR (*OUT*) result: ModeInfoType);
+
+    (* Returns information about the given mode.  If the information	*)
+    (* is not available, the parameter values are left unchanged.	*)
+
+    VAR p: ModeInfoList;
+
+    BEGIN
+	IF mode IN (VesaModes+ExtraVesaModes) THEN
+
+	    GetVESAModeInfo (mode, result);
+
+	ELSIF mode IN SupportedModes THEN
+
+	    (* Search the ModeInfo list. *)
+
+	    p := ModeInfo;
+	    LOOP
+		IF p = NIL THEN EXIT (*LOOP*)
+		ELSIF p^.mode = mode THEN
+		    result := p^.data;
+		    EXIT (*LOOP*);
+		ELSE p := p^.next;
+		END (*IF*);
+	    END (*LOOP*);
+
+	END (*IF*);
+
+    END GetModeInfo;
+
+(************************************************************************)
+(*			    DEFINING A MODE				*)
+(************************************************************************)
+
+PROCEDURE DefineMode (newmode: CARDINAL;
+			MaxX, MaxY, MaxColour, LastCharRow: CARDINAL;
+			BitsPerPixel, BytesPerRow: CARDINAL;
+			Planar, MultiBank, TextMode: BOOLEAN);
+
+    (* Adds another mode to the list of supported modes. *)
+
+    VAR p: ModeInfoList;
+
+    BEGIN
+	NEW (p);
+	WITH p^ DO
+	    next := ModeInfo;
+	    mode := newmode;
+	    data.BytesPerRow := BytesPerRow;
+	    data.MaxX := MaxX;
+	    data.MaxY := MaxY;
+	    data.MaxColour := MaxColour;
+	    data.LastCharRow := LastCharRow;
+	    data.BitsPerPixel := BitsPerPixel;
+	    data.BytesPerRow := BytesPerRow;
+	    IF mode = HercGraphics THEN
+		data.FramesPerScreen := 4;
+	    ELSIF mode IN ModeSet{4..6} THEN
+		data.FramesPerScreen := 2;
+	    ELSE
+		data.FramesPerScreen := 1;
+	    END (*IF*);
+	    data.Planar := Planar;
+	    data.MultiBank := MultiBank;
+	    data.TextMode := TextMode;
+	END (*WITH*);
+	ModeInfo := p;
+	INCL (SupportedModes, newmode);
+    END DefineMode;
+
+(************************************************************************)
+(*			EQUIPMENT KIND DETECTION			*)
+(************************************************************************)
+
+PROCEDURE VideoKind (): VideoAdaptorType;
+
+    (* Returns the display adaptor type.  This is a best guess, and it	*)
+    (* is possible that some adaptor types will be misclassified.	*)
+    (* In the present version, most SVGA adaptors will be reported as	*)
+    (* VGA or SVGA rather than something more specific; and no		*)
+    (* distinction is drawn between the "ordinary" Hercules adaptor and	*)
+    (* the Hercules Plus or Hercules InColor.				*)
+
+    BEGIN
+	RETURN AdaptorType;
+    END VideoKind;
+
+(************************************************************************)
+(*		   DETECTING A HERCULES GRAPHICS ADAPTOR		*)
+(************************************************************************)
+
+PROCEDURE CheckForHercules;
+
+    (* The Hercules graphics interface is a special case because the	*)
+    (* BIOS equipment information does not distinguish between it and	*)
+    (* the Monochrome Display Adaptor.  The HGA has the same text mode	*)
+    (* as the MDA, but it has a graphics mode as well.  One way to work	*)
+    (* out the difference is to look at the "vertical retrace" bit in	*)
+    (* the display status port.  The MDA does not implement this bit,	*)
+    (* so reading it will return a constant.				*)
+
+    VAR i, j, changes: CARDINAL;
+	oldvalue, newvalue: BYTE;
+
+    BEGIN
+	changes := 0;
+	FOR i := 0 TO 24 DO
+	    oldvalue := IANDB (InByte (CRTCport+6), 80H);
+	    j := 32767;
+	    LOOP
+		newvalue := IANDB (InByte (CRTCport+6), 80H);
+		IF newvalue <> oldvalue THEN
+		    INC (changes);  EXIT(*LOOP*);
+		END (*IF*);
+		DEC (j);
+		IF j = 0 THEN EXIT(*LOOP*) END(*IF*);
+	    END (*LOOP*);
+	END (*FOR*);
+	IF changes > 20 THEN
+	    AdaptorType := Hercules;
+	    DefineMode (HercGraphics, 719, 347, 1, 7,
+				1, 90, FALSE, FALSE, FALSE);
+	END (*IF*);
+    END CheckForHercules;
+
+(************************************************************************)
+(*		INITIALISATION FOR VESA SVGA ADAPTORS			*)
+(************************************************************************)
+
+PROCEDURE Match (StringPtr: FarPointer;  location: CARDINAL;
+				OtherString: ARRAY OF CHAR): BOOLEAN;
+
+    (* Compares two strings, where the first is a substring specified	*)
+    (* in terms of an offset from a memory address.			*)
+
+    VAR p: FarCharPointer;  k: CARDINAL;
+
+    BEGIN
+	p := FarAddOffset (StringPtr, location);
+	k := 0;
+	LOOP
+	    IF k = HIGH(OtherString) THEN RETURN TRUE END(*IF*);
+	    IF p^ <> OtherString[k] THEN RETURN FALSE END(*IF*);
+	    INC (k);
+	    p := FarAddOffset (p, 1);
+	END (*LOOP*);
+    END Match;
+
+(************************************************************************)
+
+PROCEDURE SpecificDriverChecks (OEMStringPtr: FarPointer);
+
+    (* Tries to identify the hardware type from the VESA OEM string	*)
+    (* pointer.								*)
+
+    BEGIN
+	IF Match (OEMStringPtr, 0, "761295520") THEN
+	    AdaptorType := ATI;
+	ELSIF Match (OEMStringPtr, 0, "S3") THEN
+	    AdaptorType := S3;
+	ELSIF Match (OEMStringPtr, 21, "TRIDENT") THEN
+	    AdaptorType := Trident;
+	    ExtraVesaModes := ModeSet {272, 273, 275, 276};
+	END (*IF*);
+    END SpecificDriverChecks;
+
+(************************************************************************)
+
+PROCEDURE CheckVESADriver;
+
+    (* Compiles a list of supported VESA modes, if any.	*)
+
+    TYPE PointerToCardinal = FarCardPointer;
+
+    VAR Registers: RegisterPacket;
+	ListPtr: PointerToCardinal;
+	SysInfoPtr: POINTER TO
+			    RECORD
+				VesaSignature: ARRAY [0..3] OF CHAR;
+				VesaVersion: WORD;
+				OEM_OffsetString: FarPointer;
+				capabilities: LONGWORD;
+				ModeListPointer: PointerToCardinal;
+				NumberOf64KBlocks: CARDINAL;
+				reserved: ARRAY [20..255] OF BYTE;
+			    END (*RECORD*);
+
+    (********************************************************************)
+
+    PROCEDURE VesaSignatureAbsent(): BOOLEAN;
+
+	BEGIN
+	    WITH SysInfoPtr^ DO
+		RETURN (VesaSignature[0] <> "V")
+			OR (VesaSignature[1] <> "E")
+			OR (VesaSignature[2] <> "S")
+			OR (VesaSignature[3] <> "A");
+	    END (*WITH*);
+	END VesaSignatureAbsent;
+
+    (********************************************************************)
+
+    BEGIN
+	(* Call the VESA BIOS subfunction 0, which is supposed to	*)
+	(* return system information.  If this call fails, we presume	*)
+	(* that there is no VESA driver present.			*)
+
+	NEW(SysInfoPtr);
+	WITH Registers DO
+	    AX := 4F00H;
+	    DI := OFFSET(SysInfoPtr);
+	    ES := SEGMENT(SysInfoPtr);
+	    BIOS(VideoInt,Registers);
+	    IF (Registers.AX <> 004FH) OR VesaSignatureAbsent() THEN
+		DISPOSE (SysInfoPtr);
+		RETURN;
+	    END (*IF*);
+	END (*WITH*);
+
+	(* We've found a VESA driver, now work out what modes it	*)
+	(* supports.							*)
+
+	AdaptorType := SVGA;
+	ListPtr := SysInfoPtr^.ModeListPointer;
+	WHILE ListPtr^ <> 0FFFFH DO
+	    VesaModes := VesaModes + ModeSet {ListPtr^};
+	    ListPtr := FarAddOffset (ListPtr, 2);
+	END (*WHILE*);
+	ExtraVesaModes := ModeSet {};
+	SpecificDriverChecks (SysInfoPtr^.OEM_OffsetString);
+	SupportedModes := SupportedModes + VesaModes + ExtraVesaModes;
+	DISPOSE (SysInfoPtr);
+
+    END CheckVESADriver;
+
+(************************************************************************)
+
+PROCEDURE VESAdriverPresent (): BOOLEAN;
+
+    (* Returns TRUE iff a VESA driver was detected. *)
+
+    BEGIN
+	RETURN VesaModes <> ModeSet {};
+    END VESAdriverPresent;
+
+(************************************************************************)
+(*			TESTS FOR SPECIFIC SVGA TYPES			*)
+(************************************************************************)
+
+PROCEDURE AddTridentModes;
+
+    (* Called only if we've identified a Trident adaptor.  Updates the	*)
+    (* set of supported modes, also updates DefaultBankSwitch.		*)
+
+    VAR model: CARDINAL;
+
+    BEGIN
+	(* Work out the hardware model from the hardware version	*)
+	(* register.  Reading from this register has the side-effect of	*)
+	(* toggling the definition of the mode control registers; to	*)
+	(* get into a known state, we write before reading.		*)
+
+	OutByte (3C4H, 0BH);  OutByte (3C5H, 0);
+	CASE ORD(InByte(3C5H)) OF
+	   | 3, 4:		model := 8900;
+	   | 13H, 23H, 93H:	model := 9000;
+	   | 53H, 83H:		model := 9200;
+	   | 73H:		model := 9420;
+	   | ELSE		model := 8800;
+	END (*CASE*);
+
+	(* Define (my best guess at) the available modes.  These are	*)
+	(* all untested!  (I no longer have a Trident.)			*)
+
+	DefaultBankSwitch := TridentBankSwitch;
+	DefineMode (5BH, 799, 599, 15, 7, 1, 100, TRUE, TRUE, FALSE);
+	DefineMode (5CH, 639, 399, 255, 15, 8, 640, FALSE, TRUE, FALSE);
+	DefineMode (5DH, 639, 479, 255, 15, 8, 640, FALSE, TRUE, FALSE);
+	DefineMode (5FH, 1023, 767, 15, 15, 1, 128, TRUE, TRUE, FALSE);
+	DefineMode (61H, 767, 1023, 15, 15, 1, 96, TRUE, TRUE, FALSE);
+	IF model > 8800 THEN
+	    DefineMode (5EH, 799, 599, 255, 7, 8, 800, FALSE, TRUE, FALSE);
+	    DefineMode (62H, 1023, 767, 255, 15, 8, 1024, FALSE, TRUE, FALSE);
+	END (*IF*);
+	IF model >= 9200 THEN
+	    DefaultBankSwitch := Trident9200BankSwitch;
+	    DefineMode (60H, 1023, 767, 3, 15, 2, 256, FALSE, TRUE, FALSE);
+	    DefineMode (63H, 1279, 1023, 15, 15, 1, 160, TRUE, TRUE, FALSE);
+	    DefineMode (64H, 1279, 1023, 255, 15, 8, 1280, FALSE, TRUE, FALSE);
+	    DefineMode (6CH, 639, 479, 0, 7, 24, 1920, FALSE, TRUE, FALSE);
+	    DefineMode (70H, 511, 479, 32767, 7, 16, 1024, FALSE, TRUE, FALSE);
+	    DefineMode (71H, 511, 479, 65535, 7, 16, 1024, FALSE, TRUE, FALSE);
+	    DefineMode (74H, 639, 479, 32767, 7, 16, 1280, FALSE, TRUE, FALSE);
+	    DefineMode (75H, 639, 479, 65535, 7, 16, 1280, FALSE, TRUE, FALSE);
+	    DefineMode (76H, 799, 599, 32767, 7, 16, 1600, FALSE, TRUE, FALSE);
+	    DefineMode (77H, 799, 599, 65535, 7, 16, 1600, FALSE, TRUE, FALSE);
+	END (*IF*);
+
+    END AddTridentModes;
+
+(************************************************************************)
+
+PROCEDURE TridentPresent(): BOOLEAN;
+
+    (* Returns TRUE iff a Trident adaptor is detected. *)
+
+    VAR OldMiscValue, OldValue, NewValue: BYTE;
+
+    BEGIN
+	IF AdaptorType <> VGA THEN RETURN (AdaptorType=Trident) END(*IF*);
+
+	(* The distinctive feature of a Trident is the presence of an	*)
+	(* inverting bit in the Mode Control #1 Register.  The		*)
+	(* following code purports to check for this.  I'm taking it on	*)
+	(* trust - the code is from Ferraro's book and he doesn't tell	*)
+	(* us the meaning of some of the ports.				*)
+
+	(* First set memory map field in Miscellaneous Register to 01.	*)
+
+	OutByte (3CEH, 6);
+	OldMiscValue := InByte (3CFH);
+	OutByte (3CFH, IORB(4, IANDB(OldMiscValue, 3)));
+
+	(* Write zero to the mode control register, then read it back	*)
+	(* and see whether bit 1 has been set.				*)
+
+	OutByte (3C4H, 0EH);
+	OldValue := InByte (03C5H);
+	OutByte (03C5H, 0);
+	NewValue := IANDB (InByte(03C5H), 0FH);
+
+	(* I don't claim to understand this next part.  We're writing	*)
+	(* back the old value; but if it's a Trident then we should	*)
+	(* have inverted a bit before writing it back, and if it isn't	*)
+	(* a Trident then it's hard to predict what side-effects will	*)
+	(* arise from writing to a port whose function isn't known.	*)
+	(* Nevertheless I'll just hope Ferraro knows what he's doing.	*)
+
+	OutByte (03C5H, OldValue);
+
+	(* Restore original contents of Miscellaneous Register. *)
+
+	OutByte (3CEH, 6);  OutByte (3CFH, OldMiscValue);
+	IF ORD(NewValue) >= 2 THEN RETURN TRUE END(*IF*);
+
+	(* Further possibility: an older 8800 can be detected by	*)
+	(* looking at the power up register.				*)
+
+	OutByte (3C4H, 0FH);  OutByte (3C5H, 0);
+	RETURN InByte (3C5H) <> BYTE(0);
+
+    END TridentPresent;
+
+(************************************************************************)
+
+PROCEDURE AddATIModes;
+
+    (* Called only if we've identified an ATI adaptor.  Updates the	*)
+    (* set of supported modes, also works out the value of EXTport and	*)
+    (* sets up the bank switching procedure.				*)
+
+    (********************************************************************)
+
+    PROCEDURE ModeAvailable (m: SHORTCARD): BOOLEAN;
+
+	(* Returns TRUE if the ATI hardware supports mode m. *)
+
+	VAR Registers: RegisterPacket;	
+
+	BEGIN
+	    WITH Registers DO
+		AL := m;  AH := 12H;
+		BX := 5506H;
+		BP := 0FFFFH;
+	    END (*WITH*);
+	    BIOS(VideoInt, Registers);
+	    RETURN Registers.BP <> 0FFFFH;
+	END ModeAvailable;
+
+    (********************************************************************)
+
+    PROCEDURE TryMode (mode: CARDINAL;
+			MaxX, MaxY, MaxColour, LastCharRow: CARDINAL;
+			BitsPerPixel, BytesPerRow: CARDINAL;
+			Planar, MultiBank, TextMode: BOOLEAN);
+
+	(* Defines a new available mode, if the hardware can support it. *)
+
+	BEGIN
+	    IF ModeAvailable(SHORTCARD(mode)) THEN
+		DefineMode (mode, MaxX, MaxY,
+			MaxColour, LastCharRow, BitsPerPixel,
+			BytesPerRow, Planar, MultiBank, TextMode);
+	    END (*IF*);
+	END TryMode;
+
+    (********************************************************************)
+
+    VAR p: FarCardPointer;
+
+    BEGIN	(* Body of AddATIModes *)
+
+	(* Find out the value of EXTport. *)
+
+	p := MakePointer (BIOSsegment, 010H);
+	EXTport := p^;
+
+	(* Initialise the bank switching. *)
+
+	DefaultBankSwitch := ATIBankSwitch;
+
+	(* Define the modes which are specific to the ATI adaptor.	*)
+	(* Mode 63H is buggy on some ATI models.			*)
+	(* Modes 64H, 65H are untested.					*)
+	(* Mode 67H uses a format that I don't support.			*)
+	
+	TryMode (53H, 799, 599, 15, 13, 1, 100, TRUE, TRUE, FALSE);
+	TryMode (54H, 799, 599, 15, 13, 1, 100, TRUE, TRUE, FALSE);
+	TryMode (55H, 1023, 767, 15, 15, 1, 128, TRUE, TRUE, FALSE);
+	TryMode (61H, 639, 399, 255, 15, 8, 640, FALSE, TRUE, FALSE);
+	TryMode (62H, 639, 479, 255, 15, 8, 640, FALSE, TRUE, FALSE);
+	TryMode (63H, 799, 599, 255, 13, 8, 800, FALSE, TRUE, FALSE);
+	TryMode (64H, 1023, 767, 255, 15, 8, 1024, FALSE, TRUE, FALSE);
+	TryMode (65H, 1023, 767, 15, 15, 4, 512, FALSE, TRUE, FALSE);
+
+    END AddATIModes;
+
+(************************************************************************)
+
+PROCEDURE ATIpresent(): BOOLEAN;
+
+    (* Returns TRUE iff an ATI adaptor is detected. *)
+
+    BEGIN
+	RETURN (AdaptorType = ATI)
+		OR Match (MakePointer(BIOSsegment,31H), 0, "761295520");
+    END ATIpresent;
+
+(************************************************************************)
+
+PROCEDURE IdentifySVGAtype;
+
+    (* On entry, AdaptorType >= VGA, i.e. we have detected at least a	*)
+    (* VGA, and if a VESA driver was present then we might have already	*)
+    (* made a more specific identification.  This procedure attempts	*)
+    (* to pin down the hardware more precisely, and also augments the	*)
+    (* list of supported modes where possible.				*)
+
+    BEGIN
+	IF TridentPresent() THEN
+	    AdaptorType := Trident;
+	    AddTridentModes;
+	ELSIF ATIpresent() THEN
+	    AdaptorType := ATI;
+	    AddATIModes;
+	END (*IF*);
+    END IdentifySVGAtype;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+VAR Registers: RegisterPacket;
+    p: FarCardPointer;  dummy: BOOLEAN;
+
+BEGIN
+    BIOSsegment := FarSEGMENT (Virtual(0C0000H));
+    SupportedModes := ModeSet {};
+    VesaModes := ModeSet {};  ExtraVesaModes := ModeSet {};
+    ModeInfo := NIL;
+    ReadWindow := 0;  WriteWindow := 1;
+    CurrentReadBank := 0;  CurrentWriteBank := 0;
+    DefaultBankSwitch := DummyBankSwitch;
+
+    (* Read the low byte of the system equipment word at 0040:0010.	*)
+    (* Bits 4 and 5 of this byte give the initial video mode: 00 is	*)
+    (* unused, 01 or 10 implies a colour adaptor, 11 implies a		*)
+    (* monochrome adaptor.						*)
+
+    p := MakePointer (0040H, 0010H);
+    IF ORD(IAND (p^, 30H)) = 30H THEN
+
+	(* Must be an MDA or Hercules *)
+
+	AdaptorType := MDA;  ScreenSeg:= FarSEGMENT (Virtual(0B0000H));
+	CRTCport := 03B4H;
+	DefineMode (0, 319, 199, 1, 7, 1, 40, FALSE, FALSE, TRUE);
+	DefineMode (2, 639, 199, 1, 7, 1, 80, FALSE, FALSE, TRUE);
+	DefineMode (7, 719, 349, 1, 13, 1, 80, FALSE, FALSE, TRUE);
+	CheckForHercules;
+
+    ELSE
+
+	(* Colour display present.  If there is an expansion ROM at	*)
+	(* C000:0000, we assume that it's an EGA or better.		*)
+
+	CRTCport := 03D4H;
+	DefineMode (1, 319, 199, 3, 7, 1, 40, FALSE, FALSE, TRUE);
+	DefineMode (3, 639, 199, 3, 7, 1, 80, FALSE, FALSE, TRUE);
+	DefineMode (4, 319, 199, 3, 7, 2, 80, FALSE, FALSE, FALSE);
+	DefineMode (5, 319, 199, 1, 7, 2, 80, FALSE, FALSE, FALSE);
+	DefineMode (6, 639, 199, 1, 7, 1, 80, FALSE, FALSE, FALSE);
+	p := MakePointer (BIOSsegment, 0);
+	IF p^ <> 0AA55H THEN
+	    AdaptorType := CGA;
+	    ScreenSeg:= FarSEGMENT (Virtual(0B8000H));
+	ELSE
+	    AdaptorType := EGA;
+	    ScreenSeg:= FarSEGMENT (Virtual(0A0000H));
+	    DefineMode (13, 319, 199, 15, 7, 1, 40, TRUE, FALSE, FALSE);
+	    DefineMode (14, 639, 199, 15, 7, 1, 80, TRUE, FALSE, FALSE);
+	    DefineMode (15, 639, 349, 1, 13, 1, 80, FALSE, FALSE, FALSE);
+	    DefineMode (16, 639, 349, 15, 13, 1, 80, TRUE, FALSE, FALSE);
+
+	    (* It's at least EGA, test now for VGA.  If it passes that	*)
+	    (* test, check for the presence of a VESA driver and/or for	*)
+	    (* specific SVGA types which we able to identify.		*)
+
+	    Registers.AX := 1A00H;
+	    BIOS (VideoInt, Registers);
+
+	    IF Registers.AL = 26 THEN
+
+		AdaptorType := VGA;
+		DefineMode (17, 639, 479, 1, 15, 1, 80, FALSE, FALSE, FALSE);
+		DefineMode (18, 639, 479, 15, 15, 1, 80, TRUE, FALSE, FALSE);
+		DefineMode (19, 319, 199, 255, 7, 8,320, FALSE, FALSE, FALSE);
+		
+		(* The following two procedures attempt to identify	*)
+		(* SVGA chips.  They might have the side-effect of	*)
+		(* updating AdaptorType and SupportedModes.		*)
+
+		CheckVESADriver;
+		IdentifySVGAtype;
+
+	    END (*IF*);
+
+	END (*IF*);
+
+    END (*IF*);
+
+    (* Find out what video mode is currently in effect, so that it can	*)
+    (* be restored when we are done.					*)
+
+    Registers.AH := 15;
+    BIOS (VideoInt, Registers);
+    OriginalMode := CARDINAL(Registers.AL);
+    OriginalPage := Registers.BH;
+    SetTerminationProcedure (RestoreOriginalMode);
+
+    (* By setting that mode, we ensure that our global variables are	*)
+    (* set to meaningful initial values.				*)
+
+    dummy := SetVideoMode (OriginalMode, FALSE);
+
+END Screen.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/screened.def b/examples/Modula-2_Libraries/PMOS/sources/general/screened.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/screened.def
@@ -0,0 +1,132 @@
+DEFINITION MODULE ScreenEditor;
+
+	(********************************************************)
+	(*							*)
+	(*		Screen data capture			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	28 April 1993			*)
+	(*  Status:						*)
+	(*	Basic features working, but see faults in	*)
+	(*	module RowEditor.				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE, ADDRESS;
+
+FROM Windows IMPORT
+    (* type *)	Window;
+
+FROM ListEditor IMPORT
+    (* type *)	List, ListFormat;
+
+FROM Menus IMPORT
+    (* type *)	Menu;
+
+FROM FieldEditor IMPORT
+    (* type *)	FieldType;
+
+(************************************************************************)
+
+TYPE
+    Structure;		(* is private *)
+
+(************************************************************************)
+(*		   INTRODUCING A NEW FIELD TO THE SYSTEM		*)
+(************************************************************************)
+
+PROCEDURE ByteField (VAR (*IN*) variable: BYTE;
+			screenrow, screencolumn, width: CARDINAL): Structure;
+
+    (* Creates a one-field structure for editing a BYTE variable.	*)
+
+PROCEDURE CardinalField (VAR (*IN*) variable: CARDINAL;
+			screenrow, screencolumn, width: CARDINAL): Structure;
+
+    (* Creates a one-field structure for editing the given CARDINAL	*)
+    (* variable.							*)
+
+PROCEDURE RealField (VAR (*IN*) variable: REAL;
+			screenrow, screencolumn, width: CARDINAL): Structure;
+
+    (* Creates a one-field structure for editing a REAL variable.	*)
+
+(************************************************************************)
+(*			   FOR ADVANCED USERS				*)
+(************************************************************************)
+
+PROCEDURE MenuField (VAR (*IN*) variable: CARDINAL;
+		screenrow, screencolumn, lines, width: CARDINAL;
+		M: Menu): Structure;
+
+    (* Creates a one-field structure for editing a cardinal variable	*)
+    (* via menu selection.  The caller must ensure that M has already	*)
+    (* been defined by a call to Menus.					*)
+
+PROCEDURE ListField (VAR (*IN*) variable: List;
+				screenrow, screencolumn: CARDINAL;
+					f: ListFormat): Structure;
+
+    (* Creates a structure for editing a linear list.  The caller must	*)
+    (* ensure that f has been defined by a call to module ListEditor.	*)
+    (* This procedure does not add any features beyond what ListEditor	*)
+    (* provides, but by returning a result of type Structure it allows	*)
+    (* lists and scalars to be mixed in the same editing window.	*)
+
+PROCEDURE CreateField (VariableAddress: ADDRESS;  ftype: FieldType;
+			screenrow, screencolumn, width: CARDINAL): Structure;
+
+    (* Creates a new structure consisting of a single field.  Before	*)
+    (* calling this procedure, the caller should make sure, by calling	*)
+    (* FieldEditor.DefineFieldType if necessary, that ftype is a type	*)
+    (* already known to module FieldEditor.				*)
+
+(************************************************************************)
+(*		CREATING MULTI-FIELD EDITING STRUCTURES			*)
+(************************************************************************)
+
+PROCEDURE Combine (VAR (*INOUT*) A: Structure;  B: Structure);
+
+    (* Strips all of the fields from B and adds them to the existing	*)
+    (* fields of A.  Note that B is destroyed in the process.		*)
+
+PROCEDURE MakeArray (VAR (*INOUT*) S: Structure;  count: CARDINAL;
+		addroffset, rowoffset, coloffset: CARDINAL);
+
+    (* Creates a structure for an array of count elements, where on	*)
+    (* entry S is a structure already created for the first array	*)
+    (* element.  Parameter addroffset is the difference between		*)
+    (* adjacent array elements.  The remaining two parameters give the	*)
+    (* offset on the screen between the starting positions of adjacent	*)
+    (* array elements.							*)
+
+(************************************************************************)
+(*				EDITING					*)
+(************************************************************************)
+
+PROCEDURE ScreenEdit (w: Window;  S: Structure;  VAR (*OUT*) abort: BOOLEAN);
+
+    (* Displays structure S in window w, and allows the keyboard user	*)
+    (* to edit the components of S.  It is assumed that w is already	*)
+    (* open and that S has already been fully defined.  Returns		*)
+    (* abort=TRUE if user aborted the editing with the Esc key.		*)
+
+(************************************************************************)
+(*			  CLOSING A STRUCTURE				*)
+(************************************************************************)
+
+PROCEDURE DeleteStructure (VAR (*INOUT*) S: Structure);
+
+    (* Deletes structure S.  Calling this procedure is optional, but is	*)
+    (* recommended in order to reclaim memory space when S is no longer	*)
+    (* needed (and it makes it clearer in the program listing that S	*)
+    (* will no longer be used).  Note that this procedure does NOT	*)
+    (* delete the variables to which S gives access; if, for example,	*)
+    (* you were working with lists and menus then those lists and menus	*)
+    (* continue to exist.  DeleteStructure simply deletes the overhead	*)
+    (* data which was originally allocated by this module for its own	*)
+    (* purposes.							*)
+
+END ScreenEditor.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/screened.mod b/examples/Modula-2_Libraries/PMOS/sources/general/screened.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/screened.mod
@@ -0,0 +1,414 @@
+IMPLEMENTATION MODULE ScreenEditor;
+
+	(********************************************************)
+	(*							*)
+	(*		Screen data capture			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 February 1995		*)
+	(*  Status:						*)
+	(*	Basic features working, but see faults in	*)
+	(*	module RowEditor.				*)
+	(*							*)
+	(********************************************************)
+
+FROM RowEditor IMPORT
+    (* type *)	StructureRow,
+    (* proc *)	WriteRow, EditRow, NewRow, CombineRows,
+		CopyOfRow, AdjustRow, DeleteRow, NewList, NewMenu,
+		DumpRow, StartColumn;
+
+FROM SYSTEM IMPORT
+    (* proc *)	ADR;
+
+FROM Windows IMPORT
+    (* proc *)	OpenSimpleWindow, CloseWindow, SetCursor,
+    (* proc *)	WriteLn, WriteString, PressAnyKey;	(* for debugging *)
+
+FROM NumericIO IMPORT				(* for debugging *)
+    (* proc *)	WriteAddress, WriteCard;
+
+FROM Menus IMPORT
+    (* type *)	MenuOption, MO, OffEdgeOption,
+    (* proc *)	SetOptions, OffEdge;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey, PutBack;
+
+FROM FieldEditor IMPORT
+    (* var  *)	Byte, Cardinal, Real,
+    (* proc *)	DefineFieldType;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+(************************************************************************)
+
+CONST testing = FALSE;
+
+CONST Esc = CHR(27);
+
+TYPE
+
+    Structure = POINTER TO RowHeader;
+
+    (* The fields in a RowHeader record are:				*)
+    (*		pointer:	the row structure for this row		*)
+    (*		row:		screen position				*)
+    (*		up, down:	pointers to adjacent rows		*)
+
+    RowHeader = RECORD
+		    pointer: StructureRow;
+		    row: CARDINAL;
+		    up, down: Structure;
+		END (*RECORD*);
+
+(************************************************************************)
+(*			    SCREEN OUTPUT				*)
+(************************************************************************)
+
+PROCEDURE WriteStructure (w: Window;  S: Structure);
+
+    BEGIN
+	WHILE S <> NIL DO
+	    WITH S^ DO
+		WriteRow (w, pointer, row);
+	    END (*WITH*);
+	    S := S^.down;
+	END (*WHILE*);
+    END WriteStructure;
+
+(************************************************************************)
+(*		   INTRODUCING A NEW FIELD TO THE SYSTEM		*)
+(************************************************************************)
+
+PROCEDURE CreateField (VariableAddress: ADDRESS;  ftype: FieldType;
+			screenrow, screencolumn, width: CARDINAL): Structure;
+
+    (* Creates a new structure consisting of a single field.  Before	*)
+    (* calling this procedure, the caller should make sure, by calling	*)
+    (* FieldEditor.DefineFieldType if necessary, that ftype is a type	*)
+    (* already known to module FieldEditor.				*)
+
+    VAR result: Structure;
+
+    BEGIN
+	NEW (result);
+	WITH result^ DO
+	    pointer := NewRow (VariableAddress, ftype, screencolumn, width);
+	    row := screenrow;
+	    up := NIL;  down := NIL;
+	END (*WITH*);
+	RETURN result;
+    END CreateField;
+
+(************************************************************************)
+
+PROCEDURE CardinalField (VAR (*IN*) variable: CARDINAL;
+			screenrow, screencolumn, width: CARDINAL): Structure;
+
+    (* Creates a one-field structure for editing the given CARDINAL	*)
+    (* variable.							*)
+
+    BEGIN
+	RETURN CreateField (ADR(variable), Cardinal,
+					screenrow, screencolumn, width);
+    END CardinalField;
+
+(************************************************************************)
+
+PROCEDURE ByteField (VAR (*IN*) variable: BYTE;
+			screenrow, screencolumn, width: CARDINAL): Structure;
+
+    (* Creates a one-field structure for editing a BYTE variable.	*)
+
+    BEGIN
+	RETURN CreateField (ADR(variable), Byte,
+					screenrow, screencolumn, width);
+    END ByteField;
+
+(************************************************************************)
+
+PROCEDURE RealField (VAR (*IN*) variable: REAL;
+			screenrow, screencolumn, width: CARDINAL): Structure;
+
+    (* Creates a one-field structure for editing a REAL variable.	*)
+
+    BEGIN
+	RETURN CreateField (ADR(variable), Real,
+					screenrow, screencolumn, width);
+    END RealField;
+
+(************************************************************************)
+
+PROCEDURE MenuField (VAR (*IN*) variable: CARDINAL;
+		screenrow, screencolumn, lines, width: CARDINAL;
+						M: Menu): Structure;
+
+    (* Creates a one-field structure for editing a cardinal variable	*)
+    (* via menu selection.  The caller must ensure that M has already	*)
+    (* been defined by a call to Menus.					*)
+
+    VAR result: Structure;
+
+    BEGIN
+	SetOptions (M, MO{MNoClose,MKeyBack,MNoMouse,MNoTitle,MNoBorder});
+	OffEdge (M, return, return, return, return);
+	NEW (result);
+	WITH result^ DO
+	    pointer := NewMenu (variable, M, screencolumn, lines, width);
+	    row := screenrow;
+	    up := NIL;  down := NIL;
+	END (*WITH*);
+	RETURN result;
+    END MenuField;
+
+(************************************************************************)
+
+PROCEDURE ListField (VAR (*IN*) variable: List;
+				screenrow, screencolumn: CARDINAL;
+					f: ListFormat): Structure;
+
+    (* Creates a structure for editing a linear list.  The caller must	*)
+    (* ensure that f has been defined by a call to module ListEditor.	*)
+
+    VAR result: Structure;
+
+    BEGIN
+	NEW (result);
+	WITH result^ DO
+	    pointer := NewList (variable, f, screencolumn);
+	    row := screenrow;
+	    up := NIL;  down := NIL;
+	END (*WITH*);
+	RETURN result;
+    END ListField;
+
+(************************************************************************)
+(*			    TEST PROCEDURE				*)
+(************************************************************************)
+
+PROCEDURE DumpStructure (S: Structure);
+
+    (* For debugging: writes a representation of S to the screen.	*)
+
+    VAR w: Window;
+
+    BEGIN
+	OpenSimpleWindow (w, 0, 10, 0, 79);
+	WHILE S <> NIL DO
+	    WriteLn (w);
+	    WriteString (w, "Dumping row ");  WriteCard (w, S^.row);
+	    WriteString (w, " @");  WriteAddress (w, S);
+	    WriteString (w, ", up = ");  WriteAddress (w, S^.up);
+	    WriteString (w, ", down = ");  WriteAddress (w, S^.down);
+	    DumpRow (w, S^.pointer);  S := S^.down;
+	END (*WHILE*);
+	PressAnyKey(w);
+	CloseWindow (w);
+    END DumpStructure;
+
+(************************************************************************)
+(*			  DELETING A STRUCTURE				*)
+(************************************************************************)
+
+PROCEDURE DeleteStructure (VAR (*INOUT*) S: Structure);
+
+    (* Deallocates the storage which was used in setting up structure	*)
+    (* S.  Note that this has nothing to do with the space used by	*)
+    (* variables to which S gives access; we delete only the overhead	*)
+    (* space which was originally allocated by this module.		*)
+
+    VAR temp: Structure;
+
+    BEGIN
+	WHILE S <> NIL DO
+	    DeleteRow (S^.pointer);  temp := S^.down;
+	    DISPOSE(S);  S := temp;
+	END (*WHILE*);
+    END DeleteStructure;
+
+(************************************************************************)
+(*		  CONSTRUCTING COMPLEX STRUCTURE TYPES			*)
+(************************************************************************)
+
+PROCEDURE Combine (VAR (*INOUT*) A: Structure;  B: Structure);
+
+    (* Strips all of the fields from B and adds them to the existing	*)
+    (* fields of A.  Note that B is destroyed in the process.		*)
+
+    VAR previous, current, next, temp: Structure;
+
+    BEGIN
+	previous := NIL;  current := A;
+	WHILE B <> NIL DO
+
+	    (* Find a place to insert the first element on the B list. *)
+
+	    LOOP
+		IF current = NIL THEN EXIT (*LOOP*) END (*IF*);
+		next := current^.down;
+		IF B^.row <= current^.row THEN EXIT (*LOOP*) END (*IF*);
+		previous := current;  current := next;
+	    END (*LOOP*);
+
+	    IF (current<>NIL) AND (B^.row = current^.row) THEN
+
+		(* Special case: two rows must be merged. *)
+
+		CombineRows (current^.pointer, B^.pointer);
+		temp := B;  B := B^.down;  DISPOSE (temp);
+
+	    ELSE
+
+		(* Take the whole of the B list, insert it below	*)
+		(* previous^, then take what remains of the original	*)
+		(* destination list and call it the B list.  Swapping	*)
+		(* lists like this is a little unconventional, but it	*)
+		(* works, and in many cases it speeds up the merge.	*)
+
+		IF previous = NIL THEN
+		    A := B;
+		ELSE
+		    previous^.down := B;
+		END (*IF*);
+		B^.up := previous;  previous := B;  B := current;
+		current := previous^.down;
+	    END (*IF*);
+
+	END (*WHILE*);
+	(* DumpStructure (A); *)
+
+    END Combine;
+
+(************************************************************************)
+
+PROCEDURE CopyOf (S: Structure): Structure;
+
+    (* Makes a duplicate copy of S.  The variables to be edited are not	*)
+    (* duplicated; we simply set up a duplicate set of pointers.	*)
+
+    VAR result, newrow: Structure;
+
+    BEGIN
+	result := NIL;
+	WHILE S <> NIL DO
+	    NEW (newrow);
+	    WITH newrow^ DO
+		pointer := CopyOfRow (S^.pointer);
+		row := S^.row;  up := NIL;  down := NIL;
+	    END (*WITH*);
+	    Combine (result, newrow);
+	    S := S^.down;
+	END (*WHILE*);
+	RETURN result;
+    END CopyOf;
+
+(************************************************************************)
+
+PROCEDURE AdjustAddresses (S: Structure;  addroffset, rowoffset,
+						coloffset: CARDINAL);
+
+    (* Adjusts the pointer, row, and column fields of all elements of S	*)
+    (* by adding the specified offsets to those fields.			*)
+
+    BEGIN
+	WHILE S <> NIL DO
+	    AdjustRow (S^.pointer, addroffset, coloffset);
+	    INC (S^.row, rowoffset);  S := S^.down;
+	END (*WHILE*);
+    END AdjustAddresses;
+
+(************************************************************************)
+
+PROCEDURE MakeArray (VAR (*INOUT*) S: Structure;  count: CARDINAL;
+		addroffset, rowoffset, coloffset: CARDINAL);
+
+    (* Creates a structure for an array of count elements, where on	*)
+    (* entry S is a structure already created for the first array	*)
+    (* element.  Parameter addroffset is the difference between		*)
+    (* adjacent array elements.  The remaining two parameters give the	*)
+    (* offset on the screen between the starting positions of adjacent	*)
+    (* array elements.							*)
+    (* In this version, I simply replicate item the required number of	*)
+    (* times, making appropriate adjustments to the replicated items.	*)
+    (* There is probably a more elegant solution which involves the	*)
+    (* invention of a new "replicating" type, but that will take more	*)
+    (* thought than I have as yet given to the problem.			*)
+
+    VAR current, copy: Structure;  j: CARDINAL;
+
+    BEGIN
+	copy := CopyOf(S);
+	FOR j := 2 TO count DO
+
+	    current := copy;
+	    AdjustAddresses (current, addroffset, rowoffset, coloffset);
+
+	    (* Save a copy for the next time around the loop, then	*)
+	    (* incorporate current into the result.			*)
+
+	    copy := CopyOf (current);
+	    Combine (S, current);
+
+	END (*FOR*);
+	IF testing THEN
+	    DumpStructure (S);
+	END (*IF*);
+	DeleteStructure (copy);
+    END MakeArray;
+
+(************************************************************************)
+(*			   EDITING A STRUCTURE				*)
+(************************************************************************)
+
+PROCEDURE ScreenEdit (w: Window;  S: Structure;  VAR (*OUT*) abort: BOOLEAN);
+
+    (* Displays structure S in window w, and allows the keyboard user	*)
+    (* to edit the components of S.  It is assumed that w is already	*)
+    (* open and that S has already been fully defined.  Returns		*)
+    (* abort=TRUE if user aborted the editing with the Esc key.		*)
+
+    VAR nextchar: CHAR;
+
+    BEGIN
+	abort := FALSE;
+	IF S = NIL THEN
+	    RETURN;
+	END (*IF*);
+	WriteStructure (w, S);  SetCursor (w, S^.row, StartColumn(S^.pointer));
+	LOOP
+	    EditRow (w, S^.pointer, S^.row);
+	    nextchar := InKey();
+	    IF nextchar = CHR(0) THEN
+		nextchar := InKey();
+		IF (nextchar = "H") AND (S^.up <> NIL) THEN
+		    S := S^.up;
+		ELSIF (nextchar = "P") AND (S^.down <> NIL) THEN
+		    S := S^.down;
+		ELSE
+		    PutBack (nextchar);  PutBack (CHR(0));
+		    EXIT (*LOOP*);
+		END (*IF*);
+	    ELSIF nextchar = CHR(13) THEN	(* <return> *)
+		IF S^.down <> NIL THEN
+		    S := S^.down;
+		    SetCursor (w, S^.row, StartColumn(S^.pointer));
+		ELSE
+		    EXIT (*LOOP*);
+		END (*IF*);
+	    ELSIF nextchar = Esc THEN
+		abort := TRUE;
+		EXIT (*LOOP*);
+	    ELSE
+		PutBack (nextchar);
+	    END (*IF*);
+
+	END (*LOOP*);
+
+    END ScreenEdit;
+
+(************************************************************************)
+
+END ScreenEditor.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/screenge.def b/examples/Modula-2_Libraries/PMOS/sources/general/screenge.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/screenge.def
@@ -0,0 +1,42 @@
+DEFINITION MODULE ScreenGeometry;
+
+	(********************************************************)
+	(*							*)
+	(*	    Support module for screen graphics		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	6 October 1993			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+TYPE
+    Point = RECORD
+		x, y: INTEGER;
+	    END (*RECORD*);
+
+    Rectangle =	RECORD
+		    top, bottom, left, right: INTEGER;
+		END (*RECORD*);
+
+(************************************************************************)
+
+PROCEDURE Inside (x, y: INTEGER;  R: Rectangle): BOOLEAN;
+
+    (* Returns TRUE iff point (x,y) is in (or on the border of) R.	*)
+
+PROCEDURE Adjacent (R1, R2: Rectangle;
+				VAR (*OUT*) union: Rectangle): BOOLEAN;
+
+    (* If the union of R1 and R2 is itself a rectangle, returns TRUE	*)
+    (* and sets "union" to be the combined rectangle.  Otherwise	*)
+    (* returns FALSE, and the "union" result is meaningless.		*)
+
+PROCEDURE TrimLine (VAR (*INOUT*) end1, end2: Point;  R: Rectangle): BOOLEAN;
+
+    (* Modifies end1 and end2, if necessary, to cut off the ends of	*)
+    (* the line from end1 to end2 which do not fit in R.		*)
+    (* Returns FALSE if none of the line passes through the rectangle.	*)
+
+END ScreenGeometry.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/screenge.mod b/examples/Modula-2_Libraries/PMOS/sources/general/screenge.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/screenge.mod
@@ -0,0 +1,193 @@
+IMPLEMENTATION MODULE ScreenGeometry;
+
+	(********************************************************)
+	(*							*)
+	(*	    Support module for screen graphics		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	10 October 1993			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	Might be worth looking for a better algorithm	*)
+	(*	for SolveForX and SolveForY - see module	*)
+	(*	RawGraphics, where I think I've done it better.	*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+
+PROCEDURE Inside (x, y: INTEGER;  R: Rectangle): BOOLEAN;
+
+    (* Returns TRUE iff point (x,y) is in (or on the border of) R.	*)
+
+    BEGIN
+	WITH R DO
+	    RETURN (x >= left) AND (x <= right)
+				AND (y >= bottom) AND (y <= top);
+	END (*WITH*);
+    END Inside;
+
+(************************************************************************)
+
+PROCEDURE Adjacent (R1, R2: Rectangle;
+				VAR (*OUT*) union: Rectangle): BOOLEAN;
+
+    (* If the union of R1 and R2 is itself a rectangle, returns TRUE	*)
+    (* and sets "union" to be the combined rectangle.  Otherwise	*)
+    (* returns FALSE, and the "union" result is meaningless.		*)
+
+    BEGIN
+	union := R1;
+	IF R1.top = R2.top THEN
+	    (* Possible left/right adjacency *)
+	    IF R1.bottom = R2.bottom THEN
+		IF R2.left = R1.right + 1 THEN
+		    union.right := R2.right;
+		    RETURN TRUE;
+		ELSIF R1.left = R2.right + 1 THEN
+		    union.left := R2.left;
+		    RETURN TRUE;
+		ELSE
+		    RETURN FALSE;
+		END (*IF*);
+	    ELSE
+		RETURN FALSE;
+	    END (*IF*);
+	ELSIF R1.left = R2.left THEN
+	    (* Possible above/below adjacency *)
+	    IF R1.right = R2.right THEN
+		IF R2.bottom = R1.top + 1 THEN
+		    union.top := R2.top;
+		    RETURN TRUE;
+		ELSIF R1.bottom = R2.top + 1 THEN
+		    union.bottom := R2.bottom;
+		    RETURN TRUE;
+		ELSE
+		    RETURN FALSE;
+		END (*IF*);
+	    ELSE
+		RETURN FALSE;
+	    END (*IF*);
+	ELSE
+	    RETURN FALSE;
+	END (*IF*);
+    END Adjacent;
+
+(************************************************************************)
+
+PROCEDURE SolveForX (end1, end2: Point;  y: INTEGER): INTEGER;
+
+    (* Returns the x value for which the line with endpoints end1 and	*)
+    (* end2 passes through the point (x,y).				*)
+
+    VAR x1, x2, y1, y2, temp: LONGINT;
+
+    BEGIN
+	x1 := LONGINT(end1.x);  y1 := LONGINT(end1.y);
+	x2 := LONGINT(end2.x);  y2 := LONGINT(end2.y);
+	IF y1 > y2 THEN
+	    temp := x1;  x1 := x2;  x2 := temp;
+	    temp := y1;  y1 := y2;  y2 := temp;
+	END (*IF*);
+	RETURN INTEGER ((LONGINT(y)*(x2-x1)
+			 - x2*y1 + x1*y2 + (y2-y1) DIV 2 + 1)
+						DIV (y2-y1));
+    END SolveForX;
+
+(************************************************************************)
+
+PROCEDURE SolveForY (end1, end2: Point;  x: INTEGER): INTEGER;
+
+    (* Returns the y value for which the line with endpoints end1 and	*)
+    (* end2 passes through the point (x,y).				*)
+
+    VAR x1, x2, y1, y2, temp: LONGINT;
+
+    BEGIN
+	x1 := LONGINT(end1.x);  y1 := LONGINT(end1.y);
+	x2 := LONGINT(end2.x);  y2 := LONGINT(end2.y);
+	IF x1 > x2 THEN
+	    temp := x1;  x1 := x2;  x2 := temp;
+	    temp := y1;  y1 := y2;  y2 := temp;
+	END (*IF*);
+	RETURN INTEGER ((LONGINT(x)*(y2-y1) - y2*x1
+				 + y1*x2 + (x2-x1) DIV 2 + 1)
+							DIV (x2-x1));
+    END SolveForY;
+
+(************************************************************************)
+
+PROCEDURE TrimLine (VAR (*INOUT*) end1, end2: Point;  R: Rectangle): BOOLEAN;
+
+    (* Modifies end1 and end2, if necessary, to cut off the ends of	*)
+    (* the line from end1 to end2 which do not fit in R.		*)
+    (* Returns FALSE if none of the line passes through the rectangle.	*)
+
+    VAR temp: Point;  result: INTEGER;
+
+    BEGIN
+
+	(* Check the bottom and top of the rectangle.	*)
+
+	IF end1.y > end2.y THEN
+	    temp := end1;  end1 := end2;  end2 := temp;
+	END (*IF*);
+
+	(* Exclude some special cases, to avoid overflow problems.	*)
+
+	IF (end2.y < R.bottom) OR (end1.y > R.top) THEN
+	    RETURN FALSE;
+	END (*IF*);
+
+	IF end1.y < R.bottom THEN
+	    result := SolveForX (end1, end2, R.bottom);
+	    IF (result < R.left) OR (result > R.right) THEN
+		RETURN FALSE;
+	    END (*IF*);
+	    end1.x := result;
+	    end1.y := R.bottom;
+	END (*IF*);
+	IF end2.y > R.top THEN
+	    result := SolveForX (end1, end2, R.top);
+	    IF (result < R.left) OR (result > R.right) THEN
+		RETURN FALSE;
+	    END (*IF*);
+	    end2.x := result;
+	    end2.y := R.top;
+	END (*IF*);
+
+	(* Check the left and right of the rectangle.	*)
+
+	IF end1.x > end2.x THEN
+	    temp := end1;  end1 := end2;  end2 := temp;
+	END (*IF*);
+
+	(* Exclude some special cases, to avoid overflow problems.	*)
+
+	IF (end2.x < R.left) OR (end1.x > R.right) THEN
+	    RETURN FALSE;
+	END (*IF*);
+
+	IF end1.x < R.left THEN
+	    result := SolveForY (end1, end2, R.left);
+	    IF (result < R.bottom) OR (result > R.top) THEN
+		RETURN FALSE;
+	    END (*IF*);
+	    end1.y := result;
+	    end1.x := R.left;
+	END (*IF*);
+	IF end2.x > R.right THEN
+	    result := SolveForY (end1, end2, R.right);
+	    IF (result < R.bottom) OR (result > R.top) THEN
+		RETURN FALSE;
+	    END (*IF*);
+	    end2.y := result;
+	    end2.x := R.right;
+	END (*IF*);
+
+	RETURN TRUE;
+
+    END TrimLine;
+
+END ScreenGeometry.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/semaphor.def b/examples/Modula-2_Libraries/PMOS/sources/general/semaphor.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/semaphor.def
@@ -0,0 +1,51 @@
+DEFINITION MODULE Semaphores;
+
+	(********************************************************)
+	(*							*)
+	(*	Defines the semaphore data type, and the two	*)
+	(*	basic operations on a semaphore.		*)
+	(*							*)
+	(*	Programmer:	P. Moylan			*)
+	(*	Last edited:	16 August 1993			*)
+	(*	Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+TYPE Semaphore;		(* is private *)
+
+PROCEDURE CreateSemaphore (VAR (*OUT*) s: Semaphore; InitialValue: CARDINAL);
+
+    (* Creates semaphore s, with the given initial value and an empty	*)
+    (* queue.								*)
+
+PROCEDURE DestroySemaphore (VAR (*INOUT*) s: Semaphore);
+
+    (* Reclaims any space used by semaphore s.  Remark:  It is not at	*)
+    (* all obvious what should be done with any tasks which happen to	*)
+    (* be blocked on this semaphore (should they be unblocked, or	*)
+    (* killed?).  At present we take the easy way out and assume that	*)
+    (* there are no pending operations on s at the time that it is	*)
+    (* destroyed.							*)
+
+PROCEDURE Wait (VAR (*INOUT*) s: Semaphore);
+
+    (* Decrements the semaphore value.  If the value goes negative,	*)
+    (* the calling task is blocked and there is a task switch.		*)
+
+PROCEDURE TimedWaitT (VAR (*INOUT*) s: Semaphore;
+			TimeLimit: INTEGER;  VAR (*OUT*) TimedOut: BOOLEAN);
+
+    (* Like procedure Wait, except that it returns with TimedOut TRUE	*)
+    (* if the corresponding Signal does not occur within TimeLimit	*)
+    (* clock ticks.  Note that this procedure is not recommended for	*)
+    (* general use, because "clock ticks" is not a convenient unit of	*)
+    (* time for most callers.  For a more useful version, see procedure	*)
+    (* TimedWait in module Timer.					*)
+
+PROCEDURE Signal (VAR (*INOUT*) s: Semaphore);
+
+    (* Increments the semaphore value.  Unblocks one waiting task,	*)
+    (* if there was one.						*)
+
+END Semaphores.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/semaphor.mod b/examples/Modula-2_Libraries/PMOS/sources/general/semaphor.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/semaphor.mod
@@ -0,0 +1,152 @@
+IMPLEMENTATION MODULE Semaphores;
+
+	(********************************************************)
+	(*							*)
+	(*	Implements the Wait and Signal operations on	*)
+	(*	semaphores.					*)
+	(*							*)
+	(*	Programmer:	P. Moylan			*)
+	(*	Last edited:	27 February 1995		*)
+	(*	Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM TaskControl IMPORT
+    (* type *)	TaskQueue,
+    (* proc *)	CreateQueue, MarkAsReady, QueueAndSwitchTasks,
+		QueueWithTimeout;
+
+FROM InnerKernel IMPORT
+    (* proc *)	EnterKernel, LeaveKernel;
+
+FROM Storage IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM TerminationControl IMPORT
+    (* proc *)	Crash;
+
+(************************************************************************)
+
+TYPE Semaphore = POINTER TO RECORD
+				value	:	INTEGER;
+				blockedlist :	TaskQueue
+			    END;
+
+(************************************************************************)
+
+PROCEDURE CreateSemaphore (VAR (*OUT*) s: Semaphore;
+					InitialValue: CARDINAL);
+
+    (* Creates semaphore s, with the given initial value and an empty	*)
+    (* queue.								*)
+
+    VAR savedPSW: CARDINAL;
+
+    BEGIN
+	savedPSW := EnterKernel();
+	NEW(s);
+	s^.value := InitialValue;
+	CreateQueue (s^.blockedlist);
+	LeaveKernel (savedPSW);
+    END CreateSemaphore;
+
+(************************************************************************)
+
+PROCEDURE DestroySemaphore (VAR (*INOUT*) s: Semaphore);
+
+    (* Reclaims any space used by semaphore s.  Remark:  It is not at	*)
+    (* all obvious what should be done with any tasks which happen to	*)
+    (* be blocked on this semaphore (should they be unblocked, or	*)
+    (* killed?).  At present we take the easy way out and assume that	*)
+    (* there are no pending operations on s at the time that it is	*)
+    (* destroyed.							*)
+
+    VAR savedPSW: CARDINAL;
+
+    BEGIN
+	savedPSW := EnterKernel();
+	DISPOSE (s);
+	LeaveKernel (savedPSW);
+    END DestroySemaphore;
+
+(************************************************************************)
+
+PROCEDURE Wait (VAR (*INOUT*) s: Semaphore);
+
+    (* Decrements the semaphore value.  If the value goes negative, the	*)
+    (* calling task is blocked and there is a task switch.		*)
+
+    VAR savedPSW: CARDINAL;
+
+    BEGIN
+	IF s = NIL THEN Crash ("Wait on nonexistent semaphore"); END(*IF*);
+	savedPSW := EnterKernel();
+	DEC (s^.value);
+	IF s^.value < 0 THEN
+	    QueueAndSwitchTasks (s^.blockedlist)
+	END (*IF*);
+	LeaveKernel (savedPSW);
+    END Wait;
+
+(************************************************************************)
+
+PROCEDURE TimedWaitT (VAR (*INOUT*) s: Semaphore;  TimeLimit: INTEGER;
+			VAR (*OUT*) TimedOut: BOOLEAN);
+
+    (* Like procedure Wait, except that it returns with TimedOut TRUE	*)
+    (* if the corresponding Signal does not occur within TimeLimit	*)
+    (* clock ticks.							*)
+
+    VAR savedPSW: CARDINAL;
+
+    BEGIN
+	IF s = NIL THEN
+	    Crash ("Timed Wait on nonexistent semaphore");
+	END(*IF*);
+	savedPSW := EnterKernel();
+	TimedOut := FALSE;
+	DEC (s^.value);
+	IF s^.value < 0 THEN
+	    IF TimeLimit <= 0 THEN
+		TimedOut := TRUE;
+	    ELSE
+		TimedOut := QueueWithTimeout (s^.blockedlist, TimeLimit);
+	    END (*IF*);
+
+	    IF TimedOut THEN
+		INC (s^.value);
+	    END (*IF*);
+
+	END (*IF s^.value < 0 *);
+	LeaveKernel (savedPSW);
+
+    END TimedWaitT;
+
+(************************************************************************)
+
+PROCEDURE Signal (VAR (*INOUT*) s: Semaphore);
+
+    (* Increments the semaphore value.  Unblocks one task, if there was	*)
+    (* one waiting on this semaphore.					*)
+
+    VAR savedPSW: CARDINAL;
+
+    BEGIN
+	IF s = NIL THEN Crash ("Signal on nonexistent semaphore"); END(*IF*);
+	savedPSW := EnterKernel();
+	INC (s^.value);
+	IF s^.value <= 0 THEN
+
+	    (* If the semaphore initial value is nonnegative, the test	*)
+	    (* (s^.value<=0) is equivalent to the more obvious test	*)
+	    (* for nonempty blocked list.  Negative initial values are	*)
+	    (* not permitted in this implementation.			*)
+
+	    MarkAsReady (s^.blockedlist);
+
+	END (*IF*);
+	LeaveKernel (savedPSW);
+    END Signal;
+
+END Semaphores.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/serialio.def b/examples/Modula-2_Libraries/PMOS/sources/general/serialio.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/serialio.def
@@ -0,0 +1,47 @@
+DEFINITION MODULE SerialIO;
+
+	(********************************************************)
+	(*							*)
+	(*	     Serial I/O through the COM ports		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	10 March 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+TYPE
+    SerialChannelNumber = [1..4];
+    WordLength = SHORTCARD [5..8];
+    Parity = (NoParity, OddParity, EvenParity, Always0, Always1);
+    StopBits = SHORTCARD [1..2];
+
+(************************************************************************)
+
+PROCEDURE InitSerialChannel (chan: SerialChannelNumber;  baud: CARDINAL;
+				wordlength: WordLength;
+				parity: Parity; stopbits: StopBits);
+
+    (* Performs initialisation on channel "chan".			*)
+
+PROCEDURE ModemControl (chan: SerialChannelNumber;  code: BYTE);
+
+    (* Sends the specified code to the Modem Control Register.  The	*)
+    (* code bits are: bit0=DTR, bit1=RTS, bit2=Out1, bit3=Out2,		*)
+    (* bit4=Loopback.  (The other 3 bits should be zero.)		*)
+    (* You don't normally need to call this procedure.			*)
+
+PROCEDURE MouseReset (chan: SerialChannelNumber);
+
+    (* Special break sequence needed for resetting a serial mouse.	*)
+
+PROCEDURE ReadSerial (chan: SerialChannelNumber;  VAR (*OUT*) value: BYTE);
+
+    (* Reads one byte from a serial channel.	*)
+
+PROCEDURE WriteSerial (chan: SerialChannelNumber;  value: BYTE);
+
+    (* Sends one byte to an output channel.	*)
+
+END SerialIO.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/serialio.mod b/examples/Modula-2_Libraries/PMOS/sources/general/serialio.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/serialio.mod
@@ -0,0 +1,534 @@
+IMPLEMENTATION MODULE SerialIO;
+
+	(********************************************************)
+	(*							*)
+	(*	     Serial I/O through the COM ports		*)
+	(*							*)
+	(*	This module supports the NS16450 or INS8250	*)
+	(*	serial interfaces on COM1 and COM2.  Support	*)
+	(*	for COM3 and COM4 has not yet been implemented.	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	16 March 1995			*)
+	(*  Status:		Working, needs more testing.	*)
+	(*	Faults:						*)
+	(*	 1. Can't get loopback mode to work, although	*)
+	(*	    it did work in the non-interrupt version.	*)
+	(*	 2. High-speed input seems to crash system.	*)
+	(*	 3. Spurious input on channel 1 - this goes	*)
+	(*	    away when I unplug my modem, so might not	*)
+	(*	    be a problem with this module.		*)
+	(*	Other shortcomings:				*)
+	(*	 1. Receive overrun simply ignored.		*)
+	(*	 2. No ^S/^Q controls.				*)
+	(*	 3. No support for advanced features.		*)
+	(*							*)
+	(********************************************************)
+
+FROM LowLevel IMPORT
+    (* proc *)	InByte, OutByte, LowByte, HighByte, IANDB, IORB, Div;
+
+FROM MiscPMOS IMPORT
+    (* proc *)	EnterCriticalSection, LeaveCriticalSection;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure;
+
+FROM TaskControl IMPORT
+    (* proc *)	CreateInterruptTask, WaitForInterrupt, KillInterruptTask;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM GlassTTY IMPORT	(* for testing *)
+    (* proc *)	WriteChar, WriteHexByte;
+
+(************************************************************************)
+
+TYPE PortNumbers = ARRAY SerialChannelNumber OF CARDINAL;
+     PortMasks = ARRAY SerialChannelNumber OF BYTE;
+     ParityCode = ARRAY Parity OF SHORTCARD;
+
+CONST
+    (* Starting port numbers for the four UARTs.	*)
+    (* Still have to look up the details for COM3,COM4.	*)
+
+    BasePort = PortNumbers (3F8H, 2F8H, 0, 0);
+
+    (* Interrupt numbers for the four UARTs.		*)
+    (* Still have to look up the details for COM3,COM4.	*)
+
+    IntNum = PortNumbers (12, 11, 0, 0);
+    IntNumMask = PortMasks (0EFH, 0F7H, 0FFH, 0FFH);
+
+    (* Port numbers within a UART, expressed as offsets from BasePort.	*)
+
+    TXD = 0;		(* transmitter data register	*)
+    RXD = 0;		(* receiver data register	*)
+    IER = 1;		(* interrupt enable register	*)
+    IIR = 2;		(* interrupt identification reg	*)
+    LCR = 3;		(* line control register	*)
+    MCR = 4;		(* modem control register	*)
+    LSR = 5;		(* line status register		*)
+    MSR = 6;		(* modem status register	*)
+
+    (* Mapping of parity codes into LCR bit patterns.	*)
+
+    ParitySpec = ParityCode (00H, 08H, 18H, 28H, 38H);
+
+(************************************************************************)
+
+CONST MaxBufferSubscript = 31;
+
+TYPE
+    BufferSubscript = [0..MaxBufferSubscript];
+
+    (* A CircBuffer is a circular buffer.  The DataCounter semaphore is	*)
+    (* a counting semaphore which keeps track of how many bytes are at	*)
+    (* present in the buffer (for an input buffer) or how many spare	*)
+    (* slots are still available (for an output buffer).  GetPlace	*)
+    (* points to the next byte which will be retrieved by the consumer.	*)
+    (* PutPlace is the place where the next datum will be added.	*)
+    (* The condition GetPlace=PutPlace could mean either that the	*)
+    (* buffer is completely empty or that it is completely full.  The	*)
+    (* flag BufferFlag is used to distinguish between these two cases.	*)
+    (* The condition BufferFlag=TRUE means buffer full for an input	*)
+    (* buffer, or buffer empty for an output buffer.			*)
+
+    CircBuffer =    RECORD
+			BufferFlag: BOOLEAN;
+			DataCounter: Semaphore;
+			GetPlace, PutPlace: BufferSubscript;
+			data: ARRAY BufferSubscript OF BYTE
+		    END;
+
+VAR
+    (* Receiver and transmitter circular buffers. *)
+
+    RXBuffer, TXBuffer: ARRAY SerialChannelNumber OF CircBuffer;
+
+    (* Saved state of the UARTS at startup, so we can restore them later. *)
+
+    SavedRegisters: ARRAY SerialChannelNumber OF ARRAY[1..8] OF BYTE;
+
+(************************************************************************)
+(*	    THE INTERRUPT TASKS AND THEIR SUBSIDIARY PROCEDURES		*)
+(************************************************************************)
+
+PROCEDURE PutRXBuffer (chan: SerialChannelNumber;  datum: BYTE);
+
+    (* Puts the new datum into the circular buffer used for input from	*)
+    (* the given channel.						*)
+
+    BEGIN
+	WITH RXBuffer[chan] DO
+	    IF BufferFlag THEN
+		(*Beep*);		(* no room in buffer *)
+	    ELSE
+		data[PutPlace] := datum;
+		IF PutPlace = MaxBufferSubscript THEN PutPlace := 0
+		ELSE INC (PutPlace);
+		END (*IF*);
+		BufferFlag := PutPlace = GetPlace;
+		Signal (DataCounter);
+	    END (*IF*);
+	END (*WITH*);
+    END PutRXBuffer;
+
+(************************************************************************)
+
+PROCEDURE SendFromTXBuffer (chan: SerialChannelNumber);
+
+    (* Sends a new value from the transmitter circular buffer to the	*)
+    (* outside world.  Disables "transmitter ready" interrupts if this	*)
+    (* empties the circular buffer.					*)
+
+    VAR UART: CARDINAL;
+
+    BEGIN
+	UART := BasePort[chan];
+	WITH TXBuffer[chan] DO
+	    OutByte (UART+TXD, data[GetPlace]);
+	    IF GetPlace = MaxBufferSubscript THEN GetPlace := 0
+	    ELSE INC (GetPlace);
+	    END (*IF*);
+	    BufferFlag := PutPlace = GetPlace;
+	    IF BufferFlag THEN
+		(* Buffer is empty - disable further output. *)
+		OutByte (UART+IER, IANDB (InByte(UART+IER), 0DH));
+	    END (*IF*);
+	    Signal (DataCounter);
+	END (*WITH*);
+    END SendFromTXBuffer;
+
+(************************************************************************)
+
+PROCEDURE HandleInterrupt (chan: SerialChannelNumber);
+
+    (* This procedure deals with an interrupt from any serial port.	*)
+    (* The input parameter identifies the starting port number of the	*)
+    (* hardware interface.						*)
+    (* Note: because there are multiple sources of interrupts attached	*)
+    (* to the same interrupt request, this procedure keeps looping	*)
+    (* until all causes of the interrupt have been dealt with.		*)
+
+    VAR condition, dummy: SHORTCARD;
+	UART: CARDINAL;
+
+    BEGIN
+	UART := BasePort[chan];
+	LOOP
+	    (* Read the interrupt identification register.	*)
+
+	    condition := InByte (UART+IIR);
+
+	    (* Bit 0 set means no conditions are pending.	*)
+
+	    IF ODD(condition) THEN
+		EXIT(*LOOP*)
+	    END(*IF*);
+
+	    IF condition = 6 THEN
+
+		(* Code 6 is receiver line status error.  In this	*)
+		(* version we do nothing except clear the condition by	*)
+		(* reading the Line Status Register.			*)
+
+		dummy := InByte (UART+LSR);
+
+	    ELSIF condition = 4 THEN
+
+		(* Code 4 means received data available.	*)
+
+		PutRXBuffer (chan, InByte (UART+RXD));
+
+	    ELSIF condition = 2 THEN
+
+		(* Code 2 means transmitter ready.	*)
+
+		SendFromTXBuffer (chan);
+
+	    ELSIF condition = 0 THEN
+
+		(* Code 0 is for modem status interrupt.  In this	*)
+		(* version we do nothing except clear the condition	*)
+		(* by reading the Modem Status Register.		*)
+
+		dummy := InByte (UART+MSR);
+
+	    END (*IF*);
+
+	END (*LOOP*);
+
+    END HandleInterrupt;
+
+(************************************************************************)
+
+PROCEDURE COM1InterruptTask;
+
+    BEGIN
+	LOOP
+	    WaitForInterrupt;
+	    HandleInterrupt (1);
+	END (*LOOP*);
+    END COM1InterruptTask;
+
+(************************************************************************)
+
+PROCEDURE COM2InterruptTask;
+
+    BEGIN
+	LOOP
+	    WaitForInterrupt;
+	    HandleInterrupt (2);
+	END (*LOOP*);
+    END COM2InterruptTask;
+
+(************************************************************************)
+(*			CHANNEL INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE ModemControl (chan: SerialChannelNumber;  code: BYTE);
+
+    (* Sends the specified code to the Modem Control Register.  The	*)
+    (* code bits are: bit0=DTR, bit1=RTS, bit2=Out1, bit3=Out2,		*)
+    (* bit4=Loopback.  (The other 3 bits should be zero.)		*)
+    (* You don't normally need to call this procedure.			*)
+
+    BEGIN
+	OutByte (BasePort[chan]+MCR, code);
+    END ModemControl;
+
+(************************************************************************)
+
+PROCEDURE MouseReset (chan: SerialChannelNumber);
+
+    (* Special break sequence needed for resetting a serial mouse.	*)
+    (* (But it doesn't seem to do what I want anyway.  Logitech mouse	*)
+    (* still fails to act like a Microsoft mouse.)			*)
+
+    VAR LCRcode: BYTE;  i, j: CARDINAL;
+
+    BEGIN
+	LCRcode := InByte(BasePort[chan]+LCR);
+	OutByte (BasePort[chan]+LCR, IORB(LCRcode, 40H));
+	OutByte (BasePort[chan]+MCR, 8);
+	FOR i := 0 TO 1000 DO
+	    FOR j := 0 TO 1000 DO
+	    END (*FOR*);
+	END (*FOR*);
+	OutByte (BasePort[chan]+LCR, LCRcode);
+	OutByte (BasePort[chan]+MCR, 0BH);
+    END MouseReset;
+
+(************************************************************************)
+
+PROCEDURE InitSerialChannel (chan: SerialChannelNumber;  baud: CARDINAL;
+				wordlength: WordLength;
+				parity: Parity; stopbits: StopBits);
+
+    (* Performs initialisation on channel "chan".			*)
+
+    CONST IntMaskRegister = 21H;
+
+    VAR UART: CARDINAL;
+	divisor: CARDINAL;
+	dummy: CHAR;
+
+    BEGIN
+	UART := BasePort[chan];
+
+	(* Clear the line control register.	*)
+
+	OutByte (UART+LCR, 0);
+
+	(* Set the divisor latch access bit.	*)
+
+	OutByte (UART+LCR, 80H);
+
+	(* Set the desired baud rate.  Assuming a 1.8432 MHz crystal,	*)
+	(* and an internal division by 16, we need divisor=115200/baud.	*)
+
+	divisor := Div (115200+LONGCARD(baud DIV 2), baud);
+	OutByte (UART, LowByte (divisor));
+	OutByte (UART+1, HighByte (divisor));
+
+	(* Set desired code for stop bits, data bits, and parity.	*)
+
+	OutByte (UART+LCR, ParitySpec[parity] + 4*(stopbits-1) + wordlength-5);
+
+	(* Set up modem control bits.  In this version we are setting	*)
+	(* DTR (bit 0), RTS (bit 1), Out2 (bit 3) and sometimes		*)
+	(* loopback (bit 4).  I don't know why I should set Out2, but	*)
+	(* I couldn't get the software to work without it.  I haven't	*)
+	(* yet managed to get the loopback option to work.		*)
+
+	OutByte (UART+MCR, 0BH);
+
+	(* Clear out spurious characters and error conditions.  We can	*)
+	(* clear line and modem status errors by reading the Line	*)
+	(* Status Register and the Modem Status Register, respectively.	*)
+
+	dummy := InByte (UART+RXD);
+	dummy := InByte (UART+LSR);
+	dummy := InByte (UART+MSR);
+
+	(* Enable interrupts for receiver, receiver line status, and	*)
+	(* modem status.  We don't yet enable transmitter inputs, since	*)
+	(* we have nothing to transmit so far.				*)
+
+	OutByte (UART+IER, 0DH);
+	OutByte (IntMaskRegister,
+			IANDB (InByte(IntMaskRegister), IntNumMask[chan]));
+
+    END InitSerialChannel;
+
+(************************************************************************)
+(*				INPUT					*)
+(************************************************************************)
+
+PROCEDURE ReadSerial (chan: SerialChannelNumber;  VAR (*OUT*) value: BYTE);
+
+    (* Reads one byte from a serial channel.	*)
+
+    VAR savedPSW: CARDINAL;
+
+    BEGIN
+	WITH RXBuffer[chan] DO
+	    Wait (DataCounter);
+	    value := data[GetPlace];
+	    savedPSW := EnterCriticalSection();	(* while updating BufferFlag *)
+	    IF GetPlace = MaxBufferSubscript THEN GetPlace := 0
+	    ELSE INC (GetPlace);
+	    END (*IF*);
+	    BufferFlag := FALSE;
+	    LeaveCriticalSection (savedPSW);
+	END (*WITH*);
+    END ReadSerial;
+
+(************************************************************************)
+(*				OUTPUT					*)
+(************************************************************************)
+
+PROCEDURE WriteSerial (chan: SerialChannelNumber;  value: BYTE);
+
+    (* Sends one byte to an output channel.	*)
+
+    VAR savedPSW, port: CARDINAL;
+
+    BEGIN
+	WITH TXBuffer[chan] DO
+	    Wait (DataCounter);
+	    data[PutPlace] := value;
+	    savedPSW := EnterCriticalSection();	(* while updating BufferFlag *)
+	    IF PutPlace = MaxBufferSubscript THEN PutPlace := 0
+	    ELSE INC (PutPlace);
+	    END (*IF*);
+	    BufferFlag := FALSE;
+
+	    (* Enable transmitter interrupts, in case they were disabled. *)
+
+	    port := BasePort[chan] + IER;
+	    OutByte (port, IORB(InByte(port), 2));
+
+	    LeaveCriticalSection (savedPSW);
+	END (*WITH*);
+
+    END WriteSerial;
+
+(************************************************************************)
+(*			   MODULE INITIALISATION			*)
+(************************************************************************)
+
+PROCEDURE InitialiseBuffers;
+
+    (* Sets up our global variables, but does not yet set up the	*)
+    (* interrupt tasks or enable interrupts.				*)
+
+    VAR chan: SerialChannelNumber;
+
+    BEGIN
+	FOR chan := MIN(SerialChannelNumber) TO MAX(SerialChannelNumber) DO
+	    WITH RXBuffer[chan] DO
+		BufferFlag := FALSE;
+		CreateSemaphore (DataCounter, 0);
+		GetPlace := MIN(BufferSubscript);
+		PutPlace := MIN(BufferSubscript);
+	    END (*WITH*);
+	    WITH TXBuffer[chan] DO
+		BufferFlag := TRUE;
+		CreateSemaphore (DataCounter, MaxBufferSubscript+1);
+		GetPlace := MIN(BufferSubscript);
+		PutPlace := MIN(BufferSubscript);
+	    END (*WITH*);
+	END (*FOR*);
+    END InitialiseBuffers;
+
+(************************************************************************)
+
+PROCEDURE Test;
+
+    (* Not normally used.  It's here for when I need to dump the	*)
+    (* UART registers.							*)
+
+    VAR j: [0..7];  save: BYTE;  UART: CARDINAL;
+
+    BEGIN
+	UART := BasePort[1];
+	save := InByte (UART+LCR);
+	WriteHexByte (save);  WriteChar (" ");
+	OutByte (UART+LCR, IORB(80H, save));
+	WriteHexByte (InByte (UART));  WriteChar (" ");
+	WriteHexByte (InByte (UART+1));  WriteChar (" ");
+	OutByte (UART+LCR, IANDB(7FH, save));
+	FOR j := 1 TO 7 DO
+	    WriteHexByte (InByte (UART+j));  WriteChar (" ");
+	END (*FOR*);
+    END Test;
+
+(************************************************************************)
+
+PROCEDURE SaveUARTSettings;
+
+    (* Saves the current state of the UARTS in the system.  Used only	*)
+    (* during module initialisation.					*)
+
+    VAR channel: SerialChannelNumber;
+	j: [0..6];  save: BYTE;  UART: CARDINAL;
+
+    BEGIN
+	FOR channel := 1 TO 2 DO
+	    UART := BasePort[channel];
+	    save := InByte (UART+LCR);
+
+	    (* Save the main control registers. *)
+
+	    OutByte (UART+LCR, IANDB(7FH, save));
+	    FOR j := 1 TO 6 DO
+		SavedRegisters[channel][j] := InByte (UART+j);
+	    END (*FOR*);
+
+	    (* Save the baud rate divisor. *)
+
+	    OutByte (UART+LCR, IORB(80H, save));
+	    FOR j := 0 TO 1 DO
+		SavedRegisters[channel][j+7] := InByte (UART+j);
+	    END (*FOR*);
+
+	    (* Put back the original contents of the LCR. *)
+
+	    OutByte (UART+LCR, save);
+	    SavedRegisters[channel][LCR] := save;
+
+	END (*FOR*);
+
+    END SaveUARTSettings;
+
+(************************************************************************)
+
+PROCEDURE RestoreUARTSettings;
+
+    (* Removes the interrupt tasks, and loads the UARTS with the values	*)
+    (* saved during module initialisation.				*)
+
+    VAR channel: SerialChannelNumber;
+	j: [0..6];  save: BYTE;  UART: CARDINAL;
+
+    BEGIN
+	FOR channel := 1 TO 2 DO
+	    KillInterruptTask (IntNum[channel]);
+	    UART := BasePort[channel];
+	    save := SavedRegisters[channel][LCR];
+
+	    (* Restore the baud rate divisor. *)
+
+	    OutByte (UART+LCR, IORB(80H, save));
+	    FOR j := 0 TO 1 DO
+		OutByte (UART+j, SavedRegisters[channel][j+7]);
+	    END (*FOR*);
+
+	    (* Restore the main control registers. *)
+
+	    OutByte (UART+LCR, IANDB(7FH, save));
+	    FOR j := 1 TO 6 DO
+		OutByte (UART+j, SavedRegisters[channel][j]);
+	    END (*FOR*);
+
+	END (*FOR*);
+
+    END RestoreUARTSettings;
+
+(************************************************************************)
+
+VAR dummy: BYTE;
+
+BEGIN
+    (*Test;*)
+    dummy := InByte (21H);
+    SaveUARTSettings;  InitialiseBuffers;
+    SetTerminationProcedure (RestoreUARTSettings);
+    CreateInterruptTask (IntNum[1], COM1InterruptTask, "COM1 interrupt");
+    CreateInterruptTask (IntNum[2], COM2InterruptTask, "COM2 interrupt");
+END SerialIO.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/serialmo.def b/examples/Modula-2_Libraries/PMOS/sources/general/serialmo.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/serialmo.def
@@ -0,0 +1,82 @@
+DEFINITION MODULE SerialMouse;
+
+	(********************************************************)
+	(*							*)
+	(*		  Serial mouse driver			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	17 August 1994			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(*	This module provides support for a mouse on	*)
+	(*	COM1.  Note that this is not the only mouse	*)
+	(*	driver in PMOS.  Module Mouse chooses which	*)
+	(*	mouse driver to use based on the settings	*)
+	(*	in ConfigurationOptions.DEF.			*)
+	(*							*)
+	(********************************************************)
+
+FROM Mouse0 IMPORT
+    (* type *)	ButtonSet, EventSet, EventHandler;
+
+PROCEDURE InitialiseMouseDriver(): BOOLEAN;
+
+    (* Does all initialisation needed for this module.  We make this a	*)
+    (* procedure rather than an initialisation section because module	*)
+    (* Mouse has to decide which mouse driver to use.  The function	*)
+    (* result indicates success; if it is FALSE, none of the following	*)
+    (* procedures will work.  Note: this is not an end-user procedure,	*)
+    (* it's intended to be called only by module Mouse.			*)
+
+PROCEDURE Reset (VAR (*OUT*) MousePresent: BOOLEAN;
+			VAR (*OUT*) NumberOfButtons: CARDINAL);
+
+    (* Resets the mouse, returning MousePresent as FALSE if no mouse	*)
+    (* available and as TRUE if it is, and NumberOfButtons as the	*)
+    (* number of buttons for the mouse if installed.			*)
+
+PROCEDURE SetCursorPos (X, Y : CARDINAL);
+
+    (* Sets the mouse cursor position. *)
+
+PROCEDURE GetPosBut (VAR (*OUT*) buttons: ButtonSet;
+				VAR (*OUT*) Xposition, Yposition: CARDINAL);
+
+    (* Returns the current mouse position and the state of the buttons.	*)
+    (* Note: the units here are not the same as for procedure		*)
+    (* GetTextMousePosition.  In both this procedure and in the event	*)
+    (* handlers the position is presented in units of 1/8th of a	*)
+    (* character width or height.					*)
+
+PROCEDURE SetPage (page: CARDINAL);
+
+    (* Sets the hardware screen page where the mouse is visible. *)
+
+PROCEDURE SetHorizontalLimits (MinX, MaxX : CARDINAL);
+PROCEDURE SetVerticalLimits (MinY, MaxY : CARDINAL);
+
+    (* Sets the cursor limits. *)
+
+PROCEDURE ShowCursor;
+
+    (* Makes the mouse cursor visible on the screen.  Note: we allow	*)
+    (* nesting in ShowCursor/HideCursor calls, so that for example if	*)
+    (* you've called HideCursor twice then you need to call ShowCursor	*)
+    (* twice to make the cursor reappear.				*)
+
+PROCEDURE HideCursor;
+
+    (* Makes the mouse cursor invisible. *)
+
+PROCEDURE SetEventHandler (DetectedEvents: EventSet;
+					Handler: EventHandler);
+
+    (* Nominates the procedure to be called whenever an event in the	*)
+    (* set DetectedEvents occurs.  Note: the Handler is like an		*)
+    (* interrupt procedure, in that it is executing in the context of	*)
+    (* an unknown task; typically it should probably restrict its	*)
+    (* actions to fairly elementary things, like a Signal to wake up	*)
+    (* the task that really wants to know about the event.		*)
+
+END SerialMouse.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/serialmo.mod b/examples/Modula-2_Libraries/PMOS/sources/general/serialmo.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/serialmo.mod
@@ -0,0 +1,749 @@
+IMPLEMENTATION MODULE SerialMouse;
+
+	(********************************************************)
+	(*							*)
+	(*		  Serial mouse driver			*)
+	(*							*)
+	(*	This module provides support for a mouse on	*)
+	(*	COM1 or COM2.  Note that this is not the	*)
+	(*	only mouse driver in PMOS.  The PP preprocessor	*)
+	(*	chooses which driver to use based on the	*)
+	(*	settings in file PP.CFG				*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	16 March 1995			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(*	Note: this file contains preprocessor		*)
+	(*	directives; use PP to update it.		*)
+	(*							*)
+	(********************************************************)
+
+FROM Types IMPORT
+    (* type *)	FarBytePointer;
+
+FROM Mouse0 IMPORT
+    (* type *)	Buttons, Events;
+
+FROM LowLevel IMPORT
+    (* proc *)	IANDB, IORB, RSB, LSB, ROLB, OutByte,
+		MakePointer, FarAddOffset, FarSubtractOffset;
+
+FROM TaskControl IMPORT
+    (* type *)	Lock,
+    (* proc *)	CreateTask, CreateLock, Obtain, Release;
+
+FROM SerialIO IMPORT
+    (* type *)	Parity,
+    (* proc *)	InitSerialChannel, MouseReset, ReadSerial;
+
+FROM TextVideo IMPORT
+    (* proc *)	VideoKind;
+
+(************************************************************************)
+(*			DUMMY EVENT HANDLER				*)
+(************************************************************************)
+
+    (*<TopSpeed3*)
+    (*# save, call(c_conv => off, same_ds => off, near_call => off) *)
+    (*# call(reg_param => (ax,bx,cx,dx,st0,st6,st5,st4,st3)) *)
+    (*>*)
+
+PROCEDURE DummyEventHandler (A: EventSet;  B: ButtonSet;  X, Y : CARDINAL);
+
+    (* Does nothing - this is here purely because the compiler doesn't	*)
+    (* recognise NULLPROC as being type-compatible with an event	*)
+    (* handler compiled when the call pragma c_conv is set.		*)
+
+    BEGIN
+    END DummyEventHandler;
+
+    (*<TopSpeed3*) (*# restore *) (*>*)
+
+(************************************************************************)
+(*			     GLOBAL DATA				*)
+(************************************************************************)
+
+TYPE
+    MouseType = (NoMouse, MS, Logitech, PC);
+
+CONST
+    (*<MouseChannel=COM1*) MouseChannel = 1; (*>*)
+    (*<MouseChannel=COM2 MouseChannel = 2; >*)
+
+    (*<MouseKind=Logitech MouseKind = Logitech; >*)
+    (*<MouseKind=MS MouseKind = MS; >*)
+    (*<MouseKind=PC MouseKind = PC; >*)
+    (*<(MouseKind<>Logitech)&(MouseKind<>MS)&(MouseKind<>PC)*)
+    MouseKind = NoMouse;
+    (*>*)
+
+TYPE
+    Parser = PROCEDURE (VAR ButtonSet, VAR SHORTINT, VAR SHORTINT);
+    SignedByte = RECORD
+		    CASE :BOOLEAN OF
+			FALSE:	b: BYTE;
+		      |	TRUE:	i: SHORTINT;
+		    END (*CASE*);
+		 END (*RECORD*);
+
+CONST
+    pageincr = 4096;
+    rowincr = 160;
+
+VAR
+    (* Segment of the memory-mapped display, and whether it is monochrome. *)
+
+    ScreenSeg: CARDINAL;
+    BlackAndWhite: BOOLEAN;
+
+    (* Flag to indicate that a mouse is present. *)
+
+    MousePresent: BOOLEAN;
+
+    (* Number of buttons on the mouse. *)
+
+    NumberOfButtons: CARDINAL;
+
+    (* The procedure to be called to decode the mouse data.  We give	*)
+    (* this a value during module initialisation.			*)
+
+    ParseMouseInput: Parser;
+
+    (* A decoding array to help in translating mouse data to button	*)
+    (* values.  We set up the values during module initialisation.	*)
+
+    ButtonMap: ARRAY SHORTCARD[0..7] OF ButtonSet;
+
+    (* Flag to say that we expect four bytes (rather than the normal	*)
+    (* three) of mouse data.						*)
+
+    ExpectingFourBytes: BOOLEAN;
+
+    (* The current state of the mouse, updated by the interpreter task.	*)
+
+    MouseState: RECORD
+		    access: Lock;
+		    ButtonsDown: ButtonSet;
+		    X, Y: CARDINAL;
+		END (*RECORD*);
+
+    (* The rectangle defining the boundaries of mouse movement. *)
+
+    Limits: RECORD
+		access: Lock;
+		left, right, top, bottom: CARDINAL;
+	    END (*RECORD*);
+
+    (* Mappings for translating button states to events.  These	*)
+    (* values are filled in during module initialisation.	*)
+
+    Map1, Map2: ARRAY Buttons OF Events;
+
+    (* The caller-specified event handler. *)
+
+    UserHandler: RECORD
+		     access: Lock;
+		     trigger: EventSet;
+		     HandlerProc: EventHandler;
+		 END (*RECORD*);
+
+    (* Details about the screen cursor. *)
+
+    Cursor: RECORD
+		access: Lock;
+		mousepage, row, col: CARDINAL;
+		ScreenPos: FarBytePointer;
+		ValueUnder: BYTE;
+	    END (*RECORD*);
+
+    (* The screen cursor is visible iff Visibility > 0. *)
+
+    Visibility: INTEGER;
+
+    (* A tuning parameter which controls the point at which cursor	*)
+    (* movement is sped up.						*)
+
+    Threshold: INTEGER;
+    	
+(************************************************************************)
+(*		MANIPULATING THE MOUSE CURSOR ON THE SCREEN		*)
+(************************************************************************)
+
+PROCEDURE TurnCursorOff;
+
+    (* Turns the screen cursor off, assuming it was on. *)
+
+    BEGIN
+	WITH Cursor DO
+	    Obtain (access);
+	    IF BYTE(ScreenPos^) = ROLB(ValueUnder,4) THEN
+		ScreenPos^ := ValueUnder;
+	    END (*IF*);
+	    Release (access);
+	END (*WITH*);
+    END TurnCursorOff;
+
+(************************************************************************)
+
+PROCEDURE TurnCursorOn;
+
+    (* Turns the screen cursor on, assuming it was off. *)
+
+    BEGIN
+	WITH Cursor DO
+	    Obtain (access);
+	    ValueUnder := ScreenPos^;
+	    ScreenPos^ := ROLB(ValueUnder,4);
+	    Release (access);
+	END (*WITH*);
+    END TurnCursorOn;
+
+(************************************************************************)
+
+PROCEDURE MoveCursor (r, c: INTEGER);
+
+    (* Moves the cursor to screen row r and column c. *)
+
+    VAR change: INTEGER;
+
+    BEGIN
+	IF Visibility > 0 THEN TurnCursorOff END(*IF*);
+	WITH Cursor DO
+	    Obtain (access);
+	    change := rowincr*(r-INTEGER(row)) + 2*(c-INTEGER(col));
+	    IF change >= 0 THEN
+		ScreenPos := FarAddOffset (ScreenPos, change);
+	    ELSE
+		ScreenPos := FarSubtractOffset (ScreenPos, -change);
+	    END (*IF*);
+	    row := r;  col := c;
+	    Release (access);
+	END (*WITH*);
+	IF Visibility > 0 THEN TurnCursorOn END(*IF*);
+    END MoveCursor;
+
+(************************************************************************)
+(*		INPUT PARSERS FOR SPECIFIC MOUSE TYPES			*)
+(************************************************************************)
+
+PROCEDURE GetCode(): BYTE;
+
+    (* Reads one byte from the mouse port. *)
+
+    VAR value: BYTE;
+
+    BEGIN
+	ReadSerial (MouseChannel, value);
+	RETURN value;
+    END GetCode;
+
+(************************************************************************)
+
+PROCEDURE ParseLogitechInput (VAR (*OUT*) buttons: ButtonSet;
+				VAR (*OUT*) Xmove, Ymove: SHORTINT);
+
+    (* Reads a single "unit" of information from the mouse port, and	*)
+    (* translates this into a button state and two motion values.	*)
+    (* For the Logitech mouse I don't know the exact rules, but they	*)
+    (* are roughly as shown in the following code.			*)
+
+    (* THIS PROCEDURE IS WORKING, BUT IT'S NOT CLEAR WHETHER IT'S DONE.	*)
+    (* I can't work out whether the coding I'm assuming is "true"	*)
+    (* Logitech, or just the MS mode of a Logitech mouse.		*)
+
+    VAR code: BYTE;  v3: SignedByte;
+
+    BEGIN
+	code := GetCode();
+
+	(* It's possible that at this stage we have just picked up the	*)
+	(* fourth byte of a four-byte sequence.				*)
+
+	IF code = BYTE(20H) THEN
+	    WITH MouseState DO
+		Obtain (access);
+		buttons := ButtonsDown + ButtonSet{MiddleButton};
+		Release (access);
+	    END (*WITH*);
+	    ExpectingFourBytes := TRUE;
+	    Xmove := 0;  Ymove := 0;
+	    RETURN;
+	END (*IF*);
+
+	(* The first 7-bit number picked up should have its high-order	*)
+	(* bit set, but we have to allow for resynchronisation after an	*)
+	(* error in the input.						*)
+
+	WHILE ORD(IANDB (code, 040H)) = 0 DO
+	    code := GetCode();
+	END (*WHILE*);
+
+	(* The code just picked up has bit 6 set, and bits 5 and 4 as	*)
+	(* indicators for the left and right buttons.  Bits 3-0 are	*)
+	(* the high-order bits of the motion values.			*)
+
+	buttons := ButtonMap[RSB(IANDB(code,30H),4)];
+
+	(* The next two input codes are 6-bit numbers, to which we must	*)
+	(* prepend some of the bits from the first byte.		*)
+
+	v3.b := IORB(GetCode(), LSB(code,6));
+	Xmove := v3.i;
+	v3.b := IORB(GetCode(), LSB(IANDB(code, 0CH),4));
+	Ymove := v3.i;
+
+	(* The fourth byte, if present, is 20H for middle button down,	*)
+	(* and 00 for a middle button release.				*)
+
+	IF ExpectingFourBytes THEN
+	    IF GetCode() = BYTE(20H) THEN
+		INCL (buttons, MiddleButton);
+	    ELSE
+		ExpectingFourBytes := FALSE;
+	    END (*IF*);
+	END (*IF*);
+
+    END ParseLogitechInput;
+
+(************************************************************************)
+
+PROCEDURE ParseMSInput (VAR (*OUT*) buttons: ButtonSet;
+				VAR (*OUT*) Xmove, Ymove: SHORTINT);
+
+    (* Reads a single "unit" of information from the mouse port, and	*)
+    (* translates this into a button state and two motion values.	*)
+    (* For a Microsoft mouse a "unit" is three 7-bit codes, where the	*)
+    (* first code has its high-order bit set.				*)
+
+    VAR code: BYTE;  v3: SignedByte;
+
+    BEGIN
+
+	(* The first 7-bit number picked up should have its high-order	*)
+	(* bit set, but we have to allow for resynchronisation after an	*)
+	(* error in the input.						*)
+
+	REPEAT
+	    code := GetCode();
+	UNTIL ORD(IANDB (code, 040H)) <> 0;
+
+	(* The code just picked up has bit 6 set, and bits 5 and 4 as	*)
+	(* indicators for the left and right buttons.  (The middle	*)
+	(* button doesn't seem to be detected, so I guess the Microsoft	*)
+	(* encoding doesn't allow for three-button mice.)  Bits 3-0 are	*)
+	(* the high-order bits of the motion values.			*)
+
+	buttons := ButtonMap[RSB(IANDB(code,30H),4)];
+
+	(* The next two input codes are 6-bit numbers, to which we must	*)
+	(* prepend some of the bits from the first byte.		*)
+
+	v3.b := IORB(GetCode(), LSB(code,6));
+	Xmove := v3.i;
+	v3.b := IORB(GetCode(), LSB(IANDB(code, 0CH),4));
+	Ymove := v3.i;
+
+    END ParseMSInput;
+
+(************************************************************************)
+
+PROCEDURE ParsePCInput (VAR (*OUT*) buttons: ButtonSet;
+				VAR (*OUT*) Xmove, Ymove: SHORTINT);
+
+    (* Reads a single "unit" of information from the mouse port, and	*)
+    (* translates this into a button state and two motion values.	*)
+    (* For the PC mouse a "unit" is five bytes long, with the first	*)
+    (* byte having the binary form 10000xxx.				*)
+
+    VAR value: SignedByte;
+
+    BEGIN
+	REPEAT
+	    value.b := GetCode();
+	UNTIL IANDB (value.b, 0F8H) = BYTE(80H);
+
+	buttons := ButtonMap[IANDB(value.b,7)];
+
+	value.b := GetCode();
+	Xmove := value.i;
+	value.b := GetCode();
+	Ymove := -value.i;
+
+	(* In this version we ignore the last two bytes.  (I don't know	*)
+	(* what they indicate.)						*)
+
+	value.b := GetCode();
+	value.b := GetCode();
+
+    END ParsePCInput;
+
+(************************************************************************)
+(*			THE INTERPRETER TASK				*)
+(************************************************************************)
+
+PROCEDURE ButtonEvents (oldbuttons, newbuttons: ButtonSet): EventSet;
+
+    (* Calculates the events corresponding to a change in button state	*)
+    (* from "oldbuttons" to "newbuttons".				*)
+
+    VAR B: Buttons;  result: EventSet;
+
+    BEGIN
+	result := EventSet {};
+	FOR B := LeftButton TO MiddleButton DO
+	    IF B IN newbuttons-oldbuttons THEN
+		INCL (result, Map1[B]);
+	    ELSIF B IN oldbuttons-newbuttons THEN
+		INCL (result, Map2[B]);
+	    END (*IF*);
+	END (*FOR*);
+	RETURN result;
+    END ButtonEvents;
+
+(************************************************************************)
+
+PROCEDURE MouseInterpreter;
+
+    (* Runs as a separate task, picking up signals from the mouse and	*)
+    (* updating the state appropriately.				*)
+
+    VAR buttons, oldbuttons: ButtonSet;  events, enabled: EventSet;
+	Xmove, Ymove, temp: INTEGER;
+	shortXmove, shortYmove: SHORTINT;
+	oldX, newX, oldY, newY: INTEGER;
+	Handler: EventHandler;
+
+    BEGIN
+	LOOP
+	    (* Obtain the next mouse input string. *)
+
+	    ParseMouseInput (buttons, shortXmove, shortYmove);
+	    Xmove := VAL(INTEGER, shortXmove);
+	    Ymove := VAL(INTEGER, shortYmove);
+
+	    (* It's convenient for the user if we amplify the magnitude	*)
+	    (* of fast mouse movements.					*)
+
+	    IF ABS(Xmove) > Threshold THEN
+		Xmove := 3*Xmove;
+	    END (*IF*);
+	    IF ABS(Ymove) > Threshold THEN
+		Ymove := 2*Ymove;
+	    END (*IF*);
+
+	    (* Update the mouse state. *)
+
+	    WITH MouseState DO
+		Obtain (access);
+		oldbuttons := ButtonsDown;
+		ButtonsDown := buttons;
+		oldX := X;  oldY := Y;
+		WITH Limits DO
+		    Obtain (access);
+
+		    temp := oldX + Xmove;
+		    IF temp < VAL(INTEGER,left) THEN newX := left
+		    ELSIF temp > VAL(INTEGER,right) THEN newX := right
+		    ELSE newX := temp
+		    END (*IF*);
+
+		    temp := oldY + Ymove;
+		    IF temp < VAL(INTEGER,top) THEN newY := top
+		    ELSIF temp > VAL(INTEGER,bottom) THEN newY := bottom
+		    ELSE newY := temp
+		    END (*IF*);
+
+		    Release (access);
+		END (*WITH*);
+		X := newX;  Y := newY;
+		Release (access);
+	    END (*WITH*);
+
+	    (* Turn the (oldbuttons,buttons) combination into an	*)
+	    (* "EventSet" value, and move the physical cursor if	*)
+	    (* necessary.						*)
+
+	    events := ButtonEvents (oldbuttons, buttons);
+	    IF (newX DIV 8 <> oldX DIV 8) OR (newY DIV 8 <> oldY DIV 8) THEN
+		INCL (events, Motion);
+		MoveCursor (newY DIV 8, newX DIV 8);
+	    END (*IF*);
+
+	    (* Call the event handler if appropriate. *)
+
+	    WITH UserHandler DO
+		Obtain (access);
+		Handler := HandlerProc;
+		enabled := trigger;
+		Release (access);
+	    END (*WITH*);
+	    IF (enabled*events <> EventSet{})
+				AND (Handler <> DummyEventHandler) THEN
+		Handler (events, buttons, newX, newY);
+	    END (*IF*);
+
+	END (*LOOP*);
+
+    END MouseInterpreter;
+
+(************************************************************************)
+(*		    THE EXTERNALLY CALLABLE PROCEDURES			*)
+(************************************************************************)
+
+PROCEDURE Reset (VAR (*OUT*) MousePresent: BOOLEAN;
+			VAR (*OUT*) NumberOfButtons: CARDINAL);
+
+    (* Initializes mouse, returning MousePresent as FALSE if no mouse	*)
+    (* available and as TRUE if it is, and NumberOfButtons as the	*)
+    (* number of buttons for the mouse if installed.			*)
+
+    BEGIN
+	NumberOfButtons := 3;
+	IF MouseKind = Logitech THEN
+	    InitSerialChannel (MouseChannel, 1200, 7, NoParity, 1);
+	ELSIF MouseKind = MS THEN
+	    InitSerialChannel (MouseChannel, 1200, 7, Always1, 1);
+	    NumberOfButtons := 2;
+
+	    (* The following reset operation should have no effect on a	*)
+	    (* Microsoft mouse, but should force a Logitech mouse to	*)
+	    (* enter Microsoft compatibility mode.			*)
+
+	    (* MouseReset (MouseChannel); *)
+
+	    (* THIS CODE IS NOT WORKING, IT LOOKS AS IF THE INFORMATION	*)
+	    (* I'VE RECEIVED IS WRONG.					*)
+
+	ELSIF MouseKind = PC THEN
+	    InitSerialChannel (MouseChannel, 1200, 8, NoParity, 1);
+	END (*IF*);
+	MousePresent := TRUE;
+	Visibility := 0;
+	SetCursorPos (320, 100);
+    END Reset;
+
+(************************************************************************)
+
+PROCEDURE SetCursorPos (X, Y : CARDINAL);
+
+    (* Initialises the mouse position. *)
+
+    BEGIN
+	Obtain (MouseState.access);
+	MouseState.X := X;  MouseState.Y := Y;
+	Release (MouseState.access);
+	IF Visibility > 0 THEN TurnCursorOff END(*IF*);
+	WITH Cursor DO
+	    Obtain (access);
+	    row := Y DIV 8;  col := X DIV 8;
+	    ScreenPos := MakePointer (ScreenSeg,
+				pageincr*mousepage + rowincr*row + 2*col + 1);
+	    Release (access);
+	END (*WITH*);
+	IF Visibility > 0 THEN TurnCursorOn END(*IF*);
+    END SetCursorPos;
+
+(************************************************************************)
+
+PROCEDURE ShowCursor;
+
+    (* Makes the mouse cursor visible on the screen. *)
+
+    BEGIN
+	IF Visibility = 0 THEN TurnCursorOn END(*IF*);
+	INC (Visibility);
+    END ShowCursor;
+
+(************************************************************************)
+
+PROCEDURE HideCursor;
+
+    (* Makes the mouse cursor invisible. *)
+
+    BEGIN
+	DEC (Visibility);
+	IF Visibility = 0 THEN TurnCursorOff END(*IF*);
+    END HideCursor;
+
+(************************************************************************)
+
+PROCEDURE SetPage (page: CARDINAL);
+
+    (* Sets the hardware screen page where the mouse is visible. *)
+
+    VAR change: INTEGER;
+
+    BEGIN
+	IF Visibility > 0 THEN TurnCursorOff END(*IF*);
+	WITH Cursor DO
+	    Obtain (access);
+	    IF page > mousepage THEN
+		ScreenPos := FarAddOffset (ScreenPos, pageincr*(page-mousepage));
+	    ELSE
+		ScreenPos := FarSubtractOffset(ScreenPos,
+					pageincr*(mousepage-page));
+	    END (*IF*);
+	    mousepage := page;
+	    Release (access);
+	END (*WITH*);
+	IF Visibility > 0 THEN TurnCursorOn END(*IF*);
+    END SetPage;
+
+(************************************************************************)
+
+PROCEDURE SetHorizontalLimits (MinX, MaxX : CARDINAL);
+
+    (* Sets the horizontal cursor limits. *)
+
+    BEGIN
+	WITH Limits DO
+	    Obtain (access);
+	    left := MinX;  right := MaxX;
+	    Release (access);
+	END (*WITH*);
+    END SetHorizontalLimits;
+
+(************************************************************************)
+
+PROCEDURE SetVerticalLimits (MinY, MaxY : CARDINAL);
+
+    (* Sets the vertical cursor limits. *)
+
+    BEGIN
+	WITH Limits DO
+	    Obtain (access);
+	    top := MinY;  bottom := MaxY;
+	    Release (access);
+	END (*WITH*);
+    END SetVerticalLimits;
+
+(************************************************************************)
+
+PROCEDURE GetPosBut (VAR (*OUT*) buttons: ButtonSet;
+				VAR (*OUT*) Xposition, Yposition: CARDINAL);
+
+    (* Returns the current mouse position and the state of the buttons.	*)
+    (* Note: the units here are not the same as for procedure		*)
+    (* GetTextMousePosition.  In both this procedure and in the event	*)
+    (* handlers the position is presented in units of 1/8th of a	*)
+    (* character width or height.					*)
+
+    BEGIN
+	WITH MouseState DO
+	    Obtain (access);
+	    buttons := ButtonsDown;
+	    Xposition := X;  Yposition := Y;
+	    Release (access);
+	END (*WITH*);
+    END GetPosBut;
+
+(************************************************************************)
+
+PROCEDURE SetEventHandler (DetectedEvents: EventSet;
+					Handler: EventHandler);
+
+    (* Nominates the procedure to be called whenever an event in the	*)
+    (* set DetectedEvents occurs.					*)
+
+    BEGIN
+	WITH UserHandler DO
+	    Obtain (access);
+	    HandlerProc := Handler;
+	    trigger := DetectedEvents;
+	    Release (access);
+	END (*WITH*);
+    END SetEventHandler;
+
+(************************************************************************)
+(*			MODULE INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE SetUpMappings;
+
+    (* Initializes some of the global variables. *)
+
+    BEGIN
+
+	IF MouseKind = Logitech THEN
+	    ParseMouseInput := ParseLogitechInput;
+	    Threshold := 20;
+	    ButtonMap[0] := ButtonSet {};
+	    ButtonMap[1] := ButtonSet {RightButton};
+	    ButtonMap[2] := ButtonSet {LeftButton};
+	    ButtonMap[3] := ButtonSet {LeftButton, RightButton};
+	ELSIF MouseKind = MS THEN
+	    ParseMouseInput := ParseMSInput;
+	    NumberOfButtons := 2;
+	    Threshold := 10;
+	    ButtonMap[0] := ButtonSet {};
+	    ButtonMap[1] := ButtonSet {RightButton};
+	    ButtonMap[2] := ButtonSet {LeftButton};
+	    ButtonMap[3] := ButtonSet {LeftButton, RightButton};
+	ELSIF MouseKind = PC THEN
+	    ParseMouseInput := ParsePCInput;
+	    Threshold := 2;
+	    ButtonMap[0] := ButtonSet {LeftButton,MiddleButton,RightButton};
+	    ButtonMap[1] := ButtonSet {LeftButton, MiddleButton};
+	    ButtonMap[2] := ButtonSet {LeftButton, RightButton};
+	    ButtonMap[3] := ButtonSet {LeftButton};
+	    ButtonMap[4] := ButtonSet {MiddleButton, RightButton};
+	    ButtonMap[5] := ButtonSet {MiddleButton};
+	    ButtonMap[6] := ButtonSet {RightButton};
+	    ButtonMap[7] := ButtonSet {};
+	END (*IF*);
+
+	Map1[LeftButton] := LeftDown;
+	Map1[RightButton] := RightDown;
+	Map1[MiddleButton] := MiddleDown;
+
+	Map2[LeftButton] := LeftUp;
+	Map2[RightButton] := RightUp;
+	Map2[MiddleButton] := MiddleUp;
+
+    END SetUpMappings;
+
+(************************************************************************)
+
+PROCEDURE InitialiseMouseDriver(): BOOLEAN;
+
+    (* Does all initialisation needed for this module.  We make this a	*)
+    (* procedure rather than an initialisation section because module	*)
+    (* Mouse has to decide which mouse driver to use.  The function	*)
+    (* result indicates success; if it is FALSE, none of the following	*)
+    (* procedures will work.  Note: this is not an end-user procedure,	*)
+    (* it's intended to be called only by module Mouse.			*)
+
+    BEGIN
+	VideoKind (ScreenSeg, BlackAndWhite);
+	ExpectingFourBytes := FALSE;
+	WITH Limits DO
+	    CreateLock (access);
+	    left := 0;  right := 639;
+	    top := 0;  bottom := 199;
+	END (*WITH*);
+	WITH MouseState DO
+	    CreateLock (access);
+	    ButtonsDown := ButtonSet{};
+	    X := 320;  Y := 100;
+	END (*WITH*);
+	Visibility := 0;
+	WITH Cursor DO
+	    CreateLock (access);
+	    mousepage := 0;  row := 12;  col := 40;
+	    ScreenPos := MakePointer (ScreenSeg, rowincr*row + 2*col + 1);
+	    ValueUnder := ScreenPos^;
+	END (*WITH*);
+	SetUpMappings;
+	WITH UserHandler DO
+	    CreateLock (access);
+	    HandlerProc := DummyEventHandler;
+	    trigger := EventSet{};
+	END (*WITH*);
+	CreateTask (MouseInterpreter, 9, "Mouse Interprete");
+	RETURN TRUE;
+    END InitialiseMouseDriver;
+
+(************************************************************************)
+
+END SerialMouse.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/skeleton.def b/examples/Modula-2_Libraries/PMOS/sources/general/skeleton.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/skeleton.def
@@ -0,0 +1,18 @@
+DEFINITION MODULE Skeleton;
+
+	(********************************************************)
+	(*							*)
+	(*							*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 February 1995		*)
+	(*  Status:						*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+
+PROCEDURE P;
+
+END Skeleton.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/skeleton.mod b/examples/Modula-2_Libraries/PMOS/sources/general/skeleton.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/skeleton.mod
@@ -0,0 +1,28 @@
+IMPLEMENTATION MODULE Skeleton;
+
+	(********************************************************)
+	(*							*)
+	(*							*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	18 August 1995			*)
+	(*  Status:						*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+
+PROCEDURE P;
+
+    BEGIN
+
+    END P;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+
+END Skeleton.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/soundeff.def b/examples/Modula-2_Libraries/PMOS/sources/general/soundeff.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/soundeff.def
@@ -0,0 +1,56 @@
+DEFINITION MODULE SoundEffects;
+
+	(****************************************************************)
+	(*								*)
+	(*	     Procedures to produce audible output.		*)
+	(*								*)
+	(*  Note that this is a low-level output module, in that the	*)
+	(*  method of specifying note frequencies is defined in terms	*)
+	(*  of what is convenient for the hardware rather than what is	*)
+	(*  convenient for the user.  The higher-level features are	*)
+	(*  provided in module Music.					*)
+	(*								*)
+	(*	Programmer:	P. Moylan				*)
+	(*	Last edited:	28 May 1989				*)
+	(*								*)
+	(*    Status:							*)
+	(*	Seems to be working.					*)
+	(*								*)
+	(****************************************************************)
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore;
+
+TYPE Note = RECORD
+		period, duration: CARDINAL;
+	    END (*RECORD*);
+
+    (* The "period" field of a note record specifies the note frequency	*)
+    (* indirectly, by specifying a divisor for the 1.193 MHz main clock	*)
+    (* frequency.  The "duration" is measured in milliseconds.		*)
+
+PROCEDURE Play (VAR (*IN*) playdata: ARRAY OF Note;
+			VAR (*INOUT*) done: Semaphore);
+
+    (* Adds the array to the list of music queued up waiting to be	*)
+    (* played.  The actual playing occurs automatically, after the end	*)
+    (* of anything earlier in the queue.  The output is asynchronous,	*)
+    (* in the sense that we return from this procedure before the	*)
+    (* playing is over, and perhaps even before it has started.  The	*)
+    (* array playdata must remain undisturbed until the caller receives	*)
+    (* a Signal on semaphore "done".  That is, the caller must perform	*)
+    (* a Wait(done) before re-using or destroying the playdata.  Note	*)
+    (* that a procedure return will destroy playdata if it happens to	*)
+    (* be a local variable of that procedure.				*)
+
+    (* A duration code of 0 indicates the end of the data, in cases	*)
+    (* where the data do not fill the entire array.			*)
+
+    (* A period code of 1, with a nonzero duration, produces silence	*)
+    (* for the requested duration.					*)
+
+PROCEDURE Beep;
+
+    (* Produces a short "beep" noise.	*)
+
+END SoundEffects.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/soundeff.mod b/examples/Modula-2_Libraries/PMOS/sources/general/soundeff.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/soundeff.mod
@@ -0,0 +1,264 @@
+IMPLEMENTATION MODULE SoundEffects;
+
+	(********************************************************)
+	(*							*)
+	(*	Procedures to produce audible output.		*)
+	(*							*)
+	(*	Programmer:	P. Moylan			*)
+	(*	Last edited:	9 March 1995			*)
+	(*	Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* proc *)	ADR;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM LowLevel IMPORT
+    (* proc *)	OutByte, LowByte, HighByte;
+
+FROM Queues IMPORT
+    (* type *)	Queue,
+    (* proc *)	CreateQueue, AddToQueue, TakeFromQueue, Empty;
+
+FROM Semaphores IMPORT
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM TaskControl IMPORT
+    (* proc *)	CreateTask, NotUsingFloatingPoint;
+
+FROM Timer IMPORT
+    (* proc *)	Sleep;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure;
+
+(************************************************************************)
+
+CONST
+    OffCode = 0CH;  OnCode = 0FH;
+
+TYPE
+
+    (* The following declaration is the closest we can come in Modula-2	*)
+    (* to specifying the generic type "ARRAY OF Note".  It means, of	*)
+    (* course, that we have to disable array bound checking when	*)
+    (* compiling this module.						*)
+
+    NoteArray = ARRAY [0..0] OF Note;
+
+    NoteArrayPointer = POINTER TO NoteArray;
+
+    SemaphorePointer = POINTER TO Semaphore;
+
+    QueuePointer = POINTER TO QueueElement;
+
+    (* The music waiting to be played is ordered by having a queue of	*)
+    (* waiting entries.  Each element of the queue is a record with a	*)
+    (* pointer to an array of music data, the last subscript of that	*)
+    (* array (the first subscript is always assumed to be zero), and a	*)
+    (* pointer to the semaphore on which we will perform a Signal to	*)
+    (* indicate that we have finished working on this section of data.	*)
+    (* Notice that the queue is not directly a queue of data.  Rather, 	*)
+    (* it is a queue of pointers to data.				*)
+
+    QueueElement =  RECORD
+			dataptr: NoteArrayPointer;
+			lastsubscript: CARDINAL;
+			CompletionSemaphoreAddress: SemaphorePointer;
+		    END (*RECORD*);
+
+(************************************************************************)
+
+VAR
+
+    (* PlayQueue is the actual queue.	*)
+
+    PlayQueue: Queue;
+
+    (* beep holds the data to be used to produce a "beep" noise.	*)
+
+    beep: ARRAY [0..1] OF Note;
+
+    (* The completion semaphore used when doing the beep.	*)
+
+    BeepSem: Semaphore;
+
+(************************************************************************)
+
+PROCEDURE Play (VAR (*IN*) playdata: ARRAY OF Note;
+			VAR (*INOUT*) done: Semaphore);
+
+    (* Adds the array to the list of music queued up waiting to be	*)
+    (* played.  The actual playing is handled by a separate task - see	*)
+    (* PlayerTask later in this module.  On return from this procedure,	*)
+    (* the playing is not necessarily over.  The caller must perform a	*)
+    (* Wait(done) to know when the array playdata is no longer in use.	*)
+
+    VAR elementpointer: QueuePointer;
+
+    BEGIN
+	NEW (elementpointer);
+	WITH elementpointer^ DO
+	    dataptr := ADR (playdata);  lastsubscript := HIGH (playdata);
+	    CompletionSemaphoreAddress := ADR(done);
+	END (*WITH*);
+	AddToQueue (PlayQueue, elementpointer);
+    END Play;
+
+(************************************************************************)
+
+PROCEDURE Beep;
+
+    (* Produces a short "beep" noise.	*)
+
+    BEGIN
+	Wait (BeepSem);
+	Play (beep, BeepSem);
+    END Beep;
+
+(************************************************************************)
+
+PROCEDURE PlayerTask;
+
+    (* This is the procedure which does all the real work.  It runs as	*)
+    (* a separate task, which typically spends most of its time		*)
+    (* blocked while waiting for something to play.  Even while it is	*)
+    (* playing something, it spends most of its time sleeping, because	*)
+    (* the timer hardware does most of its work for it.			*)
+
+    (* A duration code of 0 indicates the end of the data, in cases	*)
+    (* where the data do not fill the entire array.			*)
+    (* A period code of 1, with a nonzero duration, indicates a rest.	*)
+
+    CONST TimerControlPort = 67;  channel2 = 66;
+
+    VAR arrayptr: NoteArrayPointer;  j, top, Period, Duration: CARDINAL;
+	doneaddress: SemaphorePointer;  qptr: QueuePointer;
+
+    BEGIN
+	NotUsingFloatingPoint;
+	LOOP	(* forever *)
+
+	    (* Note that this task will remain blocked inside procedure	*)
+	    (* TakeFromQueue while there is nothing to play.		*)
+
+	    qptr := TakeFromQueue (PlayQueue);
+	    WITH qptr^ DO
+		arrayptr := dataptr;
+		top := lastsubscript;
+		doneaddress := CompletionSemaphoreAddress;
+	    END (*WITH*);
+	    DISPOSE (qptr);
+
+	    (* Turn on the speaker.  This is done by setting the two	*)
+	    (* low-order bits of port 97.				*)
+
+	    OutByte (97, OnCode);
+
+	    j := 0;
+
+	    LOOP
+		(*# save, check(index=>off) *)
+		Duration := arrayptr^[j].duration;
+		Period := arrayptr^[j].period;
+		(*# restore *)
+
+		(* A duration code of 0 indicates the end of the data.	*)
+
+		IF Duration = 0 THEN
+		    EXIT(*LOOP*);
+		END (*IF*);
+
+		IF Period = 1 THEN
+
+		    (* A rest has been requested.  Turn off the speaker	*)
+		    (* and sleep for a while, then turn on the speaker.	*)
+
+		    OutByte (97, OffCode);
+		    Sleep (Duration);
+		    OutByte (97, OnCode);
+
+		ELSE
+
+		    (* We have a normal note to play.  The control byte	*)
+		    (* sent to the timer control port specifies: timer	*)
+		    (* #2, two count bytes to follow, and mode 3	*)
+		    (* (square wave).					*)
+
+		    OutByte (TimerControlPort, 0B6H);
+		    OutByte (channel2, LowByte(Period));
+		    OutByte (channel2, HighByte(Period));
+
+		    Sleep (Duration);
+
+		END (*IF*);
+
+		IF j = top THEN EXIT(*LOOP*) END(*IF*);
+		INC (j);
+
+	    END (*LOOP*);
+
+	    (* Turn off the speaker.	*)
+
+	    OutByte (97, OffCode);
+
+	    (* Tell the user task that we have finished with this	*)
+	    (* buffer-full of data.					*)
+
+	    Signal (doneaddress^);
+
+	END (*LOOP*);
+    END PlayerTask;
+
+(************************************************************************)
+(*			MODULE TERMINATION				*)
+(************************************************************************)
+
+PROCEDURE CloseDown;
+
+    (* Brings the module to an orderly halt.	*)
+
+    VAR qptr: QueuePointer;
+
+    BEGIN
+	WHILE NOT Empty(PlayQueue) DO
+	    qptr := TakeFromQueue (PlayQueue);
+	    Signal (qptr^.CompletionSemaphoreAddress^);
+	    DISPOSE (qptr);
+	END (*WHILE*);
+
+	(* Turn off the speaker. *)
+
+	OutByte (97, OffCode);
+
+    END CloseDown;
+
+(************************************************************************)
+(*			MODULE INITIALISATION				*)
+(************************************************************************)
+
+BEGIN
+
+    (* Create an initially empty queue of music to be played.	*)
+
+    CreateQueue (PlayQueue);
+
+    (* Define the parameters of a "beep" noise.	*)
+
+    beep[0].period := 1000;
+    beep[0].duration := 40;
+    beep[1].period := 1;
+    beep[1].duration := 20;
+    CreateSemaphore (BeepSem, 1);
+
+    SetTerminationProcedure (CloseDown);
+
+    (* Create the task which plays the music.	*)
+
+    CreateTask (PlayerTask, 10, "Sound effects");
+
+END SoundEffects.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/storage1.def b/examples/Modula-2_Libraries/PMOS/sources/general/storage1.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/storage1.def
@@ -0,0 +1,43 @@
+DEFINITION MODULE Storage1;
+
+	(********************************************************)
+	(*							*)
+	(*  Storage allocation with critical section protection	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	26 February 1995		*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(*  This module supports the Modula-2 NEW and DISPOSE operations.	*)
+(*									*)
+(*  Why should you use this module, when the standard module Storage	*)
+(*  already provides the necessary facilities?  The answer is that	*)
+(*  most "normal" implementations of Storage don't provide critical	*)
+(*  section protection.  Some very nasty things can happen if there's	*)
+(*  a task switch in the middle of heap manipulation; and the fault	*)
+(*  is typically non-repeatable and hard to track down.			*)
+(*									*)
+(*  In the case of TopSpeed Modula-2 the MThread memory model takes	*)
+(*  care of this; but you might not want that solution, for two reasons:*)
+(*	1. It removes the possibility of using PMOS under the more	*)
+(*	   economical memory models.					*)
+(*	2. The TopSpeed solution is to disable interrupts, which could	*)
+(*	   be unacceptable in real-time applications.  The solution	*)
+(*	   adopted in the present model is better in terms of		*)
+(*	   interrupt latency.						*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE ALLOCATE (VAR (*OUT*) p: ADDRESS;  size: CARDINAL);
+
+    (* Allocates a block of size bytes. *)
+
+PROCEDURE DEALLOCATE (VAR (*INOUT*) p: ADDRESS;  size: CARDINAL);
+
+    (* Deallocates memory that was allocated by ALLOCATE. *)
+
+END Storage1.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/storage1.mod b/examples/Modula-2_Libraries/PMOS/sources/general/storage1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/storage1.mod
@@ -0,0 +1,54 @@
+IMPLEMENTATION MODULE Storage1;
+
+	(********************************************************)
+	(*							*)
+	(*  Storage allocation with critical section protection	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	15 March 1995			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+IMPORT Storage;
+
+FROM TaskControl IMPORT
+    (* type *)	Lock,
+    (* proc *)	CreateLock, Obtain, Release;
+
+(************************************************************************)
+
+VAR L: Lock;
+
+(************************************************************************)
+
+PROCEDURE ALLOCATE (VAR (*OUT*) p: ADDRESS;  size: CARDINAL);
+
+    (* Allocates a block of size bytes. *)
+
+    BEGIN
+	Obtain (L);
+	Storage.ALLOCATE (p, size);
+	Release (L);
+    END ALLOCATE;
+
+(************************************************************************)
+
+PROCEDURE DEALLOCATE (VAR (*INOUT*) p: ADDRESS;  size: CARDINAL);
+
+    (* Deallocates memory that was allocated by ALLOCATE. *)
+
+    VAR PSW: CARDINAL;
+
+    BEGIN
+	Obtain (L);
+	Storage.DEALLOCATE (p, size);
+	Release (L);
+    END DEALLOCATE;
+
+(************************************************************************)
+
+BEGIN
+    CreateLock (L);
+END Storage1.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/taskcont.def b/examples/Modula-2_Libraries/PMOS/sources/general/taskcont.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/taskcont.def
@@ -0,0 +1,258 @@
+DEFINITION MODULE TaskControl;
+
+	(****************************************************************)
+	(*								*)
+	(*   Data structures internal to the kernel of the operating	*)
+	(*     system; the dispatcher of the operating system; and	*)
+	(*		    related procedures.				*)
+	(*								*)
+	(*	This version supports priority inheritance.		*)
+	(*								*)
+	(*	Programmer:	P. Moylan				*)
+	(*	Last edited:	16 March 1995				*)
+	(*	Status:		OK					*)
+	(*								*)
+	(****************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	ADDRESS;
+
+(************************************************************************)
+(*									*)
+(*			   END-USER PROCEDURES				*)
+(*									*)
+(************************************************************************)
+
+CONST MaxPriority = 15;
+
+TYPE
+    PriorityLevel = [0..MaxPriority];
+    NameString = ARRAY [0..15] OF CHAR;
+
+PROCEDURE CreateTask (StartAddress: PROC;  taskpriority: PriorityLevel;
+						taskname: NameString);
+
+    (* Must be called to introduce a task to the system. The first	*)
+    (* parameter, which should be the name of a procedure containing	*)
+    (* the task code, gives the starting address.  The second parameter	*)
+    (* is the task's base priority.  If this task has a higher priority	*)
+    (* than its creator, it will run immediately.  Otherwise, it	*)
+    (* becomes ready.							*)
+
+    (* The effective priority of a task can be higher than its base	*)
+    (* priority, as the result of priority inheritance.  This happens	*)
+    (* when the task holds a lock on which a higher-priority task is	*)
+    (* blocked.								*)
+
+    (* NOTE: If time-slicing is enabled, tasks of equal priority share	*)
+    (* processor time on a round-robin basis.  To disable this feature,	*)
+    (* set the constant TimeSlicingEnabled (in the ConfigurationOptions	*)
+    (* module) to FALSE.						*)
+
+    (* Tasks of different priorities never share time.  When a		*)
+    (* high-priority task becomes able to run, there is an immediate	*)
+    (* task switch.							*)
+
+    (* A task terminates itself either by an explicit call to TaskExit,	*)
+    (* or simply by falling out of the bottom of its code.		*)
+    (* There is no provision for tasks to kill other tasks.  Suicide	*)
+    (* is legal, but murder is not.					*)
+
+PROCEDURE UsingFloatingPoint;
+
+    (* Tells the kernel that this task is one which performs floating	*)
+    (* point operations.  The consequence is that the state of the	*)
+    (* (physical or emulated, as applicable) floating point processor	*)
+    (* is saved on a task switch.  This call is usually unnecessary;	*)
+    (* the default assumption is that interrupt tasks do not perform	*)
+    (* floating point arithmetic but that all other tasks may.		*)
+    (* NOTE: It is never acceptable for an interrupt task to call this	*)
+    (* procedure.							*)
+
+PROCEDURE NotUsingFloatingPoint;
+
+    (* Tells the kernel that this task does not perform any floating	*)
+    (* point operations.  Calling this (optional) procedure speeds up	*)
+    (* task switching slightly, but it does put the onus on the caller	*)
+    (* to be certain that it does no floating point operations.  If you	*)
+    (* call this procedure and then perform floating point arithmetic	*)
+    (* anyway, you can get severe and erratic floating point errors.	*)
+
+PROCEDURE TaskExit;
+
+    (* Removes the currently running task from the system, and performs	*)
+    (* a task switch to the next ready task.				*)
+
+    (* There is normally no need for a task to call this procedure,	*)
+    (* because it is automatically called when the task code "falls out	*)
+    (* the bottom" by executing its final procedure return.  The stack	*)
+    (* is set up, at the time a task is created, in such a way that	*)
+    (* TaskExit will be entered at that time.				*)
+
+(************************************************************************)
+(*									*)
+(*		  LOCKS FOR CRITICAL SECTION PROTECTION			*)
+(*									*)
+(*  Note that we distinguish between a Lock and a Semaphore.		*)
+(*  A Semaphore is a general semaphore - whose operations are defined	*)
+(*  in module Semaphores - which can be used for general inter-task	*)
+(*  interlocking.  A Lock is similar to a binary semaphore (with a	*)
+(*  more efficient implementation than a Semaphore), but may be used	*)
+(*  only in a strictly nested fashion and is therefore useful only	*)
+(*  for critical section protection.  No task should perform a		*)
+(*  semaphore Wait while it holds a Lock.  Priority inheritance is	*)
+(*  used for Locks - that is, a task holding a Lock will have its	*)
+(*  priority temporarily increased as long as it is blocking another	*)
+(*  task of higher priority - but not for Semaphores.			*)
+(*									*)
+(************************************************************************)
+
+TYPE Lock;	(* is private *)
+
+PROCEDURE CreateLock (VAR (*OUT*) L: Lock);
+
+    (* Creates a new lock. *)
+
+PROCEDURE DestroyLock (VAR (*INOUT*) L: Lock);
+
+    (* Disposes of a lock. *)
+
+PROCEDURE Obtain (L: Lock);
+
+    (* Obtains lock L, waiting if necessary. *)
+
+PROCEDURE Release (L: Lock);
+
+    (* Releases lock L - which might unblock some other task. *)
+
+PROCEDURE ReleaseAllLocks;
+
+    (* Releases all locks held by the current task.  Application-level	*)
+    (* tasks normally won't need to call this procedure; it is		*)
+    (* provided to support the system shutdown function and for things	*)
+    (* like "emergency abort" operations.				*)
+
+(************************************************************************)
+(*									*)
+(*		    SUPPORT FOR INTERRUPT HANDLERS			*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE CreateInterruptTask (InterruptNumber: CARDINAL;
+				StartAddress: PROC;  taskname: NameString);
+
+    (* Introduces an interrupt task to the system.  The first parameter	*)
+    (* is the hardware-defined interrupt number, and the second is the	*)
+    (* address of the procedure whose code is the interrupt handler.	*)
+    (* An interrupt task differs from an ordinary task in that, when it	*)
+    (* is not running, it is idle rather than ready, and the dispatcher	*)
+    (* does not consider it to be among the tasks eligible to run.	*)
+    (* Rather, it is run by a task switch which is made directly by the	*)
+    (* assembly language routine which fields the interrupt.  When the	*)
+    (* interrupt task has responded to the interrupt, it must call	*)
+    (* procedure WaitForInterrupt to put itself back in the idle state.	*)
+    (* On the next interrupt, it will continue from just after the call	*)
+    (* to WaitForInterrupt.  Normally, therefore, the interrupt task	*)
+    (* will be written as an infinite loop.  If for any reason the	*)
+    (* interrupt task exits by falling out of the bottom of its code,	*)
+    (* it will be destroyed in the same way as a normal task which	*)
+    (* terminates.  That could be fatal, unless steps have been taken	*)
+    (* to reset the interrupt vector.					*)
+
+PROCEDURE KillInterruptTask (InterruptNumber: CARDINAL);
+
+    (* Removes an interrupt task from the system.  This should not be	*)
+    (* called from inside an interrupt task.				*)
+
+(************************************************************************)
+(*									*)
+(*			DEVICE DRIVER SUPPORT				*)
+(*									*)
+(*  The following procedure may be called only by an interrupt task.	*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE WaitForInterrupt;
+
+    (* Called by an interrupt task, to make itself dormant until the	*)
+    (* next interrupt comes along.  It is not necessary to specify	*)
+    (* the interrupt number, since this was fixed at the time the	*)
+    (* interrupt task was created.					*)
+
+    (* Warning: this procedure should never be called by a task which	*)
+    (* is not an interrupt task.					*)
+
+(************************************************************************)
+(*									*)
+(*		    PROCEDURES PRIVATE TO THE KERNEL			*)
+(*									*)
+(*  The remaining declarations in this module are needed because the	*)
+(*  kernel is made up of several modules.  (Unfortunately, there is no	*)
+(*  way in Modula-2 to export something to a separately compiled module	*)
+(*  without making it visible to everyone; so please close your eyes	*)
+(*  at this point.)  The procedures declared here should be called only	*)
+(*  from the innermost parts of the operating system.			*)
+(*									*)
+(************************************************************************)
+
+TYPE TaskQueue;	(* is private *)
+
+PROCEDURE CreateQueue (VAR (*OUT*) KQ: TaskQueue);
+
+    (* Creates an initially empty queue.				*)
+
+PROCEDURE MarkAsReady (VAR (*INOUT*) FromQ: TaskQueue);
+
+    (* Takes the first task from queue FromQ and puts it on the ready	*)
+    (* list, or runs it immediately if it has higher priority than the	*)
+    (* task which called MarkAsReady.					*)
+
+PROCEDURE QueueAndSwitchTasks (VAR (*INOUT*) KQ: TaskQueue);
+
+    (* Puts the current task onto list KQ, and switches to the		*)
+    (* highest-priority ready task.					*)
+
+(************************************************************************)
+(*									*)
+(*			     TIMER OPERATIONS				*)
+(*									*)
+(*   These procedures are called by the Timer and Semaphores modules	*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE Delay (sleeptime: INTEGER);
+
+    (* Puts the calling task to sleep for the specified number of clock	*)
+    (* ticks.								*)
+
+PROCEDURE QueueWithTimeout (VAR (*INOUT*) KQ: TaskQueue;
+					TimeLimit: INTEGER): BOOLEAN;
+
+    (* Like procedure QueueAndSwitchTasks, this procedure puts the	*)
+    (* current task on the tail of list KQ, and gives control to the	*)
+    (* highest-priority ready task.  The difference is that we allow	*)
+    (* this task to remain on KQ for at most TimeLimit timer ticks.	*)
+    (* If the task is removed from KQ before the time limit expires,	*)
+    (* we return a result of FALSE.  If the time limit expires first,	*)
+    (* we remove the queued task from KQ anyway, and make it runnable,	*)
+    (* and return a result of TRUE when it does run.			*)
+    (* Note: this procedure may be called only from inside the kernel.	*)
+
+PROCEDURE CheckSleepers;
+
+    (* Called from the timer interrupt routine, to deal with sleeping	*)
+    (* tasks.  Warning: there must be no kernel call between a call to	*)
+    (* this procedure and the next call to WaitForInterrupt.		*)
+
+PROCEDURE TimeSliceCheck;
+
+    (* Called from the timer interrupt routine, to check whether the	*)
+    (* current task has used up its time slice, and to perform a task	*)
+    (* switch if so.							*)
+
+    (* This procedure does nothing if time-slicing is disabled.		*)
+    (* Time-slicing is controlled by a constant TimeSlicingEnabled	*)
+    (* in module ConfigurationOptions.					*)
+
+END TaskControl.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/taskcont.mod b/examples/Modula-2_Libraries/PMOS/sources/general/taskcont.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/taskcont.mod
@@ -0,0 +1,1425 @@
+IMPLEMENTATION MODULE TaskControl;
+
+	(****************************************************************)
+	(*								*)
+	(*	    The dispatcher of the operating system, and		*)
+	(*	     related procedures and data structures.		*)
+	(*								*)
+	(*	    This version supports priority inheritance.		*)
+	(*								*)
+	(*	This is the portable part of the PMOS task control	*)
+	(*	software.  The non-portable part is in module		*)
+	(*	InnerKernel.						*)
+	(*								*)
+	(*	Programmer:	P. Moylan				*)
+	(*	Last edited:	16 March 1995				*)
+	(*	Status:		Working					*)
+	(*								*)
+	(*  Description:						*)
+	(*	See individual procedures.  This is the module which	*)
+	(*	does all task switching, also task creation.		*)
+	(*	The kernel of the operating system consists of this	*)
+	(*	module, module InnerKernel, and module Semaphores.  The	*)
+	(*	module called Timer is also intimately linked to the	*)
+	(*	kernel; it is technically not part of the kernel, but	*)
+	(*	does most of its work by calls to kernel procedures.	*)
+	(*								*)
+	(*	The present kernel implementation allows a task to	*)
+	(*	be in one of the following (mutually exclusive) states:	*)
+	(*	    1. Active						*)
+	(*		- running					*)
+	(*		- ready						*)
+	(*		- blocked waiting for a Lock			*)
+	(*	    2. Inactive						*)
+	(*		- sleeping					*)
+	(*		- waiting for a semaphore Signal		*)
+	(*		- waiting for a Signal with a timeout		*)
+	(*		- dead						*)
+	(*	In most of these cases, the state is defined by the	*)
+	(*	kernel list on which the task is placed.  (All active	*)
+	(*	tasks are on the same "Ready" structure, but we have	*)
+	(*	enough other information to distinguish among the three	*)
+	(*	active states.)  The exception is where a task is	*)
+	(*	performing a timed semaphore wait, since there the	*)
+	(*	task is simultaneously on two lists.  When such a task	*)
+	(*	is woken up, it is run immediately in order to make	*)
+	(*	indivisible the operation of removing the task from	*)
+	(*	the two lists.  If this causes a higher-priority task	*)
+	(*	to be preempted, a second task switch reinstates this	*)
+	(*	higher-priority task before we leave the kernel.	*)
+	(*	(Procedure RecheckPriorities looks after this detail.)	*)
+	(*								*)
+	(*	The priority of a task is normally a constant; but the	*)
+	(*	priority can be increased in the case of an active	*)
+	(*	task holding a Lock, where a higher-priority task is	*)
+	(*	waiting to obtain that Lock.  In such cases the task's	*)
+	(*	dynamic priority is equal to the priority of the	*)
+	(*	highest-priority task which it is blocking.  As it	*)
+	(*	turns out, there is no need to record the dynamic	*)
+	(*	priorities for each active task; it is sufficient to	*)
+	(*	maintain a global variable CurrentPriority, which holds	*)
+	(*	the dynamic priority of the currently running task.	*)
+	(*								*)
+	(*	Interrupt tasks follow their own set of rules and do	*)
+	(*	not fit into the above classification.  An interrupt	*)
+	(*	task should never obtain a Lock,  perform a semaphore	*)
+	(*	Wait (although a Signal is permitted), or Sleep.  The	*)
+	(*	only possible states for an interrupt task are running	*)
+	(*	(responding to an interrupt) or idle (waiting for an	*)
+	(*	interrupt).  When an interrupt task is running, the	*)
+	(*	variables CurrentTask and CurrentPriority continue to	*)
+	(*	refer to the interrupted task.				*)
+	(*								*)
+	(****************************************************************)
+
+FROM SYSTEM IMPORT
+    (* proc *)	ADR;
+
+FROM ConfigurationOptions IMPORT
+    (* const*)	TimeSlicingEnabled, MaxTaskNumber, StackSize;
+
+FROM InnerKernel IMPORT
+    (* type *)	TaskSelector, FloatSaveSelector,
+    (* proc *)	EnterKernel, LeaveKernel, NPXsave, NPXrestore,
+		InitMainTask, MakeFloatSaveSelector,
+		TaskInit, Transfer, IOTransfer, StartInterruptTask,
+		DisconnectFromInterrupt;
+
+	(* Procedure Transfer is the low-level primitive for the	*)
+	(* stack switch operation, which is the most crucial part of	*)
+	(* a task switch.  Procedures NPXsave and NPXrestore look after	*)
+	(* saving and restoring the state of the NPX (Numeric Processor	*)
+	(* Extension, i.e. the floating point hardware) coprocessor.	*)
+	(* TaskInit introduces a new task into the system.		*)
+
+FROM Storage IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure, Crash;
+
+(************************************************************************)
+
+TYPE
+    TaskNumber = [0..MaxTaskNumber];
+    InterruptType = CARDINAL;
+    Lock = POINTER TO LockRecord;
+    TaskPointer = POINTER TO TaskDescriptor;
+    Task = TaskPointer;
+
+    (* The kernel maintains a number of queues, which for the most part	*)
+    (* are FIFO queues.  (Very occasionally, we need to remove a task	*)
+    (* from the middle of a queue.)  Mainly because of the limitations	*)
+    (* of the Modula-2 opaque export, we choose to represent a queue by	*)
+    (* a single "head" pointer, and to implement a doubly linked list	*)
+    (* structure with the aid of "previous" and "next" pointers in the	*)
+    (* task descriptors.						*)
+
+    TaskQueue = TaskPointer;
+
+    (* Each task in the system has a task descriptor.			*)
+    (* The fields in a task descriptor are:				*)
+    (*	previous, next:	pointers to preceding and following task	*)
+    (*		descriptors on the queue (i.e. whatever system queue	*)
+    (*		this task descriptor happens to be on).			*)
+    (*	name:	a character string describing the task.  Used only for	*)
+    (*		diagnostic purposes.					*)
+    (*	priority: task priority.  This is the task's base priority.	*)
+    (*		Because of priority inheritance, the task may at times	*)
+    (*		be running at a higher priority, but we don't need to	*)
+    (*		record this in the task descriptor; it turns out to be	*)
+    (*		sufficient to keep a single global variable (see	*)
+    (*		CurrentPriority below) to hold the dynamic priority of	*)
+    (*		the currently running task.				*)
+    (*	WaitingFor: the Lock, if any, on which this task is blocked.	*)
+    (*  FirstLock: the first in the list of Locks held by this task.	*)
+    (*	selector: a selector for the task state of this task.  In the	*)
+    (*		current implementation, most of the state information	*)
+    (*		(register contents, etc.) is saved on the task's stack	*)
+    (*		when a task switch occurs, and the selector field is	*)
+    (*		used to save the stack pointer.				*)
+    (*  FPselector: used for floating point save/restore.		*)
+    (*	StackBase: the low address of the memory segment set aside for	*)
+    (*		the stack. This is needed only when we kill a task, and	*)
+    (*		wish to reclaim the memory used by its stack.		*)
+    (*	TimeLeft: for a running task, this records how much of its	*)
+    (*		current time slice the task still has left.  For a	*)
+    (*		sleeping task, it shows how long to keep the task	*)
+    (*		asleep (but not in terms of absolute time - see		*)
+    (*		procedure Delay).					*)
+    (*	InterruptHandler: true iff this task is an interrupt task.	*)
+    (*	FloatingPointUser:  true iff this task is a user (or potential	*)
+    (*		user) of the numeric coprocessor.			*)
+    (*	dead:	true iff this is an unused descriptor or a descriptor	*)
+    (*		for a task which has terminated.			*)
+    (*	sleeping: true iff this is a task which is on the sleep queue.	*)
+    (*	InterruptNo: interrupt number, used only for interrupt tasks.	*)
+    (*	nextsleeper:	pointer to next task descriptor on the sleep	*)
+    (*		queue.  Unused except when this task is a sleeping task	*)
+    (*		or one which is timing out.				*)
+
+    TaskDescriptor = RECORD
+			previous, next	: Task;
+			name		: NameString;
+			priority	: PriorityLevel;
+			WaitingFor,
+			FirstLock	: Lock;
+			selector	: TaskSelector;
+			FPselector	: FloatSaveSelector;
+			StackBase	: ADDRESS;
+			TimeLeft	: INTEGER;
+			InterruptHandler,
+			FloatingPointUser,
+			dead, sleeping	: BOOLEAN;
+			InterruptNo	: InterruptType;
+			nextsleeper	: Task;
+		     END;
+
+    (* A LockRecord holds all the data for a lock.  Note that we do	*)
+    (* not maintain the traditional blocked list; in the more standard	*)
+    (* implementations of a binary semaphore this would be needed to	*)
+    (* know which task to unblock when the lock is released, but the	*)
+    (* present algorithm leaves everything unblocked, relying on a	*)
+    (* re-check at the time of a task switch.				*)
+    (* The "next" and "previous" fields link together all locks held	*)
+    (* by a single task.  This list would not be needed if we assumed	*)
+    (* perfectly disciplined users of the locks; but we need to be	*)
+    (* able to deal with things like tasks which exit while still	*)
+    (* holding locks.							*)
+
+    LockRecord = RECORD
+		     Locked: BOOLEAN;
+		     Holder: Task;
+		     next, previous: Lock;
+		 END (*RECORD*);
+
+(************************************************************************)
+
+VAR
+    (* TaskTable is an array of task descriptors.  After procedure	*)
+    (* InitialiseTaskControl returns, there will be two tasks in the	*)
+    (* system: the initialisation task, and the null task.  The		*)
+    (* remaining task descriptors will be on UnusedDescriptors,		*)
+    (* available for the creation of new tasks.  A task descriptor is	*)
+    (* allocated by procedure CreateTask, and is returned to		*)
+    (* UnusedDescriptors by procedure TaskExit.				*)
+
+    TaskTable: ARRAY TaskNumber OF TaskDescriptor;
+
+    (* CurrentTask is the current non-interrupt task.  (Note: when an	*)
+    (* interrupt task is running, CurrentTask continues to refer to the	*)
+    (* interrupted task.)  LastTask is the task which was running just	*)
+    (* before CurrentTask got control.  Most of the time LastTask is	*)
+    (* irrelevant to us; but it is needed when dealing with some	*)
+    (* complications which arise when waking a sleeping task.		*)
+
+    LastTask, CurrentTask: Task;
+
+    (* CurrentPriority is the _dynamic_ priority of the currently	*)
+    (* running task.  If no other task is blocked on a Lock held by the	*)
+    (* current task, then CurrentPriority is the current task's base	*)
+    (* priority.  Otherwise, CurrentPriority is equal to the maximum	*)
+    (* base priority of all tasks which are blocked (directly or	*)
+    (* indirectly) by the current task as a result of their waiting to	*)
+    (* obtain a Lock.							*)
+
+    CurrentPriority: PriorityLevel;
+
+    (* Because of the way we do priority inheritance, our treatment	*)
+    (* of the "ready list" is somewhat unconventional.  This list holds	*)
+    (* not only tasks which are ready, but also				*)
+    (*		- the currently running task, and			*)
+    (*		- all tasks waiting to obtain a Lock.			*)
+    (* (Do not confuse obtaining a Lock with waiting on a general	*)
+    (* semaphore.  Tasks doing a semaphore Wait are not on the ready	*)
+    (* list.)  When we choose a task on the ready list and discover	*)
+    (* that it is blocked, we switch to its blocker instead, with the	*)
+    (* blocker inheriting the priority of the blocked task.		*)
+		
+    (* Note: priority level 0 is special - there is normally only one	*)
+    (* task, namely the null task, at priority 0.			*)
+
+    ReadyList: ARRAY PriorityLevel OF TaskQueue;
+
+    (* InterruptTaskActive = TRUE iff an interrupt task is running.	*)
+    	
+    InterruptTaskActive: BOOLEAN;
+
+    (* UnusedDescriptors is a queue of all task descriptors which are	*)
+    (* unused, i.e. which are available for use as descriptors of newly	*)
+    (* created tasks.							*)
+
+    UnusedDescriptors: TaskQueue;
+
+    (* The timequota array holds the time-slice quota, in units of	*)
+    (* clock ticks, for each priority level.  Quotas are based on a	*)
+    (* task's base priority, not on its inherited priority.		*)
+
+    timequota: ARRAY PriorityLevel OF CARDINAL;
+
+(************************************************************************)
+(*			  KERNEL QUEUE OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE CreateQueue (VAR (*OUT*) KQ: TaskQueue);
+
+    (* Creates an initially empty kernel queue.	*)
+
+    BEGIN
+	KQ := NIL;
+    END CreateQueue;
+
+(*************************************************************************)
+
+PROCEDURE AddToQueue (VAR (*INOUT*) Q: TaskQueue;  T: Task);
+
+    (* Adds task T to the tail of queue Q.	*)
+
+    VAR tail: TaskPointer;
+
+    BEGIN
+	IF Q = NIL THEN
+	    Q := T;
+	    WITH T^ DO
+		previous := T;  next := T;
+	    END (*WITH*);
+	ELSE
+	    WITH Q^ DO
+		tail := previous;  previous := T;
+	    END (*WITH*);
+	    tail^.next := T;
+	    WITH T^ DO
+		previous := tail;  next := Q;
+	    END (*WITH*);
+	END (*IF*);
+    END AddToQueue;
+
+(************************************************************************)
+
+PROCEDURE TakeFromQueue (VAR (*INOUT*) Q: TaskQueue): Task;
+
+    (* Removes the first entry from queue Q and returns it.		*)
+    (* Assumption: the caller has already verified that the queue is	*)
+    (* nonempty.							*)
+
+    VAR result: Task;  tail: TaskPointer;
+
+    BEGIN
+	result := Q;  tail := Q^.previous;
+	IF tail = Q THEN
+	    Q := NIL;
+	ELSE
+	    Q := Q^.next;  Q^.previous := tail;  tail^.next := Q;
+	END (*IF*);
+	WITH result^ DO
+	    previous := NIL;  next := NIL;
+	END (*WITH*);
+	RETURN result;
+    END TakeFromQueue;
+
+(************************************************************************)
+
+PROCEDURE LeaveQueue (VAR (*INOUT*) KQ: TaskQueue);
+
+    (* Removes the current task from queue KQ.  The caller is		*)
+    (* responsible for knowing that the current task really is on KQ.	*)
+
+    BEGIN
+	WITH CurrentTask^ DO
+	    IF next = CurrentTask THEN
+		KQ := NIL;
+	    ELSE
+		previous^.next := next;  next^.previous := previous;
+		IF KQ = CurrentTask THEN
+		    KQ := next;
+		END (*IF*);
+	    END (*IF*);
+	    previous := NIL;  next := NIL;
+	END (*WITH*);
+    END LeaveQueue;
+
+(************************************************************************)
+(*			      THE NULL TASK				*)
+(************************************************************************)
+
+PROCEDURE NullTask;
+
+    (* The only function of the null task is to soak up processor time	*)
+    (* when no other task is able to run.				*)
+
+    BEGIN
+	NotUsingFloatingPoint;
+	LOOP (* Do nothing *) END (*LOOP*);
+    END NullTask;
+
+(************************************************************************)
+(*			    	DISPATCHER				*)
+(************************************************************************)
+
+PROCEDURE TaskSwitch (T: Task);
+
+    (* Performs a task switch from the current task to task T.  It is	*)
+    (* assumed that the current task has already been moved to the	*)
+    (* appropriate kernel queue.					*)
+    (* This is, in principle, a system-dependent procedure, whose	*)
+    (* detailed implementation depends on the processor architecture	*)
+    (* and on compiler conventions.  To keep this module portable, a	*)
+    (* separate procedure InnerKernel.Transfer is called to handle the	*)
+    (* system-dependent part.						*)
+
+    (* Special case: if an interrupt task is running, the actual task	*)
+    (* switch is deferred until the interrupt task has finished		*)
+    (* processing the current interrupt and has reached its next call	*)
+    (* to WaitForInterrupt.  Procedure Transfer also looks after this	*)
+    (* detail.								*)
+
+    BEGIN
+	IF T^.dead THEN
+	    Crash ("Task switch to nonexistent task");
+	END (*IF*);
+	LastTask := CurrentTask;
+
+	IF T <> LastTask THEN
+
+	    CurrentTask := T;
+
+	    (* Save and restore the floating point state if necessary.	*)
+	    (* Notice that if an interrupt task is running (i.e. if	*)
+	    (* InterruptTaskActive = TRUE), the saved state is that of	*)
+	    (* the interrupted task, not the interrupt task.  This is	*)
+	    (* the appropriate action since there is a system-wide	*)
+	    (* assumption that interrupt handlers may not perform	*)
+	    (* floating point operations.				*)
+
+	    IF LastTask^.FloatingPointUser THEN
+		NPXsave (LastTask^.FPselector);
+	    END (*IF*);
+	    IF T^.FloatingPointUser THEN
+		NPXrestore (T^.FPselector);
+	    END (*IF*);
+
+	    Transfer (LastTask^.selector, T^.selector);
+
+	    (* By the time we get back to here, one or more other	*)
+	    (* tasks have been running; and we resume at this point	*)
+	    (* by virtue of another task having executed Transfer.	*)
+
+	END (*IF*);
+	
+    END TaskSwitch;
+
+(************************************************************************)
+
+PROCEDURE RunNextTask;
+
+    (* Performs a task switch to the first task on the ready list	*)
+    (* whose dynamic priority is CurrentPriority, if that task is not	*)
+    (* blocked.  If it is blocked, we switch to its blocker instead.	*)
+
+    VAR T: Task;  L: Lock;
+
+    BEGIN
+	T := ReadyList[CurrentPriority];
+	LOOP
+	    L := T^.WaitingFor;
+	    IF (L = NIL) OR NOT L^.Locked THEN EXIT(*LOOP*) END(*IF*);
+	    T := L^.Holder;
+	END (*LOOP*);
+	IF TimeSlicingEnabled THEN
+	    T^.TimeLeft := timequota[T^.priority];
+	END (*IF*);
+	TaskSwitch (T);
+    END RunNextTask;
+
+(************************************************************************)
+
+PROCEDURE SelectAnotherTask;
+
+    (* Performs a task switch from the current task to the next ready	*)
+    (* task.  It is assumed that the current task has already been	*)
+    (* removed from the active list.  Notice that there is always at	*)
+    (* least one ready task, namely the null task.			*)
+
+    BEGIN
+	WHILE ReadyList[CurrentPriority] = NIL DO
+	    DEC (CurrentPriority);
+	END (*WHILE*);
+	RunNextTask;
+    END SelectAnotherTask;
+
+(************************************************************************)
+
+PROCEDURE QueueAndSwitchTasks (VAR (*INOUT*) KQ: TaskQueue);
+
+    (* Puts the current task on the tail of list KQ, and gives control	*)
+    (* to the highest-priority ready task.				*)
+
+    BEGIN
+	IF CurrentTask^.FirstLock <> NIL THEN
+	    Crash ("Task became inactive while holding a lock.");
+	END (*IF*);
+	LeaveQueue (ReadyList[CurrentTask^.priority]);
+	AddToQueue (KQ, CurrentTask);
+	SelectAnotherTask;
+    END QueueAndSwitchTasks;
+
+(************************************************************************)
+
+PROCEDURE MarkAsReady (VAR (*INOUT*) FromQ: TaskQueue);
+
+    (* Removes the first task from queue FromQ and makes it ready.  If	*)
+    (* the task has a higher priority than the currently running task,	*)
+    (* then we perform an immediate task switch.  Otherwise, the new	*)
+    (* task descriptor is placed on the ready list.			*)
+    (* Special case: if the incoming task is a sleeping task, it must	*)
+    (* be a timing-out task which has been reactivated before its	*)
+    (* timeout period has expired.  We run such a task immediately,	*)
+    (* but don't yet put it on the list of active tasks.  The task runs	*)
+    (* just far enough to clean up its kernel data structures, after	*)
+    (* which procedure RecheckPriorities decides whether to switch back	*)
+    (* to the preempted task or to legitimise the task switch.		*)
+
+    VAR thispriority: PriorityLevel;
+	T: Task;
+
+    BEGIN
+	T := TakeFromQueue (FromQ);
+	IF T^.sleeping THEN
+	    TaskSwitch (T);
+	ELSE
+	    thispriority := T^.priority;
+	    AddToQueue (ReadyList[thispriority], T);
+	    IF thispriority > CurrentPriority THEN
+		CurrentPriority := thispriority;
+		IF TimeSlicingEnabled THEN
+		    T^.TimeLeft := timequota[thispriority];
+		END (*IF*);
+		TaskSwitch (T);
+	    END (*IF*);
+	END (*IF*);
+    END MarkAsReady;
+
+(************************************************************************)
+
+PROCEDURE TimeSliceCheck;
+
+    (* Called from the clock interrupt routine.  We check whether the	*)
+    (* running task has used its time quota, and if so switch to the	*)
+    (* next ready task.  Remark: it will sometimes happen that the	*)
+    (* current task has used up its time quota, but that all ready	*)
+    (* tasks have a lower priority than the current task.  In that	*)
+    (* case, the end result of the "task switch" will be that the	*)
+    (* current task gets its time quota refreshed and continues running.*)
+
+    (* This procedure does nothing is time-slicing is disabled.		*)
+
+    VAR savedPSW: CARDINAL;
+
+    BEGIN
+	IF TimeSlicingEnabled THEN
+	    savedPSW := EnterKernel();
+	    WITH CurrentTask^ DO
+		DEC (TimeLeft);
+		IF TimeLeft <= 0 THEN
+		    ReadyList[priority] := ReadyList[priority]^.next;
+		    RunNextTask;
+		END (*IF*);
+	    END (*WITH*);
+	    LeaveKernel (savedPSW);
+	END (*IF*);
+    END TimeSliceCheck;
+
+(************************************************************************)
+(*			    TASK TERMINATION				*)
+(************************************************************************)
+
+PROCEDURE TaskExit;
+
+    (* Removes the currently running task from the system, and performs	*)
+    (* a task switch to the next ready task.				*)
+    (* There is normally no need for a task to call this procedure,	*)
+    (* because it is automatically called when the task code "falls out	*)
+    (* the bottom" by executing its final procedure return.  The stack	*)
+    (* is set up, at the time a task is created, in such a way that	*)
+    (* TaskExit will be entered at that time.				*)
+
+    VAR savedPSW: CARDINAL;
+
+    BEGIN
+	savedPSW := EnterKernel();
+	WITH CurrentTask^ DO
+	    IF FirstLock <> NIL THEN
+		ReleaseAllLocks;
+	    END (*IF*);
+
+	    (* The following section is temporarily commented out,	*)
+	    (* because what is needed is a little more complex than	*)
+	    (* what is shown here.  This is just a crude first		*)
+	    (* approximation to remind me to look at this issue later.	*)
+	    (* If this code is run by an interrupt task then		*)
+	    (* CurrentTask doesn't even identify its descriptor.	*)
+	    (* The best solution might turn out to be to convert the	*)
+	    (* interrupt task to a non-interrupt task (i.e. disconnect	*)
+	    (* it from the interrupt mechanism) and then put it on the	*)
+	    (* ready list with an arrangement to call the "normal" exit	*)
+	    (* procedure when next it runs.				*)
+(*
+	    IF InterruptHandler THEN
+		DisconnectFromInterrupt (selector);
+		InterruptHandler := FALSE;
+	    END (*IF*);
+*)
+	    dead := TRUE;
+	    LeaveQueue (ReadyList[priority]);
+	END (*WITH*);
+	AddToQueue (UnusedDescriptors, CurrentTask);
+
+	(* Note that the current task is now not on any of the active	*)
+	(* kernel queues, and it never will be again.  Therefore, there	*)
+	(* will never be a return from the SelectAnotherTask call below.*)
+	(* This, plus the fact that we are still inside the kernel and	*)
+	(* cannot be interrupted, justifies our deallocation of the	*)
+	(* stack space even though the stack is about to be used to	*)
+	(* push the return address for the SelectAnotherTask call.	*)
+	(* (But this approach should perhaps be reviewed, since it does	*)
+	(* rely on assumptions about how DEALLOCATE works.)		*)
+
+	IF CurrentTask^.StackBase = NIL THEN
+	    Crash ("TaskExit called from main program");
+	ELSE
+	    DEALLOCATE (CurrentTask^.StackBase, StackSize);
+	    SelectAnotherTask;
+	END (*IF*);
+
+	(* We never reach this point.	*)
+
+    END TaskExit;
+
+(************************************************************************)
+(*			    TASK INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE UsingFloatingPoint;
+
+    (* Tells the kernel that this task is one which uses the floating	*)
+    (* point processor.							*)
+
+    BEGIN
+	IF InterruptTaskActive THEN
+	    Crash ("Interrupt task may not use floating point");
+	END (*IF*);
+	CurrentTask^.FloatingPointUser := TRUE;
+    END UsingFloatingPoint;
+
+(************************************************************************)
+
+PROCEDURE NotUsingFloatingPoint;
+
+    (* Tells the kernel that this task is one which does not use the	*)
+    (* floating point processor.  Calling this (optional) procedure	*)
+    (* speeds up task switching slightly, but it does put the onus on	*)
+    (* the caller to be certain that no floating point operations will	*)
+    (* be executed.							*)
+
+    BEGIN
+	CurrentTask^.FloatingPointUser := FALSE;
+    END NotUsingFloatingPoint;
+
+(************************************************************************)
+
+PROCEDURE MakeTask (tptr: Task;  StartAddress: PROC;
+			taskpriority: PriorityLevel;
+			AllowInterrupts: BOOLEAN;  taskname: NameString);
+
+    (* Initialises the stack for a new task, and fills in the fields of	*)
+    (* its task descriptor tptr^.  The remaining parameters are the	*)
+    (* start address of the task code; the priority of the new task;	*)
+    (* a flag which is TRUE iff the task is to be started with		*)
+    (* interrupts enabled; and a textual name for diagnostic purposes.	*)
+
+    (* Remark:  An important function of this procedure is to set up	*)
+    (* initial conditions for the task so that it looks as if it	*)
+    (* entered the ready list in the same way as, for example, a	*)
+    (* blocked task which has just become unblocked.  Procedure		*)
+    (* InnerKernel.TaskInit looks after most of that detail.		*)
+
+    BEGIN
+	WITH tptr^ DO
+
+	    (* Create the task stack, and give it the necessary		*)
+	    (* initial contents.					*)
+
+	    ALLOCATE (StackBase, StackSize);
+	    selector := TaskInit (StackBase, StackSize, AllowInterrupts,
+						TaskExit, StartAddress);
+	    FPselector := MakeFloatSaveSelector (selector);
+
+	    (* Set up the remaining task descriptor values.  Some of	*)
+	    (* the assignments below are redundant, but I believe that	*)
+	    (* filling in most of the fields is desirable in that it	*)
+	    (* makes this module more readable and guards against	*)
+	    (* strange bugs being introduced in future revisions.	*)
+
+	    name := taskname;
+	    priority := taskpriority;
+	    WaitingFor := NIL;  FirstLock := NIL;
+	    IF TimeSlicingEnabled THEN
+		TimeLeft := timequota[priority];
+	    ELSE
+		TimeLeft := 0;
+	    END (*IF*);
+	    InterruptHandler := FALSE;  dead := FALSE;  sleeping := FALSE;
+	    nextsleeper := NIL;
+	    FloatingPointUser := TRUE;
+	    InterruptNo := 0;
+
+	    (* Save the creator's floating point state in the save area	*)
+	    (* of the new task, to ensure that the new task starts with	*)
+	    (* a meaningful floating point state.  Unfortunately the	*)
+	    (* NPXsave seems to reset the floating point hardware	*)
+	    (* to an undesired default, so we must restore the state	*)
+	    (* again to get back where we were.				*)
+
+	    NPXsave (FPselector);  NPXrestore (FPselector);
+
+	END (*WITH*);
+
+    END MakeTask;
+
+(************************************************************************)
+
+PROCEDURE CreateTask (StartAddress: PROC;  taskpriority: PriorityLevel;
+						taskname: NameString);
+
+    (* Must be called to introduce a task to the system. The first	*)
+    (* parameter, which should be the name of a procedure containing	*)
+    (* the task code, gives the starting address.  The second parameter	*)
+    (* is the task's base priority.  If this task has a higher priority	*)
+    (* than its creator, it will run immediately.  Otherwise, it	*)
+    (* becomes ready.							*)
+    (* The effective priority of a task can be higher than its base	*)
+    (* priority, as the result of priority inheritance.  This happens	*)
+    (* when the task holds a lock on which a higher-priority task is	*)
+    (* waiting.								*)
+
+    VAR tptr: Task;
+	savedPSW: CARDINAL;
+	
+    BEGIN
+	savedPSW := EnterKernel();
+	tptr := UnusedDescriptors;
+	IF tptr = NIL THEN
+	    Crash ("Too many tasks created");
+	END (*IF*);
+	MakeTask (tptr, StartAddress, taskpriority, TRUE, taskname);
+	tptr^.FloatingPointUser := TRUE;
+	MarkAsReady (UnusedDescriptors);
+	LeaveKernel (savedPSW);
+    END CreateTask;
+
+(************************************************************************)
+(*		PROCEDURES TO DEAL WITH INTERRUPT TASKS			*)
+(************************************************************************)
+
+PROCEDURE CreateInterruptTask (InterruptNumber: CARDINAL;
+				StartAddress: PROC;  taskname: NameString);
+
+    (* Introduces an interrupt task to the system.  The first parameter	*)
+    (* is the hardware-defined interrupt number, and the second is the	*)
+    (* address of the procedure whose code is the interrupt handler.	*)
+    (* An interrupt task differs from an ordinary task in that, when it	*)
+    (* is not running, it is idle rather than ready, and the dispatcher	*)
+    (* does not consider it to be among the tasks eligible to run.	*)
+    (* (It is run by a task switch which is made directly by the	*)
+    (* assembly language code which fields the interrupt).  When the	*)
+    (* interrupt task has responded to the interrupt, it must call	*)
+    (* procedure WaitForInterrupt to put itself back in the idle state.	*)
+    (* On the next interrupt, it will continue from just after the call	*)
+    (* to WaitForInterrupt.  Normally, therefore, the interrupt task	*)
+    (* will be written as an infinite loop.  If for any reason the	*)
+    (* interrupt task exits by falling out of the bottom of its code,	*)
+    (* it will be destroyed in the same way as a normal task which	*)
+    (* terminates.  That could be fatal, unless steps have been taken	*)
+    (* to reset the interrupt vector.					*)
+
+    VAR ITptr: Task;  savedPSW: CARDINAL;
+
+    BEGIN
+	savedPSW := EnterKernel();
+
+	IF UnusedDescriptors = NIL THEN
+	    Crash ("Too many tasks created");
+	END (*IF*);
+
+	ITptr := TakeFromQueue (UnusedDescriptors);
+	MakeTask (ITptr, StartAddress, MAX(PriorityLevel), FALSE, taskname);
+	WITH ITptr^ DO
+	    InterruptHandler := TRUE;
+	    FloatingPointUser := FALSE;
+	    InterruptNo := InterruptNumber;
+	END (*WITH*);
+
+	(* Now start the interrupt task and connect it to the desired	*)
+	(* interrupt.  This operation includes executing the task's	*)
+	(* initialisation code, i.e. everything up to its first call to	*)
+	(* procedure WaitForInterrupt.					*)
+
+	InterruptTaskActive := TRUE;
+	StartInterruptTask (ITptr^.selector, InterruptNumber);
+
+	(* When we get back to here, the interrupt task has run to its	*)
+	(* first call to WaitForInterrupt, and InterruptTaskActive is	*)
+	(* FALSE again.							*)
+
+	LeaveKernel (savedPSW);
+	
+    END CreateInterruptTask;
+
+(************************************************************************)
+
+PROCEDURE KillInterruptTask (InterruptNumber: CARDINAL);
+
+    (* Removes an interrupt task from the system. *)
+
+    VAR k: TaskNumber;  found: BOOLEAN;
+
+    BEGIN
+	k := MaxTaskNumber;
+	REPEAT
+	    WITH TaskTable[k] DO
+		found := InterruptHandler AND NOT dead
+				AND (InterruptNo = InterruptNumber);
+	    END (*WITH*);
+	    DEC (k);
+	UNTIL found OR (k = 0);
+	IF found THEN
+	    INC (k);
+	    WITH TaskTable[k] DO
+		DisconnectFromInterrupt (selector);
+		InterruptHandler := FALSE;  dead := TRUE;
+		DEALLOCATE (StackBase, StackSize);
+	    END (*WITH*);
+	    AddToQueue (UnusedDescriptors, ADR(TaskTable[k]));
+	END (*IF*);
+    END KillInterruptTask;
+
+(************************************************************************)
+
+PROCEDURE WaitForInterrupt;
+
+    (* Called by an interrupt task, to make itself dormant until the	*)
+    (* next interrupt comes along.  It is not necessary to specify	*)
+    (* the interrupt number, since this was fixed at the time the	*)
+    (* interrupt task was created.					*)
+
+    VAR savedPSW: CARDINAL;
+
+    BEGIN
+	savedPSW := EnterKernel();
+	IF NOT InterruptTaskActive THEN
+	    Crash ("Normal task has called WaitForInterrupt");
+	END (*IF*);
+
+	(* Procedure IOTransfer performs a task switch from the		*)
+	(* interrupt task to the interrupted task, whose state was	*)
+	(* saved at the time the interrupt occurred.			*)
+
+	InterruptTaskActive := FALSE;
+	IOTransfer;
+
+	(* We return to this point after the next interrupt.	*)
+	(* Return to the interrupt task.			*)
+	
+	InterruptTaskActive := TRUE;
+	LeaveKernel (savedPSW);
+
+    END WaitForInterrupt;
+
+(************************************************************************)
+(*			CREATING AND DESTROYING LOCKS			*)
+(************************************************************************)
+
+PROCEDURE CreateLock (VAR (*OUT*) L: Lock);
+
+    (* Creates a new lock.	*)
+
+    VAR savedPSW: CARDINAL;
+
+    BEGIN
+	savedPSW := EnterKernel();
+	NEW (L);
+	WITH L^ DO
+	    Locked := FALSE;  Holder := NIL;
+	    next := NIL;  previous := NIL;
+	END (*WITH*);
+	LeaveKernel (savedPSW);
+    END CreateLock;
+
+(************************************************************************)
+
+PROCEDURE DestroyLock (VAR (*INOUT*) L: Lock);
+
+    (* Disposes of a lock.	*)
+
+    VAR savedPSW: CARDINAL;
+
+    BEGIN
+	savedPSW := EnterKernel();
+
+	(* It is legitimate for a task to obtain L before destroying	*)
+	(* it, in which case we must remove L from the list of locks	*)
+	(* held by this task.  However we leave the Locked field set in	*)
+	(* case some task still has a dangling pointer to this lock.	*)
+
+	WITH L^ DO
+	    IF Holder <> NIL THEN
+		IF previous = NIL THEN Holder^.FirstLock := next
+		ELSE previous^.next := next;
+		END (*IF*);
+		IF next <> NIL THEN
+		next^.previous := previous;
+		END (*IF*);
+	    END (*IF*);
+	    Locked := TRUE;
+	END (*WITH*);
+	DISPOSE (L);
+	LeaveKernel (savedPSW);
+    END DestroyLock;
+
+(************************************************************************)
+(*			     OBTAINING A LOCK				*)
+(************************************************************************)
+
+PROCEDURE Obtain (L: Lock);
+
+    (* Obtains lock L, waiting if necessary.	*)
+
+    VAR Blocker: Task;  M: Lock;
+	savedPSW: CARDINAL;
+
+    BEGIN
+	savedPSW := EnterKernel();
+	IF L^.Locked THEN
+
+	    (* Work out the blocker of the current task.  Note: in an	*)
+	    (* earlier version of this module I was able to avoid the	*)
+	    (* loop below by keeping a BlockedBy field in each task	*)
+	    (* descriptor; but it turned out to be more trouble than it	*)
+	    (* was worth to update the BlockedBy information when a	*)
+	    (* lock was released.  It's less expensive to incur the	*)
+	    (* penalty here and keep the Release code simple.  In any	*)
+	    (* case the penalty is not severe - it would take a really	*)
+	    (* baroque example to slow us down here.			*)
+
+	    M := L;
+	    REPEAT
+		Blocker := M^.Holder;  M := Blocker^.WaitingFor;
+	    UNTIL (M = NIL) OR NOT M^.Locked;
+
+	    IF Blocker = CurrentTask THEN
+		Crash ("Deadlock detected");
+	    END (*IF*);
+
+	    CurrentTask^.WaitingFor := L;
+	    IF TimeSlicingEnabled THEN
+		Blocker^.TimeLeft := timequota[Blocker^.priority];
+	    END (*IF*);
+	    TaskSwitch (Blocker);
+
+	    (* When execution resumes at this point (via	*)
+	    (* RunNextTask), L^.Locked will be FALSE.		*)
+
+	    CurrentTask^.WaitingFor := NIL;
+
+	END (*IF*);
+
+	WITH L^ DO
+	    Locked := TRUE;  Holder := CurrentTask;
+
+	    (* Add L to the list of locks held by CurrentTask. *)
+
+	    previous := NIL;
+	    next := CurrentTask^.FirstLock;
+	    IF next <> NIL THEN
+		next^.previous := L;
+	    END (*IF*);
+	    CurrentTask^.FirstLock := L;
+
+	END (*WITH*);
+	LeaveKernel (savedPSW);
+
+    END Obtain;
+
+(************************************************************************)
+(*			     RELEASING A LOCK				*)
+(************************************************************************)
+
+PROCEDURE Release (L: Lock);
+
+    (* Releases lock L.  This implicitly changes the "blocked by"	*)
+    (* status of all tasks blocked by the current task, but it turns	*)
+    (* out to be faster to get procedure RunNextTask to recheck the	*)
+    (* blocking status than to keep track of "blocked by" information.	*)
+    (* All we need to know here is whether we've inherited a priority	*)
+    (* greater than our base priority.  If so, we must have been	*)
+    (* blocking another task which should run now - we can trust	*)
+    (* RunNextTask to work out the identity of that task.		*)
+
+    VAR savedPSW: CARDINAL;
+
+    BEGIN
+	savedPSW := EnterKernel();
+	WITH L^ DO
+
+	    (* Remove L from the list of locks held by CurrentTask. *)
+
+	    IF previous = NIL THEN CurrentTask^.FirstLock := next
+	    ELSE previous^.next := next;
+	    END (*IF*);
+	    IF next <> NIL THEN
+		next^.previous := previous;
+	    END (*IF*);
+
+	    (* Mark the lock as free. *)
+	    Locked := FALSE;  Holder := NIL;
+
+	END (*WITH*);
+
+	(* If we have inherited an augmented priority, a task of higher	*)
+	(* priority might just have become unblocked.			*)
+
+	IF CurrentTask^.priority < CurrentPriority THEN
+	    RunNextTask;
+	END (*IF*);
+
+	LeaveKernel (savedPSW);
+    END Release;
+
+(************************************************************************)
+
+PROCEDURE ReleaseAllLocks;
+
+    (* Releases all locks held by the current task.  Application-level	*)
+    (* tasks normally won't need to call this procedure; it is		*)
+    (* provided to support the system shutdown function and for things	*)
+    (* like "emergency abort" operations.				*)
+
+    VAR savedPSW: CARDINAL;
+
+    BEGIN
+	savedPSW := EnterKernel();
+	WHILE CurrentTask^.FirstLock <> NIL DO
+	    Release (CurrentTask^.FirstLock);
+	END (*WHILE*);
+	LeaveKernel (savedPSW);
+    END ReleaseAllLocks;
+
+(************************************************************************)
+(*		PROCEDURES TO DEAL WITH SLEEPING TASKS			*)
+(************************************************************************)
+
+VAR SleepQueueHead: Task;
+
+    (* SleepQueueHead points to a priority queue of descriptors for	*)
+    (* tasks which are sleeping.  The first element of the list has the	*)
+    (* time-to-go in its TimeLeft field.  For subsequent elements,	*)
+    (* TimeLeft records the difference between its time-to-go and that	*)
+    (* of the preceding list element.  There are some situations in	*)
+    (* which the delay specification cannot be met exactly, so it is	*)
+    (* possible for the TimeLeft field to go negative.			*)
+
+(************************************************************************)
+(*			SLEEP QUEUE INITIALISATION			*)
+(************************************************************************)
+
+PROCEDURE InitialiseSleepQueue;
+
+    (* Creates an initially empty queue of sleeping tasks.	*)
+
+    BEGIN
+	SleepQueueHead := NIL;
+    END InitialiseSleepQueue;
+
+(************************************************************************)
+(*			'PUT-ME-TO-SLEEP' PROCEDURES			*)
+(************************************************************************)
+
+PROCEDURE InsertCurrentTaskInSleepQueue (sleeptime: INTEGER);
+
+    (* Inserts the current task into the sleep queue.  This queue is a	*)
+    (* linear list.  The time to sleep is stored in incremental form:	*)
+    (* for every task on the list except the first, the TimeLeft field	*)
+    (* in the task descriptor holds the difference between the time to	*)
+    (* go for this task and that of the task ahead of it in the list.	*)
+    (* This means that the clock interrupt routine need only decrement	*)
+    (* the TimeLeft field of the first sleeping task.			*)
+
+    VAR previous, following: Task;
+
+    BEGIN
+	CurrentTask^.sleeping := TRUE;
+
+	(* Find the correct place in the sleep queue. *)
+
+	following := SleepQueueHead;  previous := NIL;
+	LOOP
+	    IF following = NIL THEN EXIT(*LOOP*) END (*IF*);
+	    IF sleeptime < following^.TimeLeft THEN EXIT(*LOOP*)
+	    END (*IF*);
+	    previous := following;  following := following^.nextsleeper;
+	    DEC (sleeptime, previous^.TimeLeft);
+	END (*LOOP*);
+
+	(* Insert the task descriptor for this task between	*)
+	(* previous^ and following^.				*)
+
+	IF previous = NIL THEN
+	    SleepQueueHead := CurrentTask;
+	ELSE
+	    previous^.nextsleeper := CurrentTask;
+	END (*IF*);
+	CurrentTask^.nextsleeper := following;
+
+	(* Fix the TimeLeft fields for the current and following tasks.	*)
+
+	CurrentTask^.TimeLeft := sleeptime;
+	IF following <> NIL THEN
+	    DEC (following^.TimeLeft, sleeptime);
+	END (*IF*);
+
+    END InsertCurrentTaskInSleepQueue;
+
+(************************************************************************)
+
+PROCEDURE RemoveCurrentFromSleepQueue;
+
+    (* Removes the current task from the sleep queue.	*)
+
+    VAR previous, current: Task;
+
+    BEGIN
+	previous := NIL;  current := SleepQueueHead;
+	WHILE current <> CurrentTask DO
+	    previous := current;  current := current^.nextsleeper;
+	END (*WHILE*);
+	IF current^.nextsleeper <> NIL THEN
+	    INC (current^.nextsleeper^.TimeLeft, current^.TimeLeft);
+	END (*IF*);
+	IF previous = NIL THEN
+	    SleepQueueHead := current^.nextsleeper;
+	ELSE
+	    previous^.nextsleeper := current^.nextsleeper;
+	END (*IF*);
+	CurrentTask^.sleeping := FALSE;
+    END RemoveCurrentFromSleepQueue;
+
+(************************************************************************)
+
+PROCEDURE RecheckPriorities;
+
+    (* This procedure is called, just before leaving the kernel, by a	*)
+    (* sleeping task which has been woken up.  The task is running but	*)
+    (* has not yet been put on the list of active tasks.  If this task	*)
+    (* has a high enough priority, we put it on the active list and let	*)
+    (* it continue to run.  Otherwise, we mark it as ready but switch	*)
+    (* back to the task which it preempted.				*)
+
+    VAR thispriority: PriorityLevel;
+
+    BEGIN
+	thispriority := CurrentTask^.priority;
+	IF thispriority > CurrentPriority THEN
+	    AddToQueue (ReadyList[thispriority], CurrentTask);
+	    CurrentPriority := thispriority;
+	    IF TimeSlicingEnabled THEN
+		CurrentTask^.TimeLeft := timequota[thispriority];
+	    ELSE
+		CurrentTask^.TimeLeft := 0;
+	    END (*IF*);
+	ELSE
+	    AddToQueue (ReadyList[thispriority], CurrentTask);
+	    TaskSwitch (LastTask);
+	END (*IF*);
+    END RecheckPriorities;
+
+(************************************************************************)
+
+PROCEDURE Delay (sleeptime: INTEGER);
+
+    (* Puts the calling task to sleep for approximately the specified	*)
+    (* number of clock ticks.  The time delay is necessarily		*)
+    (* approximate, because (a) the clock might tick over when we are	*)
+    (* in the middle of this procedure; (b) after the expiration of the	*)
+    (* delay period, the sleeping task is made ready, but this does not	*)
+    (* guarantee that it will run immediately.				*)
+
+    VAR savedPSW: CARDINAL;
+
+    BEGIN
+	savedPSW := EnterKernel();
+	IF CurrentTask^.FirstLock <> NIL THEN
+	    Crash ("Task sleeping while holding a lock");
+	END (*IF*);
+	LeaveQueue (ReadyList[CurrentTask^.priority]);
+	InsertCurrentTaskInSleepQueue (sleeptime);
+	SelectAnotherTask;
+
+	(* We resume at this point after waking up.		*)
+
+	RecheckPriorities;
+	LeaveKernel (savedPSW);
+
+    END Delay;
+
+(************************************************************************)
+(*		    CLOCK TICK HANDLER FOR SLEEPING TASKS		*)
+(************************************************************************)
+
+PROCEDURE CheckSleepers;
+
+    (* Called from the clock interrupt task.  We check whether a	*)
+    (* sleeping task needs to be woken up, and wake it up if so.	*)
+
+    (* Note: this procedure typically needs no explicit critical	*)
+    (* section protection.  It is called from the clock interrupt	*)
+    (* handler, therefore runs with interrupts disabled.  We prefer,	*)
+    (* however, to stick to the rule that all kernel procedures are	*)
+    (* protected via EnterKernel and LeaveKernel, since it makes the	*)
+    (* kernel easier to check for correctness.  This convention also	*)
+    (* helps portability.  It means, for example, that this procedure	*)
+    (* will still work in the multiprocessor case, or in the case where	*)
+    (* the clock interrupt routine does not disable all interrupts.	*)
+
+    VAR	first, second: Task;
+	savedPSW: CARDINAL;
+
+    BEGIN
+	savedPSW := EnterKernel();
+	first := SleepQueueHead;
+	IF first <> NIL THEN
+
+	    (* update sleeping time of head of sleep queue *)
+
+	    DEC (first^.TimeLeft);
+
+	    (* Is it time to wake up first sleeping task? *)
+
+	    IF first^.TimeLeft <= 0 THEN
+
+		(* Yes.  Correct sleeping time of second sleeper. *)
+
+		second := first^.nextsleeper;
+		SleepQueueHead := second;
+		IF second <> NIL THEN
+		    INC (second^.TimeLeft, first^.TimeLeft);
+		END (* IF second <> NIL *);
+
+		(* Wake up the first sleeping task.  Because of		*)
+		(* complications when this task is still on a semaphore	*)
+		(* blocked list, we must run the task immediately	*)
+		(* rather than simply make it ready.  The task is not	*)
+		(* yet put on the list of active tasks, because it	*)
+		(* might be preempting a task of higher priority.	*)
+		(* Before the newly awakened task leaves the kernel, it	*)
+		(* will call procedure RecheckPriorities to clean up	*)
+		(* such details.					*)
+
+		first^.sleeping := FALSE;
+		TaskSwitch (first);
+
+	    END (* IF sleeping time has expired *)
+
+	END (* IF sleep queue not empty *);
+
+	LeaveKernel (savedPSW);
+
+    END CheckSleepers;
+
+(************************************************************************)
+(*			TASK QUEUEING WITH TIMEOUT			*)
+(************************************************************************)
+
+PROCEDURE QueueWithTimeout (VAR (*INOUT*) KQ: TaskQueue;
+					TimeLimit: INTEGER): BOOLEAN;
+
+    (* Like procedure QueueAndSwitchTasks, this procedure puts the	*)
+    (* current task on the tail of list KQ, and gives control to the	*)
+    (* highest-priority ready task.  The difference is that we allow	*)
+    (* this task to remain on KQ for at most TimeLimit timer ticks.	*)
+    (* If the task is removed from KQ before the time limit expires,	*)
+    (* we return a result of FALSE.  If the time limit expires first,	*)
+    (* we remove the queued task from KQ anyway, and make it runnable,	*)
+    (* and return a result of TRUE when it does run.			*)
+    (* Note: this procedure may be called only from inside the kernel.	*)
+    (* While being timed out, a task is simultaneously on two kernel	*)
+    (* queues: the specified KQ, and the Sleep queue.  It will be	*)
+    (* removed from one of these - which one depends, of course, on	*)
+    (* whether the time limit expires - by some other kernel action,	*)
+    (* and at that stage we must remove it from the other queue before	*)
+    (* it leaves the kernel.  If we did not guarantee indivisibility	*)
+    (* of the operation of removing the task from the two queues, we	*)
+    (* would run the risk of putting the same task onto the ready	*)
+    (* structure twice.							*)
+
+    VAR TimedOut: BOOLEAN;
+
+    BEGIN
+	InsertCurrentTaskInSleepQueue (TimeLimit);
+	QueueAndSwitchTasks (KQ);
+
+	(* When execution of this task resumes at this point, we have	*)
+	(* been activated either by being removed from KQ or by a timer	*)
+	(* event (but never both simultaneously).  That is, we have	*)
+	(* been removed from one queue, and must now remove ourself	*)
+	(* from the other.						*)
+
+	TimedOut := NOT CurrentTask^.sleeping;
+	IF TimedOut THEN
+	    LeaveQueue (KQ);
+	ELSE
+	    RemoveCurrentFromSleepQueue;
+	END (*IF*);
+
+	(* Additional complication: the kernel procedures have so far	*)
+	(* given the newly awakened task preferential treatment, to	*)
+	(* allow it to remove itself from both queues before leaving	*)
+	(* the kernel.  If this has caused a higher-priority task to be	*)
+	(* preempted, we must give the processor back.			*)
+
+	RecheckPriorities;
+	RETURN TimedOut;
+
+    END QueueWithTimeout;
+
+(************************************************************************)
+(*				PMOS SHUTDOWN				*)
+(************************************************************************)
+
+PROCEDURE ShutDown;
+
+    (* Kills all remaining interrupt tasks, and partially inhibits	*)
+    (* multitasking by giving the current task - which is running the	*)
+    (* program termination code - the maximum possible priority.  This	*)
+    (* still allows the possibility of a task switch caused by		*)
+    (* something like a semaphore Wait; but it does ensure that the	*)
+    (* mere unblocking of another task, for example by releasing a	*)
+    (* Lock, will not cause a task switch.  Notice too that time	*)
+    (* slicing is irrelevant beyond this point, because the timer	*)
+    (* interrupt task will be disabled.					*)
+
+    VAR k: TaskNumber;  savedPSW: CARDINAL;
+
+    BEGIN
+	savedPSW := EnterKernel();
+
+	(* Remove any interrupt handlers which might still be active.	*)
+	(* The reason for doing this backwards is that this is more	*)
+	(* likely to work in the case of multiple handlers for the	*)
+	(* same interrupt number.  At some time I should look for a	*)
+	(* more robust solution for this case.				*)
+
+	FOR k := MaxTaskNumber TO 0 BY -1 DO
+	    WITH TaskTable[k] DO
+		IF InterruptHandler AND NOT dead THEN
+		    DisconnectFromInterrupt (selector);
+		    InterruptHandler := FALSE;  dead := TRUE;
+		    DEALLOCATE (StackBase, StackSize);
+		    AddToQueue (UnusedDescriptors, ADR(TaskTable[k]));
+		END (*IF*);
+	    END (*WITH*);
+	END (*FOR*);
+
+	(* Increase the priority of the current task. *)
+
+	LeaveQueue (ReadyList[CurrentTask^.priority]);
+	CurrentPriority := MAX(PriorityLevel);
+	CurrentTask^.priority := CurrentPriority;
+	AddToQueue (ReadyList[CurrentPriority], CurrentTask);
+	LeaveKernel (savedPSW);
+
+    END ShutDown;
+
+(************************************************************************)
+(*			    MODULE INITIALISATION			*)
+(************************************************************************)
+
+PROCEDURE InitialiseTaskControl;
+
+    (* Must be called before any tasks are created, to initialise the	*)
+    (* task control data structures.					*)
+
+    VAR p: PriorityLevel;  j: TaskNumber;
+	k: InterruptType;
+	quota: CARDINAL;
+
+    BEGIN
+	InterruptTaskActive := FALSE;
+
+	(* Initialise the timequota array. *)
+
+	IF TimeSlicingEnabled THEN
+	    quota := 1;
+	    FOR p := MaxPriority TO 1 BY -1 DO
+		timequota[p] := quota;  quota := 2*quota;
+	    END (*FOR*);
+	    timequota[0] := 32767;
+	END (*IF*);
+
+	(* Collect all the unused task descriptors into a linear list.	*)
+
+	CreateQueue (UnusedDescriptors);
+	FOR j := 0 TO MaxTaskNumber DO
+	    TaskTable[j].dead := TRUE;
+	    TaskTable[j].sleeping := FALSE;
+	    AddToQueue (UnusedDescriptors, ADR (TaskTable[j]) );
+	END (*FOR*);
+
+	(* The active list and the sleep queue are initially empty.  *)
+
+	FOR p := 0 TO MaxPriority DO
+	    CreateQueue (ReadyList[p]);
+	END (*FOR*);
+	InitialiseSleepQueue;
+
+	(* Create a descriptor for the current task, i.e. for the task	*)
+	(* which called this procedure.  We give it a low priority	*)
+	(* because this task is often running the background jobs.  We	*)
+	(* also set its StackBase to NIL because the stack for this	*)
+	(* task already exists, i.e. it's not created by this module.	*)
+	
+	LastTask := NIL;
+	CurrentTask := TakeFromQueue (UnusedDescriptors);
+	CurrentPriority := 1;
+	WITH CurrentTask^ DO
+	    name := "Main program";
+	    priority := CurrentPriority;
+	    WaitingFor := NIL;  FirstLock := NIL;
+	    FPselector := MakeFloatSaveSelector (InitMainTask());
+	    StackBase := NIL;
+	    InterruptHandler := FALSE;  dead := FALSE;
+	    FloatingPointUser := TRUE;  sleeping := FALSE;
+	    InterruptNo := 0;
+	END (*WITH*);
+	AddToQueue (ReadyList[CurrentPriority], CurrentTask);
+	
+	(* Create the null task.  It will not run immediately, because	*)
+	(* the current (initialisation) task has higher priority.	*)
+
+	CreateTask (NullTask, 0, "Null task");
+
+	(* We have a working operating system.  It is now safe to	*)
+	(* enable clock interrupts, and to call CreateTask to introduce	*)
+	(* more tasks to the system.  Device interrupts can be enabled	*)
+	(* when the device drivers are installed.			*)
+
+    END InitialiseTaskControl;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+BEGIN
+    InitialiseTaskControl;
+    SetTerminationProcedure (ShutDown);
+END TaskControl.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/terminat.def b/examples/Modula-2_Libraries/PMOS/sources/general/terminat.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/terminat.def
@@ -0,0 +1,60 @@
+DEFINITION MODULE TerminationControl;
+
+	(****************************************************************)
+	(*								*)
+	(*	     Support for program termination procedures		*)
+	(*								*)
+	(*  The facility provided is that the caller can specify any	*)
+	(*  number of parameterless procedures to be called when the	*)
+	(*  program terminates.  This allows each module which needs it	*)
+	(*  to have a final cleanup procedure to do things like		*)
+	(*  releasing allocated memory, closing open files, etc.  The	*)
+	(*  termination procedures are called in a last-in first-out	*)
+	(*  order, which generally means that the higher-level modules	*)
+	(*  are dealt with before lower-level modules (which is usually	*)
+	(*  what we want).						*)
+	(*								*)
+	(*  Multipass termination processing is supported by allowing	*)
+	(*  any termination handler to itself install another handler.	*)
+	(*  In such a case the new handler is not executing until the	*)
+	(*  current list of waiting handlers is exhausted.  Multipass	*)
+	(*  processing is needed when, for example, part of a module	*)
+	(*  shutdown cannot be completed until it is guaranteed that	*)
+	(*  all multitasking has ceased.				*)
+	(*								*)
+	(*	Programmer:	P. Moylan				*)
+	(*	Last edited:	3 February 1994				*)
+	(*	Status:		OK					*)
+	(*								*)
+	(*  WARNING: the implementation of this facility is heavily	*)
+	(*  system-dependent; some systems do not provide any way to	*)
+	(*  regain control at program termination.			*)
+	(*								*)
+	(****************************************************************)
+
+PROCEDURE SetTerminationProcedure (TP: PROC);
+
+    (* Adds TP to the list of procedures which will be called just	*)
+    (* before program termination.  The list is ordered such that the	*)
+    (* last procedure added will be the first one called.  Exception:	*)
+    (* if termination is already in progress when this procedure is	*)
+    (* called, then TP will not be called until all of the existing	*)
+    (* termination procedures have been called.  This rule permits	*)
+    (* multi-pass termination processing, where necessary, by letting	*)
+    (* termination procedures themselves install more termination	*)
+    (* procedures.							*)
+
+PROCEDURE Crash (message: ARRAY OF CHAR);
+
+    (* Terminates the program with an error report.	*)
+
+PROCEDURE TerminationMessage (VAR (*OUT*) message: ARRAY OF CHAR): BOOLEAN;
+
+    (* Returns the message supplied by the caller of the Crash		*)
+    (* procedure.  The function result is TRUE if such a message	*)
+    (* exists, and FALSE if Crash was never called.			*)
+
+(*<TopSpeed3*) (*# restore *) (*>*)
+
+END TerminationControl.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/terminat.mod b/examples/Modula-2_Libraries/PMOS/sources/general/terminat.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/terminat.mod
@@ -0,0 +1,197 @@
+IMPLEMENTATION MODULE TerminationControl;
+
+	(********************************************************)
+	(*							*)
+	(*	Support for program termination procedures.	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM Storage IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+(*<TopSpeed*)
+FROM Lib IMPORT
+    (* proc *)	Terminate;
+(*>*)
+
+(*<FST
+FROM System IMPORT
+    (* proc *)	TermProcedure, Terminate;
+>*)
+
+FROM InnerKernel IMPORT
+    (* proc *)	PrepareForShutdown;
+
+FROM MiscPMOS IMPORT
+    (* proc *)	CopyString;
+
+(************************************************************************)
+
+TYPE
+    (* We have one ListElement for each termination procedure.	*)
+
+    ListPointer = POINTER TO ListElement;
+    ListElement =   RECORD
+			Procedure: PROC;
+			next: ListPointer;
+		    END (*RECORD*);
+
+VAR
+    (* ListHead and ListTail point to the first and last elements,	*)
+    (* respectively, of the list of termination procedures.		*)
+
+    ListHead, ListTail: ListPointer;
+
+    (* The termination handler which was present before we installed	*)
+    (* our own.								*)
+
+    OriginalHandler: PROC;
+
+    (* Text message supplied by caller of procedure Crash.	*)
+
+    CrashMessage: ARRAY [0..79] OF CHAR;
+
+    (* MessagePresent = TRUE iff procedure Crash has been called.	*)
+
+    MessagePresent: BOOLEAN;
+
+    (* Flag to say whether termination processing has commenced.	*)
+
+    TerminationInProgress: BOOLEAN;
+
+(************************************************************************)
+(*		UPDATING THE LIST OF TERMINATION PROCEDURES		*)
+(************************************************************************)
+
+PROCEDURE SetTerminationProcedure (TP: PROC);
+
+    (* Adds TP to the list of procedures which will be called just	*)
+    (* before program termination.  The list is ordered such that the	*)
+    (* last procedure added will be the first one called.  Exception:	*)
+    (* if termination is already in progress when this procedure is	*)
+    (* called, then TP will not be called until all of the existing	*)
+    (* termination procedures have been called.  This rule permits	*)
+    (* multi-pass termination processing, where necessary, by letting	*)
+    (* termination procedures themselves install more termination	*)
+    (* procedures.							*)
+
+    VAR OldHead, NewTail: ListPointer;
+
+    BEGIN
+	IF TerminationInProgress THEN
+
+	    (* Add the new list element to the tail of the list. *)
+
+	    NEW (NewTail);
+	    WITH NewTail^ DO
+		Procedure := TP;
+		next := NIL;
+	    END (*WITH*);
+	    IF ListTail = NIL THEN
+		ListHead := NewTail;
+	    ELSE
+		ListTail^.next := NewTail;
+	    END (*IF*);
+	    ListTail := NewTail;
+
+	ELSE
+
+	    (* Termination not already in progress.  Add the new item	*)
+	    (* to the head of the list, to give the desired LIFO order. *)
+
+	    OldHead := ListHead;
+	    NEW (ListHead);
+	    WITH ListHead^ DO
+		Procedure := TP;
+		next := OldHead;
+	    END (*WITH*);
+	    IF OldHead = NIL THEN
+		ListTail := ListHead;
+	    END (*IF*);
+
+	END (*IF*);
+
+    END SetTerminationProcedure;
+
+(************************************************************************)
+(*			THE ACTUAL TERMINATION HANDLER			*)
+(************************************************************************)
+
+PROCEDURE TerminationHandler;
+
+    (* This is the procedure which is called on program termination.	*)
+    (* It then calls all of the procedures which the user wants called.	*)
+
+    VAR OldHead: ListPointer;  UserProc: PROC;
+
+    BEGIN
+	TerminationInProgress := TRUE;
+
+	(* Work through the list of termination procedures.  Note that	*)
+	(* it's important to remove the termination handler from the	*)
+	(* list before calling it, to avoid recursive calls in case the	*)
+	(* handler itself triggers another termination.			*)
+
+	WHILE ListHead <> NIL DO
+	    UserProc := ListHead^.Procedure;
+	    OldHead := ListHead;  ListHead := ListHead^.next;
+	    DISPOSE (OldHead);
+	    UserProc;
+	END (*WHILE*);
+
+	(* Finally, call the system-level termination handler.	*)
+	
+	PrepareForShutdown;
+	(*<TopSpeed*) OriginalHandler(); (*>*)
+	(*<FST Terminate(0); >*)
+	
+    END TerminationHandler;
+
+(************************************************************************)
+(*			RAISING AN ERROR CONDITION			*)
+(************************************************************************)
+
+PROCEDURE Crash (message: ARRAY OF CHAR);
+
+    (* Terminates the program with an error report.	*)
+
+    BEGIN
+	CopyString (message, CrashMessage);
+	MessagePresent := TRUE;
+	TerminationHandler;
+    END Crash;
+
+(************************************************************************)
+(*			USER-CALLABLE ERROR REPORTING			*)
+(************************************************************************)
+
+PROCEDURE TerminationMessage (VAR (*OUT*) message: ARRAY OF CHAR): BOOLEAN;
+
+    (* Returns the message supplied by the caller of the Crash		*)
+    (* procedure.  The function result is TRUE if such a message	*)
+    (* exists, and FALSE if Crash was never called.			*)
+
+    BEGIN
+	IF MessagePresent THEN
+	    CopyString (CrashMessage, message);
+	    RETURN TRUE;
+	ELSE
+	    RETURN FALSE;
+	END (*IF*);
+    END TerminationMessage;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+BEGIN
+    ListHead := NIL;  ListTail := NIL;
+    TerminationInProgress := FALSE;  MessagePresent := FALSE;
+    (*<TopSpeed*) Terminate (TerminationHandler, OriginalHandler); (*>*)
+    (*<FST TermProcedure (TerminationHandler); >*)
+END TerminationControl.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/textline.def b/examples/Modula-2_Libraries/PMOS/sources/general/textline.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/textline.def
@@ -0,0 +1,33 @@
+DEFINITION MODULE TextLines;
+
+	(********************************************************)
+	(*							*)
+	(*  Drawing horizontal and vertical lines in text mode	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	22 June 1994			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM Windows IMPORT
+    (* type *)	Window;
+
+TYPE LineType = (none, single, double);
+
+PROCEDURE HLine (w: Window;  row, col1, col2: CARDINAL;  type: LineType);
+
+    (* Draws a horizontal line from (row,col1) to (row,col2).	*)
+
+PROCEDURE VLine (w: Window;  col, row1, row2: CARDINAL;  type: LineType);
+
+    (* Draws a vertical line from (row1,col) to (row2,col).	*)
+
+PROCEDURE Box (w: Window;  top, left, width, height: CARDINAL;
+							type: LineType);
+
+    (* Draws a rectangular box whose top left corner is at (top,left)	*)
+    (* and with the given width and height.				*)
+
+END TextLines.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/textline.mod b/examples/Modula-2_Libraries/PMOS/sources/general/textline.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/textline.mod
@@ -0,0 +1,215 @@
+IMPLEMENTATION MODULE TextLines;
+
+	(********************************************************)
+	(*							*)
+	(*  Drawing horizontal and vertical lines in text mode	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	25 November 1994		*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE;
+
+FROM Windows IMPORT
+    (* proc *)	ReadBack, SetCursor, WriteChar;
+
+FROM LowLevel IMPORT
+    (* proc *)	LSB, IORB, IANDB;
+
+(************************************************************************)
+(*			GLOBAL DECLARATIONS				*)
+(************************************************************************)
+
+TYPE
+    (* On PC-compatible machines, line graphics can be done with	*)
+    (* characters from the following range.				*)
+    (*		│┤╡╢╖╕╣║╗╝╜╛┐└┴┬├─┼╞╟╚╔╩╦╠═╬╧╨╤╥╙╘╒╓╫╪┘┌		*)
+
+    GraphicsCharRange = [CHR(179)..CHR(218)];
+
+    (* Internally, we represent a graphics character by a 4-tuple	*)
+    (* (N,E,S,W), where the components represent the north, east,	*)
+    (* south, and west sides of the character.  Each component is	*)
+    (* encoded as 0=nothing, 1=single, 2=double, 3=triple; and we pack	*)
+    (* all four as an 8-bit quantity.  Of course there's no hardware	*)
+    (* support for the triple-line case, but it simplifies the coding	*)
+    (* if we pretend that there is.					*)
+
+    PackedCode = BYTE;
+    EncodingTable = ARRAY PackedCode OF CHAR;
+    DecodingTable = ARRAY GraphicsCharRange OF PackedCode;
+
+CONST
+    (* The following table converts packed codes to characters.  The	*)
+    (* packed code should be read as NNEESSWW.				*)
+
+    CharTable = EncodingTable (
+
+		(* Codes 00000000..00001111 *)
+	' ','─','═','═','│','┐','╕','╕','║','╖','╗','╗','║','╖','╗','╗',
+		(* Codes 00010000..00011111 *)
+	'─','─','═','═','┌','┬','╤','╤','╓','╥','╦','╦','╓','╥','╦','╦',
+		(* Codes 00100000..00101111 *)
+	'═','═','═','═','╒','╤','╤','╤','╔','╦','╦','╦','╔','╦','╦','╦',
+		(* Codes 00110000..00111111 *)
+	'═','═','═','═','╒','╤','╤','╤','╔','╦','╦','╦','╔','╦','╦','╦',
+
+		(* Codes 01000000..01001111 *)
+	'│','┘','╛','╛','│','┤','╡','╡','║','╢','╣','╣','║','╢','╣','╣',
+		(* Codes 01010000..01011111 *)
+	'└','┴','╧','╧','├','┼','╪','╪','╟','╫','╬','╬','╟','╫','╬','╬',
+		(* Codes 01100000..01101111 *)
+	'╘','╧','╧','╧','╞','╪','╪','╪','╠','╬','╬','╬','╠','╬','╬','╬',
+		(* Codes 01110000..01111111 *)
+	'╘','╧','╧','╧','╞','╪','╪','╪','╠','╬','╬','╬','╠','╬','╬','╬',
+
+		(* Codes 10000000..10001111 *)
+	'║','╜','╝','╝','║','╢','╣','╣','║','╢','╣','╣','║','╢','╣','╣',
+		(* Codes 10010000..10011111 *)
+	'╙','╨','╩','╩','╟','╫','╬','╬','╟','╫','╬','╬','╟','╫','╬','╬',
+		(* Codes 10100000..10101111 *)
+	'╚','╩','╩','╩','╠','╬','╬','╬','╠','╬','╬','╬','╠','╬','╬','╬',
+		(* Codes 10110000..10111111 *)
+	'╚','╩','╩','╩','╠','╬','╬','╬','╠','╬','╬','╬','╠','╬','╬','╬',
+
+		(* Codes 11000000..11001111 *)
+	'║','╜','╝','╝','║','╢','╣','╣','║','╢','╣','╣','║','╢','╣','╣',
+		(* Codes 11010000..11011111 *)
+	'╙','╨','╩','╩','╟','╫','╬','╬','╟','╫','╬','╬','╟','╫','╬','╬',
+		(* Codes 11100000..11101111 *)
+	'╚','╩','╩','╩','╠','╬','╬','╬','╠','╬','╬','╬','╠','╬','╬','╬',
+		(* Codes 11110000..11111111 *)
+	'╚','╩','╩','╩','╠','╬','╬','╬','╠','╬','╬','╬','╠','╬','╬','╬');
+
+    (* The following table converts characters to packed codes.	*)
+
+    CodeTable = DecodingTable (
+		    44H,45H,46H,89H,09H,06H,8AH,88H,	(* │┤╡╢╖╕╣║ *)
+		    0AH,82H,81H,42H,05H,50H,51H,15H,	(* ╗╝╜╛┐└┴┬ *)
+		    54H,11H,55H,64H,98H,0A0H,28H,0A2H,	(* ├─┼╞╟╚╔╩ *)
+		    2AH,0A8H,22H,0AAH,62H,91H,26H,19H,	(* ╦╠═╬╧╨╤╥ *)
+		    90H,60H,24H,18H,99H,66H,41H,14H);	(* ╙╘╒╓╫╪┘┌ *)
+
+(************************************************************************)
+(*		     DECODING OF GRAPHICS CHARACTERS			*)
+(************************************************************************)
+
+PROCEDURE Decode (char: CHAR): PackedCode;
+
+    (* Converts a character to a PackedCode representation.	*)
+
+    TYPE CharSet = SET OF CHAR;
+
+    CONST GraphicsChars = CharSet
+			{MIN(GraphicsCharRange)..MAX(GraphicsCharRange)};
+
+    BEGIN
+	IF char IN GraphicsChars THEN
+	    RETURN CodeTable[char];
+	ELSE
+	    RETURN PackedCode(0);
+	END (*IF*);
+    END Decode;
+
+(************************************************************************)
+(*			 WRITING TO THE SCREEN				*)
+(************************************************************************)
+
+PROCEDURE PutChar (w: Window;  row, col: CARDINAL;
+				N, E, S, W: LineType;  mask: PackedCode);
+
+    (* Adds a new part of a line, described by (N,E,S,W), at location	*)
+    (* (row,col) in window w.  The mask is applied to the graphics	*)
+    (* character, if any, that is already present at that screen	*)
+    (* location: we can selectively remove parts of that character.	*)
+
+    VAR code: PackedCode;
+
+    BEGIN
+	(* Decode the existing character. *)
+
+	code := IANDB (Decode(ReadBack (w, row, col)), mask);
+
+	(* Encode and write the character for a combined code. *)
+
+	code := IORB (code, LSB(BYTE(N),6) + LSB(BYTE(E),4)
+				+ LSB(BYTE(S),2) + BYTE(W));
+	SetCursor (w, row, col);
+	WriteChar (w, CharTable[code]);
+
+    END PutChar;
+
+(************************************************************************)
+(*		    THE EXTERNALLY CALLABLE PROCEDURES			*)
+(************************************************************************)
+
+PROCEDURE HLine (w: Window;  row, col1, col2: CARDINAL;  type: LineType);
+
+    (* Draws a horizontal line from (row,col1) to (row,col2).	*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	IF col1 > col2 THEN
+	    j := col1;  col1 := col2;  col2 := j;
+	END (*IF*);
+	PutChar (w, row, col1, none, type, none, none, 0CFH);
+	FOR j := col1+1 TO col2-1 DO
+	    PutChar (w, row, j, none, type, none, type, 0CCH);
+	END (*FOR*);
+	PutChar (w, row, col2, none, none, none, type, 0FCH);
+    END HLine;
+
+(************************************************************************)
+
+PROCEDURE VLine (w: Window;  col, row1, row2: CARDINAL;  type: LineType);
+
+    (* Draws a vertical line from (row1,col) to (row2,col).	*)
+
+    VAR i: CARDINAL;
+
+    BEGIN
+	IF row1 > row2 THEN
+	    i := row1;  row1 := row2;  row2 := i;
+	END (*IF*);
+	PutChar (w, row1, col, none, none, type, none, 0F3H);
+	FOR i := row1+1 TO row2-1 DO
+	    PutChar (w, i, col, type, none, type, none, 033H);
+	END (*FOR*);
+	PutChar (w, row2, col, type, none, none, none, 03FH);
+    END VLine;
+
+(************************************************************************)
+
+PROCEDURE Box (w: Window;  top, left, width, height: CARDINAL;
+							type: LineType);
+
+    (* Draws a rectangular box whose top left corner is at (top,left)	*)
+    (* and with the given width and height.				*)
+
+    VAR i: CARDINAL;
+
+    BEGIN
+	(* Put in the corners. *)
+
+	PutChar (w, top, left, none, type, type, none, 0C3H);
+	PutChar (w, top, left+width, none, none, type, type, 0F0H);
+	PutChar (w, top+height, left, type, type, none, none, 00FH);
+	PutChar (w, top+height, left+width, type, none, none, type, 03CH);
+
+	(* Now the sides. *)
+
+	HLine (w, top, left, left+width, type);
+	HLine (w, top+height, left, left+width, type);
+	VLine (w, left, top, top+height, type);
+	VLine (w, left+width, top, top+height, type);
+
+    END Box;
+
+(************************************************************************)
+
+END TextLines.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/textvide.def b/examples/Modula-2_Libraries/PMOS/sources/general/textvide.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/textvide.def
@@ -0,0 +1,77 @@
+DEFINITION MODULE TextVideo;
+
+	(********************************************************)
+	(*							*)
+	(*		Low-level screen functions		*)
+	(*							*)
+	(*	The function of this module is to look after	*)
+	(*	the low-level screen initialisation needed	*)
+	(*	by the text-mode modules GlassTTY and Windows.	*)
+	(*	This reduces the likelihood of conflicts	*)
+	(*	arising in programs which import both of those	*)
+	(*	modules.					*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	25 October 1993			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(*									*)
+(*		WARNING		WARNING		WARNING			*)
+(*									*)
+(*  The operations performed by this module are among the rare examples	*)
+(*  where a programming error can cause physical damage to the		*)
+(*  hardware.  Do NOT attempt to modify anything in this module unless	*)
+(*  you have a detailed understanding of how the video adaptors work.	*)
+(*  In particular, beware of putting inappropriate values into the	*)
+(*  registers of the 6845 video controller.				*)
+(*									*)
+(*  It is normal for the screen picture to "bloom" or "bounce" after	*)
+(*  a mode change (e.g. changing from a text mode to a graphics mode).	*)
+(*  Some monitors are worse than others for this, but all should	*)
+(*  regain synchronism after a second or so.  A bright dot at the	*)
+(*  centre of the screen or a "tearing" effect are NOT normal; if the	*)
+(*  screen display goes crazy you should turn off the monitor and/or	*)
+(*  reset the computer immediately, since it probably means that the	*)
+(*  software is not compatible with your hardware.			*)
+(*									*)
+(*  The procedures in this module are for the use of other library	*)
+(*  modules such as GlassTTY and Windows.  They should not normally	*)
+(*  be called directly from applications programs.			*)
+(*									*)
+(*  DISCLAIMER: This software is supplied "as is" with no warranty as	*)
+(*  to its compatibility with your hardware.  It has been tested on a	*)
+(*  small sample of computers, but because of the wide variety of	*)
+(*  video adaptors on the market it is impossible to be certain that	*)
+(*  it will work correctly on all hardware configurations.		*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE VideoKind (VAR (*OUT*) ScreenSegment: CARDINAL;
+				VAR (*OUT*) BlackAndWhite: BOOLEAN);
+
+    (* Returns the segment of the screen memory, and a flag saying	*)
+    (* whether we are using a monochrome adaptor.			*)
+
+PROCEDURE SetVideoMode (newmode: CARDINAL);
+
+    (* Sets the video mode, as defined in the BIOS. At present only	*)
+    (* modes 3 (25*80 colour) and 7 (25*80 monochrome) are supported.	*)
+
+PROCEDURE RestoreOriginalMode;
+
+    (* Sets the video mode back to what it was before this program ran.	*)
+
+PROCEDURE SetTextPage (page: SHORTCARD);
+
+    (* Changes the active display page.	*)
+
+PROCEDURE PositionCursor (visible: BOOLEAN;  position: CARDINAL;
+					blockcursor: BOOLEAN);
+
+    (* Displays a blinking screen cursor at the specified position.	*)
+
+END TextVideo.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/textvide.mod b/examples/Modula-2_Libraries/PMOS/sources/general/textvide.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/textvide.mod
@@ -0,0 +1,201 @@
+IMPLEMENTATION MODULE TextVideo;
+
+	(********************************************************)
+	(*							*)
+	(*		Low-level screen functions		*)
+	(*							*)
+	(*	The function of this module is to look after	*)
+	(*	the low-level screen initialisation needed	*)
+	(*	by the text-mode modules GlassTTY and Windows.	*)
+	(*	This reduces the likelihood of conflicts	*)
+	(*	arising in programs which import both of those	*)
+	(*	modules.					*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	30 January 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM LowLevel IMPORT
+    (* proc *)	SEGMENT, Virtual, OutByte, HighByte, LowByte;
+
+FROM MiscPMOS IMPORT
+    (* type *)	RegisterPacket,
+    (* proc *)	BIOS, EnterCriticalSection, LeaveCriticalSection;
+
+IMPORT Screen;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure;
+
+(************************************************************************)
+
+CONST
+    VideoInt = 16;		(* Interrupt number for BIOS calls	*)
+    PageSize = 4096;		(* Size of a hardware page buffer	*)
+    BytesPerChar = 2;
+
+VAR
+    (* A flag to say whether we have a monochrome adaptor.	*)
+
+    Monochrome: BOOLEAN;
+
+    (* ScreenSeg is a segment selector for the hardware video buffer,	*)
+    (* and CRTCport is the port number to use when addressing the CRT	*)
+    (* controller chip.  They are variables because their values depend	*)
+    (* on whether a colour or monochrome interface is installed.	*)
+
+    ScreenSeg: CARDINAL;
+    CRTCport: CARDINAL;
+
+(************************************************************************)
+(*			    CURSOR CONTROL				*)
+(************************************************************************)
+
+PROCEDURE SetCursorShape (startline, endline: CARDINAL);
+
+    (* Sets the start and end scan lines for the cursor.  This has to	*)
+    (* be done with a BIOS call, rather than by programming the CRTC	*)
+    (* registers directly, to ensure correct treatment over the variety	*)
+    (* of different video interfaces which could be present.		*)
+
+    VAR BIOSframe: RegisterPacket;
+
+    BEGIN
+	WITH BIOSframe DO
+	    AH := 1;  CH := SHORTCARD(startline);
+	    CL := SHORTCARD(endline);
+	END (*WITH*);
+	BIOS (VideoInt, BIOSframe);
+    END SetCursorShape;
+
+(************************************************************************)
+
+PROCEDURE PositionCursor (visible: BOOLEAN;  position: CARDINAL;
+					blockcursor: BOOLEAN);
+
+    (* Displays a blinking screen cursor at the specified position.	*)
+    (* Note that this procedure actually has to halve the specified	*)
+    (* argument to take account of the fact that attribute bytes take	*)
+    (* space in the character buffer but are not counted by the cursor	*)
+    (* setting hardware.						*)
+
+    VAR start, end: CARDINAL;
+
+    BEGIN
+	position := position DIV BytesPerChar;
+	OutByte (CRTCport, 14);	(* the "cursor position higher" register *)
+	OutByte (CRTCport+1, HighByte(position));
+	OutByte (CRTCport, 15);	(* the "cursor position lower" register *)
+	OutByte (CRTCport+1, LowByte(position));
+	IF Monochrome THEN end := 12 ELSE end := 7 END (*IF*);
+	IF blockcursor THEN start := 1 ELSE start := end-1 END(*IF*);
+	IF visible THEN SetCursorShape (start, end)
+	ELSE SetCursorShape (16, 0);
+	END (*IF*);
+    END PositionCursor;
+
+(************************************************************************)
+(*		      OPERATIONS ON THE VIDEO MODE			*)
+(************************************************************************)
+
+PROCEDURE SetVideoMode (newmode: CARDINAL);
+
+    (* Sets the video mode, as defined in the BIOS. At present only	*)
+    (* modes 3 (25*80 colour) and 7 (25*80 monochrome) are supported.	*)
+
+    VAR Registers: RegisterPacket;  dummy: BOOLEAN;
+	
+    BEGIN
+	dummy := Screen.SetVideoMode (newmode, FALSE);
+	Screen.GetAddresses (ScreenSeg, CRTCport);
+    END SetVideoMode;
+
+(************************************************************************)
+
+PROCEDURE SetTextPage (page: SHORTCARD);
+
+    (* Changes the active display page.	*)
+
+    VAR position: CARDINAL;
+
+    BEGIN
+	position := PageSize*VAL(CARDINAL,page) DIV BytesPerChar;
+	OutByte (CRTCport, 12);	(* the "start address higher" register *)
+	OutByte (CRTCport+1, HighByte(position));
+	OutByte (CRTCport, 13);	(* the "start address lower" register *)
+	OutByte (CRTCport+1, LowByte(position));
+    END SetTextPage;
+
+(************************************************************************)
+
+PROCEDURE RestoreCursor;
+
+    (* Makes the screen cursor visible at the top of the screen.	*)
+
+    BEGIN
+	PositionCursor (TRUE, 0, FALSE);
+    END RestoreCursor;
+
+(************************************************************************)
+
+PROCEDURE RestoreOriginalMode;
+
+    (* Sets the video mode back to what it was before this program ran.	*)
+
+    BEGIN
+	Screen.RestoreOriginalMode;
+	RestoreCursor;
+    END RestoreOriginalMode;
+
+(************************************************************************)
+
+PROCEDURE ShutDown;
+
+    (* Makes sure that the screen cursor is turned on at program	*)
+    (* termination.  Note that we're setting a termination procedure	*)
+    (* inside a termination procedure, to ensure that the cursor is	*)
+    (* turned on in pass 2 of the termination processing.		*)
+
+    BEGIN
+	SetTerminationProcedure (RestoreCursor);
+    END ShutDown;
+
+(************************************************************************)
+(*			EQUIPMENT KIND DETECTION			*)
+(************************************************************************)
+
+PROCEDURE VideoKind (VAR (*OUT*) ScreenSegment: CARDINAL;
+				VAR (*OUT*) BlackAndWhite: BOOLEAN);
+
+    (* Returns the segment of the screen memory, and a flag saying	*)
+    (* whether we are using a monochrome adaptor.			*)
+
+    BEGIN
+	ScreenSegment := ScreenSeg;  BlackAndWhite := Monochrome;
+    END VideoKind;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+VAR Registers: RegisterPacket;
+    Adaptor: Screen.VideoAdaptorType;
+
+BEGIN
+    Adaptor := Screen.VideoKind();
+    Monochrome := (Adaptor=Screen.MDA) OR (Adaptor=Screen.Hercules);
+    SetTerminationProcedure (ShutDown);
+
+    (* Set an appropriate text mode: 25*80 colour if possible, or	*)
+    (* 25*80 monochrome for a monochrome adaptor.			*)
+
+    IF Monochrome THEN
+	SetVideoMode (7);
+    ELSE
+	SetVideoMode (3);
+    END (*IF*);
+
+END TextVideo.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/tiles.def b/examples/Modula-2_Libraries/PMOS/sources/general/tiles.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/tiles.def
@@ -0,0 +1,88 @@
+DEFINITION MODULE Tiles;
+
+	(********************************************************)
+	(*							*)
+	(*	    Support module for screen graphics		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	11 February 1995		*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	NOTE: This is a support module for GWindows,	*)
+	(*	and is not intended to be called directly by	*)
+	(*	applications programs.  It does not contain	*)
+	(*	all of the data validity checks which the	*)
+	(*	end-user procedures perform.			*)
+	(*							*)
+	(********************************************************)
+
+FROM ScreenGeometry IMPORT
+    (* type *)	Point, Rectangle;
+
+FROM Graphics IMPORT
+    (* type *)	ColourType;
+
+TYPE
+    TileSet;		(* is private *)
+
+PROCEDURE CreateTileSet (border: Rectangle;  background: ColourType): TileSet;
+
+    (* Creates a TileSet which covers the given rectangular region.	*)
+    (* The second parameter specifies the background colour.		*)
+    (* This will usually require breaking up tiles of previously	*)
+    (* created TileSets, but since the caller does not have access to	*)
+    (* the internal structure of a TileSet this restructuring is	*)
+    (* transparent to the caller.					*)
+
+PROCEDURE DiscardTileSet (VAR (*INOUT*) T: TileSet);
+
+    (* Destroys TileSet T.  This too might involve restructuring the	*)
+    (* tiling of other TileSets, but again the caller need not know	*)
+    (* the details.							*)
+
+PROCEDURE ClearTileSet (T: TileSet);
+
+    (* Removes all points, lines, and text from T, and re-displays	*)
+    (* the visible parts of T.						*)
+
+PROCEDURE TileSetMemory (T: TileSet;  memory: BOOLEAN);
+
+    (* Specifying a FALSE value for the memory parameter means that	*)
+    (* subsequent data sent to this TileSet will be written to the	*)
+    (* screen but not remembered.  This saves time and memory, the only	*)
+    (* penalty being that data covered by an overlapping TileSet will	*)
+    (* be lost.  Specifying TRUE restores the default condition, where	*)
+    (* all data are retained for refreshing the screen when necessary.	*)
+
+PROCEDURE AddPoint (T: TileSet;  p: Point;  colour: ColourType);
+
+    (* Adds a new point to TileSet T, and displays it on the screen.	*)
+
+PROCEDURE AddLine (T: TileSet;  start, end: Point;  colour: ColourType);
+
+    (* Adds a new line to TileSet T, and displays it on the screen.	*)
+
+PROCEDURE AddRectangle (T: TileSet;  R: Rectangle;  colour: ColourType);
+
+    (* Draws a rectangular shape.  A shorthand for four AddLine calls.	*)
+
+PROCEDURE AddString (T: TileSet;  place: Point;
+			VAR (*IN*) text: ARRAY OF CHAR;
+			count: CARDINAL;  colour: ColourType;  R: Rectangle);
+
+    (* Adds a string of count characters to tileset T, and displays it.	*)
+    (* Points outside rectangle R are not displayed.			*)
+
+PROCEDURE AddRotatedString (T: TileSet;  place: Point;
+			VAR (*IN*) text: ARRAY OF CHAR;
+			count: CARDINAL;  colour: ColourType;  R: Rectangle);
+
+    (* Like AddString, but writes in the +Y direction.	*)
+
+PROCEDURE ScrollContents (TS: TileSet;  amount: INTEGER;  R: Rectangle);
+
+    (* Moves all data within R up by "amount" rows, discarding what	*)
+    (* falls outside the rectangle.					*)
+
+END Tiles.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/tiles.mod b/examples/Modula-2_Libraries/PMOS/sources/general/tiles.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/tiles.mod
@@ -0,0 +1,1518 @@
+IMPLEMENTATION MODULE Tiles;
+
+	(********************************************************)
+	(*							*)
+	(*	    Support module for screen graphics		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 February 1995		*)
+	(*  Status:		Working				*)
+	(*	The logic for forcing a restart when checking	*)
+	(*	 for things to merge could be made less		*)
+	(*	 conservative - is this worth the extra effort?	*)
+	(*	Still have to check for missing features.	*)
+	(*	Text implemented inefficiently.			*)
+	(*							*)
+	(*	Now adding a scrolling mechanism.  Procedure	*)
+	(*	ScrollContents is basically working but is	*)
+	(*	still missing the mechanism to fix up		*)
+	(*	scrolled points.				*)
+	(*							*)
+	(********************************************************)
+
+FROM ScreenGeometry IMPORT
+    (* proc *)	Inside;
+
+FROM Graphics IMPORT
+    (* proc *)	Fill, PlotDot, PlotLine, PlotRectangle, ClippedLine,
+		ClippedString, ClippedUpString, ACopy;
+
+FROM Screen IMPORT
+    (* proc *)	RestoreOriginalMode;
+
+FROM Queues IMPORT
+    (* type *)	Queue,
+    (* proc *)	CreateQueue, AddToQueue, TakeFromQueue, Empty, DestroyQueue;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM TaskControl IMPORT
+    (* type *)	Lock,
+    (* proc *)	CreateLock, Obtain, Release;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure;
+
+FROM Keyboard IMPORT	(* for testing *)
+    (* proc *)	InKey;
+
+(************************************************************************)
+
+CONST testing = FALSE;		(* If TRUE, we display TileSlots *)
+
+CONST BigNumber = MAX(CARDINAL) - 1;
+
+TYPE
+    TextPointer = POINTER TO ARRAY [0..BigNumber] OF CHAR;
+
+    (* A PointList is a set of Points.	*)
+
+    PointList = POINTER TO PointListRecord;
+    PointListRecord =
+		    RECORD
+			next: PointList;
+			datum: Point;
+			colour: ColourType;
+		    END (*RECORD*);
+
+    (* A LineList is a set of Lines defined by their endpoints.	*)
+
+    LineList = POINTER TO LineListRecord;
+    LineListRecord =
+		    RECORD
+			next: LineList;
+			end1, end2: Point;
+			colour: ColourType;
+		    END (*RECORD*);
+
+    (* A StringList is a set of text strings.	*)
+
+    StringList = POINTER TO StringListRecord;
+    StringListRecord =
+		    RECORD
+			next: StringList;
+			location: Point;
+			colour: ColourType;
+			length: CARDINAL;
+			textptr: TextPointer;
+		    END (*RECORD*);
+
+    (* A TileSlot is defined later - see the TileSlotInfo declaration.	*)
+
+    TileSlot = POINTER TO TileSlotInfo;
+
+    (* A Tile is an object holding graphic data to be displayed on the	*)
+    (* screen.  Each Tile matches exactly one TileSlot, but multiple	*)
+    (* Tiles can occupy the same TileSlot.  The field "under" shows the	*)
+    (* next Tile which occupies the same TileSlot, "next" shows the	*)
+    (* next Tile in the same TileSet, and "set" is the TileSet itself.	*)
+
+    Tile = POINTER TO TileRecord;
+    TileRecord =    RECORD
+			under: Tile;
+			next: Tile;
+			set: TileSet;
+			slot: TileSlot;
+		 	points: PointList;
+		    END (*RECORD*);
+
+    (* A TileSet - which is the only data type of interest to clients	*)
+    (* of this module - is a set of Tiles, plus a set of lines and text	*)
+    (* strings to be plotted.  The background field gives the common	*)
+    (* background colour for all the tiles in the set.  The retain	*)
+    (* field specifies whether to save newly plotted data for future	*)
+    (* refreshing.							*)
+
+    TileSet = POINTER TO TileSetRecord;
+    TileSetRecord = RECORD
+			head, tail: Tile;
+			background: ColourType;
+			retain: BOOLEAN;
+			lines: LineList;
+			strings, upstrings: StringList;
+		    END (*RECORD*);
+
+    (* A TileStack is a stack of tiles - each belonging to a distinct	*)
+    (* TileSet - occupying the same position on the screen.		*)
+
+    TileStack = Tile;
+
+    (* A TileSlot represents a rectangular region on the screen, which	*)
+    (* can contain zero or more Tiles.  This module maintains a master	*)
+    (* list of TileSlots, showing how the screen is currently tiled.	*)
+    (* Initially there is just one TileSlot covering the whole screen.	*)
+    (* Each time CreateTileSet is called there is a likelihood that	*)
+    (* existing TileSlots will have to be broken up, so the master list	*)
+    (* of TileSlots changes with time.  When a TileSlot is broken up,	*)
+    (* the corresponding Tiles must of course also be broken up.	*)
+    (* The nextslot field in a TileSlot record points to the next	*)
+    (* TileSlot in the master list, and the stacktop field points to a	*)
+    (* a stack of tiles which occupy this TileSlot.  The mark field is	*)
+    (* normally FALSE; we set it to indicate a candidate for merging	*)
+    (* with adjacent slots.						*)
+    (* So far I haven't given enough thought as to the most desirable	*)
+    (* ordering of the TileSlot list.  It should possibly be ordered	*)
+    (* to make searching faster.					*)
+
+    TileSlotInfo =  RECORD
+			shape: Rectangle;
+			nextslot: TileSlot;
+			stacktop: TileStack;
+			mark: BOOLEAN;
+		    END (*RECORD*);
+
+(************************************************************************)
+
+VAR
+    (* SlotListHead is the head of the master list of TileSlots.	*)
+
+    SlotListHead: TileSlot;
+
+    (* MainLock protects all entry points to this module.  Because of	*)
+    (* the heavily interlocked nature of the data structures maintained	*)
+    (* by this module, and in particular because operations on one	*)
+    (* TileSet can affect the internal structure of other TileSets,	*)
+    (* there is little point in trying for finer granularity in the	*)
+    (* critical section protection.					*)
+
+    MainLock: Lock;
+
+(************************************************************************)
+
+(*
+PROCEDURE DebugPause (message: ARRAY OF CHAR);
+
+    (* For testing - can remove from production version.	*)
+
+    VAR dummy: CHAR;
+
+    BEGIN
+	GlassTTY.SetCursor (24, 0);
+	GlassTTY.WriteString (message);
+	dummy := InKey();
+    END DebugPause;
+*)
+
+(************************************************************************)
+(*	  OPERATIONS ON TYPES PointList, LineList, AND StringList	*)
+(************************************************************************)
+
+PROCEDURE DiscardPointList (VAR (*INOUT*) PL: PointList);
+
+    (* Destroys a PointList.	*)
+
+    VAR following: PointList;
+
+    BEGIN
+	WHILE PL <> NIL DO
+	    following := PL^.next;
+	    DISPOSE (PL);
+	    PL := following;
+	END (*WHILE*);
+    END DiscardPointList;
+
+(************************************************************************)
+
+PROCEDURE DiscardLineList (VAR (*INOUT*) LL: LineList);
+
+    (* Destroys a LineList.	*)
+
+    VAR following: LineList;
+
+    BEGIN
+	WHILE LL <> NIL DO
+	    following := LL^.next;
+	    DISPOSE (LL);
+	    LL := following;
+	END (*WHILE*);
+    END DiscardLineList;
+
+(************************************************************************)
+
+PROCEDURE PlotLineListClipped (LL: LineList;  R: Rectangle);
+
+    (* Plots all lines in LL, clipping them on the display such that	*)
+    (* only the part inside R is shown.					*)
+
+    BEGIN
+	WHILE LL <> NIL DO
+	    WITH LL^ DO
+		WITH R DO
+		    ClippedLine (end1.x, end1.y, end2.x, end2.y, colour,
+						left, right, bottom, top);
+		END (*WITH*);
+	    END (*WITH*);
+	    LL := LL^.next;
+	END (*WHILE*);
+    END PlotLineListClipped;
+
+(************************************************************************)
+
+PROCEDURE DiscardStringList (VAR (*INOUT*) SL: StringList);
+
+    (* Destroys a StringList.	*)
+
+    VAR following: StringList;
+
+    BEGIN
+	WHILE SL <> NIL DO
+	    following := SL^.next;
+	    DEALLOCATE (SL^.textptr, SL^.length);
+	    DISPOSE (SL);
+	    SL := following;
+	END (*WHILE*);
+    END DiscardStringList;
+
+(************************************************************************)
+
+PROCEDURE PlotStringListClipped (SL: StringList;  R: Rectangle);
+
+    (* Plots all strings in SL, clipping them on the display such that	*)
+    (* only the part inside R is shown.					*)
+
+    BEGIN
+	WHILE SL <> NIL DO
+	    WITH SL^ DO
+		WITH R DO
+		    ClippedString (textptr^, location.x, location.y,
+						length, colour,
+						left, right, bottom, top);
+		END (*WITH*);
+	    END (*WITH*);
+	    SL := SL^.next;
+	END (*WHILE*);
+    END PlotStringListClipped;
+
+(************************************************************************)
+
+PROCEDURE PlotUpStringListClipped (USL: StringList;  R: Rectangle);
+
+    (* Plots all strings in USL, clipping them on the display such	*)
+    (* that only the part inside R is shown.				*)
+
+    BEGIN
+	WHILE USL <> NIL DO
+	    WITH USL^ DO
+		WITH R DO
+		    ClippedUpString (textptr^, location.x, location.y,
+						length, colour,
+						left, right, bottom, top);
+		END (*WITH*);
+	    END (*WITH*);
+	    USL := USL^.next;
+	END (*WHILE*);
+    END PlotUpStringListClipped;
+
+(************************************************************************)
+(*			OPERATIONS ON TYPE Tile				*)
+(************************************************************************)
+
+PROCEDURE Unlink (tile: Tile);
+
+    (* Removes the tile from its stack, without otherwise changing it.	*)
+
+    VAR slot: TileSlot;  current, above: Tile;
+
+    BEGIN
+	slot := tile^.slot;
+	current := slot^.stacktop;  above := NIL;
+	WHILE current <> tile DO
+	    above := current;  current := current^.under;
+	END (*WHILE*);
+	IF above = NIL THEN
+	    slot^.stacktop := current^.under;
+	ELSE
+	    above^.under := current^.under;
+	END (*IF*);
+	current^.under := NIL;
+    END Unlink;
+
+(************************************************************************)
+
+PROCEDURE Display (slot: TileSlot);
+
+    (* Displays the contents of the tile on top of the stack for the	*)
+    (* given slot.  If the slot is empty, clears the screen area	*)
+    (* described by slot^.shape.					*)
+
+    (* Remark: should perhaps include a parameter to say whether the	*)
+    (* entire TileSet is being redisplayed - in which case it would be	*)
+    (* more efficient to skip displaying lines and strings in this	*)
+    (* procedure, and let the caller display the unclipped versions.	*)
+
+    VAR PL: PointList;  LL: LineList;  toptile: Tile;
+	background: ColourType;  R: Rectangle;
+
+    BEGIN
+	WITH slot^ DO
+	    R := shape;
+	    toptile := stacktop;
+	    IF toptile = NIL THEN background := 0;
+	    ELSE background := toptile^.set^.background;
+	    END (*IF*);
+	END (*WITH*);
+
+	(* Fill in the background *)
+
+	WITH R DO
+	    Fill (left, bottom, right, top, background);
+	END (*WITH*);
+
+	(* Is there a tile present?	*)
+
+	IF toptile = NIL THEN
+	    RETURN;
+	END (*IF*);
+
+	(* Yes, display its contents.	*)
+
+	PL := toptile^.points;
+	WHILE PL <> NIL DO
+	    WITH PL^ DO
+		WITH datum DO
+		    PlotDot (x, y, colour);
+		END (*WITH*);
+	    END (*WITH*);
+	    PL := PL^.next;
+	END (*WHILE*);
+
+	WITH toptile^.set^ DO
+	    PlotLineListClipped (lines, R);
+	    PlotStringListClipped (strings, R);
+	    PlotUpStringListClipped (upstrings, R);
+	END (*WITH*);
+
+    END Display;
+
+(************************************************************************)
+
+PROCEDURE CreateTile (VAR (*OUT*) T: Tile;  Slot: TileSlot);
+
+    (* Creates a new tile T on top of the stack for the given slot.	*)
+    (* The tile is not attached to any set.				*)
+
+    BEGIN
+	NEW (T);
+	WITH T^ DO
+	    under := Slot^.stacktop;  next := NIL;  set := NIL;
+	    slot := Slot;  points := NIL;
+	END (*WITH*);
+	Slot^.stacktop := T;
+    END CreateTile;
+
+(************************************************************************)
+
+PROCEDURE DiscardTile (tile: Tile);
+
+    (* Destroys a tile.  This includes removing the tile from its stack	*)
+    (* and updating the screen display if necessary.			*)
+
+    VAR wasontop: BOOLEAN;
+
+    BEGIN
+	WITH tile^ DO
+	    wasontop := tile = slot^.stacktop;
+	    Unlink (tile);
+	    IF wasontop THEN Display (slot) END(*IF*);
+	    DiscardPointList (points);
+	END (*WITH*);
+	DISPOSE (tile);
+    END DiscardTile;
+
+(************************************************************************)
+
+PROCEDURE ClearTileData (tile: Tile);
+
+    (* Removes all points from the tile, and displays the blanked	*)
+    (* region if the tile is on top of its stack.			*)
+
+    BEGIN
+	WITH tile^ DO
+	    DiscardPointList (points);
+	    IF tile = slot^.stacktop THEN
+		Display (slot);
+	    END (*IF*);
+	END (*WITH*);
+    END ClearTileData;
+
+(************************************************************************)
+
+PROCEDURE TileSetMemory (T: TileSet;  memory: BOOLEAN);
+
+    (* Specifying a FALSE value for the memory parameter means that	*)
+    (* subsequent data sent to this TileSet will be written to the	*)
+    (* screen but not remembered.  This saves time and memory, the only	*)
+    (* penalty being that data covered by an overlapping TileSet will	*)
+    (* be lost.  Specifying TRUE restores the default condition, where	*)
+    (* all data are retained for refreshing the screen when necessary.	*)
+
+    BEGIN
+	T^.retain := memory;
+    END TileSetMemory;
+
+(************************************************************************)
+
+PROCEDURE PutTileOnTop (tile: Tile);
+
+    (* Puts a tile on the top of its stack and displays it.  (Does	*)
+    (* nothing if the tile is already on top of its stack.)		*)
+
+    VAR slot: TileSlot;
+
+    BEGIN
+	slot := tile^.slot;
+	IF slot^.stacktop <> tile THEN
+	    Unlink (tile);
+	    tile^.under := slot^.stacktop;
+	    slot^.stacktop := tile;
+	    Display (slot);
+	END (*IF*);
+    END PutTileOnTop;
+
+(************************************************************************)
+
+PROCEDURE FindTile (TS: TileSet;  p: Point): Tile;
+
+    (* Returns the tile in TS whose TileSlot contains p.  Also puts	*)
+    (* this tile on the top of its stack and displays it.  NOTE: we	*)
+    (* assume that the caller has checked that p lies in the region	*)
+    (* covered by TS.							*)
+
+    VAR current: Tile;  x, y: CARDINAL;
+
+    BEGIN
+	x := p.x;  y := p.y;
+	current := TS^.head;
+	LOOP
+	    IF Inside (x, y, current^.slot^.shape) THEN
+		PutTileOnTop (current);
+		RETURN current;
+	    END (*IF*);
+	    current := current^.next;
+	END (*LOOP*);
+    END FindTile;
+
+(************************************************************************)
+
+PROCEDURE AddPointToTile (p: Point;  colour: ColourType;  T: Tile);
+
+    (* Appends p to the list of points in T.	*)
+
+    VAR PL: PointList;
+
+    BEGIN
+	NEW (PL);
+	WITH PL^ DO
+	    next := T^.points;  datum := p;
+	END (*WITH*);
+	PL^.colour := colour;
+	T^.points := PL;
+    END AddPointToTile;
+
+(************************************************************************)
+
+PROCEDURE SplitTile (VAR (*INOUT*) T: Tile;  VAR (*OUT*) T2: Tile;
+			S2: TileSlot;  bound: CARDINAL;  Xsplit: BOOLEAN);
+
+    (* Creates a new tile T2, to fit into slot S2 and in the same	*)
+    (* TileSet as T; and moves some of the data from T to T2.  The data	*)
+    (* moved are those with horizontal coordinate >= bound in the case	*)
+    (* Xsplit = TRUE, or those with vertical coordinate >= bound in the	*)
+    (* case Xsplit = FALSE.  T2 is left on the top of the S2 stack.	*)
+    (* Remark: the order of the points in their PointList is altered	*)
+    (* as they are shifted, but this shouldn't matter since the list	*)
+    (* is not being used as an ordered set.				*)
+
+    VAR pcurrent, pprevious, pfollowing: PointList;
+	test: CARDINAL;
+
+    BEGIN
+	CreateTile (T2, S2);  T2^.set := T^.set;
+	T2^.next := T^.next;  T^.next := T2;
+
+	(* Work through the points in T^.points, shifting them to	*)
+	(* T2^.points as necessary.					*)
+
+	pcurrent := T^.points;  pprevious := NIL;
+	WHILE pcurrent <> NIL DO
+	    pfollowing := pcurrent^.next;
+	    WITH pcurrent^.datum DO
+		IF Xsplit THEN test := x ELSE test := y END(*IF*);
+	    END (*WITH*);
+	    IF test >= bound THEN
+
+		(* Remove the point from T^.points.	*)
+
+		IF pprevious = NIL THEN T^.points := pfollowing
+		ELSE pprevious^.next := pfollowing;
+		END (*IF*);
+
+		(* Put the point into T2^.points.	*)
+
+		pcurrent^.next := T2^.points;  T2^.points := pcurrent;
+
+	    ELSE
+		pprevious := pcurrent;
+	    END (*IF*);
+	    pcurrent := pfollowing;
+
+	END (*WHILE*);
+
+    END SplitTile;
+
+(************************************************************************)
+
+PROCEDURE MergeTiles (VAR (*INOUT*) T1, T2: Tile);
+
+    (* The opposite operation to SplitTile: all data from T2 are moved	*)
+    (* into T1, and T2 is destroyed.					*)
+
+    VAR previous, current: Tile;  plast: PointList;
+
+    BEGIN
+	(* Find the predecessor of T2 in its TileSet. *)
+
+	previous := NIL;  current := T2^.set^.head;
+	WHILE current <> T2 DO
+	    previous := current;  current := current^.next;
+	END (*WHILE*);
+
+	(* Remove T2 from the set. *)
+
+	IF previous = NIL THEN T2^.set^.head := T2^.next
+	ELSE previous^.next := T2^.next
+	END (*IF*);
+	IF T2 = T2^.set^.tail THEN
+	    T2^.set^.tail := previous;
+	END (*IF*);
+
+	(* Move T2's PointList into T1. *)
+
+	plast := T1^.points;
+	IF plast = NIL THEN
+	    T1^.points := T2^.points;
+	ELSE
+	    WHILE plast^.next <> NIL DO
+		plast := plast^.next;
+	    END (*WHILE*);
+	    plast^.next := T2^.points;
+	END (*IF*);
+
+	(* All done, discard T2. *)
+
+	DISPOSE (T2);
+
+    END MergeTiles;
+
+(************************************************************************)
+
+PROCEDURE MatchingStack (stack1, stack2: TileStack): BOOLEAN;
+
+    (* The input parameters each point to the top of a stack of tiles.	*)
+    (* We return TRUE if the two stacks are equal in the following	*)
+    (* sense: for each tile in stack1, there is a corresponding tile in	*)
+    (* stack2 (and vice versa) belonging to the same TileSet.		*)
+
+    VAR copy: TileStack;
+
+    BEGIN
+	(* Simplification: if the tiles on the two stacks really do	*)
+	(* belong to the same TileSet, then they have gone through the	*)
+	(* same history, and therefore should be stacked in the same	*)
+	(* order.							*)
+
+	LOOP
+	    IF stack1 = NIL THEN
+		RETURN (stack2 = NIL);
+	    END (*IF*);
+	    IF stack2 = NIL THEN
+		RETURN FALSE;
+	    END (*IF*);
+	    IF stack1^.set <> stack2^.set THEN
+		RETURN FALSE;
+	    END (*IF*);
+	    stack1 := stack1^.under;
+	    stack2 := stack2^.under;
+	END (*LOOP*);
+
+    END MatchingStack;
+
+(************************************************************************)
+
+PROCEDURE MergeStacks (VAR (*OUT*) stack1: TileStack;  stack2: TileStack);
+
+    (* The input parameters each point to the top of a stack of tiles.	*)
+    (* On exit all data from tiles in stack2 have been moved into the	*)
+    (* corresponding tiles in stack1, and the tiles in stack2 have been	*)
+    (* destroyed.							*)
+
+    VAR T1, T2: Tile;
+
+    BEGIN
+	T1 := stack1;
+	WHILE stack2 <> NIL DO
+	    T2 := stack2;  stack2 := stack2^.under;
+	    MergeTiles (T1, T2);
+	    T1 := T1^.under;
+	END (*WHILE*);
+    END MergeStacks;
+
+(************************************************************************)
+(*			OPERATIONS ON TYPE TileSlot			*)
+(************************************************************************)
+
+PROCEDURE DisplayAllSlots (S: TileSlot;  colour: ColourType);
+
+    (* For testing: draws the boundaries of all TileSlots, pauses a	*)
+    (* while, and then erases the drawing.  Because this procedure is	*)
+    (* used only during module testing, we're not particularly fussy	*)
+    (* about leaving the screen picture in a completely clean state.	*)
+    (* The parameters specify the slot we're currently working on - we	*)
+    (* display S in colour "colour".					*)
+
+    VAR dummy: CHAR;
+
+    PROCEDURE DrawSlotOutlines (colour: ColourType);
+
+	VAR current: TileSlot;
+
+	BEGIN
+	    current := SlotListHead;
+	    WHILE current <> NIL DO
+		PlotRectangle (current^.shape, colour);
+		current := current^.nextslot;
+	    END (*WHILE*);
+	END DrawSlotOutlines;
+
+    (********************************************************************)
+
+    BEGIN
+	DrawSlotOutlines (1);
+	IF S <> NIL THEN
+	    PlotRectangle (S^.shape, colour);
+	END (*IF*);
+	Release (MainLock);
+	dummy := InKey();
+	Obtain (MainLock);
+	DrawSlotOutlines (0);
+    END DisplayAllSlots;
+
+(************************************************************************)
+
+PROCEDURE FindSlot (x, y: CARDINAL): TileSlot;
+
+    (* Returns a slot containing the point (x,y).	*)
+
+    VAR p: TileSlot;
+
+    BEGIN
+	p := SlotListHead;
+	LOOP
+	    IF Inside (x, y, p^.shape) THEN
+		RETURN p;
+	    END (*IF*);
+	    p := p^.nextslot;
+	END (*LOOP*);
+    END FindSlot;
+
+(************************************************************************)
+
+PROCEDURE SplitSlot (VAR (*INOUT*) S: TileSlot;  bound: CARDINAL;
+							Xsplit: BOOLEAN);
+
+    (* Breaks S into two adjacent tile slots - side by side in the case	*)
+    (* Xsplit = TRUE, or one on top of the other when Xsplit = FALSE.	*)
+    (* On return S is the leftmost or bottommost, as appropriate, and	*)
+    (* S^.nextslot is the other.					*)
+
+    VAR S2: TileSlot;  T, T2, bottom: Tile;
+
+    BEGIN
+	NEW (S2);
+	S2^ := S^;
+	S^.nextslot := S2;
+	IF Xsplit THEN
+	    S^.shape.right := bound - 1;
+	    S2^.shape.left := bound;
+	ELSE
+	    S^.shape.top := bound - 1;
+	    S2^.shape.bottom := bound;
+	END (*IF*);
+	S2^.stacktop := NIL;
+
+	(* This completes the splitting of the TileSlot itself.  Now we	*)
+	(* must also split every Tile in the stack for the original	*)
+	(* TileSlot, and construct a stack for the S2 TileSlot.  Note	*)
+	(* that, because a newly created tile goes on top of the stack	*)
+	(* for its slot, we need to shuffle stack elements to avoid a	*)
+	(* situation where the stack constructed for S2 would be upside	*)
+	(* down relative to the stack for S.				*)
+
+	T := S^.stacktop;
+	IF T <> NIL THEN
+	    SplitTile (T, bottom, S2, bound, Xsplit);
+	    LOOP
+		T := T^.under;
+		IF T = NIL THEN EXIT(*LOOP*) END(*IF*);
+		SplitTile (T, T2, S2, bound, Xsplit);
+
+		(* Move the newly created tile T2 and move it from the	*)
+		(* top to the bottom of S2's stack.  This ensures that	*)
+		(* the new stack is built in the same order as the	*)
+		(* original stack.					*)
+
+		S2^.stacktop := T2^.under;  T2^.under := NIL;
+		bottom^.under := T2;  bottom := T2;
+	    END (*LOOP*);
+	END (*IF*);
+
+	IF testing THEN
+	    DisplayAllSlots (S, 4);
+	END (*IF*);
+
+    END SplitSlot;
+
+(************************************************************************)
+(*			COMBINING ADJACENT SLOTS			*)
+(************************************************************************)
+
+PROCEDURE Join (VAR (*INOUT*) S1, S2: TileSlot;  preS2: TileSlot;
+						newshape: Rectangle);
+
+    (* On entry, S1 and S2 have already been found to be suitable for	*)
+    (* combining, preS2 is the predecessor of S2 in the master list of	*)
+    (* TileSlots, and newshape is the shape of the union of S1 and S2.	*)
+    (* On exit, S1 is the union, the old S2 has been destroyed, and	*)
+    (* S2 is the successor of the old S2 in the master list.		*)
+
+    VAR following: TileSlot;
+
+    BEGIN
+	(* Remove S2 from the master list of TileSlots. *)
+
+	following := S2^.nextslot;
+	IF preS2 = NIL THEN SlotListHead := following
+	ELSE preS2^.nextslot := following
+	END (*IF*);
+
+	(* Combine corresponding tiles in S1 and S2,	*)
+	(* leaving the result in S1.			*)
+
+	S1^.shape := newshape;
+	MergeStacks (S1^.stacktop, S2^.stacktop);
+	DISPOSE (S2);
+	S2 := following;
+
+	IF testing THEN
+	    DisplayAllSlots (S1, 3);
+	END (*IF*);
+
+    END Join;
+
+(************************************************************************)
+
+PROCEDURE UpDownMatch (R1, R2: Rectangle;
+				VAR (*OUT*) union: Rectangle): BOOLEAN;
+
+    (* If R1 and R2 are vertically adjacent rectangles, returns TRUE	*)
+    (* and sets "union" to be the combined rectangle.  Otherwise	*)
+    (* returns FALSE, and the "union" result is meaningless.		*)
+
+    BEGIN
+	union := R1;
+	IF (R1.left = R2.left) AND (R1.right = R2.right) THEN
+	    (* Possible above/below adjacency *)
+	    IF R2.bottom = R1.top + 1 THEN
+		union.top := R2.top;
+		RETURN TRUE;
+	    ELSIF R1.bottom = R2.top + 1 THEN
+		union.bottom := R2.bottom;
+		RETURN TRUE;
+	    ELSE
+		RETURN FALSE;
+	    END (*IF*);
+	ELSE
+	    RETURN FALSE;
+	END (*IF*);
+    END UpDownMatch;
+
+(************************************************************************)
+
+PROCEDURE SideMatch (VAR (*INOUT*) S1, S2, preS2: TileSlot;
+			VAR (*OUT*) union: Rectangle;
+			VAR (*OUT*) HaveSplit: BOOLEAN): BOOLEAN;
+
+    (* Like UpDownMatch, but checks for left/right adjacency.  However	*)
+    (* we're more generous in this case about the meaning of "adjacent"	*)
+    (* since we're prepared to split S1 and/or S2 to make the heights	*)
+    (* match.  (This is why the first two parameters have to specify	*)
+    (* TileSlots rather than simply their shapes.)  If a split occurs	*)
+    (* the pieces split off have their "mark" fields set - since those	*)
+    (* pieces will have to be re-evaluated for possible further		*)
+    (* combinations - and we return with "HaveSplit" set to TRUE.	*)
+    (* Exception: if we can guarantee that the slots needing to be	*)
+    (* rechecked come after S1 in the master list of slots, then we	*)
+    (* don't set HaveSplit.						*)
+    (* Note: parameter preS2 is the predecessor of S2 in the master	*)
+    (* list of tile slots; it's updated appropriately if we have to	*)
+    (* modify that list.						*)
+
+    VAR R1, R2: Rectangle;  adjacent: BOOLEAN;
+
+    BEGIN
+	HaveSplit := FALSE;
+	R1 := S1^.shape;  R2 := S2^.shape;
+	union := R1;
+	IF (R1.bottom > R2.top) OR (R1.top < R2.bottom) THEN
+	    adjacent := FALSE;
+	ELSIF R2.left = R1.right + 1 THEN
+	    union.right := R2.right;
+	    adjacent := TRUE;
+	ELSIF R1.left = R2.right + 1 THEN
+	    union.left := R2.left;
+	    adjacent := TRUE;
+	ELSE
+	    adjacent := FALSE;
+	END (*IF*);
+
+	IF adjacent THEN
+
+	    (* The two rectangles are adjacent, but we haven't yet	*)
+	    (* checked their heights.  Perform one or two splits, as	*)
+	    (* necessary, to get the heights to line up.		*)
+
+	    IF R1.top > R2.top THEN
+		S1^.mark := TRUE;
+		SplitSlot (S1, R2.top+1, FALSE);
+		union.top := R2.top;
+		IF preS2 = S1 THEN
+		    preS2 := S1^.nextslot;
+		END (*IF*);
+	    ELSIF R1.top < R2.top THEN
+		S2^.mark := TRUE;
+		SplitSlot (S2, R1.top+1, FALSE);
+		HaveSplit := TRUE;
+	    END (*IF*);
+
+	    IF R1.bottom < R2.bottom THEN
+		S1^.mark := TRUE;
+		SplitSlot (S1, R2.bottom, FALSE);
+		HaveSplit := TRUE;
+		IF preS2 = S1 THEN
+		    preS2 := S1^.nextslot;
+		END (*IF*);
+		S1 := S1^.nextslot;
+		union.bottom := R2.bottom;
+	    ELSIF R1.bottom > R2.bottom THEN
+		S2^.mark := TRUE;
+		SplitSlot (S2, R1.bottom, FALSE);
+		preS2 := S2;  S2 := S2^.nextslot;
+		HaveSplit := TRUE;
+	    END (*IF*);
+
+	END (*IF*);
+
+	RETURN adjacent;
+
+    END SideMatch;
+
+(************************************************************************)
+
+PROCEDURE MergeWithNeighbours (VAR (*INOUT*) S: TileSlot): BOOLEAN;
+
+    (* Combines S with its neighbours if this turns out to be possible.	*)
+    (* The condition for combining slots is that the tiles in the two	*)
+    (* slots belong to the same TileSets, and that the union of their	*)
+    (* shapes is again a rectangular region.  A function result of	*)
+    (* TRUE indicates that all recombinations (if any) involving S	*)
+    (* have already been taken care of by this procedure, and further	*)
+    (* that no slots preceding S in the master list of TileSlots have	*)
+    (* been modified.  A result of FALSE indicates that this procedure	*)
+    (* may have created the conditions for further recombinations, i.e.	*)
+    (* that the caller needs to rescan the master list of TileSlots.	*)
+
+    VAR NoChange, HaveSplit, NoRescanNeeded: BOOLEAN;
+	previous, S2: TileSlot;  union: Rectangle;
+
+    BEGIN
+	NoRescanNeeded := TRUE;
+	REPEAT
+	    NoChange := TRUE;
+
+	    (* Search for a candidate S2 to be merged with S.	*)
+
+	    previous := NIL;  S2 := SlotListHead;
+
+	    WHILE S2 <> NIL DO
+
+		(* Check for adjacency.  In the above/below case we	*)
+		(* simply merge.  In the left/right case we merge when	*)
+		(* an exact match is found, but we also allow for the	*)
+		(* possibility of a left or right neighbour which is	*)
+		(* taller or shorter than S.  In the latter case, we	*)
+		(* perform a split followed by a join.			*)
+
+		IF (S2 <> S) AND MatchingStack (S^.stacktop, S2^.stacktop) AND
+			(UpDownMatch (S^.shape, S2^.shape, union) OR
+			    SideMatch (S, S2, previous, union, HaveSplit)) THEN
+		    Join (S, S2, previous, union);
+		    NoChange := FALSE;
+		    IF HaveSplit THEN
+			NoRescanNeeded := FALSE;  S2 := NIL;
+		    END (*IF*);
+		ELSE
+		    previous := S2;
+		    S2 := S2^.nextslot;
+		END (*IF*);
+
+	    END (*WHILE S2 <> NIL*);
+
+	UNTIL NoChange;
+
+	S^.mark := FALSE;
+	RETURN NoRescanNeeded;
+
+    END MergeWithNeighbours;
+
+(************************************************************************)
+
+PROCEDURE RecombineSlots;
+
+    (* Goes through the master list of slots, checking all slots which	*)
+    (* have their "mark" field set, and combining adjacent slots where	*)
+    (* possible.  Note: in the process of doing this we sometimes have	*)
+    (* to mark previously unmarked slots, so we have to keep looping	*)
+    (* until we are sure we have cleared all marks.			*)
+
+    VAR slot: TileSlot;  scanned: BOOLEAN;
+
+    BEGIN
+	REPEAT
+	    scanned := TRUE;
+	    slot := SlotListHead;
+	    WHILE slot <> NIL DO
+		IF slot^.mark THEN
+		    scanned := scanned AND MergeWithNeighbours (slot);
+		END (*IF*);
+		slot := slot^.nextslot;
+	    END (*WHILE*);
+	UNTIL scanned;
+    END RecombineSlots;
+
+(************************************************************************)
+(*			OPERATIONS ON TYPE TileSet			*)
+(************************************************************************)
+
+PROCEDURE CreateEmptyTileSet (VAR (*OUT*) TS: TileSet;  colour: ColourType);
+
+    (* Creates a TileSet containing no tiles.	*)
+
+    BEGIN
+	NEW (TS);
+	WITH TS^ DO
+	    head := NIL;  tail := NIL;  lines := NIL;  strings := NIL;
+	    upstrings := NIL;  background := colour;  retain := TRUE;
+	END (*WITH*);
+    END CreateEmptyTileSet;
+
+(************************************************************************)
+
+PROCEDURE AddToTileSet (VAR (*INOUT*) TS: TileSet;  S: TileSlot);
+
+    (* Creates a new tile in slot S, adds it to set TS, and displays it.*)
+
+    VAR p: Tile;
+
+    BEGIN
+	CreateTile (p, S);  p^.set := TS;
+	Display (S);
+	WITH TS^ DO
+	    IF tail = NIL THEN head := p
+	    ELSE tail^.next := p
+	    END (*IF*);
+	    tail := p;
+	END (*WITH*);
+    END AddToTileSet;
+
+(************************************************************************)
+
+PROCEDURE PutTileSetOnTop (TS: TileSet);
+
+    (* Ensures that TS is fully displayed on the screen.	*)
+
+    VAR tile: Tile;
+
+    BEGIN
+	tile := TS^.head;
+	WHILE tile <> NIL DO
+	    PutTileOnTop (tile);
+	    tile := tile^.next;
+	END (*WHILE*);
+    END PutTileSetOnTop;
+
+(************************************************************************)
+
+PROCEDURE Redraw (TS: TileSet);
+
+    (* Refreshes the visible parts of TS on the screen.  This procedure	*)
+    (* is for use in the case where the TileSet contents have been	*)
+    (* changed and what is already on the screen is obsolete.  (For the	*)
+    (* case where we are simply adding to the existing contents there	*)
+    (* are faster methods than calling this procedure.)			*)
+
+    VAR tile: Tile;
+
+    BEGIN
+	tile := TS^.head;
+	WHILE tile <> NIL DO
+	    WITH tile^ DO
+		IF tile = slot^.stacktop THEN
+		    Display (slot);
+		END (*IF*);
+	    END (*WITH*);
+	    tile := tile^.next;
+	END (*WHILE*);
+    END Redraw;
+
+(************************************************************************)
+(*		THE MAIN EXTERNALLY CALLABLE PROCEDURES			*)
+(************************************************************************)
+
+PROCEDURE CreateTileSet (border: Rectangle; background: ColourType): TileSet;
+
+    (* Creates a TileSet which covers the given rectangular region.	*)
+    (* The second parameter specifies the background colour.		*)
+    (* This will usually require breaking up tiles of previously	*)
+    (* created TileSets, but since the caller does not have access to	*)
+    (* the internal structure of a TileSet this restructuring is	*)
+    (* transparent to the caller.					*)
+
+    VAR result: TileSet;  S: TileSlot;
+	StillToHandle: Queue;
+	RLptr: POINTER TO Rectangle;
+
+    BEGIN
+	Obtain (MainLock);
+
+	(* Start by creating an empty tile set, and a list of		*)
+	(* rectangles still to be dealt with.				*)
+
+	CreateEmptyTileSet (result, background);
+	CreateQueue (StillToHandle);
+	NEW (RLptr);  RLptr^ := border;
+	AddToQueue (StillToHandle, RLptr);
+
+	(* The following loop breaks the rectangle into tiles by	*)
+	(* gradually breaking up the rectangle.  The loop body has two	*)
+	(* phases: (a) find a tile slot which matches or is contained	*)
+	(* in the desired rectangle; (b) break off any parts of the	*)
+	(* rectangle which do not fit into that slot, to be dealt with	*)
+	(* in subsequent passes through the loop.			*)
+
+	REPEAT
+	    RLptr := TakeFromQueue (StillToHandle);
+	    border := RLptr^;  DISPOSE (RLptr);
+
+	    (* Find a tile slot containing the bottom left corner.	*)
+
+	    S := FindSlot (border.left, border.bottom);
+
+	    (* Break up S, if necessary, so that no part of S lies	*)
+	    (* outside the rectangular region.  The order of these	*)
+	    (* operations is significant: we work on the bottom and top	*)
+	    (* edges before looking at the left and right edges, to	*)
+	    (* ensure that horizontal cuts are done before vertical	*)
+	    (* cuts.							*)
+
+	    IF S^.shape.bottom < border.bottom THEN
+		SplitSlot (S, border.bottom, FALSE);
+		S := S^.nextslot;
+	    END (*IF*);
+	    IF S^.shape.top > border.top THEN
+		SplitSlot (S, border.top+1, FALSE);
+	    END (*IF*);
+
+	    IF S^.shape.left < border.left THEN
+		SplitSlot (S, border.left, TRUE);
+		S := S^.nextslot;
+	    END (*IF*);
+	    IF S^.shape.right > border.right THEN
+		SplitSlot (S, border.right+1, TRUE);
+	    END (*IF*);
+
+	    (* We have now split TileSlots to the point where the lower	*)
+	    (* left corner of S is aligned with the lower left corner	*)
+	    (* of border, and the whole of S either matches or is	*)
+	    (* contained within the desired rectangle; so we have a	*)
+	    (* slot we can use in the final result.  All that remains	*)
+	    (* is to separate out those parts of the rectangle which	*)
+	    (* don't fit inside S, and which will be dealt with in	*)
+	    (* subsequent passes through the loop.			*)
+
+	    IF border.right > S^.shape.right THEN
+		NEW (RLptr);
+		RLptr^ := border;  RLptr^.left := S^.shape.right + 1;
+		border.right := S^.shape.right;
+		AddToQueue (StillToHandle, RLptr);
+	    END (*IF*);
+	    IF border.top > S^.shape.top THEN
+		NEW (RLptr);
+		RLptr^ := border;  RLptr^.bottom := S^.shape.top + 1;
+		border.top := S^.shape.top;
+		AddToQueue (StillToHandle, RLptr);
+	    END (*IF*);
+
+	    AddToTileSet (result, S);
+
+	UNTIL Empty (StillToHandle);
+
+	DestroyQueue (StillToHandle);
+	Release (MainLock);
+	RETURN result;
+
+    END CreateTileSet;
+
+(************************************************************************)
+
+PROCEDURE DiscardTileSet (VAR (*INOUT*) TS: TileSet);
+
+    (* Destroys TileSet TS.	*)
+
+    VAR current, following: Tile;
+
+    BEGIN
+	Obtain (MainLock);
+	DiscardLineList (TS^.lines);
+	DiscardStringList (TS^.strings);
+	DiscardStringList (TS^.upstrings);
+	current := TS^.head;
+	WHILE current <> NIL DO
+	    current^.slot^.mark := TRUE;
+	    following := current^.next;
+	    DiscardTile (current);
+	    current := following;
+	END (*WHILE*);
+	DISPOSE (TS);
+	RecombineSlots;
+	Release (MainLock);
+    END DiscardTileSet;
+
+(************************************************************************)
+
+PROCEDURE ClearTileSet (T: TileSet);
+
+    (* Removes all points, lines, and text from T, and re-displays	*)
+    (* the visible parts of T.						*)
+
+    VAR current: Tile;
+
+    BEGIN
+	Obtain (MainLock);
+	DiscardLineList (T^.lines);
+	DiscardStringList (T^.strings);
+	DiscardStringList (T^.upstrings);
+	current := T^.head;
+	WHILE current <> NIL DO
+	    ClearTileData (current);
+	    current := current^.next;
+	END (*WHILE*);
+	Release (MainLock);
+    END ClearTileSet;
+
+(************************************************************************)
+
+PROCEDURE AddPoint (T: TileSet;  p: Point;  colour: ColourType);
+
+    (* Adds a new point to TileSet T, and displays it on the screen.	*)
+
+    VAR tile: Tile;
+
+    BEGIN
+	Obtain (MainLock);
+	tile := FindTile (T, p);
+	IF T^.retain THEN
+	    AddPointToTile (p, colour, tile);
+	END (*IF*);
+	PlotDot (p.x, p.y, colour);
+	Release (MainLock);
+    END AddPoint;
+
+(************************************************************************)
+
+PROCEDURE AddLine (T: TileSet;  start, finish: Point;  colour: ColourType);
+
+    (* Adds a new line to TileSet T, and displays it on the screen.	*)
+
+    VAR LL: LineList;
+
+    BEGIN
+	Obtain (MainLock);
+	PutTileSetOnTop (T);
+	IF T^.retain THEN
+	    NEW (LL);
+	    WITH LL^ DO
+		next := T^.lines;  end1 := start;  end2 := finish;
+	    END (*WITH*);
+	    LL^.colour := colour;
+	    T^.lines := LL;
+	END (*IF*);
+	PlotLine (start.x, start.y, finish.x, finish.y, colour);
+	Release (MainLock);
+    END AddLine;
+
+(************************************************************************)
+
+PROCEDURE AddRectangle (T: TileSet;  R: Rectangle;  colour: ColourType);
+
+    (* Draws a rectangular shape.  A shorthand for four AddLine calls.	*)
+
+    VAR start, end: Point;
+
+    BEGIN
+	WITH R DO
+	    WITH start DO
+		x := left;  y := bottom;
+	    END (*WITH*);
+	    WITH end DO
+		x := right;  y := bottom;
+	    END (*WITH*);
+	END (*WITH*);
+	AddLine (T, start, end, colour);
+	end.x := R.left;  end.y := R.top;
+	AddLine (T, start, end, colour);
+	start.x := R.right;  start.y := R.top;
+	AddLine (T, start, end, colour);
+	end.x := R.right;  end.y := R.bottom;
+	AddLine (T, start, end, colour);
+    END AddRectangle;
+
+(************************************************************************)
+
+PROCEDURE AddString (T: TileSet;  place: Point;
+			VAR (*IN*) text: ARRAY OF CHAR;
+			count: CARDINAL;  colour: ColourType;  R: Rectangle);
+
+    (* Adds a string of count characters to tileset T, and displays it.	*)
+    (* Points outside rectangle R are not displayed.			*)
+
+    VAR SL: StringList;  j: CARDINAL;
+
+    BEGIN
+	Obtain (MainLock);
+	PutTileSetOnTop (T);
+	IF T^.retain THEN
+	    NEW (SL);
+	    WITH SL^ DO
+		next := T^.strings;  location := place;
+		length := count;
+		ALLOCATE (textptr, count);
+		FOR j := 0 TO count-1 DO
+		    textptr^[j] := text[j];
+		END (*FOR*);
+	    END (*WITH*);
+	    SL^.colour := colour;
+	    T^.strings := SL;
+	END (*IF*);
+	WITH R DO
+	    ClippedString (SL^.textptr^, place.x, place.y, count, colour,
+						left, right, bottom, top);
+	END (*WITH*);
+	Release (MainLock);
+    END AddString;
+
+(************************************************************************)
+
+PROCEDURE AddRotatedString (T: TileSet;  place: Point;
+			VAR (*IN*) text: ARRAY OF CHAR;
+			count: CARDINAL;  colour: ColourType;  R: Rectangle);
+
+    (* Like AddString, but writes in the +Y direction.	*)
+
+    VAR USL: StringList;  j: CARDINAL;
+
+    BEGIN
+	Obtain (MainLock);
+	PutTileSetOnTop (T);
+	IF T^.retain THEN
+	    NEW (USL);
+	    WITH USL^ DO
+		next := T^.upstrings;  location := place;
+		length := count;
+		ALLOCATE (textptr, count);
+		FOR j := 0 TO count-1 DO
+		    textptr^[j] := text[j];
+		END (*FOR*);
+	    END (*WITH*);
+	    USL^.colour := colour;
+	    T^.upstrings := USL;
+	END (*IF*);
+	WITH R DO
+	    ClippedUpString (USL^.textptr^, place.x, place.y, count, colour,
+						left, right, bottom, top);
+	END (*WITH*);
+	Release (MainLock);
+
+    END AddRotatedString;
+
+(************************************************************************)
+
+PROCEDURE ShiftTextUp (VAR (*INOUT*) List: StringList;
+				amount: CARDINAL;  limit: INTEGER);
+
+    (* Moves all character strings up by "amount" rows, discarding what	*)
+    (* falls above the limit.						*)
+
+    (* Layout fault: this procedure should be moved higher up in the	*)
+    (* module after I have completed implemented scrolling.		*)
+
+    VAR previous, current, following: StringList;
+	felloff: BOOLEAN;
+
+    BEGIN
+	previous := NIL;  current := List;
+	WHILE current <> NIL DO
+	    following := current^.next;
+	    WITH current^.location DO
+		INC (y, amount);
+		felloff := y > limit
+	    END (*WITH*);
+	    IF felloff THEN
+		IF previous = NIL THEN List := following
+		ELSE previous^.next := following;
+		END (*IF*);
+		DEALLOCATE (current^.textptr, current^.length);
+		DISPOSE (current);
+	    ELSE
+		previous := current;
+	    END (*IF*);
+	    current := following;
+	END (*WHILE*);
+    END ShiftTextUp;
+
+(************************************************************************)
+
+PROCEDURE ShiftLinesUp (List: LineList;  amount: CARDINAL;  limit: INTEGER);
+
+    (* Moves all lines up by "amount" rows, discarding what falls above	*)
+    (* the limit.							*)
+
+    (* Layout fault: this procedure should be moved higher up in the	*)
+    (* module after I have completed implemented scrolling.		*)
+
+    VAR previous, current, following: LineList;
+	felloff: BOOLEAN;
+
+    BEGIN
+	previous := NIL;  current := List;
+	WHILE current <> NIL DO
+	    following := current^.next;
+	    WITH current^.end1 DO
+		INC (y, amount);
+		felloff := y > limit;
+	    END (*WITH*);
+	    WITH current^.end2 DO
+		INC (y, amount);
+		felloff := felloff AND (y > limit);
+	    END (*WITH*);
+	    IF felloff THEN
+		IF previous = NIL THEN List := following
+		ELSE previous^.next := following;
+		END (*IF*);
+		DISPOSE (current);
+	    ELSE
+		previous := current;
+	    END (*IF*);
+	    current := following;
+	END (*WHILE*);
+    END ShiftLinesUp;
+
+(************************************************************************)
+
+PROCEDURE ScrollContents (TS: TileSet;  amount: INTEGER;  R: Rectangle);
+
+    (* Moves all data within R up by "amount" rows, discarding what	*)
+    (* falls outside the rectangle.					*)
+
+    BEGIN
+	Obtain (MainLock);
+	PutTileSetOnTop (TS);
+
+	WITH R DO
+
+	    (* Physically move the data on the screen. *)
+
+	    ACopy (left, top-amount, right-left+1,
+				top-amount-bottom+1, 0, amount);
+
+	    (* Clear the vacated section at the bottom. *)
+
+	    Fill (left, bottom, right, bottom+amount-1,
+						TS^.background);
+
+	END (*WITH*);
+
+	(* Modify our records of where everything is. *)
+	(* The shifting of points is not yet properly implemented. *)
+(*
+	ShiftPointsUp (TS, amount, R.top);
+*)
+	ShiftLinesUp (TS^.lines, amount, R.top);
+	ShiftTextUp (TS^.strings, amount, R.top);
+	ShiftTextUp (TS^.upstrings, amount, R.top);
+	Release (MainLock);
+
+    END ScrollContents;
+
+(************************************************************************)
+(*			CLEANUP ON TERMINATION				*)
+(************************************************************************)
+
+PROCEDURE Cleanup;
+
+    (* Tidies up all the leftover data on program termination, and	*)
+    (* restores the original display mode.				*)
+
+    VAR current: TileSlot;
+
+    BEGIN
+	Obtain (MainLock);
+	WHILE SlotListHead <> NIL DO
+	    IF SlotListHead^.stacktop = NIL THEN
+		current := SlotListHead;
+		SlotListHead := SlotListHead^.nextslot;
+		DISPOSE (current);
+	    ELSE
+		DiscardTileSet (SlotListHead^.stacktop^.set);
+	    END (*IF*);
+	END (*WHILE*);
+	RestoreOriginalMode;
+	Release (MainLock);
+    END Cleanup;
+
+(************************************************************************)
+(*			MODULE INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE SetUpInitialTileSlot;
+
+    (* Creates the master list of TileSlots.  Since we don't yet know	*)
+    (* what video mode will be used, we assume a very large screen.	*)
+    (* The fact that the initial tile is certainly too large is not a	*)
+    (* problem, since it will be split as new TileSets are created,	*)
+    (* and the overhead of holding TileSlots for the unusable parts is	*)
+    (* minor.								*)
+
+    CONST Large = MAX(INTEGER)-1;
+
+    BEGIN
+	Obtain (MainLock);
+	NEW (SlotListHead);
+	WITH SlotListHead^ DO
+	    WITH shape DO
+		left := 0;  bottom := 0;
+		top := Large;  right := Large;
+	    END (*WITH*);
+	    nextslot := NIL;  stacktop := NIL;  mark := FALSE;
+	END (*WITH*);
+	Release (MainLock);
+    END SetUpInitialTileSlot;
+
+(************************************************************************)
+
+BEGIN
+    CreateLock (MainLock);
+    SetUpInitialTileSlot;
+    SetTerminationProcedure (Cleanup);
+END Tiles.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/timeofda.def b/examples/Modula-2_Libraries/PMOS/sources/general/timeofda.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/timeofda.def
@@ -0,0 +1,40 @@
+DEFINITION MODULE TimeOfDay;
+
+	(****************************************************************)
+	(*								*)
+	(*			Time-of-day Module			*)
+	(*								*)
+	(*  This module keeps a time-of-day record, to the nearest 16th	*)
+	(*  of a second, by using the CMOS clock hardware.		*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	3 July 1993				*)
+	(*  Status:		OK					*)
+	(*								*)
+	(****************************************************************)
+
+TYPE TimeRecord=RECORD
+		    ticks,
+		    seconds, minutes, hours,
+		    dayofweek, dayofmonth,
+		    month, year, century	: SHORTCARD
+		END (*RECORD*);
+
+(************************************************************************)
+
+PROCEDURE ReadClock (VAR (*OUT*) result: TimeRecord);
+
+    (* Returns the current time and date.	*)
+
+PROCEDURE SetClock (VAR (*IN*) newtime: TimeRecord);
+
+    (* Modifies the current time and date.	*)
+
+PROCEDURE SetBinaryMode (NewMode: BOOLEAN);
+
+    (* Makes the clock run in BCD if NewMode is FALSE, or in binary if	*)
+    (* NewMode is TRUE.  If this requires a mode change, adjusts the	*)
+    (* current date/time values held by the hardware.			*)
+
+END TimeOfDay.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/timeofda.mod b/examples/Modula-2_Libraries/PMOS/sources/general/timeofda.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/timeofda.mod
@@ -0,0 +1,323 @@
+IMPLEMENTATION MODULE TimeOfDay;
+
+	(****************************************************************)
+	(*								*)
+	(*			Time-of-day Module			*)
+	(*								*)
+	(*  This module keeps a time-of-day record, to the nearest 16th	*)
+	(*  of a second, by using the CMOS clock hardware.		*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	22 March 1995				*)
+	(*  Status:		Working					*)
+	(*								*)
+	(****************************************************************)
+
+FROM MiscPMOS IMPORT
+    (* proc *)	ReadCMOS, WriteCMOS, EnterCriticalSection, LeaveCriticalSection;
+
+FROM LowLevel IMPORT
+    (* proc *)	IORB, IAND, IANDB, LS, RS, OutByte, InByte;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, WriteString, WriteLn;
+
+FROM NumericIO IMPORT
+    (* proc *)	WriteHexByte;
+
+FROM TaskControl IMPORT
+    (* proc *)	CreateInterruptTask, WaitForInterrupt;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure;
+
+(************************************************************************)
+(*									*)
+(*  The first 14 bytes of CMOS are used for the real-time clock:	*)
+(*									*)
+(*	00	seconds			01	second alarm		*)
+(*	02	minutes			03	minute alarm		*)
+(*	04	hours			05	hour alarm		*)
+(*	06	day of week		07	date of month		*)
+(*	08	month			09	year			*)
+(*	0A	status register A	0B	status register B	*)
+(*	0C	status register C	0D	status register D	*)
+(*									*)
+(*  Byte number 50 (decimal) holds the century.  This is maintained	*)
+(*  by software, not hardware.						*)
+(*									*)
+(*  Times and dates are normally stored in BCD format, although there	*)
+(*  is an option to use binary.  The four status registers are for	*)
+(*  various options and flags; for the details, the Technical Reference	*)
+(*  Manual should be consulted.						*)
+(*									*)
+(************************************************************************)
+
+CONST
+    InterruptNo = 70H;		(* hardware interrupt number *)
+    StatusA = 10;		(* status register A	*)
+    StatusB = 11;		(* status register B	*)
+    StatusC = 12;		(* status register C	*)
+
+VAR
+    MasterTime: TimeRecord;
+
+    (* BinaryClock keeps track of whether we are currently running in	*)
+    (* binary mode.  (If FALSE, we are running in BCD mode.)		*)
+
+    BinaryClock: BOOLEAN;
+
+    (* WrapPending should logically be a local static variable of the	*)
+    (* interrupt handler, but Modula-2 has no local static variables.	*)
+
+    WrapPending: BOOLEAN;
+
+(************************************************************************)
+(*			    THE INTERRUPT TASK				*)
+(************************************************************************)
+
+PROCEDURE InterruptHandler;
+
+    CONST UF = 010H;	(* update-ended flag in Status Register C *)
+	testing = FALSE;
+
+    VAR flags: BYTE;
+	w: Window;
+
+    BEGIN
+	IF testing THEN
+	    OpenWindow (w, blue, cyan, 16, 24, 0, 79, simpleframe, nodivider);
+	END (*IF*);
+
+	LOOP (*FOREVER*)
+	    WaitForInterrupt;
+	    flags := ReadCMOS (StatusC);
+
+	    IF testing THEN
+		WriteHexByte (w, flags);  WriteString (w, "  ");
+	    END (*IF*);
+
+	    IF ORD(IANDB (flags, UF)) <> 0 THEN
+		WITH MasterTime DO
+		    ticks := 0;
+		    seconds := ReadCMOS (0);
+		    minutes := ReadCMOS (2);
+		    hours := ReadCMOS (4);
+		    dayofweek := ReadCMOS (6);
+		    dayofmonth := ReadCMOS (7);
+		    month := ReadCMOS (8);
+		    year := ReadCMOS (9);
+		    century := ReadCMOS (50);
+		    IF ((year=99) AND BinaryClock)
+		    		OR ((year=99H) AND NOT BinaryClock) THEN
+			WrapPending := TRUE;
+		    ELSIF WrapPending AND (year = 0) THEN
+			WrapPending := FALSE;
+			INC (century);
+			IF NOT BinaryClock
+				AND (ORD(IANDB(century,0FH)) > 9) THEN
+			    INC (century, 6);
+			END (*IF*);
+			WriteCMOS (50, century);
+		    END (*IF*);
+		END (*WITH*);
+
+		IF testing THEN WriteLn(w) END(*IF*);
+
+	    ELSE
+		INC(MasterTime.ticks);
+	    END (*IF*);
+
+	END (*LOOP*);
+    END InterruptHandler;
+
+(************************************************************************)
+(*			READING AND SETTING THE CLOCK			*)
+(************************************************************************)
+
+PROCEDURE ReadClock (VAR (*OUT*) result: TimeRecord);
+
+    (* Returns the current time and date.	*)
+
+    BEGIN
+
+	(* Take a copy of the master time record, disabling clock	*)
+	(* interrupts via the slave interrupt mask register.		*)
+
+	OutByte (0A1H, IORB(InByte(0A1H), 1));
+	result := MasterTime;
+	OutByte (0A1H, IANDB(InByte(0A1H), 0FEH));
+    END ReadClock;
+
+(************************************************************************)
+
+PROCEDURE SetClock (VAR (*IN*) newtime: TimeRecord);
+
+    (* Modifies the current time and date.  Note that newtime.ticks is	*)
+    (* in effect ignored.  To take that into account, and thereby	*)
+    (* achieve greater accuracy, we would need to use the more complex	*)
+    (* approach of delaying for a few ticks before resetting.		*)
+
+    VAR PSW: CARDINAL;
+
+    BEGIN
+	(* Disable clock interrupts by setting a bit in the mask	*)
+	(* register of the slave interrupt controller.  Also prevent	*)
+	(* any clock updates by setting the high-order bit of Status	*)
+	(* Register B.  For extra safety (just in case other tasks are	*)
+	(* accessing CMOS), disable processor interrupts as well.	*)
+
+	PSW := EnterCriticalSection();
+	OutByte (0A1H, IORB(InByte(0A1H), 1));
+	WriteCMOS (StatusB, IORB(ReadCMOS(StatusB), 80H));
+
+	MasterTime := newtime;
+	WITH newtime DO
+	    WriteCMOS (0, seconds);
+	    WriteCMOS (2, minutes);
+	    WriteCMOS (4, hours);
+	    WriteCMOS (6, dayofweek);
+	    WriteCMOS (7, dayofmonth);
+	    WriteCMOS (8, month);
+	    WriteCMOS (9, year);
+	    WriteCMOS (50, century);
+	END (*WITH*);
+
+	(* Re-enable the clock.	*)
+
+	OutByte (0A1H, IANDB(InByte(0A1H), 0FEH));
+	WriteCMOS (StatusB, IANDB(ReadCMOS(StatusB), 7FH));
+	LeaveCriticalSection (PSW);
+
+    END SetClock;
+
+(************************************************************************)
+(*		     SETTING CLOCK MODE TO BINARY OR BCD		*)
+(************************************************************************)
+
+PROCEDURE Convert (j: CARDINAL;  SetToBinary: BOOLEAN);
+
+    (* Converts the value in CMOS register j from BCD to binary if	*)
+    (* SetToBinary is TRUE, and from binary to BCD otherwise.		*)
+
+    VAR value: CARDINAL;
+
+    BEGIN
+	value := ORD(ReadCMOS(j));
+	IF SetToBinary THEN
+	    value := 10*ORD(RS(value, 4)) + ORD(IAND(value, 0FH));
+	ELSE
+	    value := ORD(LS(value DIV 10, 4)) + (value MOD 10);
+	END (*IF*);
+	WriteCMOS (j, BYTE(value));
+    END Convert;
+
+(************************************************************************)
+
+PROCEDURE SetBinaryMode (NewMode: BOOLEAN);
+
+    (* Makes the clock run in BCD if NewMode is FALSE, or in binary if	*)
+    (* NewMode is TRUE.  If this requires a mode change, adjusts the	*)
+    (* current date/time values held by the hardware.			*)
+
+    VAR j: CARDINAL;  StatusBvalue: BYTE;
+
+    BEGIN
+	StatusBvalue := ReadCMOS (StatusB);
+	IF (BinaryClock <> NewMode) THEN
+
+	    (* Modify our copy of the date mode bit. *)
+
+	    StatusBvalue := IANDB (StatusBvalue, 07BH);
+	    IF NewMode THEN
+		INC (StatusBvalue, 4);
+	    END (*IF*);
+
+	    (* Disable clock interrupts and clock updating.  See	*)
+	    (* procedure SetClock for explanation.			*)
+
+	    OutByte (0A1H, IORB (InByte (0A1H), 1));
+	    WriteCMOS (StatusB, IORB (StatusBvalue, 080H));
+
+	    (* Modify all the time and date values. *)
+
+	    FOR j := 0 TO 9 DO
+		Convert(j, NewMode);
+	    END (*FOR*);
+	    Convert (50, NewMode);	(* Don't forget the century *)
+
+	    (* Re-enable the clock in the new mode.	*)
+
+	    BinaryClock := NewMode;
+	    WriteCMOS (StatusB, StatusBvalue);
+	    OutByte (0A1H, IANDB(InByte(0A1H), 0FEH));
+
+	END (*IF*);
+    END SetBinaryMode;
+
+(************************************************************************)
+(*			PROGRAM TERMINATION HANDLER			*)
+(************************************************************************)
+
+PROCEDURE Cleanup;
+
+    (* Disables CMOS interrupts, and sets the CMOS clock back to its	*)
+    (* standard MS-DOS setup condition.					*)
+
+    VAR PSW: CARDINAL;
+
+    BEGIN
+	PSW := EnterCriticalSection();
+	SetBinaryMode (FALSE);
+	WriteCMOS (StatusA, 26H);
+	WriteCMOS (StatusB, 2);
+	LeaveCriticalSection (PSW);
+    END Cleanup;
+
+(************************************************************************)
+(*				INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE HardwareSetup;
+
+    CONST
+	PIenable = 40H;		(* periodic interrupt enable	*)
+	UIenable = 10H;		(* update-ended interrupt enable *)
+	mode24 = 2;		(* 24-hour mode *)
+
+    VAR PSW: CARDINAL;
+
+    BEGIN
+	PSW := EnterCriticalSection();
+	BinaryClock := ORD(IANDB(ReadCMOS (StatusB), 4)) <> 0;
+	SetBinaryMode (FALSE);
+
+	(* Select a periodic clock rate of 16 Hz.	*)
+
+	WriteCMOS (StatusA, 2CH);
+
+	(* Set the desired interrupt options in status register B, and	*)
+	(* install the interrupt handler.				*)
+
+	WriteCMOS (StatusB, PIenable+mode24);
+	CreateInterruptTask (InterruptNo, InterruptHandler, "CMOS interrupt");
+
+	(* Clear a bit in the interrupt mask register.  The mask	*)
+	(* register address is 21H for the master interrupt controller,	*)
+	(* 0A1H for the slave.						*)
+
+	OutByte (0A1H, IANDB(InByte(0A1H), 0FEH));
+	OutByte (021H, IANDB(InByte(021H), 0FBH));
+	LeaveCriticalSection (PSW);
+
+    END HardwareSetup;
+
+(************************************************************************)
+
+BEGIN
+    WrapPending := FALSE;
+    SetTerminationProcedure (Cleanup);
+    HardwareSetup;
+END TimeOfDay.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/timer.def b/examples/Modula-2_Libraries/PMOS/sources/general/timer.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/timer.def
@@ -0,0 +1,44 @@
+DEFINITION MODULE Timer;
+
+	(********************************************************)
+	(*							*)
+	(*	Clock handler for operating system.		*)
+	(*							*)
+	(*	Author:		P. Moylan			*)
+	(*	Last edited:	27 May 1989			*)
+	(*	Description:					*)
+	(*		This module contains the clock		*)
+	(*		interrupt routine.  It checks whether	*)
+	(*		the current task has used its time	*)
+	(*		quota, also keeps track of sleeping	*)
+	(*		tasks.					*)
+	(*							*)
+	(*	Status:	Seems to be working.			*)
+	(*							*)
+	(********************************************************)
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore;
+
+PROCEDURE Sleep (milliseconds: CARDINAL);
+
+    (* Puts the caller to sleep for approximately the given number of	*)
+    (* milliseconds.  The time is not guaranteed to be precise, because	*)
+    (* (a) after the specified time has expired, the caller is made	*)
+    (* ready, but will not run immediately unless it has a higher	*)
+    (* priority than the task which is running at that time, and (b) we	*)
+    (* do not necessarily run the hardware timer with millisecond	*)
+    (* resolution anyway.  High resolution just adds to the system	*)
+    (* overhead created by the timer interrupts.  For an application	*)
+    (* which genuinely needs high-precision delays, it makes more sense	*)
+    (* to have a separate hardware timer dedicated just to that job.	*)
+
+PROCEDURE TimedWait (VAR (*INOUT*) s: Semaphore;  TimeLimit: INTEGER;
+					VAR (*OUT*) TimedOut: BOOLEAN);
+
+    (* Like a semaphore Wait, except that it returns with TimedOut TRUE	*)
+    (* if the corresponding Signal does not occur within TimeLimit	*)
+    (* milliseconds.							*)
+
+END Timer.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/timer.mod b/examples/Modula-2_Libraries/PMOS/sources/general/timer.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/timer.mod
@@ -0,0 +1,296 @@
+IMPLEMENTATION MODULE Timer;
+(*  disable # debug(vid=>off) *)
+
+	(********************************************************)
+	(*							*)
+	(*		   Clock tick handler			*)
+	(*							*)
+	(*	Author:		P. Moylan			*)
+	(*	Last edited:	17 March 1995			*)
+	(*	Description:					*)
+	(*	  This module contains the clock interrupt	*)
+	(*	  handler.  It checks whether the current task	*)
+	(*	  has used its time quota, also keeps track of	*)
+	(*	  delayed tasks and timeouts.			*)
+	(*							*)
+	(*	Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM LowLevel IMPORT
+    (*<ChainTimerInt*)
+    (* proc *)	INCV, MakePointer,
+    (*>*)
+    (* proc *)	LowByte, HighByte, OutByte;
+
+FROM MiscPMOS IMPORT
+    (* proc *)	EnterCriticalSection, LeaveCriticalSection;
+
+FROM Semaphores IMPORT
+    (*<ChainTimerInt*)
+    (* proc *)	CreateSemaphore, Wait, Signal,
+    (*>*)
+    (* proc *)	TimedWaitT;
+
+FROM TaskControl IMPORT
+    (*<ChainTimerInt*)
+    (* proc *)	CreateTask, NotUsingFloatingPoint,
+    (*>*)
+    (* proc *)	CreateInterruptTask, KillInterruptTask, WaitForInterrupt,
+    		Delay, CheckSleepers, TimeSliceCheck;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure;
+
+(************************************************************************)
+
+CONST MillisecondsPerTick = 20;
+
+    (* It is convenient to choose milliseconds as the system-wide unit	*)
+    (* for things like time delays (or, at least, for time delays	*)
+    (* controlled by this module), on the grounds that a resolution	*)
+    (* finer than one millisecond could make the handling of timer	*)
+    (* interrupts a major source of system overhead.			*)
+    (* Hardware limitations restrict the value of MillisecondsPerTick	*)
+    (* to be in the range [1..109].  We could in principle go as low as	*)
+    (* 1.7 microseconds per tick by using real arithmetic, but that	*)
+    (* would be fooling ourselves - the timer can go that fast, but the	*)
+    (* processor would not keep up.					*)
+
+CONST channel0 = 040H;  TimerControlPort = 043H;
+
+    (* I/O port definitions for the 8254 timer chip.	*)
+
+    (* The following variables are used only in the case where we want	*)
+    (* to enable the timer interrupt handler that was active before	*)
+    (* this program started running.  There's some overhead in doing	*)
+    (* this, but in some environments it's necessary in order to avoid	*)
+    (* killing background stuff.					*)
+
+(*<ChainTimerInt*)
+(*# save, call(interrupt=>on, reg_param=>(), same_ds=>off, near_call=>off) *)
+(*# data(near_ptr => off) *)
+TYPE IntProc = PROCEDURE();
+     IntProcPointer = POINTER TO IntProc;
+VAR OriginalHandler: IntProc;
+(*# restore *)
+
+VAR
+    ClockCount, CountPerInterrupt: CARDINAL;
+    CounterWrap: Semaphore;
+(*>*)
+
+(************************************************************************)
+(*			"PUT-ME-TO-SLEEP" PROCEDURE			*)
+(************************************************************************)
+
+PROCEDURE Sleep (milliseconds: CARDINAL);
+
+    (* Puts the caller to sleep for approximately the given number of	*)
+    (* milliseconds.  The time is not guaranteed to be precise, because	*)
+    (* (a) after the specified time has expired, the caller is made	*)
+    (* ready, but will not run immediately unless it has a higher	*)
+    (* priority than the task which is running at that time, and (b) we	*)
+    (* do not necessarily run the hardware timer with millisecond	*)
+    (* resolution anyway.  High resolution just adds to the system	*)
+    (* overhead created by the timer interrupts.  For an application	*)
+    (* which genuinely needs high-precision delays, it makes more sense	*)
+    (* to have a separate hardware timer dedicated just to that job.	*)
+
+    BEGIN
+	Delay (milliseconds DIV MillisecondsPerTick);
+    END Sleep;
+
+(************************************************************************)
+(*			SEMAPHORE WAIT WITH TIMEOUT			*)
+(************************************************************************)
+
+PROCEDURE TimedWait (VAR (*INOUT*) s: Semaphore;  TimeLimit: INTEGER;
+					VAR (*OUT*) TimedOut: BOOLEAN);
+
+    (* Like a semaphore Wait, except that it returns with TimedOut TRUE	*)
+    (* if the corresponding Signal does not occur within TimeLimit	*)
+    (* milliseconds.							*)
+
+    BEGIN
+	TimedWaitT (s,
+	    (TimeLimit + MillisecondsPerTick DIV 2) DIV MillisecondsPerTick,
+	    TimedOut);
+    END TimedWait;
+
+(************************************************************************)
+(*			    THE INTERRUPT TASK				*)
+(************************************************************************)
+
+PROCEDURE ClockInterruptTask;
+
+    (* Activated periodically by the hardware clock.  In between ticks,	*)
+    (* we become dormant via a call to WaitForInterrupt.  This task	*)
+    (* has two functions:						*)
+    (* 1.  Check whether a sleeping task needs to be woken up, and wake	*)
+    (*     it up if so.							*)
+    (* 2.  Check whether the running task has used its time quota, and	*)
+    (*     if so deal with that situation.				*)
+    (* To spread the load on the system, we perform the above functions	*)
+    (* on alternate clock ticks.					*)
+
+    BEGIN
+	LOOP (*FOREVER*)
+
+	    (* On the first interrupt, check the time allotment of	*)
+	    (* the interrupted task.  (This does nothing unless		*)
+	    (* timeslicing is enabled in module TaskControl.)		*)
+
+	    WaitForInterrupt;
+	    TimeSliceCheck;
+
+	    (*<ChainTimerInt*)
+	    IF INCV (ClockCount, CountPerInterrupt) THEN
+		Signal (CounterWrap);
+	    END (*IF*);
+	    (*>*)
+
+	    (* On the next interrupt, check for sleeping tasks.	*)
+
+	    WaitForInterrupt;
+
+	    (*<ChainTimerInt*)
+	    IF INCV (ClockCount, CountPerInterrupt) THEN
+		(* Important note: this Signal must come BEFORE the	*)
+		(* call to CheckSleepers, because of complications	*)
+		(* related to the way the kernel handles time-outs.	*)
+		Signal (CounterWrap);
+	    END (*IF*);
+	    (*>*)
+
+	    CheckSleepers;
+
+	END (*LOOP*);
+    END ClockInterruptTask;
+
+(************************************************************************)
+(*		EXECUTING THE ORIGINAL TIMER INTERRUPT ROUTINE		*)
+(************************************************************************)
+
+(*<ChainTimerInt*)
+
+PROCEDURE LookAfterOriginalInterruptRoutine;
+
+    (* This is a separate task which calls the original interrupt	*)
+    (* routine (i.e. the one that was active before this module took	*)
+    (* over) each time the timer count wraps around.			*)
+
+    (* You're probably wondering why we use this roundabout method of	*)
+    (* calling the routine.  The answer is that there's a conflict	*)
+    (* between the PMOS design conventions and the BIOS approach.	*)
+    (* PMOS requires that interrupt tasks be non-interruptible; but	*)
+    (* BIOS interrupt handlers often re-enable interrupts.  Thus, we	*)
+    (* cannot safely execute a BIOS routine from inside an interrupt	*)
+    (* task.								*)
+
+    BEGIN
+	NotUsingFloatingPoint ();
+	LOOP
+	    Wait (CounterWrap);
+	    OriginalHandler;
+	END (*LOOP*);
+    END LookAfterOriginalInterruptRoutine;
+
+(*>*)
+
+(************************************************************************)
+(*			CLEANUP ON PROGRAM TERMINATION			*)
+(************************************************************************)
+
+PROCEDURE SetCount (count: CARDINAL);
+
+    (* Set up timer 0 to generate a square wave of period proportional	*)
+    (* to parameter 'count'.  Note: There are three timers on the timer	*)
+    (* chip, but only timer 0 is available for our present purposes;	*)
+    (* the other two are hardwired to do sound generation and dynamic	*)
+    (* RAM refresh.							*)
+
+    BEGIN
+	OutByte (TimerControlPort, 036H);
+	OutByte (channel0, LowByte(count));
+	OutByte (channel0, HighByte(count));
+    END SetCount;
+
+(************************************************************************)
+
+PROCEDURE Cleanup;
+
+    (* Restores the timer 0 frequency to that used by MS-DOS, and	*)
+    (* de-installs the interrupt handler.				*)
+
+    VAR savedPSW: CARDINAL;
+
+    BEGIN
+	savedPSW := EnterCriticalSection();
+	SetCount (0);
+	KillInterruptTask (8);
+	LeaveCriticalSection (savedPSW);
+    END Cleanup;
+
+(************************************************************************)
+(*			      INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE InitialiseClock;
+
+    (* Performs the appropriate hardware initialisation to (a) set up	*)
+    (* the hardware timer to interrupt at the desired rate, and (b) set	*)
+    (* up the interrupt vector to point to the interrupt routine.	*)
+
+    VAR savedPSW: CARDINAL;
+	(*<ChainTimerInt*) p: IntProcPointer; (*>*)
+
+    BEGIN
+	savedPSW := EnterCriticalSection();
+
+	(* The input frequency to the hardware timer is 1.19318 MHz,	*)
+	(* and the actual interrupt frequency is this frequency divided	*)
+	(* by variable "count".  There is an extra factor of 2 caused	*)
+	(* by the fact that our interrupt task effectively divides	*)
+	(* the interrupt frequency by 2.  The end result is the		*)
+	(* following formula:						*)
+
+	(*<~ChainTimerInt
+	SetCount ((59659 * MillisecondsPerTick + 50) DIV 100);
+	>*)
+
+	(*<ChainTimerInt*)
+
+	(* In the case where we're chaining the timer interrupt, we	*)
+	(* have to initialise some extra variables and create a new	*)
+	(* task to handle the job.					*)
+
+	CountPerInterrupt := (59659 * MillisecondsPerTick + 50) DIV 100;
+	SetCount (CountPerInterrupt);
+	ClockCount := 0;
+	CreateSemaphore (CounterWrap, 0);
+	p := MakePointer (0, 8*4);
+	OriginalHandler := p^;
+
+	(* The priority assigned in the next call may need to be varied	*)
+	(* depending on the application.  With a Microsoft mouse driver	*)
+	(* it is essential that the priority be >1; otherwise the mouse	*)
+	(* driver crashes the entire system.  With some communications	*)
+	(* drivers we might want to make the priority even higher.	*)
+
+	CreateTask (LookAfterOriginalInterruptRoutine, 2, "Old timer int");
+	(*>*)
+
+	(* Connect the interrupt routine to the interrupt source. *)
+
+	CreateInterruptTask (8, ClockInterruptTask, "Heartbeat tick");
+
+	LeaveCriticalSection (savedPSW);
+    END InitialiseClock;
+
+(************************************************************************)
+
+BEGIN
+    SetTerminationProcedure (Cleanup);
+    InitialiseClock;
+END Timer.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/trace.def b/examples/Modula-2_Libraries/PMOS/sources/general/trace.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/trace.def
@@ -0,0 +1,52 @@
+DEFINITION MODULE Trace;
+
+	(************************************************)
+	(*						*)
+	(*	    Trace routines for Modula-2		*)
+	(*		program development.		*)
+	(*						*)
+	(*  Programmer:		P. Moylan		*)
+	(*  Last edited:	16 August 1992		*)
+	(*  Status:		Working on TS conversion*)
+	(*						*)
+	(************************************************)
+
+FROM Windows IMPORT
+    (* type *)	RowRange, ColumnRange;
+
+PROCEDURE NYI (name: ARRAY OF CHAR);
+
+	(* Types a "not yet implemented" message.	*)
+
+PROCEDURE Pause;
+
+	(* "Press any key to continue."			*)
+
+PROCEDURE InTrace (name: ARRAY OF CHAR);
+
+	(* Types "Entering 'name'".	*)
+
+PROCEDURE OutTrace (name: ARRAY OF CHAR);
+
+	(* Types "Leaving 'name'".	*)
+
+PROCEDURE TraceOn (firstrow, lastrow: RowRange;
+			firstcol, lastcol: ColumnRange;
+			SlowDownFactor: CARDINAL);
+
+	(* Turns on tracing.  The first four parameters specify the	*)
+	(* size of a screen window to be used for trace messages.  The	*)
+	(* size of the final parameter governs how slowly the program	*)
+	(* will run - it is needed because in many cases the trace	*)
+	(* messages appear on the screen faster than you can read them.	*)
+
+PROCEDURE TraceOff;
+
+	(* Turns off tracing.		*)
+
+PROCEDURE TraceStatus(): BOOLEAN;
+
+	(* Says whether tracing is currently on.	*)
+
+END Trace.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/trace.mod b/examples/Modula-2_Libraries/PMOS/sources/general/trace.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/trace.mod
@@ -0,0 +1,199 @@
+IMPLEMENTATION MODULE Trace;
+
+	(************************************************)
+	(*						*)
+	(*	    Trace routines for Modula-2		*)
+	(*		program development.		*)
+	(*						*)
+	(*  Programmer:		P. Moylan		*)
+	(*  Last edited:	21 February 1994	*)
+	(*  Status:		OK			*)
+	(*						*)
+	(************************************************)
+
+FROM Mouse IMPORT
+    (* proc *)	MouseAvailable;
+
+FROM Windows IMPORT
+    (* type *)	Window,
+    (* proc *)	OpenSimpleWindow, CloseWindow, WriteString, WriteLn,
+		ReadChar, EraseLine, CursorUp;
+
+FROM UserInterface IMPORT
+    (* type *)	UIWindow, Capability, CapabilitySet,
+    (* proc *)	AllowMouseControl;
+
+(************************************************************************)
+
+VAR TraceWindowOpen, TraceEnabled: BOOLEAN;
+    nesting: CARDINAL;  PauseLength: CARDINAL;
+    TraceWindow: Window;
+
+(************************************************************************)
+
+PROCEDURE Pause;
+
+    (* Types a "Press any key to continue" message.	*)
+    (* A temporary trace window is opened if necessary.	*)
+
+    VAR dummy: CHAR;  UIW: UIWindow;
+
+    BEGIN
+	IF NOT TraceWindowOpen THEN
+	    OpenSimpleWindow (TraceWindow, 22, 24, 0, 28);
+	    IF MouseAvailable() THEN
+		UIW := AllowMouseControl (TraceWindow, "Pause message",
+					CapabilitySet {wshow, wmove});
+	    END (*IF*);
+	END (*IF*);
+	WriteLn (TraceWindow);
+	WriteString (TraceWindow, "Press any key to continue.");
+	ReadChar (TraceWindow, dummy);
+	IF TraceWindowOpen THEN    (* i.e. not just the temporary window *)
+	    EraseLine (TraceWindow, 0);  CursorUp(TraceWindow);
+	ELSE
+	    CloseWindow (TraceWindow);
+	END (*IF*);
+    END Pause;
+
+(************************************************************************)
+
+PROCEDURE NYI (name: ARRAY OF CHAR);
+
+    (* Types a "not yet implemented" message.  A trace window is opened	*)
+    (* if necessary.							*)
+
+    VAR UIW: UIWindow;
+
+    BEGIN
+	IF NOT TraceWindowOpen THEN
+	    OpenSimpleWindow (TraceWindow, 21, 24, 1, 45);
+	    TraceWindowOpen := TRUE;
+	    IF MouseAvailable() THEN
+		UIW := AllowMouseControl (TraceWindow, "Procedure trace",
+				CapabilitySet {wshow, wmove, whide});
+	    END (*IF*);
+	END (*IF*);
+	WriteLn (TraceWindow);
+	WriteString (TraceWindow, name);
+	WriteString (TraceWindow, " is not yet implemented.");
+    END NYI;
+
+(************************************************************************)
+
+PROCEDURE DeliberatePause;
+
+    (* Inserts a delay in execution, for situations where the trace	*)
+    (* messages would otherwise flash by on the screen too quickly	*)
+    (* to read.								*)
+
+    VAR j,k: CARDINAL;
+
+    BEGIN
+	FOR j := 1 TO PauseLength DO
+	    FOR k := 0 TO 1000 DO
+		(*NOTHING*)
+	    END(*FOR*);
+	END (*FOR*);
+    END DeliberatePause;
+
+(************************************************************************)
+
+PROCEDURE InTrace (name: ARRAY OF CHAR);
+
+    (* To be called when entering a procedure.	*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	IF TraceEnabled THEN
+	    WriteLn (TraceWindow);
+	    FOR j := 1 TO nesting DO
+		WriteString (TraceWindow, "   ");
+	    END (*FOR*);
+	    WriteString (TraceWindow, "Entering ");
+	    WriteString (TraceWindow, name);
+	    DeliberatePause;
+	END (*IF*);
+	INC (nesting);
+    END InTrace;
+
+(************************************************************************)
+
+PROCEDURE OutTrace (name: ARRAY OF CHAR);
+
+    (* To be called when leaving a procedure.	*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	DEC (nesting);
+	IF TraceEnabled THEN
+	    WriteLn (TraceWindow);
+	    FOR j := 1 TO nesting DO
+		WriteString (TraceWindow, "   ");
+	    END (*FOR*);
+	    WriteString (TraceWindow, "Leaving ");
+	    WriteString (TraceWindow, name);
+	    DeliberatePause;
+	END (*IF*);
+    END OutTrace;
+
+(************************************************************************)
+
+PROCEDURE TraceOn (firstrow, lastrow: RowRange;
+			firstcol, lastcol: ColumnRange;
+			SlowDownFactor: CARDINAL);
+
+    (* Turns tracing on.		*)
+
+    VAR UIW: UIWindow;
+
+    BEGIN
+	IF TraceWindowOpen THEN
+
+	    (* Close any previous trace window. *)
+
+	    CloseWindow (TraceWindow);
+
+	END (*IF*);
+	PauseLength := SlowDownFactor;
+	OpenSimpleWindow (TraceWindow, firstrow, lastrow, firstcol, lastcol);
+	IF MouseAvailable() THEN
+	    UIW := AllowMouseControl (TraceWindow, "Procedure trace",
+				CapabilitySet {wshow, wmove, whide});
+	END (*IF*);
+	TraceWindowOpen := TRUE;  TraceEnabled := TRUE;
+    END TraceOn;
+
+(************************************************************************)
+
+PROCEDURE TraceOff;
+
+    (* Turns tracing off.		*)
+
+    BEGIN
+	IF TraceEnabled THEN
+	    CloseWindow (TraceWindow);  TraceWindowOpen := FALSE;
+	END (*IF*);
+	TraceEnabled := FALSE;
+    END TraceOff;
+
+(************************************************************************)
+
+PROCEDURE TraceStatus (): BOOLEAN;
+
+    (* Says whether tracing is currently on.		*)
+
+    BEGIN
+	RETURN TraceEnabled;
+    END TraceStatus;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+BEGIN
+    TraceEnabled := FALSE;  nesting := 0;  TraceWindowOpen := FALSE;
+END Trace.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/types.def b/examples/Modula-2_Libraries/PMOS/sources/general/types.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/types.def
@@ -0,0 +1,32 @@
+DEFINITION MODULE Types;
+
+	(********************************************************)
+	(*							*)
+	(*	Definitions of non-quite-portable types		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	15 March 1995			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT BYTE, WORD, ADDRESS (*<TopSpeed3*) , FarADDRESS (*>*);
+
+(*<TopSpeed3*) (*# save, data(near_ptr => off) *) (*>*)
+
+TYPE
+    (* Pointer types which must be "far" regardless of the memory model	*)
+
+    FarPointer = (*<~TopSpeed3 ADDRESS; >*)
+		 (*<TopSpeed3*) FarADDRESS; (*>*)
+    FarBytePointer = POINTER TO BYTE;
+    FarWordPointer = POINTER TO WORD;
+    FarCharPointer = POINTER TO CHAR;
+    FarCardPointer = POINTER TO CARDINAL;
+    FarPointerPointer = (*<~TopSpeed3 POINTER TO ADDRESS; >*)
+			 (*<TopSpeed3*) POINTER TO FarADDRESS; (*>*)
+    FarProcPointer = POINTER TO PROCEDURE();
+
+(*<TopSpeed3*) (*# restore *) (*>*)
+
+END Types.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/types.mod b/examples/Modula-2_Libraries/PMOS/sources/general/types.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/types.mod
@@ -0,0 +1,16 @@
+IMPLEMENTATION MODULE Types;
+
+	(********************************************************)
+	(*							*)
+	(*	Definitions of non-quite-portable types		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 February 1995		*)
+	(*  Status:		OK				*)
+	(*							*)
+	(*	The implementation part is deliberately empty	*)
+	(*							*)
+	(********************************************************)
+
+END Types.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/userinte.def b/examples/Modula-2_Libraries/PMOS/sources/general/userinte.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/userinte.def
@@ -0,0 +1,94 @@
+DEFINITION MODULE UserInterface;
+
+	(****************************************************************)
+	(*								*)
+	(*		Text User Interface for PMOS			*)
+	(*								*)
+	(*	This module allows you to put selected text windows	*)
+	(*	under the control of the mouse.  In the present		*)
+	(*	version, the controls available are for repositioning	*)
+	(*	and for hiding windows.  The module also lets you	*)
+	(*	define "active regions" within windows, i.e. regions	*)
+	(*	within which a mouse click will cause a caller-supplied	*)
+	(*	procedure to be executed.				*)
+	(*								*)
+	(*		Original version by M.Walsh.			*)
+	(*		  This version by P.Moylan			*)
+	(*								*)
+	(*	Last Edited:	25 February 1994			*)
+	(*	Status:		OK					*)
+	(*								*)
+	(****************************************************************)
+
+FROM Mouse IMPORT
+    (* type *)	ButtonSet;
+
+FROM Windows IMPORT
+    (* type *)	RowRange, ColumnRange, Window;
+
+(************************************************************************)
+
+TYPE
+    (* A UIWindow is like a Window from module Windows, but it has	*)
+    (* a few extra attributes added for the purposes of this module.	*)
+
+    UIWindow;	(* is private *)
+
+    (* The capabilities which you can add to a Window by making it into	*)
+    (* a UIWindow are:							*)
+    (*	wshow	left click anywhere on visible part of window (except,	*)
+    (*		of course, regions for which other click actions are	*)
+    (*		defined) brings it to the top of the stack of windows.	*)
+    (*		This will also change the input focus in cases where	*)
+    (*		a task is waiting for keyboard input in this window.	*)
+    (*	whide	window gets a "hide button", and left clicking on this	*)
+    (*		makes the window invisible.				*)
+    (*	wmove	window gets a "move button", and you can drag the	*)
+    (*		window around the screen with the left or right button.	*)
+    (*	wescape	window gets a "hide button", and left clicking on this	*)
+    (*		simulates an Esc from the keyboard.  Note that this	*)
+    (*		option supersedes the operation of whide, since the	*)
+    (*		same button location is used for both.			*)
+
+    Capability = (wshow, wmove, whide, wescape);
+    CapabilitySet = SET OF Capability;
+
+    (* This module also gives a special meaning to a right mouse click	*)
+    (* on a blank area of the screen: it brings up a list of windows	*)
+    (* for which mouse control is enabled, and you can click on a	*)
+    (* window name to bring that window to the top of the display.	*)
+    (* This is a way of getting back hidden windows.			*)
+
+    (* An Action procedure is one to be called on a mouse click in a	*)
+    (* defined Active Region.  The parameters identify the window	*)
+    (* which was clicked on, and the row and column within that window.	*)
+
+    Action = PROCEDURE (Window, RowRange, ColumnRange);
+
+(************************************************************************)
+(*		ACTIVATING MOUSE CONTROL FOR A WINDOW			*)
+(************************************************************************)
+
+PROCEDURE AllowMouseControl (w: Window;  Title: ARRAY OF CHAR;
+				OptionsEnabled: CapabilitySet): UIWindow;
+
+    (* Adds w to the set of windows which this module is allowed to	*)
+    (* manipulate.  The window should already be open (but not		*)
+    (* necessarily visible).  The Title parameter gives a name to be	*)
+    (* used when a list of windows is displayed.			*)
+
+(************************************************************************)
+(*			DEFINING ACTIVE REGIONS				*)
+(************************************************************************)
+
+PROCEDURE AddActiveRegion (UIW: UIWindow; Top, Bottom: RowRange;
+			Left, Right: ColumnRange;  ButtonsEnabled: ButtonSet;
+			ActionProc: Action);
+
+    (* After a call to this procedure, any mouse click on a button in	*)
+    (* ButtonsEnabled, and in the rectangle defined by the other	*)
+    (* parameters, will cause ActionProc to be called.			*)
+    (* Note: Active regions may overlap.  In the event of an ambiguity,	*)
+    (* the more recently defined active region takes precedence.	*)
+
+END UserInterface.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/userinte.mod b/examples/Modula-2_Libraries/PMOS/sources/general/userinte.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/userinte.mod
@@ -0,0 +1,860 @@
+IMPLEMENTATION MODULE UserInterface;
+
+	(****************************************************************)
+	(*								*)
+	(*		Text User Interface for PMOS			*)
+	(*								*)
+	(*		Original version by M. Walsh			*)
+	(*		 This version by P. Moylan			*)
+	(*								*)
+	(*	Last Edited:	24 February 1995			*)
+	(*	Status:		OK					*)
+	(*								*)
+	(****************************************************************)
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure;
+
+FROM TaskControl IMPORT
+    (* type *)	Lock,
+    (* proc *)	CreateTask, CreateLock, DestroyLock, Obtain, Release;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	Wait, Signal, CreateSemaphore;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM MiscPMOS IMPORT
+    (* proc *)	CopyString;
+
+FROM Keyboard IMPORT
+    (* proc *)	StuffKeyboardBuffer;
+
+FROM Windows IMPORT
+    (* type *)	ColumnRange, RowRange, Rectangle, DisplayPage,
+		Colour, Window, FrameType, DividerType, DisplayPage,
+    (* proc *)	OpenWindow, SetCursor, WriteChar, WriteString, Hide,
+		ShiftWindowAbs, CloseWindow, PutOnTop, IdentifyTopWindow,
+		WindowLocation, PageOf, SaveCursor, InstallCloseHandler,
+		RequestPageChangeNotification, PutOnPage;
+
+FROM Mouse IMPORT
+    (* type *)	Events, EventSet, Buttons,
+    (* proc *)	MouseAvailable, InstallEventHandler, SetTextMousePage,
+		ShowMouseCursor, HideMouseCursor, SetMouseCursorLimits,
+		SetTextMousePosition;
+
+(************************************************************************)
+
+CONST
+    LeftOnly = ButtonSet {LeftButton};
+    RightOnly = ButtonSet {RightButton};
+    LeftOrRight = ButtonSet {LeftButton, RightButton};
+
+TYPE	
+    UIWindow = POINTER TO WindowData;
+
+    ActiveRegionPtr = POINTER TO ActiveRegion;
+
+    (* An ActiveRegion is a rectangle within a window which has had a	*)
+    (* "mouse click" action defined for it.				*)
+
+    ActiveRegion = RECORD
+			region: Rectangle;
+			LiveButtons: ButtonSet;
+			ActionToBeTaken: Action;
+			NextActiveRegion: ActiveRegionPtr;
+		   END (*RECORD*);
+
+    (* A UIWindow is a pointer to a WindowData record.  This refers to	*)
+    (* a Window (as defined in module Windows), together with some	*)
+    (* extra information that this module keeps concerning the Window.	*)
+    (* The fields are:							*)
+    (*	win			the Window itself			*)
+    (*	access			critical section protection Lock	*)
+    (*	page			the display page on which the window	*)
+    (*				resides					*)
+    (*	ActiveRegionList	head of linked list of active regions	*)
+    (*				associated with this window		*)
+    (*	next, previous		used to keep the set of all UIWindows	*)
+    (*				as a linked list			*)
+    (*	title			title to use when the list of all	*)
+    (*				windows is displayed.			*)
+
+    WindowData =    RECORD
+    			win: Window;
+			access: Lock;
+			page: DisplayPage;
+			ActiveRegionList: ActiveRegionPtr;
+			next, previous: UIWindow;
+			title: ARRAY [0..19] OF CHAR;
+		    END (*RECORD*);
+
+(************************************************************************)
+
+VAR
+    (* For each display page we keep all UIWindows in a linked list,	*)
+    (* and FirstUIW[page] is the head of this list.			*)
+
+    FirstUIW: ARRAY DisplayPage OF UIWindow;
+
+    (* Lock to control access to the lists of all windows.	*)
+
+    ListAccess: Lock;
+
+    (* DefaultUIW is a special UIWindow which does not go into the	*)
+    (* master list, and which is associated with those areas of the	*)
+    (* screen which are not otherwise covered by a UIWindow.		*)
+
+    DefaultUIW: UIWindow;
+
+    (* The hardware display page currently active. *)
+
+    CurrentDisplayPage: DisplayPage;
+
+    (* The number of UIWindows in each hardware page. *)
+
+    WindowCount: ARRAY DisplayPage OF CARDINAL;
+
+    (* WindowList[p] is a special Window, used to display the titles of	*)
+    (* all the other windows on display page p.				*)
+
+    WindowList: ARRAY DisplayPage OF Window;
+
+    (* Flag to indicate that the list of all windows is on the screen.	*)
+
+    WindowListOpen: ARRAY DisplayPage OF BOOLEAN;
+
+    (* A semaphore to signal the event-handling task that a mouse	*)
+    (* event has occurred.						*)
+
+    MouseEvent: Semaphore;
+
+    (* EventData records the triggering event, the button status, and	*)
+    (* the mouse cursor position when a mouse event occurs.		*)
+
+    EventData:	RECORD
+		    access: Lock;
+		    Trigger: EventSet;
+		    ButtonStatus: ButtonSet;
+		    Xpos: ColumnRange;
+		    Ypos: RowRange;
+		END (*RECORD*);
+
+    (* MoveInProgress is set iff a "move window" operation is being	*)
+    (* carried out.							*)
+
+    MoveInProgress: BOOLEAN;
+
+    (* While a move is in progress, we need to carry some information	*)
+    (* forward from one event to the next.  These data don't need	*)
+    (* critical section protection, since it's impossible for more than	*)
+    (* one move to be in progress at a time.				*)
+
+    MoveData:	RECORD
+		    window: Window;
+		    rowoffset: RowRange;
+		    coloffset: ColumnRange;
+		END (*RECORD*);
+
+(************************************************************************)
+(*			THE MOUSE CLICK HANDLER				*)
+(************************************************************************)
+
+
+(*<TopSpeed3*)
+(*# save, call(c_conv => off, same_ds => off, near_call => off) *)
+(*# call(reg_param => (ax,bx,cx,dx,st0,st6,st5,st4,st3)) *)
+(*>*)
+
+PROCEDURE MouseClickHandler (A: EventSet;  B: ButtonSet;  X, Y: CARDINAL);
+
+    (* This procedure is called by the mouse driver whenever there is	*)
+    (* a mouse event, and that event is in the event set specified at	*)
+    (* the time this handler was activated.  Parameter A shows the	*)
+    (* event(s) that triggered the call; B shows the current up/down	*)
+    (* state of the mouse buttons; and (X,Y) is the mouse cursor	*)
+    (* position.							*)
+
+    BEGIN
+	WITH EventData DO
+	    Obtain (access);
+	    Trigger := A;
+	    ButtonStatus := B;
+	    Xpos := X DIV 8;  Ypos := Y DIV 8;
+	    Release (access);
+	END (*WITH*);
+	Signal (MouseEvent);
+    END MouseClickHandler;
+
+(*<TopSpeed3*) (*# restore *) (*>*)
+
+(************************************************************************)
+(*			MISCELLANEOUS PROCEDURES			*)
+(************************************************************************)
+
+PROCEDURE Inside (row: RowRange;  col: ColumnRange;  R: Rectangle): BOOLEAN;
+
+    (* Returns TRUE iff point (row,col) is in (or on the border of) R.	*)
+
+    BEGIN
+	WITH R DO
+	    RETURN (col >= left) AND (col <= right)
+				AND (row >= top) AND (row <= bottom);
+	END (*WITH*);
+    END Inside;
+
+(************************************************************************)
+
+PROCEDURE FindOwner (w: Window): UIWindow;
+
+    (* Returns the UIWindow with which w is associated, or returns NIL	*)
+    (* if there is no such UIWindow.					*)
+
+    VAR result: UIWindow;  page: DisplayPage;
+
+    BEGIN
+	Obtain (ListAccess);
+	page := 0;
+	LOOP
+	    result := FirstUIW[page];
+	    LOOP
+		IF result = NIL THEN EXIT (*LOOP*)
+		ELSIF result^.win = w THEN EXIT (*LOOP*)
+		ELSE result := result^.next;
+		END (*IF*);
+	    END (*LOOP*);
+	    IF (result <> NIL) OR (page = MAX(DisplayPage)) THEN
+		EXIT (*LOOP*);
+	    END (*IF*);
+	    INC (page);
+	END (*LOOP*);
+	Release (ListAccess);
+	RETURN result;
+    END FindOwner;
+
+(************************************************************************)
+(*			SHUTTING DOWN A UIWINDOW			*)
+(************************************************************************)
+
+PROCEDURE CloseWindowList (w: Window;  r: RowRange;  c: ColumnRange);
+
+    (* Closes w - which happens to be the window list for some display	*)
+    (* page, because of the way this procedure is called.		*)
+
+    VAR page: DisplayPage;
+
+    BEGIN
+	page := PageOf(w);
+	HideMouseCursor;
+	WindowListOpen[page] := FALSE;
+
+	(* Subtle point: we don't explicitly destroy the UIWindow to	*)
+	(* which w belongs, since it is automatically destroyed (by	*)
+	(* procedure UnregisterWindow) as a side-effect of CloseWindow.	*)
+
+	(* The complications caused by side-effects disturb me a little	*)
+	(* on philosophical grounds.  One day I should try to invent	*)
+	(* a better substitute for call-back procedures.  They're	*)
+	(* really designed for a language like C or C++ whose		*)
+	(* programmers are trained to expect hidden gotchas.		*)
+
+	CloseWindow (w);
+	ShowMouseCursor;
+
+    END CloseWindowList;
+
+(************************************************************************)
+
+PROCEDURE DestroyUIWindow (VAR (*INOUT*) UIW: UIWindow);
+
+    (* Destroys UIW, without closing its window. *)
+
+    VAR ActiveRegionNext, ActiveRegionToDispose: ActiveRegionPtr;
+	page: DisplayPage;
+
+    BEGIN
+	page := UIW^.page;
+
+	(* If the window list is currently open, close it, since its	*)
+	(* entries are about to become invalid.  Hidden trap: watch out	*)
+	(* for a recursive close of the window list.			*)
+
+	IF WindowListOpen[page] AND (UIW^.win <> WindowList[page]) THEN
+	    CloseWindowList (WindowList[page], 0, 0);
+	END (*IF*);
+
+	Obtain (UIW^.access);
+
+	(* Reclaim the space used in the ActiveRegionList linked list. *)
+
+	ActiveRegionNext := UIW^.ActiveRegionList;
+	WHILE ActiveRegionNext <> NIL DO
+	    ActiveRegionToDispose := ActiveRegionNext;
+	    ActiveRegionNext := ActiveRegionNext^.NextActiveRegion;
+	    DISPOSE (ActiveRegionToDispose);
+	END (*WHILE *);
+	Release (UIW^.access);
+	DestroyLock (UIW^.access);
+
+	(* Remove this UIWindow from the master list. *)
+
+	Obtain (ListAccess);
+	DEC (WindowCount[page]);
+	IF WindowCount[CurrentDisplayPage] = 0 THEN
+	    HideMouseCursor;
+	END(*IF*);
+	IF UIW^.previous = NIL THEN
+	    FirstUIW[page] := UIW^.next;
+	ELSE
+	    UIW^.previous^.next := UIW^.next;
+	END (*IF*);
+	IF UIW^.next <> NIL THEN
+	    UIW^.next^.previous := UIW^.previous;
+	END (*IF*);
+	Release (ListAccess);
+	DISPOSE (UIW);
+
+    END DestroyUIWindow;
+
+(************************************************************************)
+
+PROCEDURE UnregisterWindow (w: Window;  dummy: DisplayPage);
+
+    (* Removes w from the set of Windows controlled by this module.	*)
+    (* The second parameter is a dummy for compatibility with		*)
+    (* procedure InstallCloseHandler.					*)
+
+    VAR UIW: UIWindow;
+
+    BEGIN
+	UIW := FindOwner (w);
+	IF UIW <> NIL THEN
+	    DestroyUIWindow (UIW);
+	END (*IF*);
+    END UnregisterWindow;
+
+(************************************************************************)
+(*			MANIPULATING ACTIVE REGIONS			*)
+(************************************************************************)
+
+PROCEDURE AddActiveRegion (UIW: UIWindow; Top, Bottom: RowRange;
+			Left, Right: ColumnRange;  ButtonsEnabled: ButtonSet;
+			ActionProc: Action);
+
+    (* After a call to this procedure, any mouse click on a button in	*)
+    (* ButtonsEnabled, and in the rectangle defined by the other	*)
+    (* parameters, will cause ActionProc to be called.			*)
+
+    VAR NewActiveRegion: ActiveRegionPtr;
+
+    BEGIN
+	IF UIW = NIL THEN RETURN END(*IF*);
+
+	NEW (NewActiveRegion);
+	WITH NewActiveRegion^ DO
+	    WITH region DO
+		top := Top;  bottom := Bottom;
+		left := Left;  right := Right;
+	    END (*WITH*);
+	    LiveButtons := ButtonsEnabled;
+	    ActionToBeTaken := ActionProc;
+	END (*WITH*);
+
+	(* Insert the new active region at the head of the UIWindow's	*)
+	(* active region list.  Putting it at the head gives it		*)
+	(* priority over other (possibly overlapping) regions which	*)
+	(* were earlier added, and this is exactly the effect we want.	*)
+
+	WITH UIW^ DO
+	    Obtain (access);
+	    NewActiveRegion^.NextActiveRegion := ActiveRegionList;
+	    ActiveRegionList := NewActiveRegion;
+	    Release (access);
+	END (*WITH*);
+
+    END AddActiveRegion;
+
+(************************************************************************)
+(*		THE BUILT-IN ACTIVE REGION HANDLERS			*)
+(************************************************************************)
+
+PROCEDURE MoveWindow (w: Window;  yrel: RowRange;  xrel: ColumnRange);
+
+    (* An ActiveRegion procedure to move a window on the screen.  Most	*)
+    (* of the work is actually done by procedure ContinueMove, given	*)
+    (* later.  This procedure just sets up the right conditions for	*)
+    (* ContinueMove to be called by the event dispatcher.		*)
+
+    VAR R: Rectangle;
+
+    BEGIN
+	R := WindowLocation(w);
+	WITH R DO
+	    SetMouseCursorLimits (yrel, MAX(RowRange) - bottom + yrel + top,
+				xrel, MAX(ColumnRange) - right + xrel + left);
+	END (*WITH*);
+
+	WITH MoveData DO
+	    window := w;
+	    rowoffset := yrel;  coloffset := xrel;
+	END (*WITH*);
+
+	InstallEventHandler (EventSet {LeftUp, RightUp, Motion},
+						MouseClickHandler);
+	MoveInProgress := TRUE;
+
+    END MoveWindow;
+
+(***********************************************************************)
+
+PROCEDURE HideWindow (w: Window;  r: RowRange;  c: ColumnRange);
+
+    (* An ActiveRegion procedure to hide a window. *)
+
+    BEGIN
+	HideMouseCursor;
+	Hide (w);
+	ShowMouseCursor;
+    END HideWindow;
+
+(***********************************************************************)
+
+PROCEDURE ShowWindow (w: Window;  r: RowRange;  c: ColumnRange);
+
+    (* An ActiveRegion procedure to put a window on top. *)
+
+    BEGIN
+	HideMouseCursor;
+	PutOnTop (w);
+	ShowMouseCursor;
+    END ShowWindow;
+
+(************************************************************************)
+
+PROCEDURE ContinueMove (x: ColumnRange;  y: RowRange);
+
+    (* Called by the mouse event handler when a "move window" operation	*)
+    (* is in progress.  If the global variable MoveInProgress is FALSE,	*)
+    (* we've just reached the end of the move.				*)
+
+    BEGIN
+	IF MoveInProgress THEN
+	    WITH MoveData DO
+		HideMouseCursor;
+		ShiftWindowAbs (window, y-rowoffset, x-coloffset);
+		ShowMouseCursor;
+	    END (*WITH*);
+	ELSE
+	    (* End of move.  Restore the normal event handler. *)
+	    SetMouseCursorLimits (0, MAX(RowRange), 0, MAX(ColumnRange));
+	    InstallEventHandler (EventSet {LeftDown, RightDown},
+						MouseClickHandler);
+	END (*IF*);
+    END ContinueMove;
+
+(************************************************************************)
+
+PROCEDURE StuffEscape (w: Window;  r: RowRange;  c: ColumnRange);
+
+    (* An ActiveRegion procedure to stuff an Esc character into the	*)
+    (* keyboard buffer.							*)
+
+    CONST Esc = CHR(27);
+
+    BEGIN
+	StuffKeyboardBuffer (Esc);
+    END StuffEscape;
+
+(************************************************************************)
+(*			LOOKING AFTER THE WINDOW LIST			*)
+(************************************************************************)
+
+PROCEDURE SelectFromWindowList (dummy: Window;
+					row: RowRange;  col: ColumnRange);
+
+    (* Called when the user clicks on a window name in the window list.	*)
+    (* Brings that window to the top, and closes the window list.	*)
+
+    VAR p: UIWindow;  j: RowRange;
+
+    BEGIN
+	HideMouseCursor;
+	Obtain (ListAccess);
+	p := FirstUIW[CurrentDisplayPage];
+	FOR j := 1 TO WindowCount[CurrentDisplayPage]-row DO
+	    p := p^.next;
+	END (*FOR*);
+	Release (ListAccess);
+	PutOnTop (p^.win);
+	CloseWindowList (WindowList[CurrentDisplayPage], 0, 0);
+	ShowMouseCursor;
+    END SelectFromWindowList;
+
+(************************************************************************)
+
+PROCEDURE DisplayWindowList (dummy: Window;  Y: RowRange;  X: ColumnRange);
+
+    (* Displays the list of all windows which this module knows about,	*)
+    (* and sets up active regions which will allow the user to select	*)
+    (* a window (possibly hidden) with a mouse click.			*)
+
+    VAR ListUIW, UIW: UIWindow;  j, count: CARDINAL;  p: DisplayPage;
+
+    BEGIN
+	p := CurrentDisplayPage;
+	count := WindowCount[p];
+	IF WindowListOpen[p] THEN DEC(count) END(*IF*);
+
+	(* Adjust the cursor position, if necessary, to ensure that the	*)
+	(* window list won't fall outside the screen boundaries.	*)
+
+	IF Y > MAX(RowRange) - count - 1 THEN
+	    Y := MAX(RowRange) - count - 1;
+	END (*IF*);
+	IF X < 2 THEN
+	    X := 2;
+	ELSIF X > MAX(ColumnRange) - 19 THEN
+	    X := MAX(ColumnRange) - 19;
+	END (*IF*);
+	HideMouseCursor;
+	SetTextMousePosition (X, Y);
+
+	IF WindowListOpen[p] THEN
+	    ShiftWindowAbs (WindowList[p], Y, X-2);
+	ELSE
+	    OpenWindow (WindowList[p], black, white, Y, Y+count+1,
+				X-2, X+19, doubleframe, nodivider);
+	    PutOnPage (WindowList[p], p);
+	    ListUIW := AllowMouseControl (WindowList[p], "",
+				CapabilitySet {wmove, whide, wshow});
+	
+	    (* Overlay the HideWindow ActiveRegion - which we specified	*)
+	    (* above only in order to get its button displayed - with a	*)
+	    (* CloseWindowList region.					*)
+
+	    AddActiveRegion (ListUIW,0,0,19,19,LeftOnly,CloseWindowList);
+
+	    (* Display the names of all the windows we control		*)
+	    (* (ignoring the first, which is the WindowList itself).	*)
+
+	    SetCursor (WindowList[p], 0, 5);
+	    WriteString (WindowList[p], "Window List");
+	    Obtain (ListAccess);
+	    UIW := FirstUIW[p]^.next;
+	    FOR j := count TO 1 BY -1 DO
+		SetCursor (WindowList[p], j, 1);
+		WriteString (WindowList[p], UIW^.title);
+		UIW := UIW^.next;
+	    END (*FOR*);
+	    Release (ListAccess);
+
+	    (* Create an ActiveRegion which will allow the user to	*)
+	    (* click on the list of names.				*)
+
+	    AddActiveRegion (ListUIW,1,count,1,20,LeftOnly,
+						SelectFromWindowList);
+	    WindowListOpen[p] := TRUE;
+	END (*IF*);
+	ShowMouseCursor;
+	MoveWindow (WindowList[p], 0, 2);
+
+    END DisplayWindowList;
+
+(************************************************************************)
+(*			CREATING A UI WINDOW				*)
+(************************************************************************)
+
+PROCEDURE MakeDefaultUIWindow;
+
+    (* Creates a special UIWindow which does not live on any page, and	*)
+    (* which does not have any Window associated with it.  The sole	*)
+    (* purpose of this special UIWindow is to allow us to create	*)
+    (* active regions on parts of the screen not occupied by any	*)
+    (* Window known to this module.					*)
+
+    BEGIN
+	NEW (DefaultUIW);
+	WITH DefaultUIW^ DO
+	    win := Window(NIL);
+	    CreateLock (access);
+	    page := 0;
+	    ActiveRegionList := NIL;
+	    previous := NIL;  next := NIL;
+	    title := "Default UIWindow";
+	END (*WITH*);
+    END MakeDefaultUIWindow;
+
+(************************************************************************)
+
+PROCEDURE MakeUIWindow (p: DisplayPage;  Label: ARRAY OF CHAR): UIWindow;
+
+    (* Creates a new UIWindow on page p, puts it into the list of all	*)
+    (* UIWindows.							*)
+
+    VAR result: UIWindow;
+
+    BEGIN
+	(* If the window list is currently open, close it, since its	*)
+	(* entries are about to become invalid.				*)
+
+	IF WindowListOpen[p] THEN
+	    CloseWindowList (WindowList[p], 0, 0);
+	END (*IF*);
+
+	(* Create a new UIWindow record, and fill in the details.	*)
+
+	NEW (result);
+	WITH result^ DO
+	    CreateLock (access);
+	    page := p;
+	    ActiveRegionList := NIL;
+	    CopyString (Label, title);
+	END (*WITH*);
+
+	(* Link the new record into the master list. *)
+
+	Obtain (ListAccess);
+	INC (WindowCount[p]);
+	result^.next := FirstUIW[p];
+	result^.previous := NIL;
+	IF FirstUIW[p] <> NIL THEN
+	    FirstUIW[p]^.previous := result;
+	END (*IF*);
+	FirstUIW[p] := result;
+	Release (ListAccess);
+
+	IF (p = CurrentDisplayPage) AND (WindowCount[p] = 1) THEN
+	    ShowMouseCursor;
+	END (*IF*);
+
+	RETURN result;
+
+    END MakeUIWindow;
+
+(************************************************************************)
+
+PROCEDURE AddCapabilities (UIW: UIWindow;  CS: CapabilitySet);
+
+    (* Activates the specified set of user-controlled capabilities.	*)
+    (* This includes drawing the "buttons" on the border, therefore	*)
+    (* UIW^.win must already be open.					*)
+
+    VAR w: Window;  R: Rectangle;  maxrow, maxcol: CARDINAL;
+	oldrow, oldcol: CARDINAL;
+
+    BEGIN
+	w := UIW^.win;
+	SaveCursor (w, oldrow, oldcol);
+	R := WindowLocation (w);
+	WITH R DO
+	    maxrow := bottom - top;
+	    maxcol := right - left;
+	END (*WITH*);
+
+	IF wshow IN CS THEN
+	    AddActiveRegion (UIW,0,maxrow,0,maxcol,LeftOnly,ShowWindow);
+	END (*IF*);
+
+	IF wmove IN CS THEN
+	    SetCursor (w, 0, 1);
+	    WriteChar (w, '[');
+	    WriteChar (w, CHAR(29));
+	    WriteChar (w, ']');
+	    AddActiveRegion (UIW, 0, 0, 2, 2, LeftOrRight, MoveWindow);
+	END (*IF*);
+
+	IF whide IN CS THEN
+	    SetCursor(w, 0, maxcol-3);
+	    WriteChar(w, '[');
+	    WriteChar(w, CHAR(15));
+	    WriteChar(w, ']');
+	    AddActiveRegion (UIW,0,0,maxcol-2,maxcol-2,LeftOnly, HideWindow);
+	END (*IF*);
+
+	IF wescape IN CS THEN
+	    SetCursor(w, 0, maxcol-3);
+	    WriteChar(w, '[');
+	    WriteChar(w, CHAR(15));
+	    WriteChar(w, ']');
+	    AddActiveRegion (UIW,0,0,maxcol-2,maxcol-2,LeftOnly, StuffEscape);
+	END (*IF*);
+
+	SetCursor (w, oldrow, oldcol);
+
+    END AddCapabilities;
+
+(************************************************************************)
+(*		ACTIVATING MOUSE CONTROL FOR A WINDOW			*)
+(************************************************************************)
+
+PROCEDURE AllowMouseControl (w: Window;  Title: ARRAY OF CHAR;
+				OptionsEnabled: CapabilitySet): UIWindow;
+
+    (* Adds w to the set of windows which this module is allowed to	*)
+    (* manipulate.							*)
+
+    VAR result: UIWindow;
+
+    BEGIN
+	IF MouseAvailable() THEN
+	    result := MakeUIWindow (PageOf(w), Title);
+	    result^.win := w;
+	    InstallCloseHandler (w, UnregisterWindow);
+	    AddCapabilities (result, OptionsEnabled);
+	ELSE
+	    result := NIL;
+	END (*IF*);
+	RETURN result;
+    END AllowMouseControl;
+
+(************************************************************************)
+(*			SETTING THE DISPLAY PAGE			*)
+(************************************************************************)
+
+PROCEDURE SelectPage (page: DisplayPage);
+
+    (* Switches the mouse focus to the given display page (but we don't	*)
+    (* update the display, it's assumed that the caller is taking care	*)
+    (* of that).  Also aborts any move in progress.			*)
+
+    BEGIN
+	IF WindowCount[CurrentDisplayPage] > 0 THEN
+	    HideMouseCursor;
+	END(*IF*);
+	SetTextMousePage (page);
+	MoveInProgress := FALSE;
+	CurrentDisplayPage := page;
+	IF WindowCount[page] > 0 THEN
+	    ShowMouseCursor;
+	END(*IF*);
+    END SelectPage;
+
+(************************************************************************)
+(*			THE EVENT DISPATCHER				*)
+(************************************************************************)
+
+PROCEDURE DoWindowAction (col: ColumnRange;  row: RowRange;  BS: ButtonSet);
+
+    (* This procedure is called when a mouse button is pressed, with	*)
+    (* (col,row) being the current mouse cursor position.  We check	*)
+    (* whether any action has been defined for this position, and if so	*)
+    (* we call the appropriate action handler.				*)
+
+    CONST EmptySet = ButtonSet {};
+
+    VAR w: Window;
+	UIW: UIWindow;
+	CurrentRegion: ActiveRegionPtr;
+	RegionFound: BOOLEAN;
+
+    BEGIN
+	RegionFound := FALSE;  UIW := NIL;
+
+	IF IdentifyTopWindow (w, row, col) THEN
+	    UIW := FindOwner (w);
+	ELSE
+	    UIW := DefaultUIW;
+	END (*IF*);
+
+	(* If a window has been found at this screen position, check	*)
+	(* whether an ActiveRegion for that window includes the cursor	*)
+	(* position.  Note: a side-effect of the call to procedure	*)
+	(* IdentifyTopWindow is that (col,row) are now window-relative.	*)
+
+	IF UIW <> NIL THEN
+	    CurrentRegion := UIW^.ActiveRegionList;
+	    WHILE  (CurrentRegion <> NIL) AND (NOT RegionFound) DO
+		IF Inside (row, col, CurrentRegion^.region)
+			AND (BS*CurrentRegion^.LiveButtons <> EmptySet) THEN
+		    RegionFound := TRUE;
+		ELSE
+		    CurrentRegion := CurrentRegion^.NextActiveRegion;
+		END (*IF*);
+	    END (*WHILE*);
+	END (*IF *);
+
+	IF RegionFound THEN
+	    CurrentRegion^.ActionToBeTaken (w, row, col);
+	END (*IF*);
+
+    END DoWindowAction;
+
+(************************************************************************)
+
+PROCEDURE EventDispatcher;
+
+    (* Runs as a separate task, whose function is to call the		*)
+    (* appropriate event handler whenever a mouse event occurs.		*)
+
+    VAR X: ColumnRange;  Y: RowRange;  A: EventSet;  B: ButtonSet;
+
+    BEGIN
+	LOOP
+	    Wait (MouseEvent);
+	    WITH EventData DO
+		Obtain (access);
+		A := Trigger;
+		B := ButtonStatus;
+		X := Xpos;  Y := Ypos;
+		Release (access);
+	    END (*WITH*);
+	    IF MoveInProgress THEN
+		IF (LeftUp IN A) OR (RightUp IN A) THEN
+		    MoveInProgress := FALSE;
+		END (*IF*);
+		ContinueMove (X, Y);
+	    ELSE
+		DoWindowAction (X, Y, B);
+	    END (*IF*);
+	END (*LOOP*);
+    END EventDispatcher;
+
+(************************************************************************)
+(*				TERMINATION				*)
+(************************************************************************)
+
+PROCEDURE Shutdown;
+
+    (* Creates a new UIWindow, puts it into the list of all UIWindows. *)
+
+    VAR p: DisplayPage;
+
+    BEGIN
+	FOR p := 0 TO MAX(DisplayPage) DO
+	    IF WindowListOpen[p] THEN
+		CloseWindowList (WindowList[p], 0, 0);
+	    END (*IF*);
+	END (*FOR*);
+    END Shutdown;
+
+(************************************************************************)
+(*			  MODULE INITIALISATION				*)
+(************************************************************************)			
+
+VAR p: DisplayPage;
+
+BEGIN
+    SetTerminationProcedure (Shutdown);
+    FOR p := 0 TO MAX(DisplayPage) DO
+	FirstUIW[p] := NIL;  WindowCount[p] := 0;
+	WindowListOpen[p] := FALSE;
+    END (*FOR*);
+    MakeDefaultUIWindow;
+    MoveInProgress := FALSE;
+    CurrentDisplayPage := 0;
+    CreateLock (ListAccess);
+    IF MouseAvailable() THEN
+	RequestPageChangeNotification (SelectPage);
+	CreateSemaphore (MouseEvent, 0);
+	CreateLock (EventData.access);
+	CreateTask (EventDispatcher, 8, "Mouse Events");
+	InstallEventHandler (EventSet {LeftDown, RightDown}, MouseClickHandler);
+	SelectPage (0);
+    END (*IF*);
+    AddActiveRegion (DefaultUIW, 0, MAX(RowRange), 0, MAX(ColumnRange),
+					RightOnly, DisplayWindowList);
+
+END UserInterface.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/wgraph.def b/examples/Modula-2_Libraries/PMOS/sources/general/wgraph.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/wgraph.def
@@ -0,0 +1,109 @@
+DEFINITION MODULE WGraph;
+
+	(********************************************************)
+	(*							*)
+	(*		Graph module For GWindows.		*)
+	(*							*)
+	(*  Programmer:		S.P.Lontis, P. Moylan.		*)
+	(*  Last edited:	15 February 1993		*)
+	(*  Status:						*)
+	(*	Basically working, but still fiddling with	*)
+	(*	the details.					*)
+	(*							*)
+	(*	It's not clear whether OpenGraph needs so many	*)
+	(*	parameters.  Also not clear how bar graphs	*)
+	(*	fit into the overall picture.			*)
+	(*							*)
+	(********************************************************)
+
+FROM GWindows IMPORT 
+     (* type *)   Window;
+
+(************************************************************************)
+
+TYPE
+    Graph;		(* is private *)
+    
+    (* Types of graphs that can be drawn.	*)
+
+    GraphType = (linear, loglinear, loglog, bar);
+
+    (* Line Types that can be used.	*)
+
+    LineType  = (dots, joined, vertical, normal);
+
+    (* Marker Types for individual points plotted.	*)
+
+    MarkType  = (none, square, cross, plus, diamond);
+
+    BarType = (One, Two, Three, Four, Five);
+
+(************************************************************************)
+
+PROCEDURE OpenGraph (VAR (*OUT*) G: Graph;  w: Window;  GrphType: GraphType;
+		    LnType: LineType; xst, yst, xen, yen: CARDINAL;
+		    xmin, ymin, xmax, ymax: LONGREAL;  Mark: MarkType);
+
+    (* Creates graph G in window w.  The Graph will occupy a rectangle	*)
+    (* with a bottom left corner of (xs,ys) and top right corner of	*)
+    (* (xe,ye) relative to the window. The range of values which can be	*)
+    (* plotted is from (xmin,ymin) to (xmax,ymax).  NOTE: for a bar	*)
+    (* graph, xmin gives the width of the bars and xmax gives the	*)
+    (* distance between different bars.					*)
+
+PROCEDURE DrawXAxis (G: Graph;  xinc: LONGREAL;
+			yoffset, DecPlaces: CARDINAL;  numbering: BOOLEAN);
+
+    (* Draws the x-axis for a graph; xinc is the distance between tick	*)
+    (* marks, and yoffset gives the distance that the axis will lie	*)
+    (* below the line y=ys (ys is defined in OpenGraph).  The option	*)
+    (* yoffset <> 0 allows for the case where more than one graph	*)
+    (* occupies the same window, since the graphs may have different	*)
+    (* scales.  DecPlaces gives the number of decimal places that will	*)
+    (* be used.  If numbering is FALSE, the axis is drawn but not	*)
+    (* labelled.							*)
+
+PROCEDURE DrawYAxis (G: Graph;  yinc: LONGREAL;
+			xoffset, DecPlaces: CARDINAL;  numbering: BOOLEAN);
+
+    (* Draws the y-axis for a graph; yinc is the space between tick	*)
+    (* marks, and xoffset gives the distance that the axis will lie to	*)
+    (* the left of the line x=xs (xs is defined in OpenGraph).		*)
+    (* DecPlaces gives the number of decimal places that will be used.	*)
+    (* If numbering is FALSE, the axis is drawn but not labelled.	*)
+
+PROCEDURE DrawAxes (G: Graph;
+	xinc: LONGREAL;  yoffset, xdecplaces: CARDINAL;  numberx: BOOLEAN;
+	yinc: LONGREAL;  xoffset, ydecplaces: CARDINAL;  numbery: BOOLEAN);
+
+    (* Draws both the X and Y axes.  See the definitions of		*)
+    (* DrawXAxis and DrawYAxis above.					*)
+
+PROCEDURE AddPoint (G: Graph;  x, y: LONGREAL);
+
+    (* For lines of type						*)
+    (*		'dots'	: only the marker will be displayed.		*)
+    (*		'joined': draws a line from the last point and marker.	*)
+    (*		'vertical' : draws a vertical line and a marker.	*)
+    (* NOTE: lines of type 'normal' are used for discontinuous graphs	*)
+    (* and are not drawn using this procedure.				*)
+    (* Points outside the region (xmin <= x <= xmax, ymin <= y <= ymax	*)
+    (* will be clipped.							*)
+
+PROCEDURE DrawLines (G: Graph;  x, y: ARRAY OF LONGREAL);
+
+    (* Allows vectors of x and y points to be drawn.  Refer to		*)
+    (* procedure AddPoint for specifications of the line types.		*)
+
+PROCEDURE DrawLine (G: Graph;  x0, y0, x1, y1: LONGREAL);
+
+    (* Used for drawing discontinuous lines.  The line is drawn between	*)
+    (* (x0,y0) and (x1,y1) relative to graph G.				*)
+
+PROCEDURE BarGraph (G: Graph;  y: ARRAY OF LONGREAL;  del: CARDINAL;  bt: BarType);
+
+    (* Displays a BarGraph of the vector y.  Parameter del gives the	*)
+    (* number of stripes per bar, in the case of striped fill patterns.	*)
+
+END WGraph.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/wgraph.mod b/examples/Modula-2_Libraries/PMOS/sources/general/wgraph.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/wgraph.mod
@@ -0,0 +1,808 @@
+IMPLEMENTATION MODULE WGraph;
+
+	(********************************************************)
+	(*							*)
+	(*		Graph module For GWindows.		*)
+	(*							*)
+	(*  Programmer:		S.P.Lontis, P. Moylan.		*)
+	(*  Last edited:	21 February 1995		*)
+	(*  Status:						*)
+	(*	Conversion to TS version still not complete.	*)
+	(*							*)
+	(*	This started as a copy of the Lontis version,	*)
+	(*	but by now I've modified it a fair bit.		*)
+	(*							*)
+	(*	Have converted the formatting to my standards,	*)
+	(*	but still need to work through things like	*)
+	(*	the program logic, confusing names, etc.	*)
+	(*							*)
+	(*	The algorithm for labelling logarithmic scales	*)
+	(*	looks unsatisfactory to me.			*)
+	(*							*)
+	(********************************************************)
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure;
+
+FROM TaskControl IMPORT
+    (* type *)	Lock,
+    (* proc *)	CreateLock, Obtain, Release;
+
+FROM MATHLIB IMPORT
+    (* proc *)	Log;
+
+FROM Conversions IMPORT
+    (* proc *)	LongRealToF, atoi;
+
+FROM GWindows IMPORT
+    (* proc *)	Line2, PutPixel2, GString;
+
+(************************************************************************)
+
+TYPE
+    str = ARRAY[0..10] OF CHAR;   (* string type *)
+
+    (********************************************************************)
+    (*									*)
+    (* A Graph is implemented as a pointer to a record with fields:	*)
+    (*	Win		the window in which the graph is written	*)
+    (*	GT		graph type: linear, bar, etc.			*)
+    (*	xs, ys		the bottom left corner of the rectangle in	*)
+    (*			which the graph is written (in window-relative	*)
+    (*			coordinates					*)
+    (*	xe, ye		the top right corner of the rectangle		*)
+    (*	xscale, yscale	scale factors used to convert the real user	*)
+    (*			data into the screen ranges (xs..xe), (ys..ye)	*)
+    (*	minx, maxx	the range of x values that can be plotted	*)
+    (*	miny, maxy	the range of y values than can be plotted	*)
+    (*	lastx, lasty	the last point added to the graph		*)
+    (*	LT		line type: dots, joined, vertical, normal	*)
+    (*	MT		marker type: diamond, plus, etc.		*)
+    (*	NextGraph	used to hold all the graphs together in a	*)
+    (*			linked list.  I'm not yet sure why.		*)
+    (*	found		set to TRUE when the first point is added to	*)
+    (*			the graph					*)
+    (*									*)
+    (********************************************************************)
+
+    Graph = POINTER TO GraphInstance;
+    GraphInstance = RECORD
+			Win: Window;
+			GT: GraphType;
+			xs, ys, xe, ye: CARDINAL;
+			xscale, yscale,
+			minx, maxx,
+			miny, maxy: LONGREAL;
+			lastx, lasty: INTEGER;
+			LT: LineType;
+			MT: MarkType;
+			NextGraph: Graph;
+			found: BOOLEAN;
+		    END (* RECORD *);
+
+(************************************************************************)
+
+VAR
+    (* Lock to protect critical sections.  I presume that the		*)
+    (* only critical section problem is with the linked list of graphs.	*)
+    (* The only reason for linking all graphs together is for the	*)
+    (* CloseDown procedure.						*)
+
+    GraphAccess: Lock;
+
+    (* Reference to the head of the linked list *)
+
+    TopGraph: Graph;
+
+(************************************************************************)
+(*			MISCELLANEOUS UTILITIES				*)
+(*									*)
+(*  N.B. It's not clear why most of these should be needed.  I'll have	*)
+(*  to look more carefully at how scales are labelled.			*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE TenToPower(n: INTEGER): LONGREAL;
+
+    (* Returns the value 10^n.	*)	
+
+    BEGIN
+	RETURN atoi (10.0, n);
+    END TenToPower;
+
+(************************************************************************)
+
+PROCEDURE Scale (VAR (*INOUT*) mantissa: LONGREAL;
+			VAR (*INOUT*) exponent: INTEGER;
+			power: CARDINAL;  lower, upper: LONGREAL);
+
+    (* Adjusts mantissa so that lower <= mantissa < upper, while	*)
+    (* keeping the quantity (mantissa * 10^exponent) invariant. To save	*)
+    (* some calculation, the caller must ensure that upper = 10^power	*)
+    (* and lower = 10^(-power).						*)
+
+    BEGIN
+	WHILE mantissa >= upper DO
+	    INC (exponent, power);  mantissa := lower*mantissa;
+	END (* WHILE *);
+
+	WHILE mantissa < lower DO
+	    DEC (exponent, power);  mantissa := upper*mantissa;
+	END (* WHILE *)
+
+    END Scale;
+
+(************************************************************************)
+
+PROCEDURE FindExponent (number: LONGREAL;  VAR (*OUT*) exponent: INTEGER);
+
+    (* Separates the first argument into a mantissa and exponent part,	*)
+    (* so that  number = mantissa * 10^exponent.  Returns the exponent.	*)
+
+    VAR mantissa: LONGREAL;
+
+    BEGIN
+	IF number = 0.0 THEN exponent := 1
+	ELSE
+	    mantissa := number;  exponent := 0;
+	    Scale (mantissa, exponent, 64, 1.0E-64, 1.0E64);
+	    Scale (mantissa, exponent, 16, 1.0E-16, 1.0E16);
+	    Scale (mantissa, exponent, 4, 1.0E-4, 1.0E4);
+	    Scale (mantissa, exponent, 1, 1.0E-1, 1.0E1);
+	END (* IF *);
+
+	(* Not sure why the following modification is included. But	*)
+	(* then I'm not sure either why this procedure is needed!	*)
+
+	IF (exponent<0) THEN DEC(exponent, 1) END (* IF *)
+
+    END FindExponent;
+
+(************************************************************************)
+
+PROCEDURE RealToStr (x: LONGREAL;  decplace: CARDINAL;
+			VAR (*OUT*) string: ARRAY OF CHAR;
+			VAR (*OUT*) count: CARDINAL);
+
+    (* Converts the Real value x into a string; decplace specifies	*)
+    (* the maximum number of places to allow after the decimal point.	*)
+    (* On return, count gives the number of characters used.		*)
+
+    BEGIN
+	count := SIZE (string);
+	LongRealToF (x, count, decplace, TRUE, string);
+    END RealToStr;
+
+(************************************************************************)
+
+PROCEDURE PrintLogScale (G: Graph;  xaxis: BOOLEAN;  incr: LONGREAL;
+					offset, Numbits: CARDINAL);
+
+    (* Draws a labelled logarithmic scale.  The logic of this		*)
+    (* procedure is still quite obscure to me, and I'm still in the	*)
+    (* process of changing the unhelpful variable names and trying to	*)
+    (* put in a few comments.						*)
+    (* The labelling happens only at multiples of 10.  Depending on the	*)
+    (* minimum values and increment, and depending also on roundoff	*)
+    (* error, the labelling might not be done at all.  This seems to me	*)
+    (* to be a fairly unsatisfactory situation, which perhaps calls for	*)
+    (* a completely different algorithm.				*)
+
+    VAR exponent: INTEGER;  xy, xybase, count: CARDINAL;
+	value, z, k, step, max, temp1, logmin, scale: LONGREAL;
+	label: str;
+	w: Window;
+
+    BEGIN
+	WITH G^ DO
+	    IF xaxis THEN
+		value := minx;  max := maxx;
+		logmin := Log(minx);  scale := xscale;
+		xybase := xs;
+	    ELSE
+		value := miny;  max := maxy;
+		logmin := Log(miny);  scale := yscale;
+		xybase := ys;
+	    END (*IF*);
+	    w := Win;
+	END (*WITH*);
+
+	FindExponent (value, exponent);
+
+	(* Compute z := 10^exponent	*)
+
+	IF exponent >= 0 THEN
+	    z := TenToPower(exponent)
+	ELSE
+	    z := 1.0 / TenToPower(-exponent)
+	END (* IF *);
+
+	(* Initially step = incr*10^exponent and k = 10.0*10^exponent.	*)
+	(* As we go around the loop step and k are updated together, so	*)
+	(* we have the invariant step = (incr/10.0) * k.		*)
+
+	step := incr*z;  k := 10.0*z;
+
+	(* Beyond this point the variable z is used only once, in a	*)
+	(* comparison.  Its value is not altered.  The value of k is	*)
+	(* however altered each time around the loop.			*)
+
+	WHILE value <= max DO
+
+	    temp1 := Log(value) - logmin;
+
+	    (* logmin is not used beyond this point.	*)
+
+	    (* Compute xy := xybase + scale*Log(value/min)	*)
+
+	    xy := xybase + VAL(CARDINAL, scale*temp1 + 0.5);
+
+	    (* Put the tick mark.	*)
+
+	    WITH G^ DO
+		IF xaxis THEN
+		    Line2 (w, xy, ys-offset, xy, ys-offset-2)
+		ELSE
+		    Line2 (w, xs-offset-2, xy, xs-offset, xy)
+		END (*IF*);
+	    END (*WITH*);
+
+	    (* Note k >= z always, so depending on the relationship	*)
+	    (* between value and z (which is not yet clear) it is	*)
+	    (* possible that the comparison below can be simplified.	*)
+	    (* What is clear is that we are putting the labelling only	*)
+	    (* when value is a multiple of 10.  By the way, the		*)
+	    (* equality comparison is somewhat untrustworthy since it	*)
+	    (* is sensitive to rounding error.				*)
+
+	    IF (value = k) OR (value = z) THEN
+		RealToStr (value, Numbits, label, count);
+		IF xaxis THEN
+		    GString (w, xy-4*count, G^.ys-offset-13, label);
+		ELSE
+		    GString (w, G^.xs-8*count-6-offset, xy-4, label);
+		END (* IF *)
+	    END (* IF *);
+
+	    (* Update the step each time we pass a multiple of 10.	*)
+
+	    IF value >= k THEN
+		step := 10.0*step;  k := 10.0*k;
+	    END (* IF *);
+
+	    value := value + step;
+
+	END (*WHILE*);
+
+    END PrintLogScale;
+
+(************************************************************************)
+
+PROCEDURE PrintLinearScale (G: Graph;  xaxis: BOOLEAN;  incr: LONGREAL;
+			offset, Numbits: CARDINAL;  WriteNumbers: BOOLEAN);
+
+    (* Prints a linear scale for the graph, with incr distance between	*)
+    (* the markers.  Numbers are written iff WriteNumbers is TRUE.	*)
+    (* This procedure draws the tick marks and (if specified) the	*)
+    (* labelling, but not the actual axis line.				*)
+
+    VAR value, limit, nextmark, start, scale: LONGREAL;
+	xy, xybase, NumOfChar: CARDINAL;
+	text: str;
+
+    BEGIN
+	WITH G^ DO
+
+	    IF xaxis THEN
+		limit := maxx;  start := minx;
+		scale := xscale;  xybase := xs;
+	    ELSE
+		limit := maxy;  start := miny;
+		scale := yscale;  xybase := ys;
+	    END (* IF *);
+	    value := start;
+
+	    WHILE value <= limit DO
+	
+		(* Find the position of the next marker point on the	*)
+		(* axis i.e.  nextmark := (value-start)*scale.		*)
+
+		nextmark := value - start;
+		xy := xybase + VAL(CARDINAL, scale*nextmark + 0.5);
+
+		IF xaxis THEN
+		    Line2 (Win, xy, ys-offset, xy, ys-offset-2)
+		ELSE
+		    Line2 (Win, xs-offset-3, xy, xs-offset, xy)
+		END (* IF *);
+
+		IF WriteNumbers THEN
+
+		    (* Convert value to string *)
+
+		    RealToStr (value, Numbits, text, NumOfChar);
+
+		    (* Display the value under or beside the marker.	*)
+
+		    IF xaxis THEN
+			GString (Win, xy-4*NumOfChar, ys-offset-13, text);
+		    ELSE
+			GString (Win, xs-offset-8*NumOfChar-6, xy-4, text);
+		    END (*IF*);
+
+		END (* IF *);
+	
+		value := value + incr;
+
+	    END (* WHILE *)
+
+	END (* WITH *)
+
+    END PrintLinearScale;
+
+(************************************************************************)
+
+PROCEDURE BarGraphMarkers (G: Graph;  yoffset: CARDINAL);
+
+    (* Draws the tick marks on the X axis of a bar graph.  The axis is	*)
+    (* a distance yoffset screen points below the graph y origin.	*)
+
+    VAR temp: LONGREAL;
+	xcurrent, increment: CARDINAL;
+
+    BEGIN
+	WITH G^ DO
+
+	    xcurrent:= xs + VAL(CARDINAL, 0.5*minx + 0.5);
+	    increment := VAL(CARDINAL, maxx + minx + 0.5);
+
+	    WHILE xcurrent <= xe DO
+		Line2 (Win, xcurrent, ys-yoffset, xcurrent, ys-yoffset-3);
+		INC (xcurrent, increment)
+	    END (* WHILE *)
+
+	END (*WITH*);
+
+    END BarGraphMarkers;
+
+(************************************************************************)
+
+PROCEDURE DrawXAxis (G: Graph;  xinc: LONGREAL;  yoffset, DecPlaces: CARDINAL;
+						numbering: BOOLEAN);
+
+    (* Draws the x-axis for a graph; xinc is the distance between tick	*)
+    (* marks, and yoffset gives the distance that the axis will lie	*)
+    (* below the line y=ys (ys is defined in OpenGraph).  The option	*)
+    (* yoffset <> 0 allows for the case where more than one graph	*)
+    (* occupies the same window, since the graphs may have different	*)
+    (* scales.  DecPlaces gives the number of decimal places that will	*)
+    (* be used.  If numbering is FALSE, the axis is drawn but not	*)
+    (* labelled.							*)
+
+    BEGIN
+	WITH G^ DO
+	
+	    (* Draw x-axis line *)
+
+	    Line2 (Win, xs, ys-yoffset, xe, ys-yoffset);
+
+	    IF GT = bar THEN
+		BarGraphMarkers (G, yoffset);
+	    ELSIF GT = linear THEN
+		PrintLinearScale (G,TRUE,xinc,yoffset,DecPlaces,numbering)
+	    ELSIF (GT=loglog) OR (GT=loglinear) THEN
+		PrintLogScale (G, TRUE, xinc, yoffset, DecPlaces)
+	    END (* IF *);
+
+	END (* WITH *)
+
+    END DrawXAxis;
+
+(************************************************************************)
+
+PROCEDURE DrawYAxis (G: Graph;  yinc: LONGREAL;  xoffset, DecPlaces: CARDINAL;
+						numbering: BOOLEAN);
+
+    (* Draws the y-axis for a graph; yinc is the space between tick	*)
+    (* marks, and xoffset gives the distance that the axis will lie to	*)
+    (* the left of the line x=xs (xs is defined in OpenGraph).		*)
+    (* DecPlaces gives the number of decimal places that will be used.	*)
+    (* If numbering is FALSE, the axis is drawn but not labelled.	*)
+
+    BEGIN
+	WITH G^ DO
+
+	    Line2 (Win, xs-xoffset, ys, xs-xoffset, ye);
+
+	    IF (GT=linear) OR (GT=loglinear) OR (GT=bar) THEN
+		PrintLinearScale (G, FALSE, yinc, xoffset,
+						DecPlaces, numbering)
+	    ELSIF GT=loglog THEN
+		PrintLogScale (G, FALSE, yinc, xoffset, DecPlaces)
+	    END (* IF *);
+
+	END (* WITH *);
+
+    END DrawYAxis;
+
+(************************************************************************)
+
+PROCEDURE DrawAxes (G: Graph;
+	xinc: LONGREAL;  yoffset, xdecplaces: CARDINAL;  numberx: BOOLEAN;
+	yinc: LONGREAL;  xoffset, ydecplaces: CARDINAL;  numbery: BOOLEAN);
+
+    (* Draws both the X and Y axes.  See the definitions of		*)
+    (* DrawXAxis and DrawYAxis above.					*)
+
+    BEGIN
+	WITH G^ DO
+	    DrawXAxis (G, xinc, yoffset, xdecplaces, numberx);
+	    DrawYAxis (G, yinc, xoffset, ydecplaces, numbery);
+	END (* WITH *)
+    END DrawAxes;
+
+(************************************************************************)
+
+PROCEDURE OpenGraph (VAR (*OUT*) G: Graph;  w: Window;  GrphType: GraphType;
+		    LnType: LineType; xst, yst, xen, yen: CARDINAL;
+		    xmin, ymin, xmax, ymax: LONGREAL;  Mark: MarkType);
+
+    (* Initialises a Graph, adding it to the top of the Graph stack.	*)
+
+    VAR num: INTEGER;
+
+    BEGIN
+	NEW(G);
+	WITH G^ DO
+    
+	    (* Add Graph to start of the stack *)
+
+	    Obtain (GraphAccess);
+	    NextGraph := TopGraph;
+	    TopGraph := G;
+	    Release (GraphAccess);
+	    Win := w;
+
+	    (* Set up graph variables *)
+
+	    GT := GrphType;  LT := LnType;
+	    minx := xmin;  miny := ymin;
+	    maxx := xmax;  maxy := ymax;
+	    xs := xst;  ys := yst;
+	    xe := xen;  ye := yen;
+	    MT := Mark;
+	    found := FALSE;
+
+	    (* Calculate the mapping values xscale and yscale. *)
+
+	    IF GT <> bar THEN
+		IF (GT<>loglinear) AND (GT<>loglog) THEN
+
+		    (* xscale = Float(xe-xs) / (maxx-minx)	*)
+
+		    xscale := VAL(LONGREAL, xe - xs) / (maxx - minx);
+
+		ELSE
+
+		    (* xscale:= (xe-xs)/(Log(maxx)-Log(minx)) *)
+		    (* Used to be xscale:= (xe-xs-5)/(Log(maxx)-Log(minx)) *)
+
+		    xscale := VAL(LONGREAL,xe-xs) / (Log(maxx) - Log(minx));
+
+		END (* IF *);
+	    END (* IF *);
+
+	    IF GT <> loglog THEN
+
+		(* yscale = Float(ye-ys) / (maxy-miny)	*)
+
+		yscale := VAL(LONGREAL,ye - ys) / (maxy - miny);
+
+	    ELSE
+
+		(* yscale:= (ye-ys)/(Log(maxy)-Log(miny)) *)
+
+		yscale := VAL(LONGREAL,ye-ys) / (Log(maxy) - Log(miny));	
+
+	    END (*IF*);
+
+	END (*WITH*)
+
+    END OpenGraph;
+
+(*************************************************************************)
+
+PROCEDURE DrawMarker (G: Graph;  x, y: INTEGER);
+
+    (* Puts a marker at point (x,y).  The coordinates are window-relative. *)
+
+    BEGIN
+
+	WITH G^ DO
+	    CASE MT OF
+		none:	IF (LT=dots) THEN
+			    PutPixel2 (Win, x, y)
+			END (* IF *);
+	      |
+		square:	Line2 (Win, x-2, y+1, x+2, y+1);
+			Line2 (Win, x+2, y+1, x+2, y-1);
+			Line2 (Win, x+2, y-1, x-2, y-1);
+			Line2 (Win, x-2, y-1, x-2, y+1);
+	      |
+		plus:	Line2 (Win, x, y+2, x, y-2);
+			Line2 (Win, x-3, y, x+3, y);
+	      |
+		cross:	Line2 (Win, x-2, y+2, x+2, y-2);
+			Line2 (Win, x+2, y+2, x-2, y-2);
+	      |
+		diamond: Line2 (Win, x, y+2, x+3, y);
+			Line2 (Win, x+3, y, x, y-2);
+			Line2 (Win, x, y-2, x-3, y);
+			Line2 (Win, x-3, y, x, y+2);
+
+	    END (* CASE *);
+	END (* WITH *);
+
+    END DrawMarker;
+
+(***********************************************************************)
+
+PROCEDURE XScaled (G: Graph;  x0: LONGREAL): CARDINAL;
+
+    (* Convert the number x0 in the range  (xmin <= x <= xmax) to a	*)
+    (* value that is relative to the graph's screen range (xs to xe).	*)
+
+    (* USED ONLY BY PROCEDURE Scaled, BELOW.	*)
+
+    VAR temp: LONGREAL;
+
+    BEGIN
+	WITH G^ DO
+	    IF (GT=loglog) OR (GT=loglinear) THEN
+
+		(* Use a log mapping. *)
+
+		temp := xscale * (Log(x0) - Log(minx));
+
+	    ELSE
+
+		(* use a linear mapping *)
+
+		temp := xscale * (x0 - minx);
+
+	    END (* IF *);
+
+	    RETURN xs + VAL(CARDINAL, temp+0.5);
+
+	END (* WITH *)
+
+    END XScaled;
+
+(************************************************************************)
+
+PROCEDURE YScaled (G: Graph;  y0: LONGREAL): CARDINAL;
+
+    (* Convert the number y0 in the range (ymin <= y <= ymax) to a	*)
+    (* value that is relative to the graph's screen range (ys to ye).	*)
+
+    VAR temp: LONGREAL;
+
+    BEGIN
+	WITH G^ DO
+	    IF (GT=loglog) THEN
+
+		(* use a Log mapping *)
+
+		temp := yscale * (Log(y0) - Log(miny));
+
+	    ELSE
+
+  		(* use a linear mapping *)
+
+		temp := yscale * (y0 - miny);
+
+	    END (* IF *);
+
+	    RETURN ys + VAL(CARDINAL, temp+0.5);
+
+	END (* WITH *)
+
+    END YScaled;
+
+(************************************************************************)
+
+PROCEDURE Scaled (G: Graph;  VAR (*OUT*) xscaled, yscaled: CARDINAL;
+							x0, y0: LONGREAL);
+
+    (* Scale the values of (x0,y0). See definition above of XScaled	*)
+    (* and YScaled. 							*)
+
+    BEGIN
+	xscaled := XScaled (G, x0);
+	yscaled := YScaled (G, y0);
+    END Scaled;
+
+(************************************************************************)
+
+PROCEDURE ClipPoint (G: Graph;  VAR (*INOUT*) x, y: LONGREAL);
+
+    (* Lets the values saturate to the permissible ranges for G.	*)
+
+    BEGIN
+	WITH G^ DO
+	    IF x < minx THEN x := minx
+	    ELSIF x > maxx THEN x := maxx;
+	    END (* IF *);
+	    IF y < miny THEN y := miny
+	    ELSIF y > maxy THEN y := maxy
+	    END (* IF *);
+	END (* WITH *)
+    END ClipPoint;
+
+(************************************************************************)
+
+PROCEDURE AddPoint (G: Graph;  x, y: LONGREAL);
+
+    VAR ix, iy: CARDINAL;
+
+    BEGIN
+	WITH G^ DO
+  
+	    (* Clip point (x,y) if necessary. *)
+
+	    ClipPoint (G, x, y);
+
+	    (* scale the point (x,y) *)
+
+	    Scaled (G, ix, iy, x, y);
+
+	    (* Display the scaled point (ix,iy) *)
+
+	    CASE LT OF
+		joined:	IF found THEN Line2 (Win, lastx, lasty, ix, iy)
+			END (* IF *);
+	      |
+		dots:	;
+	      |
+		vertical: Line2 (Win, ix, iy, ix, ys);
+	    END (* CASE *);
+	    DrawMarker (G, ix, iy);
+
+	    (* Remember the last point drawn *)
+
+	    found := TRUE;  lastx := ix;  lasty := iy;
+
+	END (* WITH *)
+
+    END AddPoint;
+
+(************************************************************************)
+
+PROCEDURE DrawLines(G: Graph;  x, y: ARRAY OF LONGREAL);
+
+    VAR i: INTEGER;
+
+    BEGIN
+	WITH G^ DO
+	    FOR i:= 0 TO HIGH(x) DO
+		AddPoint (G, x[i], y[i])
+	    END (* FOR *)
+	END (* WITH *)
+    END DrawLines;
+
+(************************************************************************)
+
+PROCEDURE DrawLine (G: Graph; x0, y0, x1, y1: LONGREAL);
+
+    (* Used for drawing discontinuous lines.  The line is drawn between	*)
+    (* (x0,y0) and (x1,y1) relative to graph G.				*)
+
+    VAR xstart, ystart, xend, yend: CARDINAL;
+   
+    BEGIN
+	ClipPoint (G, x0, y0);
+	ClipPoint (G, x1, y1);
+	Scaled (G, xstart, ystart, x0, y0);
+	Scaled (G, xend, yend, x1, y1);
+	Line2 (G^.Win, xstart, ystart, xend, yend);
+	DrawMarker (G, xstart, ystart);
+	DrawMarker (G, xend, yend)
+    END DrawLine;
+
+(************************************************************************)
+
+PROCEDURE BarGraph (G: Graph;  y: ARRAY OF LONGREAL;
+					del: CARDINAL;  Bt: BarType);
+
+    (* Displays a BarGraph of the vector y.  Parameter del gives the	*)
+    (* number of stripes per bar, in the case of striped fill patterns.	*)
+
+    VAR index, BarStartPt, BarEndPt, incr, y1, barinc, i: CARDINAL;
+	temp2, incr2, barwidth, bargap: LONGREAL;
+
+    BEGIN
+	barwidth := G^.minx+0.5;	(* width of a bar		*)
+	bargap := G^.maxx;		(* distance between two bars	*)
+
+	barinc := VAL(CARDINAL, barwidth) DIV del;
+
+	(* incr := bargap + barwidth  *)
+
+	incr2 := bargap + barwidth;
+	incr := VAL(CARDINAL, incr2);
+
+	WITH G^ DO
+	    BarStartPt := xs;
+	    index := 0;
+	    WHILE index <= HIGH(y) DO
+
+		y1 := YScaled (G, y[index]);
+		temp2 := VAL(LONGREAL,BarStartPt) + barwidth;
+		BarEndPt := VAL(CARDINAL, temp2);
+
+		(* Draw one Bar of the Bar Graph *)
+
+		Line2 (Win, BarStartPt, ys, BarStartPt, y1);
+		Line2 (Win, BarStartPt, y1, BarEndPt, y1);
+		Line2 (Win, BarEndPt, y1, BarEndPt, ys);
+
+		(* Add pattern to the Bar Graph *)
+
+		IF (Bt<>Four) THEN
+		    IF (Bt=Two) THEN
+			Line2 (Win, BarStartPt, ys, BarEndPt, y1);
+			Line2 (Win, BarEndPt, ys, BarStartPt, y1)
+		    ELSE
+			IF (Bt=One)OR(Bt=Five) THEN
+			    i:= BarStartPt + barinc;
+			    WHILE (i<BarEndPt) DO
+				Line2 (Win, i, ys, i, y1);
+				INC(i, barinc)
+			    END (* WHILE *)
+			END (* IF *);
+			IF (Bt=Three)OR(Bt=Five) THEN
+			    i := ys + barinc;
+			    WHILE (i<y1) DO
+				Line2 (Win, BarStartPt, i, BarEndPt, i);
+				INC(i, barinc)
+			    END (* WHILE *)
+			END (* IF *)
+		    END (* IF *)
+		END (* IF *);
+
+		INC (BarStartPt, incr); INC (index)
+
+	    END (* WHILE *)
+	END (* WITH *)
+
+    END BarGraph;
+
+(***********************************************************************)
+
+PROCEDURE CloseGraphs;
+
+    (* Destroys all Graphs Created. *)
+
+    VAR following: Graph;
+
+    BEGIN
+	Obtain (GraphAccess);
+	WHILE TopGraph <> NIL DO
+	    following := TopGraph^.NextGraph;
+	    DISPOSE (TopGraph);
+	    TopGraph := following;
+	END (*WHILE*);
+	Release (GraphAccess);
+    END CloseGraphs;
+
+(***********************************************************************)
+
+BEGIN
+    TopGraph := NIL;
+    CreateLock (GraphAccess);
+    SetTerminationProcedure(CloseGraphs);
+END WGraph.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/windows.def b/examples/Modula-2_Libraries/PMOS/sources/general/windows.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/windows.def
@@ -0,0 +1,394 @@
+DEFINITION MODULE Windows;
+
+	(****************************************************************)
+	(*								*)
+	(*		    Text-mode screen windows.			*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	10 December 1994			*)
+	(*  Status:		Working					*)
+	(*								*)
+	(****************************************************************)
+
+(************************************************************************)
+(*									*)
+(* REMARK: There are two versions of the basic 'write' procedure.	*)
+(* Procedure WriteChar treats every character as a printable character,	*)
+(* so it can write any character in the standard character set.  This	*)
+(* is the output procedure recommended for general use.  Control	*)
+(* operations are supplied by separate procedures such as WriteLn,	*)
+(* SetCursor, etc., so there is no need to resort to the BASIC		*)
+(* programmers' trick of writing long strings of obscure control codes.	*)
+(* But for people who can't break this bad habit, procedure Write is	*)
+(* supplied; this treats character codes 0..31 as control codes.	*)
+(* Its main intended uses are to echo keyboard input, and to print a	*)
+(* file which contains embedded control characters; but it may be	*)
+(* used for other purposes if desired.					*)
+(*									*)
+(* Warning: I have not bothered to look after all the control codes,	*)
+(* just the ones I found a use for.  Most of them print as a		*)
+(* two-character sequence ^<letter>.					*)
+(*									*)
+(************************************************************************)
+
+(************************************************************************)
+(*									*)
+(* NOTE ON CRITICAL SECTIONS: When using this module in a multitasking	*)
+(* environment, there are numerous critical sections because several	*)
+(* tasks may be using the same physical screen.  These sections are	*)
+(* protected by semaphores.  (For the case where we are not using the	*)
+(* multitasking kernel, there is a version of module Semaphores which	*)
+(* contains dummy procedures).  The general philosophy is to assume	*)
+(* that critical section protection is needed for inter-window		*)
+(* conflicts, but that no protection is needed for operations on a	*)
+(* single window because the most common situation is that each window	*)
+(* is used by only one task.  If there happen to be windows which are	*)
+(* shared by two or more tasks, the associated synchronization problems	*)
+(* must be resolved by the caller; they are not resolved in module	*)
+(* Windows, on the grounds that the extra overhead is not justified	*)
+(* just to support a case which rarely happens in practice.		*)
+(*									*)
+(*									*)
+(*			LATEST DEVELOPMENT				*)
+(*									*)
+(* Because of the addition of the MouseControl module, it can happen in	*)
+(* practice, so I've added partial protection.  The following		*)
+(* procedures are indivisible with respect to one another, as far as	*)
+(* shared uses of a window are concerned:				*)
+(*	OpenWindow, CloseWindow, ShiftWindowRel, ScrollUp, ScrollDown,	*)
+(*	WriteChar, WriteLn, SetCursor, Hide, PutOnTop.			*)
+(* Minor technicality: in some cases there is an implied PutOnTop, or	*)
+(* similar side-effect, and this is not always part of the indivisible	*)
+(* section.  I can't think of any case where this would matter to the	*)
+(* user.  I don't like making protected sections too large, since this	*)
+(* can degrade overall system responsiveness.				*)
+(*									*)
+(* Note: procedures WriteString and Write, while not indivisible in	*)
+(* the above sense, are protected at the "write a character" level.	*)
+(*									*)
+(************************************************************************)
+
+CONST
+    MaxRowNumber = 24;
+    MaxColumnNumber = 79;
+
+TYPE
+    Window;	(* is private *)
+    Colour = (black, blue, green, cyan, red, magenta, brown, white,
+		darkgrey, lightblue, lightgreen, lightcyan, lightred,
+		lightmagenta, yellow, intensewhite);
+
+    (* Note: Any of these colours may be used as a foreground colour,	*)
+    (* but in most applications only [black..white] are suitable as	*)
+    (* background colours.  The others may be used, but they can give	*)
+    (* strange effects such as a blinking display.  Use with care!	*)
+
+    RowRange = [0..MaxRowNumber];
+    ColumnRange = [0..MaxColumnNumber];
+
+    Rectangle = RECORD
+		    top, bottom: RowRange;
+		    left, right: ColumnRange;
+		END (*RECORD*);
+
+    FrameType = (noframe, simpleframe, doubleframe);
+    DividerType = (nodivider, simpledivider, doubledivider);
+
+    DisplayPage = [0..3];
+
+PROCEDURE OpenWindow (VAR (*OUT*) w: Window;
+			ForegroundColour, BackgroundColour: Colour;
+			firstline, lastline: RowRange;
+			firstcol, lastcol: ColumnRange;
+			FrameDesired: FrameType;
+			DividerDesired: DividerType);
+
+    (* Create a new window.  Note that row and column numbers start	*)
+    (* from 0.  NOTE: If the window has a box drawn around it (the case	*)
+    (* FrameDesired <> noframe), this subtracts from the space		*)
+    (* available for text.						*)
+
+PROCEDURE OpenSimpleWindow (VAR (*OUT*) w: Window;
+			firstline, lastline: RowRange;
+			firstcol, lastcol: ColumnRange);
+
+    (* Identical to OpenWindow, except that you don't get any choice	*)
+    (* about the colours or frame.  The window is white-on-black with	*)
+    (* a simple frame and no dividers for the scrolling region.  This	*)
+    (* version of OpenWindow is useful for those with monochrome	*)
+    (* displays who don't want to be bothered with importing the types	*)
+    (* Colour, FrameType, and DividerType.				*)
+
+PROCEDURE ChangeScrollingRegion (w: Window; firstline, lastline: RowRange);
+
+    (* Changes the scrolling region of window w to the new line		*)
+    (* boundaries given, and sets the cursor of this window to the	*)
+    (* start of the scrolling region.  Row numbers are window-relative;	*)
+    (* that is, line 0 is the top line of the window (which is where	*)
+    (* the border is, unless you have no border).			*)
+
+PROCEDURE NewScrollingRegion (w: Window;  firstline, lastline: RowRange;
+				firstcolumn, lastcolumn: ColumnRange);
+
+    (* Changes the scrolling region of w to be the specified rectangle,	*)
+    (* but unlike ChangeScrollingRegion this procedure does not redraw	*)
+    (* the dividers.  Furthermore the old scrolling region set by	*)
+    (* ChangeScrollingRegion is remembered and may be restored by a	*)
+    (* call to ResetScrollingRegion.					*)
+
+PROCEDURE ResetScrollingRegion (w: Window);
+
+    (* Changes the scrolling region of w back to what it was the last	*)
+    (* time ChangeScrollingRegion was called.  If ChangeScrollingRegion	*)
+    (* was never called, the scrolling region goes back to being the	*)
+    (* entire window minus the frame (if any).				*)
+
+PROCEDURE ShiftWindowRel (w: Window;  rowchange, columnchange: INTEGER);
+
+    (* Moves w on the screen.  The second and third arguments may be	*)
+    (* negative.  The amount of move may be reduced to prevent a move	*)
+    (* off the edge of the screen.					*)
+
+PROCEDURE ShiftWindowAbs (w: Window;  top: RowRange;  left: ColumnRange);
+
+    (* Like ShiftWindowRel, except that we directly specify the target	*)
+    (* position of the top left corner in screen coordinates.		*)
+
+PROCEDURE CloseWindow (w: Window);
+
+    (* Destroys the window.  Note that this could have side-effects	*)
+    (* if procedure InstallCloseHandler (see below) has been called.	*)
+
+PROCEDURE Hide (w: Window);
+
+    (* Makes this window invisible on the screen.  It is still possible	*)
+    (* to write to the window, but the output will not appear until	*)
+    (* a PutOnTop(w) is executed.					*)
+
+PROCEDURE PutOnPage (w: Window;  p: DisplayPage);
+
+    (* Moves window w to another display page.  The default is to put	*)
+    (* every window on page 0 when it is first opened.  To override	*)
+    (* the default, call this procedure after opening the window.	*)
+
+PROCEDURE PageOf (w: Window): DisplayPage;
+
+    (* Returns the display page on which window w resides. *)
+
+PROCEDURE PutOnTop (w: Window);
+
+    (* Makes sure that window w is fully visible on the screen.  (This	*)
+    (* also cancels the effect of a Hide(w).)  Rarely needed, since	*)
+    (* many window operations automatically put their window on top.	*)
+
+PROCEDURE IdentifyTopWindow (VAR (*OUT*) w: Window;
+				VAR (*INOUT*) row: RowRange;
+				VAR (*INOUT*) col: ColumnRange): BOOLEAN;
+
+    (* On entry w is unspecified and (row,col) describes a position on	*)
+    (* the screen.  On exit w is equal to the top window containing	*)
+    (* this screen location, and (row,col) have been altered to be	*)
+    (* window-relative coordinates.  Exception: if there is no visible	*)
+    (* window containing the given point, the function result is FALSE,	*)
+    (* the returned w is meaningless, and row and col are unchanged.	*)
+
+PROCEDURE RefreshDisplay;
+
+    (* Rewrites every open window.  Should not normally be needed, but	*)
+    (* available for use in cases the display is corrupted by, for	*)
+    (* example, software which bypasses this module and writes directly	*)
+    (* to the screen.							*)
+
+PROCEDURE SetActivePage (page: DisplayPage);
+
+    (* Changes the active display page.  Not needed unless you are	*)
+    (* switching among multiple pages.					*)
+
+TYPE PageChangeHandler = PROCEDURE (DisplayPage);
+
+PROCEDURE RequestPageChangeNotification (Proc: PageChangeHandler);
+
+    (* Sets up Proc as a procedure to be called on a page change.	*)
+
+TYPE CloseHandlerProc = PROCEDURE (Window, DisplayPage);
+
+PROCEDURE InstallCloseHandler (w: Window;  P: CloseHandlerProc);
+
+    (* Sets up P as a procedure to be called when the window is closed.	*)
+    (* It is legal to define multiple handlers for the same window.	*)
+
+PROCEDURE WindowLocation (w: Window): Rectangle;
+
+    (* Returns the current location of w on the screen. *)
+
+PROCEDURE SetCursor (w: Window; row: RowRange; column: ColumnRange);
+
+    (* Sets the cursor for window w to the given row and column.  The	*)
+    (* coordinates are window-relative; that is, they start at (0,0) at	*)
+    (* the top left of the window.					*)
+
+PROCEDURE SaveCursor (w: Window; VAR (*OUT*) row, column: CARDINAL);
+
+    (* Returns the current cursor position.  The coordinates are	*)
+    (* window-relative; that is, they start at (0,0) at the top left of	*)
+    (* the window.							*)
+
+PROCEDURE CursorLeft (w: Window);
+
+    (* Moves the window cursor one position left.  If it falls off the	*)
+    (* left edge of the window, it moves to the right edge in the same	*)
+    (* row.								*)
+
+PROCEDURE CursorRight (w: Window);
+
+    (* Moves the window cursor one position right.  If it falls off the	*)
+    (* right edge of the window, it moves to the left edge in the same	*)
+    (* row.								*)
+
+PROCEDURE CursorUp (w: Window);
+
+    (* Moves the window cursor one position up.  If it falls off the	*)
+    (* top edge of the window, it moves to the bottom edge in the same	*)
+    (* column.								*)
+
+PROCEDURE CursorDown (w: Window);
+
+    (* Moves the window cursor one position down.  If it falls off the	*)
+    (* bottom edge of the window, it moves to the top edge in the same	*)
+    (* column.								*)
+
+PROCEDURE ScrollUp (w: Window);
+
+    (* Scrolls the scrolling region of window w up by one row, filling	*)
+    (* the vacated row with spaces.					*)
+
+PROCEDURE ScrollDown (w: Window);
+
+    (* Scrolls the scrolling region of window w down by one row,	*)
+    (* filling the vacated row with spaces.				*)
+
+PROCEDURE WriteLn (w: Window);
+
+    (* Go to next line in window, scrolling if necessary.  N.B. The	*)
+    (* window does not scroll if you are not in the scrolling region	*)
+    (* at the time of the WriteLn.					*)
+
+PROCEDURE WriteChar (w: Window; ch: CHAR);
+
+    (* Write one character.  Control characters are not given special	*)
+    (* treatment; they produce something visible just like any other	*)
+    (* character.  Wraps to the next line before writing if the write	*)
+    (* would put us on or beyond the right border of w.			*)
+
+PROCEDURE Write (w: Window; ch: CHAR);
+
+    (* Like WriteChar, but codes in the range 0..31 are treated as	*)
+    (* control characters.  This procedure is not recommended for	*)
+    (* general use, as it leads to obscure programs.  (Instead, do the	*)
+    (* control operations by direct calls to the cursor control		*)
+    (* procedures which are also supplied in this module).  It is	*)
+    (* supplied mainly to help those who are used to the conventions of	*)
+    (* the "standard" Modula-2 I/O modules such as InOut.		*)
+
+PROCEDURE WriteString (w: Window; text: ARRAY OF CHAR);
+
+    (* Write a string of characters, stopping at the first NUL		*)
+    (* character or the end of the array, whichever comes first.	*)
+
+PROCEDURE ReadBack (w: Window;  r: RowRange;  c: ColumnRange): CHAR;
+
+    (* Returns the character which currently occupies relative location	*)
+    (* (r,c) on the display of window w.				*)
+
+PROCEDURE ReadChar (w: Window;  VAR (*OUT*) ch: CHAR);
+
+    (* Read one character, and echo it.	*)
+
+PROCEDURE LookaheadChar (w: Window): CHAR;
+
+    (* Reads a character without consuming it.  That is, the character	*)
+    (* remains available to be read by ReadChar.  This allows the	*)
+    (* caller to check whether the character is really wanted.		*)
+
+PROCEDURE ReadCharWithoutEcho (w: Window;  VAR (*OUT*) ch: CHAR);
+
+    (* Read one character, but don't echo it.  However, a blinking	*)
+    (* cursor is still displayed to prompt for the character.  (If you	*)
+    (* don't want the blinking cursor, use procedure GetKey).		*)
+
+PROCEDURE GetKey (w: Window): CHAR;
+
+    (* Read one character, without any prompt to the user.  The reason	*)
+    (* for specifying a window parameter is to ensure that keyboard	*)
+    (* input comes to us only when this window has input focus.		*)
+    (* (If you want the input regardless of input focus, use procedure	*)
+    (* Keyboard.InKey).							*)
+
+PROCEDURE PressAnyKey (w: Window);
+
+    (* Types a "Press any key to continue" message.	*)
+
+PROCEDURE ReadString (w: Window;  VAR (*OUT*) result: ARRAY OF CHAR);
+
+    (* Reads a character string, terminated by carriage return.		*)
+
+PROCEDURE EditString (w: Window;  VAR (*INOUT*) result: ARRAY OF CHAR;
+						fieldsize: CARDINAL);
+
+    (* Reads a character string, where a default result is supplied by	*)
+    (* the caller.  The final result is the state of the string at the	*)
+    (* time where the keyboard user types a carriage return or Esc, or	*)
+    (* uses a cursor movement key to move out of the displayed field.	*)
+    (* The terminating character remains available, via Keyboard.InKey,	*)
+    (* to the caller.  At most fieldsize characters of the string can	*)
+    (* be edited, and perhaps fewer if the result array is smaller or	*)
+    (* if there is insufficient space in the window.			*)
+
+PROCEDURE EditAborted (): BOOLEAN;
+
+    (* Checks the next keyboard input.  Returns TRUE for Escape, FALSE	*)
+    (* for anything else.  Escape or Carriage Return are consumed, any	*)
+    (* other character is returned to the Keyboard module.		*)
+
+PROCEDURE SetColours (w: Window; row: RowRange; col: ColumnRange;
+			nchar: CARDINAL;  foreground, background: Colour);
+
+    (* Sets a field of nchar characters, starting at (row,col), to	*)
+    (* the specified foreground and background colours.  The location	*)
+    (* is given in window-relative coordinates, not absolute screen	*)
+    (* positions.  NOTE: Do not assume that this procedure can wrap	*)
+    (* around to a new line.  It normally cannot.			*)
+
+PROCEDURE ColourSwap (w: Window; row: RowRange; col: ColumnRange;
+							nchar: CARDINAL);
+
+    (* Sets a field of nchar characters, starting at (row,col), to	*)
+    (* "reverse video" by swapping the foreground and background	*)
+    (* colours.  Notice that the process is reversible: you get back to	*)
+    (* "normal video" by calling this procedure again.  The location is	*)
+    (* given in window-relative coordinates, not absolute screen	*)
+    (* positions.  NOTE: Do not assume that this procedure can wrap	*)
+    (* around to a new line.  It normally cannot.			*)
+
+PROCEDURE Blink (w: Window; r: RowRange; c: ColumnRange; nchar: CARDINAL);
+
+    (* Toggles the blinking status - that is, turns blinking on if it	*)
+    (* was off, and vice versa - for nchar characters, starting at	*)
+    (* relative location (r,c) in window w.				*)
+    (* NOTE: This procedure will not wrap around to a new row.		*)
+
+PROCEDURE EraseLine (w: Window; option: CARDINAL);
+
+    (* Erases some or all of the current line (but never the border).	*)
+    (* The erased characters are replaced by space characters.  The	*)
+    (* window cursor is moved to the location of the first erased	*)
+    (* character.  If w is not the currently active window, the changes	*)
+    (* will not be visible until w is on top again.  The options are:	*)
+    (*		0	the whole of the line, except for the border	*)
+    (*		1	from the current cursor position onwards	*)
+    (*		2	from the start to just before the cursor	*)
+    (* If we are inside a scrolling region, then only that part of the	*)
+    (* line inside the scrolling region is affected.			*)
+
+END Windows.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/general/windows.mod b/examples/Modula-2_Libraries/PMOS/sources/general/windows.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/general/windows.mod
@@ -0,0 +1,2300 @@
+IMPLEMENTATION MODULE Windows;
+
+	(********************************************************)
+	(*							*)
+	(*		    Text-mode screen windows.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	27 February 1995		*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	For further thought at some later stage:	*)
+	(*	   -	(maybe) extend the set of procedures	*)
+	(*		for which w^.access0p5 is locked.	*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* proc *)	ADR;
+
+FROM Types IMPORT
+    (* proc *)	FarPointer, FarCharPointer;
+
+FROM LowLevel IMPORT
+    (* proc *)	Far, MakePointer, FarAddOffset, Copy, FarCopy, CopyUp, IXOR;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure, TerminationMessage;
+
+FROM TaskControl IMPORT
+    (* type *)	Lock,
+    (* proc *)	CreateTask, CreateLock, DestroyLock,
+		Obtain, Release, ReleaseAllLocks;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, DestroySemaphore, Wait, Signal;
+
+FROM TextVideo IMPORT
+    (* proc *)	VideoKind, SetTextPage, PositionCursor;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey, PutBack;
+
+(************************************************************************)
+(*	If you want black-and-white operation even though your		*)
+(*	display supports colour (e.g. for the case where the colours	*)
+(*	are not very readable), set ForcedMonochrome to TRUE.		*)
+(*	Otherwise, this module selects colour operation if it		*)
+(*	thinks that the hardware can support it.			*)
+(************************************************************************)
+
+CONST ForcedMonochrome = FALSE;
+
+(************************************************************************)
+
+CONST
+    BytesPerChar = 2;			(* # bytes/char in video buffer	*)
+    CharsPerRow = MaxColumnNumber + 1;	(* characters per row		*)
+    BytesPerRow = BytesPerChar*CharsPerRow;
+    buffersize = BytesPerRow * (MaxRowNumber+1);
+					(* size of window buffer	*)
+    PageSize = 4096;			(* offset to next display page	*)
+
+    DefaultPage = 0;
+    DefaultTabs =
+"        T       T       T       T       T       T       T       T       T";
+
+(************************************************************************)
+
+TYPE
+    buffersubscript = [0..buffersize - 1];
+    extendedbuffersubscript = [0..buffersize + BytesPerRow - 1];
+
+    CloseHandlerList = POINTER TO CloseHandlerRecord;
+    CloseHandlerRecord = RECORD
+			    next: CloseHandlerList;
+			    proc: CloseHandlerProc;
+			 END (*RECORD*);
+
+    PageChangeList = POINTER TO PageChangeRecord;
+    PageChangeRecord = RECORD
+			  next: PageChangeList;
+			  proc: PageChangeHandler;
+		       END (*RECORD*);
+
+    Window = POINTER TO WindowData;
+
+	(****************************************************************)
+	(*								*)
+	(* WindowData records are linked (by next and previous) as a	*)
+	(* doubly linked list, to implement a stack of windows.		*)
+	(* There is a separate stack for each display page.		*)
+	(* Variable TopWindow[page] points to the top of this stack.	*)
+	(*								*)
+	(* The access0p5 lock is to control simultaneous access		*)
+	(* to a single window by multiple tasks.  This is a new		*)
+	(* feature, so the protection is implemented for some but not	*)
+	(* all operations at this stage.  I'm still working on whether	*)
+	(* access0p5 should be a Lock or a Semaphore.  From the		*)
+	(* viewpoint of the external caller it's better to make it a	*)
+	(* Lock, but that creates problems during shutdown.		*)
+	(*								*)
+	(* CloseList points to a linked list of procedures to be	*)
+	(* called when this window is closed.				*)
+	(*								*)
+	(* The row and column values stored in this record are actual	*)
+	(* screen row and column, i.e. they are not window-relative.	*)
+	(*								*)
+	(* The ScreenPosition field is a subscript into the hardware	*)
+	(* video buffer.  It can be computed easily from the "page",	*)
+	(* "row", and "column" fields, but it is more convenient to	*)
+	(* keep this technically redundant variable.			*)
+	(*								*)
+	(* BufferBias is the difference between a byte location in the	*)
+	(* window's buffer and the corresponding ScreenPosition value.	*)
+	(* In the present version it's always equal to PageSize*page,	*)
+	(* but I might want to change that in future.			*)
+	(*								*)
+	(* A window's InputWaiting flag is set when it is waiting for	*)
+	(* a keyboard character.  When the character arrives it is	*)
+	(* stored in the InputChar field of this record, and we are	*)
+	(* notified of this by a Release(CharAvailable).  Because the	*)
+	(* requests for input are not necessarily satisfied in a FIFO	*)
+	(* order - because the input focus can change before the input	*)
+	(* arrives - we need a separate semaphore and InputChar field	*)
+	(* for each window, even though these fields remain unused for	*)
+	(* most windows.						*)
+	(*								*)
+	(* A window with the "hidden" flag set is not part of the	*)
+	(* stack of windows, and is not visible on the screen.		*)
+	(*								*)
+	(* The "obscured" field indicates whether this window is wholly	*)
+	(* or partially obscured by another window on the screen.  By	*)
+	(* keeping track of this, we can avoid some unnecessary screen	*)
+	(* refreshing.							*)
+	(*								*)
+	(* The "blockcursor" field specifies what kind of cursor to	*)
+	(* display: a block cursor if TRUE, an underline cursor if	*)
+	(* FALSE.  Most of the time this is irrelevant, as we display	*)
+	(* a cursor only during input, and even then we display it only	*)
+	(* if the window's CursorWanted flag is TRUE.			*)
+	(*								*)
+	(* The "buffer" array holds a copy of what is supposed to be	*)
+	(* transferred to the video buffer.				*)
+	(* 								*)
+	(****************************************************************)
+
+    WindowData = RECORD
+		    next, previous: Window;
+		    access0p5: Semaphore;
+		    CloseList: CloseHandlerList;
+		    frame: FrameType;  divider: DividerType;
+		    tabstops: ARRAY ColumnRange OF CHAR;
+		    ScrollRegion, DefaultScrollRegion: Rectangle;
+		    page: DisplayPage;
+		    FirstRow, LastRow, row: RowRange;
+		    FirstColumn, LastColumn: ColumnRange;
+		    column: [0..MAX(ColumnRange)+1];
+		    ScreenPosition, BufferBias: CARDINAL;
+		    foreground, background: Colour;
+		    CurrentAttributes: CHAR;
+		    InputChar: CHAR;
+		    CharAvailable: Semaphore;
+		    InputWaiting, hidden, obscured,
+				CursorWanted, blockcursor: BOOLEAN;
+		    buffer: ARRAY buffersubscript OF CHAR;
+		 END (*RECORD*);
+
+(************************************************************************)
+(*		   NOTE ON CRITICAL SECTION PROTECTION			*)
+(* The potential deadlock problems in this module are surprisingly	*)
+(* subtle, arising from the fact that a procedure incorporating one	*)
+(* form of critical section protection may call other procedures which	*)
+(* themselves contain critical section protection.  To avoid these	*)
+(* problems, we use an ordered resource policy.  Each critical section	*)
+(* protection semaphore is given a "level", which for clarity is shown	*)
+(* as the last character of its name.  A piece of code is said to be	*)
+(* executing at level N if it is inside a critical section protected	*)
+(* by a semaphore whose level is N (and not inside a critical section	*)
+(* protected by any semaphore of any higher level).  The rule which	*)
+(* avoids deadlock is: to lock a semaphore at level N, we must be	*)
+(* executing at a level < N.						*)
+(* For the purposes of this analysis, Locks and Semaphores are treated	*)
+(* as being equivalent.							*)
+(*									*)
+(*			LATEST DEVELOPMENT				*)
+(* Because I'm adding a new semaphore, but haven't yet updated the	*)
+(* notation, a new level 0p5 (meaning 0.5) has been added.		*)
+(************************************************************************)
+
+VAR
+
+    (* BlackAndWhite is true if we have a monochrome display.		*)
+
+    BlackAndWhite: BOOLEAN;
+
+    (* ActivePage is the display page currently visible on the screen.	*)
+
+    ActivePage: DisplayPage;
+
+    (* A list of procedures to call whenever the current display page	*)
+    (* is changed, and a lock to control access to this list.		*)
+
+    PageChangeProcs: PageChangeList;
+    PageChangeListAccess: Lock;
+
+    (* A semaphore to say that somebody wants some keyboard input.	*)
+
+    InputRequest: Semaphore;
+
+    (* BlankRow is set up by the initialisation code as a row of space	*)
+    (* characters.  Note however that the attribute codes need to be	*)
+    (* filled in before each use.					*)
+
+    BlankRow: ARRAY [0..BytesPerRow-1] OF CHAR;
+
+    (* Access to BlankRow is a critical section, so we protect it with	*)
+    (* a Lock.								*)
+
+    BlankRowAccess1: Lock;
+
+    (* StackAccess2 is used to protect access to the shared data	*)
+    (* structure which defines the stacks of windows.			*)
+
+    StackAccess2: Lock;
+
+    (* TopWindow[p] is the current top of the stack of windows for	*)
+    (* display on physical display page p.				*)
+
+    TopWindow: ARRAY DisplayPage OF Window;
+
+    (* ScreenAccess3 is used to protect access to memory in segment	*)
+    (* ScreenSeg, i.e. the memory belonging to the physical screen.	*)
+
+    ScreenAccess3: Lock;
+
+    (* ScreenSeg is a segment selector for the hardware video buffer.	*)
+
+    ScreenSeg: CARDINAL;
+
+    (* PhysicalCursor keeps track of the blinking screen cursor.  The	*)
+    (* CursorWindow field shows which window, if any, currently "owns"	*)
+    (* the physical cursor.  CursorVisible[page] shows whether the	*)
+    (* cursor should be visible when "page" is the active display page.	*)
+    (* Lock access4 is used to protect these variables and the hardware	*)
+    (* operations of turning the cursor on and off.			*)
+    (* For now, access4 also protects alterations to the active		*)
+    (* display page.							*)
+
+    PhysicalCursor: RECORD
+			access4: Lock;
+			CursorWindow: ARRAY DisplayPage OF Window;
+			CursorVisible: ARRAY DisplayPage OF BOOLEAN;
+		    END (*RECORD*);
+
+(************************************************************************)
+(*		   TURNING THE SCREEN CURSOR ON AND OFF			*)
+(************************************************************************)
+
+PROCEDURE CursorOff;
+
+    (* Turns the cursor off.  Caller must be executing at level 4.	*)
+
+    BEGIN
+	PositionCursor (FALSE, 0, FALSE);
+    END CursorOff;
+
+(************************************************************************)
+
+PROCEDURE CursorOn (position: CARDINAL;  blockcursor: BOOLEAN);
+
+    (* Displays a blinking screen cursor at the specified position.	*)
+    (* Caller must be executing at level 4.				*)
+
+    BEGIN
+	PositionCursor (TRUE, position, blockcursor);
+    END CursorOn;
+
+(************************************************************************)
+
+PROCEDURE UpdatePhysicalCursor;
+
+    (* Turns the physical cursor on or off, as appropriate.  Also	*)
+    (* signals a new input request, if a window on the active page is	*)
+    (* waiting for input, in case the input task has gone idle.		*)
+    (* The caller must be running at level<4.				*)
+
+    VAR w: Window;
+
+    BEGIN
+	WITH PhysicalCursor DO
+	    Obtain (access4);
+	    w := CursorWindow[ActivePage];
+	    IF w <> NIL THEN
+		Signal (InputRequest);
+	    END (*IF*);
+	    IF CursorVisible[ActivePage] THEN
+		CursorOn (w^.ScreenPosition, w^.blockcursor);
+	    ELSE
+		CursorOff;
+	    END (*IF*);
+	    Release (access4);
+	END (*WITH*);
+    END UpdatePhysicalCursor;
+
+(************************************************************************)
+(*		    HARDWARE DISPLAY PAGE CHANGES			*)
+(************************************************************************)
+
+PROCEDURE SetActivePage (page: DisplayPage);
+
+    (* Changes the active display page.	*)
+
+    VAR PCL: PageChangeList;
+
+    BEGIN
+	Obtain (PhysicalCursor.access4);
+	SetTextPage (VAL(SHORTCARD,page));
+	ActivePage := page;
+	Release (PhysicalCursor.access4);
+
+	(* Call the procedures which want notification of the change.	*)
+
+	Obtain (PageChangeListAccess);
+	PCL := PageChangeProcs;
+	WHILE PCL <> NIL DO
+	    PCL^.proc (page);
+	    PCL := PCL^.next;
+	END (*WHILE*);
+	Release (PageChangeListAccess);
+
+	(* Turn the cursor off or on, as appropriate. *)
+
+	UpdatePhysicalCursor;
+
+    END SetActivePage;
+
+(************************************************************************)
+
+PROCEDURE RequestPageChangeNotification (Proc: PageChangeHandler);
+
+    (* Sets up Proc as a procedure to be called on a page change.	*)
+
+    VAR PCL: PageChangeList;
+
+    BEGIN
+	NEW (PCL);
+	Obtain (PageChangeListAccess);
+	WITH PCL^ DO
+	    next := PageChangeProcs;
+	    proc := Proc;
+	END (*WITH*);
+	PageChangeProcs := PCL;
+	Release (PageChangeListAccess);
+    END RequestPageChangeNotification;
+
+(************************************************************************)
+
+PROCEDURE PageOf (w: Window): DisplayPage;
+
+    (* Returns the display page on which window w resides. *)
+
+    BEGIN
+	RETURN w^.page;
+    END PageOf;
+
+(************************************************************************)
+(*		MANIPULATION OF THE STACK OF WINDOWS			*)
+(************************************************************************)
+
+PROCEDURE UnLink (w: Window);
+
+    (* Removes w^ from the stack, but otherwise leaves it unchanged.	*)
+    (* Caller must have locked StackAccess2.				*)
+
+    BEGIN
+	WITH w^ DO
+	    IF previous <> NIL THEN previous^.next := next END (*IF*);
+	    IF next <> NIL THEN next^.previous := previous END (*IF*);
+	    IF TopWindow[page] = w THEN TopWindow[page] := next END (*IF*);
+	    previous := NIL;  next := NIL;
+	END (*WITH*);
+    END UnLink;
+
+(************************************************************************)
+
+PROCEDURE IdentifyTopWindow (VAR (*OUT*) w: Window;
+				VAR (*INOUT*) row: RowRange;
+				VAR (*INOUT*) col: ColumnRange): BOOLEAN;
+
+    (* On entry w is unspecified and (row,col) describes a position on	*)
+    (* the screen.  On exit w is equal to the top window containing	*)
+    (* this screen location, and (row,col) have been altered to be	*)
+    (* window-relative coordinates.  Exception: if there is no visible	*)
+    (* window containing the given point, the function result is FALSE,	*)
+    (* the returned w is NIL, and row and col are unchanged.		*)
+
+    BEGIN
+	Obtain (StackAccess2);
+	w := TopWindow[ActivePage];
+	LOOP
+	    IF w = NIL THEN EXIT(*LOOP*);
+	    ELSIF (col >= w^.FirstColumn) AND (col <= w^.LastColumn)
+			AND (row >= w^.FirstRow) AND (row <= w^.LastRow) THEN
+		DEC (row, w^.FirstRow);  DEC (col, w^.FirstColumn);
+		EXIT (*LOOP*);
+	    ELSE
+		w := w^.next;
+	    END (*IF*);
+	END (*LOOP*);
+	Release (StackAccess2);
+	RETURN w <> NIL;
+    END IdentifyTopWindow;
+
+(************************************************************************)
+
+PROCEDURE ComputeCursorWindow (page: DisplayPage);
+
+    (* Rechecks which window on this page should have the physical	*)
+    (* screen cursor, and displays or turns off the cursor, as 		*)
+    (* appropriate, if a change is needed.  This procedure should be	*)
+    (* called whenever there is a chance that the input focus might	*)
+    (* need to be shifted.						*)
+
+    VAR w, wtop: Window;  visible: BOOLEAN;
+	row: RowRange;  col: ColumnRange;
+
+    BEGIN
+	(* Find the top window that's waiting for input. *)
+
+	Obtain (StackAccess2);
+	w := TopWindow[page];
+	LOOP
+	    IF w = NIL THEN EXIT(*LOOP*) END(*IF*);
+	    IF w^.InputWaiting THEN EXIT(*LOOP*) END(*IF*);
+	    w := w^.next;
+	END (*LOOP*);
+	Release (StackAccess2);
+
+	(* Check whether the cursor should be visible. *)
+
+	IF w = NIL THEN
+	    visible := FALSE;
+	ELSE
+	    row := w^.row;  col := w^.column;
+	    visible := IdentifyTopWindow (wtop, row, col) AND (wtop = w);
+	END (*IF*);
+
+	(* Turn the cursor on or off, if necessary. *)
+
+	WITH PhysicalCursor DO
+	    Obtain (access4);
+	    IF (w = NIL) OR (CursorWindow[page] <> w) THEN
+		CursorWindow[page] := w;
+		CursorVisible[page] := visible AND w^.CursorWanted;
+		IF page = ActivePage THEN
+		    IF CursorVisible[page] THEN
+			CursorOn (w^.ScreenPosition, w^.blockcursor);
+		    ELSE
+			CursorOff;
+		    END (*IF*);
+		END (*IF*);
+	    END (*IF*);
+	    Release (access4);
+	END (*WITH*);
+    END ComputeCursorWindow;
+
+(************************************************************************)
+(*			   SCREEN REFRESHING				*)
+(************************************************************************)
+
+PROCEDURE PartialRefresh (w: Window;  startrow, endrow: RowRange;
+					startcol, endcol: ColumnRange);
+
+    (* Re-draws the image of window w on the screen, in the area	*)
+    (* bounded by the given absolute screen coordinates.  The ranges	*)
+    (* specified are inclusive limits.					*)
+    (* Caller must be executing at level <3.				*)
+
+    VAR i: RowRange;
+	offset: extendedbuffersubscript;  count: CARDINAL;
+
+    BEGIN
+	WITH w^ DO
+
+	    (* Work out the overlap between the region and the window.	*)
+
+	    IF FirstRow > startrow THEN startrow := FirstRow END (*IF*);
+	    IF LastRow < endrow THEN endrow := LastRow END (*IF*);
+	    IF FirstColumn > startcol THEN startcol := FirstColumn END (*IF*);
+	    IF LastColumn < endcol THEN endcol := LastColumn END (*IF*);
+
+	    (* Refresh that region, if it is nonempty.	*)
+
+	    IF (startrow <= endrow) AND (startcol <= endcol) THEN
+		offset := BytesPerRow*startrow + BytesPerChar*startcol;
+		count := BytesPerChar*(endcol - startcol + 1);
+		Obtain (ScreenAccess3);
+		FOR i := startrow TO endrow DO
+		    FarCopy (Far(ADR(buffer[offset])),
+			MakePointer(ScreenSeg, offset+BufferBias), count);
+		    INC (offset, BytesPerRow);
+		END (*FOR*);
+		Release (ScreenAccess3);
+	    END (*IF*);
+	END (*WITH*);
+    END PartialRefresh;
+
+(************************************************************************)
+
+PROCEDURE Refresh (w: Window);
+
+    (* Re-draws the image of window w on the screen.	*)
+    (* Caller must be executing at level <3.		*)
+
+    VAR i: RowRange;  offset: extendedbuffersubscript;
+	count: CARDINAL;
+
+    BEGIN
+	WITH w^ DO
+	    offset := BytesPerRow*FirstRow + BytesPerChar*FirstColumn;
+	    count := BytesPerChar*(LastColumn - FirstColumn + 1);
+	    Obtain (ScreenAccess3);
+	    FOR i := FirstRow TO LastRow DO
+		FarCopy (Far(ADR(buffer[offset])),
+			MakePointer(ScreenSeg, offset+BufferBias), count);
+		INC (offset, BytesPerRow);
+	    END (*FOR*);
+	    Release (ScreenAccess3);
+	    obscured := FALSE;
+	END (*WITH*);
+    END Refresh;
+
+(************************************************************************)
+
+PROCEDURE ComputeCollisions (w: Window);
+
+    (* Updates the "obscured" field of all windows which are below this	*)
+    (* one on the stack, and sets w^.obscured to FALSE.  Also updates	*)
+    (* the cursor visibility information, based on the assumption that	*)
+    (* w is the window on top of its stack.				*)
+    (* Caller must have locked StackAccess2.				*)
+    (* Caller must be executing at level <4.				*)
+
+    VAR left, right: ColumnRange;
+	top, bottom: RowRange;
+	w2: Window;  p: DisplayPage;
+
+    BEGIN
+	(* Take note of the screen location of this window. *)
+
+	WITH w^ DO
+	    obscured := FALSE;
+	    left := FirstColumn;  right := LastColumn;
+	    top := FirstRow;  bottom := LastRow;
+	    w2 := next;  p := page;
+	END (*WITH*);
+
+	(* Update the cursor visibility information. *)
+
+	WITH PhysicalCursor DO
+	    Obtain (access4);
+	    IF w^.InputWaiting THEN
+		CursorWindow[p] := w;
+		CursorVisible[p] := w^.CursorWanted;
+	    ELSIF CursorVisible[p] THEN
+		WITH CursorWindow[p]^ DO
+		    CursorVisible[p] := (row < top) OR (row > bottom)
+				OR (column < left) OR (column > right);
+	        END (*WITH*);
+	    END (*IF*);
+	    Release (access4);
+	END (*WITH*);
+
+	(* Update the "obscured" information for all windows under	*)
+	(* the current window.  (For those which are already obscured	*)
+	(* by some other window, no further check is needed.)		*)
+
+	WHILE w2 <> NIL DO
+	    WITH w2^ DO
+		IF NOT obscured THEN
+		    obscured := (LastColumn >= left) AND (FirstColumn <= right)
+				AND (LastRow >= top) AND (FirstRow <= bottom);
+		END (*IF*);
+	    END (*WITH*);
+	    w2 := w2^.next;
+	END (*WHILE*);
+    END ComputeCollisions;
+
+(************************************************************************)
+
+PROCEDURE PutOnTopI (w: Window);
+
+    (* Makes w the top of stack, and refreshes its image on the screen.	*)
+    (* This procedure does the same job as PutOnTop (see below), but	*)
+    (* different entry assumptions.					*)
+    (* The caller must have locked StackAccess2.			*)
+    (* The caller must be executing at level 2.				*)
+
+    BEGIN
+	UnLink (w);
+	IF TopWindow[w^.page] <> NIL THEN
+	    TopWindow[w^.page]^.previous := w
+	END (*IF*);
+	w^.next := TopWindow[w^.page];  TopWindow[w^.page] := w;
+	Refresh (w);  ComputeCollisions (w);
+	IF w^.page = ActivePage THEN
+	    UpdatePhysicalCursor;
+	END (*IF*);
+    END PutOnTopI;
+
+(************************************************************************)
+
+PROCEDURE PutOnTop (w: Window);
+
+    (* Makes w the top of stack, and refreshes its image on the screen.	*)
+    (* This also unhides w if it was hidden.				*)
+    (* This is the externally callable version.				*)
+    (* The caller must be executing at a level <0.5.			*)
+
+    BEGIN
+	Wait (w^.access0p5);
+	Obtain (StackAccess2);
+	w^.hidden := FALSE;
+	IF TopWindow[w^.page] <> w THEN
+	    PutOnTopI (w);
+	ELSIF w^.page = ActivePage THEN
+	    UpdatePhysicalCursor;
+	END (*IF*);
+	Release (StackAccess2);
+	Signal (w^.access0p5);
+    END PutOnTop;
+
+(************************************************************************)
+
+PROCEDURE Repaint (page: DisplayPage;  startrow, endrow: RowRange;
+					startcol, endcol: ColumnRange);
+
+    (* Repaints the specified (inclusive) rectangular region on the	*)
+    (* screen, and sets the physical screen cursor as necessary.	*)
+    (* The caller must be executing at level <1.			*)
+
+    CONST NormalVideo = CHR(07H);
+
+    VAR i: RowRange;
+	offset: CARDINAL; count: buffersubscript;
+	p: Window;
+
+    BEGIN
+	(* First, clear the region.	*)
+
+	Obtain (BlankRowAccess1);
+	FOR offset := 1 TO BytesPerRow-1 BY BytesPerChar DO
+	    BlankRow[offset] := NormalVideo;
+	END (*FOR*);
+	offset := PageSize*page + BytesPerRow*startrow + BytesPerChar*startcol;
+	count := BytesPerChar*(endcol - startcol + 1);
+	Obtain (ScreenAccess3);
+	FOR i := startrow TO endrow DO
+	    FarCopy (Far(ADR(BlankRow)),
+				MakePointer(ScreenSeg, offset), count);
+	    INC (offset, BytesPerRow);
+	END (*FOR*);
+	Release (ScreenAccess3);
+	Release (BlankRowAccess1);
+
+	(* Now refresh all open windows (or, more precisely, the parts	*)
+	(* of them which lie in the affected region).			*)
+
+	Obtain (StackAccess2);
+	WITH PhysicalCursor DO
+	    Obtain (access4);
+	    CursorWindow[page] := NIL;
+	    CursorVisible[page] := FALSE;
+	    Release (access4);
+	END (*WITH*);
+	IF TopWindow[page] <> NIL THEN
+	    p := TopWindow[page];
+	    WHILE p^.next <> NIL DO  p := p^.next  END (*WHILE*);
+	    REPEAT
+		PartialRefresh (p, startrow, endrow, startcol, endcol);
+		ComputeCollisions (p);  p := p^.previous;
+	    UNTIL p = NIL;
+	END (*IF*);
+	IF page = ActivePage THEN
+	    UpdatePhysicalCursor;
+	END (*IF*);
+	Release (StackAccess2);
+    END Repaint;
+
+(************************************************************************)
+
+PROCEDURE RefreshDisplay;
+
+    (* Rewrites every open window.  Should not normally be needed, but	*)
+    (* available for use in cases the display is corrupted by, for	*)
+    (* example, software which bypasses this module and writes directly	*)
+    (* to the screen.							*)
+    (* The caller must be executing at level <1.			*)
+
+    VAR p: DisplayPage;
+
+    BEGIN
+	FOR p := 0 TO MAX(DisplayPage) DO
+	    Repaint (p, 0, MAX(RowRange), 0, MAX(ColumnRange));
+	END (*FOR*);
+    END RefreshDisplay;
+
+(************************************************************************)
+
+PROCEDURE Hide (w: Window);
+
+    (* Makes this window invisible on the screen.  It is still possible	*)
+    (* to write to the window, but the output will not appear until	*)
+    (* a PutOnTop(w) is executed.					*)
+    (* The caller must be executing at level <0.5.			*)
+
+    BEGIN
+	Wait (w^.access0p5);
+	Obtain (StackAccess2);
+	w^.hidden := TRUE;
+	UnLink (w);
+	Release (StackAccess2);
+	Signal (w^.access0p5);
+
+	(* Repaint the part of the screen which this window occupied.	*)
+
+	WITH w^ DO
+	    Repaint (page, FirstRow, LastRow, FirstColumn, LastColumn);
+	END (*WITH*);
+
+    END Hide;
+
+(************************************************************************)
+
+PROCEDURE PutOnPage (w: Window;  p: DisplayPage);
+
+    (* Moves window w to another display page.  The default is to put	*)
+    (* every window on page 0 when it is first opened.  To override	*)
+    (* the default, call this procedure after opening the window.	*)
+
+    VAR wasvisible: BOOLEAN;
+
+    BEGIN
+	wasvisible := NOT w^.hidden;
+	Hide (w);
+
+	WITH w^ DO
+
+	    (* Change the page.	*)
+
+	    ScreenPosition := ScreenPosition + PageSize*(p - page);
+	    page := p;
+	    BufferBias := PageSize*page;
+
+	    IF wasvisible THEN
+		hidden := FALSE;  PutOnTop (w);
+	    END(*IF*);
+
+	END (*WITH*);
+
+    END PutOnPage;
+
+(************************************************************************)
+(*			SETTING THE SCROLLING REGION			*)
+(************************************************************************)
+
+PROCEDURE InScrollingRegion (w: Window): BOOLEAN;
+
+    (* Returns TRUE iff the current cursor position of window w is	*)
+    (* inside its scrolling region.					*)
+
+    BEGIN
+	WITH w^ DO
+	    WITH ScrollRegion DO
+		RETURN (row >= top) AND (row <= bottom)
+			AND (column >= left) AND (column <= right);
+	    END (*WITH*);
+	END (*WITH*);
+    END InScrollingRegion;
+
+(************************************************************************)
+
+PROCEDURE ChangeScrollingRegion (w: Window;  firstline, lastline: RowRange);
+
+    (* Changes the scrolling region of window w to the new line		*)
+    (* boundaries given, and sets its cursor to the start of the new	*)
+    (* scrolling region.  The line numbers are window-relative.		*)
+
+    VAR horizontal, vertical, leftT, rightT: CHAR;
+	j: ColumnRange;  place: buffersubscript;
+
+    BEGIN
+	(* Although the user specifies window-relative line numbers,	*)
+	(* we use screen-relative numbers internally.  Adjust the	*)
+	(* parameters to take this into account.			*)
+
+	INC (firstline, w^.FirstRow);
+	INC (lastline, w^.FirstRow);
+
+	(* Work out what characters to use for the frame and divider.	*)
+
+	horizontal := '─';  vertical := '│';
+	leftT := '├';  rightT := '┤';
+	WITH w^ DO
+	    IF divider = doubledivider THEN
+		horizontal := '═';
+	    END (*IF*);
+	    IF frame = doubleframe THEN
+		vertical := '║';
+		IF divider = doubledivider THEN
+		    leftT := '╠';  rightT := '╣';
+		ELSE
+		    leftT := '╟';  rightT := '╢';
+		END (*IF*);
+	    ELSIF divider = doubledivider THEN
+		leftT := '╞';  rightT := '╡';
+	    END (*IF*);
+
+	    (* Clean up the frame. *)
+
+	    ScrollRegion := DefaultScrollRegion;
+	    IF frame <> noframe THEN
+
+		(* Remove the left and right T belonging to the	*)
+		(* old divider bars, if necessary.		*)
+
+		IF ScrollRegion.top - 1 > FirstRow THEN
+		    place := BytesPerRow*(ScrollRegion.top - 1)
+					+ BytesPerChar*FirstColumn;
+		    buffer[place] := vertical;
+		    buffer[place + BytesPerChar*(LastColumn - FirstColumn)]
+					:= vertical;
+		END (*IF*);
+
+		IF ScrollRegion.bottom + 1 < LastRow THEN
+		    place := BytesPerRow*(ScrollRegion.bottom+1)
+					+ BytesPerChar*FirstColumn;
+		    buffer[place] := vertical;
+		    buffer[place + BytesPerChar*(LastColumn - FirstColumn)]
+					:= vertical;
+		END (*IF*);
+	    END (*IF*);
+
+	    (* Put in the new divider bars.	*)
+
+	    IF divider <> nodivider THEN
+
+		(* Put in the top horizontal bar.	*)
+
+		IF firstline > FirstRow + 1 THEN
+		    place := BytesPerRow*(firstline-1)
+					+ BytesPerChar*FirstColumn;
+		    IF frame <> noframe THEN
+			buffer[place] := leftT;  INC (place, BytesPerChar);
+		    END (*IF*);
+		    FOR j := ScrollRegion.left TO ScrollRegion.right DO
+			buffer[place] := horizontal;  INC(place, BytesPerChar);
+		    END (*FOR*);
+		    IF frame <> noframe THEN
+			buffer[place] := rightT;
+		    END (*IF*);
+		END (*IF*);
+
+		(* Put in the bottom horizontal bar.	*)
+
+		IF lastline < LastRow - 1 THEN
+		    place := BytesPerRow*(lastline+1)
+					+ BytesPerChar*FirstColumn;
+		    IF frame <> noframe THEN
+			buffer[place] := leftT;  INC (place, BytesPerChar);
+		    END (*IF*);
+		    FOR j := ScrollRegion.left TO ScrollRegion.right DO
+			buffer[place] := horizontal; INC(place, BytesPerChar);
+		    END (*FOR*);
+		    IF frame <> noframe THEN
+			buffer[place] := rightT;
+		    END (*IF*);
+		END (*IF*);
+
+	    END (*IF*);
+
+	    (* Finally, update the scrolling region parameters.	*)
+
+	    WITH ScrollRegion DO
+		top := firstline;  bottom := lastline;
+	    END (*WITH*);
+	    DefaultScrollRegion := ScrollRegion;
+	    SetCursor (w, firstline - FirstRow,
+				ScrollRegion.left - FirstColumn);
+	    Obtain (StackAccess2);
+	    IF NOT (hidden OR obscured) THEN
+		Refresh (w);
+	    END (*IF*);
+	    Release (StackAccess2);
+	END (*WITH*);
+    END ChangeScrollingRegion;
+
+(************************************************************************)
+
+PROCEDURE NewScrollingRegion (w: Window;  firstline, lastline: RowRange;
+				firstcolumn, lastcolumn: ColumnRange);
+
+    (* Changes the scrolling region of w to be the specified rectangle,	*)
+    (* but unlike ChangeScrollingRegion this procedure does not redraw	*)
+    (* the dividers.  Furthermore the old scrolling region set by	*)
+    (* ChangeScrollingRegion is remembered and may be restored by a	*)
+    (* call to ResetScrollingRegion.					*)
+
+    BEGIN
+	WITH w^ DO
+	    WITH ScrollRegion DO
+		top := FirstRow+firstline;  bottom := FirstRow+lastline;
+		left := FirstColumn+firstcolumn;
+		right := FirstColumn+lastcolumn;
+	    END (*WITH*);
+	END (*WITH*);
+    END NewScrollingRegion;
+
+(************************************************************************)
+
+PROCEDURE ResetScrollingRegion (w: Window);
+
+    (* Changes the scrolling region of w back to what it was the last	*)
+    (* time ChangeScrollingRegion was called.  If ChangeScrollingRegion	*)
+    (* was never called, the scrolling region goes back to being the	*)
+    (* entire window minus the frame (if any).				*)
+
+    BEGIN
+	w^.ScrollRegion := w^.DefaultScrollRegion;
+    END ResetScrollingRegion;
+
+(************************************************************************)
+(*			    OPENING A WINDOW				*)
+(************************************************************************)
+
+PROCEDURE FillInFrame (w: Window);
+
+    (* Puts the box around the window into the window buffer.	*)
+
+    VAR i: RowRange;  j: ColumnRange;
+	corner: ARRAY [1..4] OF CHAR;
+	horizontal, vertical: CHAR;
+	place, offset: buffersubscript;
+
+    BEGIN
+	IF w^.frame = simpleframe THEN
+	    corner[1] := '┌';  corner[2] := '┐';
+	    corner[3] := '└';  corner[4] := '┘';
+	    horizontal := '─';  vertical := '│';
+	ELSE
+	    corner[1] := '╔';  corner[2] := '╗';
+	    corner[3] := '╚';  corner[4] := '╝';
+	    horizontal := '═';  vertical := '║';
+	END (*IF*);
+
+	WITH w^ DO
+
+	    offset := BytesPerChar*(LastColumn - FirstColumn);
+	    place := BytesPerRow*FirstRow + BytesPerChar*FirstColumn;
+	    buffer[place] := corner[1];
+	    buffer[place+offset] := corner[2];
+	    INC (place, BytesPerRow);
+
+	    FOR i := FirstRow + 1 TO LastRow - 1 DO
+		buffer[place] := vertical;
+		buffer[place+offset] := vertical;
+		INC (place, BytesPerRow);
+	    END (*FOR*);
+
+	    buffer[place] := corner[3];
+	    buffer[place+offset] := corner[4];
+
+	    offset := BytesPerRow*(LastRow - FirstRow);
+	    FOR j := FirstColumn + 1 TO LastColumn - 1 DO
+		INC (place, BytesPerChar);
+		buffer[place-offset] := horizontal;
+		buffer[place] := horizontal;
+	    END (*FOR*);
+
+	END (*WITH*);
+    END FillInFrame;
+
+(************************************************************************)
+
+PROCEDURE MakeMonochrome (VAR (*INOUT*) foreground, background: Colour);
+
+    (* Changes the two given colours to a suitable B/W combination.	*)
+
+    BEGIN
+	IF (foreground = black) OR (foreground = darkgrey) THEN
+	    background := white
+	ELSE
+	    IF foreground > white THEN
+		foreground := intensewhite
+	    ELSE
+		foreground := white;
+	    END (*IF*);
+	    background := black;
+	END (*IF*);
+    END MakeMonochrome;
+
+(************************************************************************)
+
+PROCEDURE OpenWindow (VAR (*OUT*) w: Window;
+			ForegroundColour, BackgroundColour: Colour;
+			firstline, lastline: RowRange;
+			firstcol, lastcol: ColumnRange;
+			FrameDesired: FrameType;
+			DividerDesired: DividerType);
+
+    (* Creates a new window, and makes it the current window, filled	*)
+    (* initially with space characters.					*)
+    (* The caller must be executing at level <0.5.			*)
+
+    VAR i: RowRange;  j: ColumnRange;  k: buffersubscript;
+
+    BEGIN
+
+	(* Create the new window, and fill in all its fields.	*)
+
+	NEW (w);
+	WITH w^ DO
+	    CreateSemaphore (access0p5, 0);
+	    CloseList := NIL;
+	    previous := NIL;  next := NIL;  blockcursor := FALSE;
+	    page := DefaultPage;  hidden := FALSE;
+	    InputWaiting := FALSE;  CursorWanted := FALSE;
+	    CreateSemaphore (CharAvailable, 0);
+	    foreground := ForegroundColour;  background := BackgroundColour;
+	    IF BlackAndWhite OR ForcedMonochrome THEN
+		MakeMonochrome (foreground, background);
+	    END (*IF*);
+	    CurrentAttributes := CHR(16*ORD(background) + ORD(foreground));
+	    frame := FrameDesired;  divider := DividerDesired;
+	    FirstRow := firstline;  LastRow := lastline;
+	    FirstColumn := firstcol;  LastColumn := lastcol;
+	    tabstops := DefaultTabs;
+	    IF frame <> noframe THEN
+		FOR j := MAX(ColumnRange) TO 1 BY -1 DO
+		    tabstops[j] := tabstops[j-1];
+		END (*FOR*);
+		tabstops[0] := " ";
+	    END (*IF*);
+
+	    (* Set the window contents to all space characters.	*)
+
+	    Obtain (BlankRowAccess1);
+	    FOR k := 1 TO BytesPerRow-1 BY BytesPerChar DO
+		BlankRow[k] := CurrentAttributes;
+	    END (*FOR*);
+	    FOR i := 0 TO MaxRowNumber DO
+		Copy (ADR(BlankRow), ADR(buffer[i*BytesPerRow]), BytesPerRow);
+	    END (*FOR*);
+	    Release (BlankRowAccess1);
+
+	    (* Set up a default scrolling region.	*)
+
+	    WITH ScrollRegion DO
+		top := FirstRow;  bottom := LastRow;
+		left := FirstColumn;  right := LastColumn;
+	    END (*WITH*);
+
+	    (* Make the frame.	*)
+
+	    IF frame <> noframe THEN
+		FillInFrame(w);
+		WITH ScrollRegion DO
+		    INC (top);  INC (left);  DEC (bottom);  DEC (right);
+		END (*WITH*);
+	    END (*IF*);
+
+	    DefaultScrollRegion := ScrollRegion;
+	    row := ScrollRegion.top;  column := ScrollRegion.left;
+	    ScreenPosition := PageSize*page + BytesPerRow*row
+						+ BytesPerChar*column;
+	    BufferBias := PageSize*page;
+	    Signal (access0p5);
+
+	END (*WITH*);
+
+	(* Put the new window on top of the stack of active windows.	*)
+
+	PutOnTop (w);
+
+    END OpenWindow;
+
+(************************************************************************)
+
+PROCEDURE OpenSimpleWindow (VAR (*OUT*) w: Window;
+			firstline, lastline: RowRange;
+			firstcol, lastcol: ColumnRange);
+
+    (* Identical to OpenWindow, except that you don't get any choice	*)
+    (* about the colours or frame.  The window is white-on-black with	*)
+    (* a simple frame and no dividers for the scrolling region.  This	*)
+    (* version of OpenWindow is useful for those with monochrome	*)
+    (* displays who don't want to be bothered with importing the types	*)
+    (* Colour, FrameType, and DividerType.				*)
+
+    BEGIN
+	OpenWindow (w, white, black, firstline, lastline,
+			firstcol, lastcol, simpleframe, nodivider);
+    END OpenSimpleWindow;
+
+(************************************************************************)
+(*		   CHANGING THE POSITION OF A WINDOW			*)
+(************************************************************************)
+
+PROCEDURE ShiftWindowRel (w: Window;  rowchange, columnchange: INTEGER);
+
+    (* Moves w on the screen.  The second and third arguments may be	*)
+    (* negative.  The amount of move may be reduced to prevent a move	*)
+    (* off the edge of the screen.					*)
+    (* The caller must be executing at level <0.5.			*)
+
+    VAR byteshift: INTEGER;  wasvisible: BOOLEAN;
+
+    BEGIN
+	IF (rowchange <> 0) OR (columnchange <> 0) THEN
+	    WITH w^ DO
+		(* Temporarily remove the window from the stack of windows. *)
+
+		wasvisible := NOT hidden;  Hide(w);
+
+		Wait (access0p5);
+
+		(* Clip the shift amount to avoid going off the screen.	*)
+
+		IF INTEGER(FirstRow)+rowchange < 0 THEN
+	            rowchange := - INTEGER(FirstRow)
+		ELSIF INTEGER(LastRow)+rowchange > MaxRowNumber THEN
+		    rowchange := MaxRowNumber - LastRow
+		END (*IF*);
+
+		IF INTEGER(FirstColumn)+columnchange < 0 THEN
+	            columnchange := -INTEGER(FirstColumn)
+		ELSIF INTEGER(LastColumn)+columnchange > MaxColumnNumber THEN
+		    columnchange := MaxColumnNumber - LastColumn
+		END (*IF*);
+
+		byteshift := BytesPerRow*rowchange + BytesPerChar*columnchange;
+
+		(* Shift the buffer contents.	*)
+
+		IF byteshift < 0 THEN
+		    Copy (ADR(buffer[-byteshift]), ADR(buffer[0]),
+						buffersize+byteshift)
+		ELSE
+		    CopyUp (Far(ADR(buffer[0])), Far(ADR(buffer[byteshift])),
+						buffersize-byteshift)
+		END (*IF*);
+
+		(* Adjust the affected window parameters.	*)
+
+		IF rowchange > 0 THEN
+		    WITH ScrollRegion DO
+			INC (top, rowchange);  INC (bottom, rowchange);
+		    END (*WITH*);
+		    WITH DefaultScrollRegion DO
+			INC (top, rowchange);  INC (bottom, rowchange);
+		    END (*WITH*);
+		    INC (FirstRow, rowchange);  INC (LastRow, rowchange);
+		    INC (row, rowchange);
+		ELSE
+		    rowchange := -rowchange;
+		    WITH ScrollRegion DO
+			DEC (top, rowchange);  DEC (bottom, rowchange);
+		    END (*WITH*);
+		    WITH DefaultScrollRegion DO
+			DEC (top, rowchange);  DEC (bottom, rowchange);
+		    END (*WITH*);
+		    DEC (FirstRow, rowchange);  DEC (LastRow, rowchange);
+		    DEC (row, rowchange);
+		END (*IF*);
+
+		IF columnchange > 0 THEN
+		    WITH ScrollRegion DO
+			INC (left, columnchange);  INC (right, columnchange);
+		    END (*WITH*);
+		    WITH DefaultScrollRegion DO
+			INC (left, columnchange);  INC (right, columnchange);
+		    END (*WITH*);
+		    INC (FirstColumn, columnchange);
+		    INC (LastColumn, columnchange);
+		    INC (column, columnchange);
+		ELSE
+		    columnchange := -columnchange;
+		    WITH ScrollRegion DO
+			DEC (left, columnchange);  DEC (right, columnchange);
+		    END (*WITH*);
+		    WITH DefaultScrollRegion DO
+			DEC (left, columnchange);  DEC (right, columnchange);
+		    END (*WITH*);
+		    DEC (FirstColumn, columnchange);
+		    DEC (LastColumn, columnchange);
+		    DEC (column, columnchange);
+		END (*IF*);
+
+		IF byteshift > 0 THEN
+		    INC (ScreenPosition, byteshift);
+		ELSE
+		    DEC (ScreenPosition, -byteshift);
+		END (*IF*);
+
+		Signal (access0p5);
+
+		(* Put w back onto the stack and onto the screen.	*)
+
+		IF wasvisible THEN
+		    hidden := FALSE;  PutOnTop (w);
+		END (*IF*);
+
+	    END (*WITH*);
+
+	END (*IF*);
+
+    END ShiftWindowRel;
+
+(************************************************************************)
+
+PROCEDURE ShiftWindowAbs (w: Window;  top: RowRange;  left: ColumnRange);
+
+    (* Like ShiftWindowRel, except that we directly specify the target	*)
+    (* position of the top left corner in screen coordinates.		*)
+
+    BEGIN
+	ShiftWindowRel (w, VAL(INTEGER,top)-VAL(INTEGER,w^.FirstRow),
+				VAL(INTEGER,left)-VAL(INTEGER,w^.FirstColumn));
+    END ShiftWindowAbs;
+
+(************************************************************************)
+
+PROCEDURE WindowLocation (w: Window): Rectangle;
+
+    (* Returns the current location of w on the screen. *)
+
+    VAR result: Rectangle;
+
+    BEGIN
+	WITH w^ DO
+	    WITH result DO
+		top := FirstRow;  bottom := LastRow;
+		left := FirstColumn;  right := LastColumn;
+	    END (*WITH*);
+	END (*WITH*);
+	RETURN result;
+    END WindowLocation;
+
+(************************************************************************)
+(*			    CLOSING A WINDOW				*)
+(************************************************************************)
+
+PROCEDURE InstallCloseHandler (w: Window;  P: CloseHandlerProc);
+
+    (* Sets up P as a procedure to be called when the window is closed.	*)
+    (* It is legal to define multiple handlers for the same window.	*)
+
+    VAR HLP: CloseHandlerList;
+
+    BEGIN
+	NEW (HLP);
+	WITH w^ DO
+	    Wait (access0p5);
+	    HLP^.next := CloseList;
+	    HLP^.proc := P;
+	    CloseList := HLP;
+	    Signal (access0p5);
+	END (*WITH*);
+    END InstallCloseHandler;
+
+(************************************************************************)
+
+PROCEDURE CloseWindow (w: Window);
+
+    (* Reclaims the buffer space used for this window, and removes its	*)
+    (* image on the screen.						*)
+    (* The caller must be executing at level <0.5.			*)
+
+    VAR p: CloseHandlerList;
+
+    BEGIN
+	Hide (w);
+	WITH w^ DO
+	    Wait (access0p5);
+	    WHILE CloseList <> NIL DO
+		p := CloseList^.next;
+		CloseList^.proc (w, w^.page);
+		DISPOSE (CloseList);
+		CloseList := p;
+	    END (*WHILE*);
+	    Signal (access0p5);
+	    DestroySemaphore (access0p5);
+	END (*WITH*);
+	DISPOSE (w);
+    END CloseWindow;
+
+(************************************************************************)
+(*	     	OPERATIONS ON CHARACTER ATTRIBUTES			*)
+(************************************************************************)
+
+PROCEDURE SetColours (w: Window; r: RowRange; c: ColumnRange;
+				nchar: CARDINAL;  fore, back: Colour);
+
+    (* Sets a field of nchar characters, starting at (row,col), to	*)
+    (* the specified foreground and background colours.  The location	*)
+    (* is given in window-relative coordinates, not absolute screen	*)
+    (* positions.  NOTE: This procedure will not wrap around to a new	*)
+    (* row.  The caller must be executing at level <3.			*)
+
+    VAR k, start: buffersubscript;  attributes: CHAR;
+
+    BEGIN
+	attributes := CHR(16*ORD(back) + ORD(fore));
+	WITH w^ DO
+	    start := BytesPerRow*(r+FirstRow)
+			+ BytesPerChar*(c+FirstColumn) + 1;
+	    FOR k := start TO start+BytesPerChar*(nchar-1) BY BytesPerChar DO
+		buffer[k] := attributes;
+	    END (*FOR*);
+	    IF NOT hidden THEN
+		Obtain (StackAccess2);
+		IF obscured THEN PutOnTopI(w)
+		ELSE
+		    Obtain (ScreenAccess3);
+		    FarCopy (Far(ADR(buffer[start])),
+				MakePointer(ScreenSeg, start+BufferBias),
+				BytesPerChar*nchar);
+		    Release (ScreenAccess3);
+		END (*IF obscured*);
+		Release (StackAccess2);
+	    END (*IF NOT hidden*);
+	END (*WITH*);
+    END SetColours;
+
+(************************************************************************)
+
+PROCEDURE ColourSwap (w: Window; r: RowRange; c: ColumnRange;
+							nchar: CARDINAL);
+
+    (* Switches the foreground and background colours for nchar		*)
+    (* characters, starting at location (r,c).  The row and column	*)
+    (* numbers are window-relative, not absolute screen coordinates.	*)
+    (* This is our colour equivalent of the "reverse video" operation.	*)
+    (* NOTE: This procedure will not wrap around to a new row.		*)
+    (* The caller must be executing at level <3.			*)
+
+    VAR k, start: buffersubscript;  oldattribute: CARDINAL;
+
+    BEGIN
+	WITH w^ DO
+	    start := BytesPerRow*(r+FirstRow)
+			+ BytesPerChar*(c+FirstColumn) + 1;
+	    FOR k := start TO start+BytesPerChar*(nchar-1) BY BytesPerChar DO
+		oldattribute := ORD(buffer[k]);
+		buffer[k] := CHR (16*(oldattribute MOD 16)
+					+ (oldattribute DIV 16));
+	    END (*FOR*);
+	    IF NOT hidden THEN
+		Obtain (StackAccess2);
+		IF obscured THEN PutOnTopI(w)
+		ELSE
+		    Obtain (ScreenAccess3);
+		    FarCopy (Far(ADR(buffer[start])),
+				MakePointer(ScreenSeg, start+BufferBias),
+				BytesPerChar*nchar);
+		    Release (ScreenAccess3);
+		END (*IF obscured*);
+		Release (StackAccess2);
+	    END (*IF NOT hidden*);
+	END (*WITH*);
+    END ColourSwap;
+
+(************************************************************************)
+
+PROCEDURE Blink (w: Window; r: RowRange; c: ColumnRange; nchar: CARDINAL);
+
+    (* Toggles the blinking status - that is, turns blinking on if it	*)
+    (* was off, and vice versa - for nchar characters, starting at	*)
+    (* relative location (r,c) in window w.				*)
+    (* NOTE: This procedure will not wrap around to a new row.		*)
+    (* The caller must be executing at level <3.			*)
+
+    VAR k, start: buffersubscript;
+
+    BEGIN
+	WITH w^ DO
+	    start := BytesPerRow*(r+FirstRow)
+			+ BytesPerChar*(c+FirstColumn) + 1;
+	    FOR k := start TO start+BytesPerChar*(nchar-1) BY BytesPerChar DO
+		buffer[k] := CHR (IXOR(ORD(buffer[k]), 80H));
+	    END (*FOR*);
+	    IF NOT hidden THEN
+		Obtain (StackAccess2);
+		IF obscured THEN PutOnTopI(w)
+		ELSE
+		    INC (start, PageSize*page);
+		    Obtain (ScreenAccess3);
+		    FarCopy (Far(ADR(buffer[start])),
+				MakePointer(ScreenSeg, start),
+				BytesPerChar*nchar);
+		    Release (ScreenAccess3);
+		END (*IF obscured*);
+		Release (StackAccess2);
+	    END (*IF NOT hidden*);
+	END (*WITH*);
+    END Blink;
+
+(************************************************************************)
+(*			    CURSOR OPERATIONS				*)
+(************************************************************************)
+
+PROCEDURE SetCursor (w: Window; r: RowRange; c: ColumnRange);
+
+    (* Sets the cursor for window w to relative row r, column c.	*)
+    (* The caller must be executing at level <0.5.			*)
+
+    BEGIN
+	WITH w^ DO
+	    Wait (access0p5);
+	    row := r + FirstRow;  column := c + FirstColumn;
+	    ScreenPosition := PageSize*page + BytesPerRow*row
+					+ BytesPerChar*column;
+	    Signal (access0p5);
+	END (*WITH*);
+    END SetCursor;
+
+(************************************************************************)
+
+PROCEDURE SaveCursor (w: Window; VAR (*OUT*) r, c: CARDINAL);
+
+    (* Returns the current cursor position of window w.		*)
+
+    BEGIN
+	WITH w^ DO
+	    r := row - FirstRow;  c := column - FirstColumn;
+	END (*WITH*);
+    END SaveCursor;
+
+(************************************************************************)
+
+PROCEDURE CursorLeft (w: Window);
+
+    (* Moves the window cursor one position left.  If it falls off the	*)
+    (* left edge of the window, move to the right edge in the same row.	*)
+
+    BEGIN
+	WITH w^ DO
+	    IF column = FirstColumn THEN
+		column := LastColumn;
+		ScreenPosition := PageSize*page + BytesPerRow*row
+						+ BytesPerChar*column;
+	    ELSE
+		DEC (column);  DEC (ScreenPosition, BytesPerChar);
+	    END (*IF*);
+	END (*WITH*);
+    END CursorLeft;
+
+(************************************************************************)
+
+PROCEDURE CursorRight (w: Window);
+
+    (* Moves the window cursor one position right.  If it falls off the	*)
+    (* right edge of the window, move to the left edge in the same row.	*)
+
+    BEGIN
+	WITH w^ DO
+	    IF column = LastColumn THEN
+		column := FirstColumn;
+		ScreenPosition := PageSize*page + BytesPerRow*row
+						+ BytesPerChar*column;
+	    ELSE
+		INC (column);  INC (ScreenPosition, BytesPerChar);
+	    END (*IF*);
+	END (*WITH*);
+    END CursorRight;
+
+(************************************************************************)
+
+PROCEDURE CursorUp (w: Window);
+
+    (* Moves the window cursor one position up.  If it falls off the	*)
+    (* top edge of the window, it moves to the bottom edge in the same	*)
+    (* column.								*)
+
+    BEGIN
+	WITH w^ DO
+	    IF row = FirstRow THEN
+		row := LastRow;
+		ScreenPosition := PageSize*page + BytesPerRow*row
+						+ BytesPerChar*column;
+	    ELSE
+		DEC (row);  DEC (ScreenPosition, BytesPerRow);
+	    END (*IF*);
+	END (*WITH*);
+    END CursorUp;
+
+(************************************************************************)
+
+PROCEDURE CursorDown (w: Window);
+
+    (* Moves the window cursor one position down.  If it falls off the	*)
+    (* bottom edge of the window, it moves to the top edge in the same	*)
+    (* column.								*)
+
+    BEGIN
+	WITH w^ DO
+	    IF row = LastRow THEN
+		row := FirstRow;
+		ScreenPosition := PageSize*page + BytesPerRow*row
+						+ BytesPerChar*column;
+	    ELSE
+		INC (row);  INC (ScreenPosition, BytesPerRow);
+	    END (*IF*);
+	END (*WITH*);
+    END CursorDown;
+
+(************************************************************************)
+
+PROCEDURE ScrollUpI (w: Window);
+
+    (* The version of ScrollUp (see below) for internal use.		*)
+    (* The caller must be executing at level <1.			*)
+
+    VAR rownum: RowRange;  count: CARDINAL;
+	k: buffersubscript;
+	srcptr, destptr, pscreen: FarPointer;
+
+    BEGIN
+	WITH w^ DO
+	    WITH ScrollRegion DO
+		k := BytesPerRow*top + BytesPerChar*left;
+		count := BytesPerChar*(right-left+1);
+		destptr := Far(ADR(buffer[k]));
+		pscreen := MakePointer(ScreenSeg, k+BufferBias);
+
+		(* Move the contents of the scrolling region up. *)
+
+		FOR rownum := top TO bottom-1 DO
+		    srcptr := FarAddOffset (destptr, BytesPerRow);
+		    FarCopy (srcptr, destptr, count);
+		    IF NOT (obscured OR hidden) THEN
+			Obtain (ScreenAccess3);
+			FarCopy (destptr, pscreen, count);
+			Release (ScreenAccess3);
+		    END (*IF*);
+		    destptr := srcptr;
+		    pscreen := FarAddOffset (pscreen, BytesPerRow);
+		END (*FOR*);
+		Obtain (BlankRowAccess1);
+
+		(* Fill in the attributes of BlankRow. *)
+
+		FOR k := 1 TO BytesPerRow-1 BY BytesPerChar DO
+		    BlankRow[k] := CurrentAttributes;
+		END (*FOR*);
+
+		(* Blank the bottom line of scrolling region. *)
+
+		FarCopy (Far(ADR(BlankRow)), destptr, count);
+		Release (BlankRowAccess1);
+		IF NOT (obscured OR hidden) THEN
+		    Obtain (ScreenAccess3);
+		    FarCopy (destptr, pscreen, count);
+		    Release (ScreenAccess3);
+		END (*IF*);
+
+	    END (*WITH*);
+
+	    IF obscured AND NOT hidden THEN
+		Obtain (StackAccess2);
+		PutOnTopI(w);
+		Release (StackAccess2);
+	    END (*IF*);
+
+	END (*WITH*);
+
+    END ScrollUpI;
+
+(************************************************************************)
+
+PROCEDURE ScrollUp (w: Window);
+
+    (* Scrolls window w up by one line, both on the screen and in its	*)
+    (* buffer.  The last row is filled with spaces.			*)
+    (* The caller must be executing at level <0.5.			*)
+
+    VAR k: buffersubscript;
+
+    BEGIN
+	Wait (w^.access0p5);
+	ScrollUpI (w);
+	Signal (w^.access0p5);
+    END ScrollUp;
+
+(************************************************************************)
+
+PROCEDURE ScrollDown (w: Window);
+
+    (* Scrolls window w down by one line, both on the screen and in its	*)
+    (* buffer.  The first row is filled with spaces.			*)
+    (* The caller must be executing at level <0.5.			*)
+
+    VAR k: buffersubscript;
+
+    BEGIN
+	WITH w^ DO
+	    Wait (access0p5);
+	    Obtain (BlankRowAccess1);
+	    FOR k := 1 TO BytesPerRow-1 BY BytesPerChar DO
+		BlankRow[k] := CurrentAttributes;
+	    END (*FOR*);
+	    WITH ScrollRegion DO
+		k := BytesPerRow * top;
+		CopyUp (Far(ADR(buffer[k])), Far(ADR(buffer[k+BytesPerRow])),
+			BytesPerRow*(bottom-top));
+		Copy (ADR(BlankRow), ADR(buffer[k+BytesPerChar*left]),
+			BytesPerChar*(right-left+1));
+	    END (*WITH*);
+	    Release (BlankRowAccess1);
+	    IF NOT hidden THEN
+		Obtain (StackAccess2);
+		IF obscured THEN PutOnTopI(w) ELSE Refresh (w);
+		END (*IF*);
+		Release (StackAccess2);
+	    END (*IF*);
+	    Signal (access0p5);
+	END (*WITH*);
+    END ScrollDown;
+
+(************************************************************************)
+(*			    MAIN OUTPUT ROUTINES			*)
+(************************************************************************)
+
+PROCEDURE WriteLnI (w: Window);
+
+    (* The internal version of WriteLn (see below).	*)
+    (* The caller must be executing at level <1.	*)
+
+    BEGIN
+	WITH w^ DO
+	    IF InScrollingRegion (w) THEN
+		column := ScrollRegion.left;
+		IF row = ScrollRegion.bottom THEN ScrollUpI (w)
+		ELSE INC (row);
+		END (*IF*);
+	    ELSE
+		column := DefaultScrollRegion.left;
+		IF row >= LastRow THEN row := LastRow
+		ELSE INC (row);
+		END (*IF*);
+	    END (*IF*);
+	    ScreenPosition := PageSize*page + BytesPerRow*row
+						+ BytesPerChar*column;
+	END (*WITH*);
+    END WriteLnI;
+
+(************************************************************************)
+
+PROCEDURE WriteLn (w: Window);
+
+    (* Moves the cursor of window w to the start of the next row.  If	*)
+    (* we are already at the last row, the window scrolls up.		*)
+
+    BEGIN
+	Wait (w^.access0p5);
+	WriteLnI (w);
+	Signal (w^.access0p5);
+    END WriteLn;
+
+(************************************************************************)
+
+PROCEDURE WriteChar (w: Window; ch: CHAR);
+
+    (* Writes one character to window w, and updates the cursor for	*)
+    (* this window.  As a side-effect, this window becomes the		*)
+    (* currently active window if it was obscured.  Wraps around to the	*)
+    (* next line if we are about to run off the end of the current	*)
+    (* line.  This procedure does not recognise the concept of a	*)
+    (* control character.  Every possible value of ch produces		*)
+    (* something readable on the screen.				*)
+    (* The caller must be executing at level <0.5.			*)
+
+    VAR place: CARDINAL;  screenloc: FarCharPointer;
+
+    BEGIN
+	WITH w^ DO
+	    Wait (access0p5);
+
+	    (* Wrap to a new line if we about to leave the scrolling	*)
+	    (* region or if we are outside the legal writing region.	*)
+
+	    IF (column = ScrollRegion.right + 1)
+			OR (column > DefaultScrollRegion.right) THEN
+		DEC (column);  WriteLnI (w);
+	    END (*IF*);
+
+	    place := ScreenPosition - BufferBias;
+	    buffer[place] := ch;
+	    buffer[place+1] := CurrentAttributes;
+
+	    IF NOT hidden THEN
+		Obtain (StackAccess2);
+		IF obscured THEN PutOnTopI(w) END (*IF*);
+		Obtain (ScreenAccess3);
+		screenloc := MakePointer (ScreenSeg, ScreenPosition);
+		screenloc^ := ch;
+		screenloc := MakePointer (ScreenSeg, ScreenPosition+1);
+		screenloc^ := CurrentAttributes;
+		Release (ScreenAccess3);
+		Release (StackAccess2);
+	    END (*IF NOT hidden*);
+
+	    (* Note that the following statement may cause column to	*)
+	    (* go beyond the edge of the window; but this will be	*)
+	    (* picked up on the next call to WriteChar.  We prefer not	*)
+	    (* to do a WriteLn just yet, because that could cause an	*)
+	    (* unintended scroll operation when writing to the bottom	*)
+	    (* right of the window.					*)
+
+	    INC (column);  INC (ScreenPosition, BytesPerChar);
+
+	    Signal (access0p5);
+
+	END (*WITH*);
+    END WriteChar;
+
+(************************************************************************)
+
+PROCEDURE WriteString (w: Window; text: ARRAY OF CHAR);
+
+    (* Writes a sequence of characters, terminated either by NUL or by	*)
+    (* the end of the array.						*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	j := 0;
+	LOOP
+	    IF ORD (text[j]) = 0 THEN EXIT (*LOOP*)  END (*IF*);
+	    WriteChar (w, text[j]);  INC (j);
+	    IF j > HIGH (text) THEN EXIT (*LOOP*)  END (*IF*);
+	END (*LOOP*);
+    END WriteString;
+
+(************************************************************************)
+
+PROCEDURE Write (w: Window; ch: CHAR);
+
+    (* A version of procedure WriteChar which looks after some of the	*)
+    (* control characters.						*)
+
+    BEGIN
+	IF ch >= " " THEN WriteChar (w, ch)
+	ELSIF ORD(ch) = 8 THEN		(* backspace *)
+	    CursorLeft(w)
+	ELSIF ORD(ch) = 9 THEN		(* tab *)
+	    WITH w^ DO
+		REPEAT
+		    WriteChar (w, " ");
+		UNTIL (column=MAX(ColumnRange)) OR (tabstops[column]="T");
+	    END (*WITH*);
+	ELSIF ORD(ch) = 10 THEN		(* line feed - ignore *)
+	ELSIF ORD(ch) = 13 THEN		(* carriage return *)
+	    WriteLn(w)
+	ELSE				(* other control character *)
+	    WriteChar (w, "^");  WriteChar (w, CHR(ORD(ch)+64))
+	END (*IF*);
+    END Write;
+
+(************************************************************************)
+(*				INPUT					*)
+(************************************************************************)
+
+PROCEDURE ReadBack (w: Window;  r: RowRange;  c: ColumnRange): CHAR;
+
+    (* Returns the character which currently occupies relative location	*)
+    (* (r,c) on the display of window w.				*)
+
+    BEGIN
+	WITH w^ DO
+	    RETURN buffer[BytesPerRow*(r+FirstRow)
+				+ BytesPerChar*(c+FirstColumn)];
+	END (*WITH*);
+    END ReadBack;
+
+(************************************************************************)
+
+PROCEDURE KeyTask;
+
+    (* Runs as a separate task, getting a character from the keyboard	*)
+    (* as needed and making it available to the task which has input	*)
+    (* focus.  If no task has input focus, the character is returned	*)
+    (* to the keyboard module.						*)
+
+    VAR ch: CHAR;  w: Window;
+
+    BEGIN
+	LOOP
+	    Wait (InputRequest);
+	    ch := InKey();
+	    WITH PhysicalCursor DO
+		Obtain (access4);
+		w := CursorWindow[ActivePage];
+		CursorWindow[ActivePage] := NIL;
+		CursorVisible[ActivePage] := FALSE;
+		Release (access4);
+	    END (*WITH*);
+	    IF w = NIL THEN
+		PutBack(ch);
+	    ELSE
+		WITH w^ DO
+		    InputChar := ch;
+		    InputWaiting := FALSE;
+		    ComputeCursorWindow (ActivePage);
+		    Signal (CharAvailable);
+		END (*WITH*);
+	    END (*IF*);
+	END (*LOOP*);
+    END KeyTask;
+
+(************************************************************************)
+
+PROCEDURE GetKey (w: Window): CHAR;
+
+    (* Read one character, without any prompt to the user (unless the	*)
+    (* caller has already set w^.CursorWanted to TRUE).  The reason for	*)
+    (* specifying a window parameter is to ensure that keyboard input	*)
+    (* comes to us only when this window has input focus.		*)
+
+    BEGIN
+	w^.InputWaiting := TRUE;
+	ComputeCursorWindow (w^.page);
+	Signal (InputRequest);
+	Wait (w^.CharAvailable);
+	RETURN w^.InputChar;
+    END GetKey;
+
+(************************************************************************)
+
+PROCEDURE ReadCharWithoutEcho (w: Window;  VAR (*OUT*) ch: CHAR);
+
+    (* Read one character, with a blinking cursor in window w as a	*)
+    (* prompt.								*)
+
+    BEGIN
+	w^.CursorWanted := TRUE;
+	ch := GetKey (w);
+	w^.CursorWanted := FALSE;
+    END ReadCharWithoutEcho;
+
+(************************************************************************)
+
+PROCEDURE ReadChar (w: Window;  VAR (*OUT*) ch: CHAR);
+
+    (* Like ReadCharWithoutEcho, but the input character is echoed.	*)
+
+    BEGIN
+	ReadCharWithoutEcho (w, ch);  Write (w, ch);
+    END ReadChar;
+
+(************************************************************************)
+
+PROCEDURE LookaheadChar (w: Window): CHAR;
+
+    (* Reads a character without consuming it.  That is, the character	*)
+    (* remains available to be read by ReadChar.  This allows the	*)
+    (* caller to check whether the character is really wanted.		*)
+
+    VAR ch: CHAR;
+
+    BEGIN
+	ch := GetKey(w);  PutBack (ch);
+	RETURN ch;
+    END LookaheadChar;
+
+(************************************************************************)
+
+PROCEDURE PressAnyKey (w: Window);
+
+    (* Types a "Press any key to continue" message.	*)
+
+    VAR dummy: CHAR;
+
+    BEGIN
+	WriteLn (w);
+	WriteString (w, "Press any key to continue.");
+	ReadChar (w, dummy);
+	IF ORD(dummy) = 0 THEN ReadChar (w, dummy) END (*IF*);
+	EraseLine (w, 0);  CursorUp(w);
+    END PressAnyKey;
+
+(************************************************************************)
+
+PROCEDURE ReadString (w: Window;  VAR (*OUT*) result: ARRAY OF CHAR);
+
+    (* Reads a character string, terminated by carriage return.		*)
+
+    VAR j: CARDINAL;  ch: CHAR;
+
+    BEGIN
+	FOR j := 0 TO HIGH(result) DO
+	    result[j] := " ";
+	END (*FOR*);
+	j := 0;
+	LOOP
+	    ReadChar (w, ch);
+	    IF ORD(ch) = 13 THEN
+		result[j] := CHR(0);  EXIT(*LOOP*)
+	    ELSIF ORD(ch) = 8 THEN	(* backspace *)
+		IF j > 0 THEN
+		    CursorLeft(w);  WriteChar(w, " ");  CursorLeft(w);
+		    DEC (j);
+		END (*IF*);
+	    ELSE
+		result[j] := ch;
+		IF j = HIGH(result) THEN EXIT(*LOOP*) END(*IF*);
+		INC (j);
+	    END(*IF*);
+	END (*LOOP*);
+    END ReadString;
+
+(************************************************************************)
+
+PROCEDURE EditString (w: Window;  VAR (*INOUT*) result: ARRAY OF CHAR;
+						fieldsize: CARDINAL);
+
+    (* Reads a character string, where a default result is supplied by	*)
+    (* the caller.  The final result is the state of the string at the	*)
+    (* time where the keyboard user types a carriage return or Esc, or	*)
+    (* uses a cursor movement key to move out of the displayed field.	*)
+    (* The terminating character remains available, via Keyboard.InKey,	*)
+    (* to the caller.  At most fieldsize characters of the string can	*)
+    (* be edited, and perhaps fewer if the result array is smaller or	*)
+    (* if there is insufficient space in the window.			*)
+
+    CONST Esc = CHR(01BH);  Space = " ";
+
+    VAR place, k: CARDINAL;  ch: CHAR;  limit: ColumnRange;
+	SavedAttributes: CHAR;
+	startrow, startcolumn: CARDINAL;
+	InsertMode, SavedCursorType: BOOLEAN;
+
+    (********************************************************************)
+
+    PROCEDURE RewriteString ();
+
+	BEGIN
+	    SetCursor (w, startrow, startcolumn);
+	    WriteString (w, result);
+	    SetCursor (w, startrow, startcolumn+place);
+	END RewriteString;
+
+    (********************************************************************)
+
+    PROCEDURE GoToEnd;
+
+	(* Puts the cursor just after the last non-blank character.	*)
+
+	BEGIN
+	    place := limit+1;
+	    WHILE (place > 0) AND (result[place-1] = Space) DO
+		DEC (place);
+	    END (*WHILE*);
+	    SetCursor (w, startrow, startcolumn+place);
+	END GoToEnd;
+
+    (********************************************************************)
+
+    PROCEDURE HandleControlChar(): BOOLEAN;
+
+	(* Called after detecting the CHR(0) which means that a control	*)
+	(* character has been typed.  Performs the appropriate actions,	*)
+	(* returns TRUE iff editing is finished.			*)
+
+	BEGIN
+	    ch := GetKey (w);
+	    IF ch = "K" THEN				(* cursor left *)
+		IF place = 0 THEN
+		    PutBack(ch);  PutBack(CHR(0));
+		    RETURN TRUE;
+		END (*IF*);
+		CursorLeft(w);  DEC (place);
+	    ELSIF ch = "M" THEN				(* cursor right *)
+		IF place > limit THEN
+		    PutBack(ch);  PutBack(CHR(0));
+		    RETURN TRUE;
+		END (*IF*);
+		CursorRight(w);  INC (place);
+	    ELSIF (ch = "H") OR (ch = "P") THEN		(* cursor up/down *)
+		PutBack(ch);  PutBack(CHR(0));
+		RETURN TRUE;
+	    ELSIF ch = "G" THEN				(* home *)
+		place := 0;
+		SetCursor (w, startrow, startcolumn);
+	    ELSIF ch = "O" THEN				(* end *)
+		GoToEnd;
+	    ELSIF ch = "R" THEN				(* insert *)
+		w^.blockcursor := InsertMode;
+		InsertMode := NOT InsertMode;
+	    ELSIF ch = "S" THEN				(* delete right *)
+		IF place <= limit THEN
+		    FOR k := place TO limit-1 DO
+			result[k] := result[k+1];
+		    END (*FOR*);
+		    result[limit] := Space;
+		    RewriteString ();
+		END (*IF*);
+	    END (*IF*);
+	    RETURN FALSE;
+	END HandleControlChar;
+
+    (********************************************************************)
+
+    BEGIN	(* Body of EditString *)
+
+	SaveCursor (w, startrow, startcolumn);
+	SavedCursorType := w^.blockcursor;
+	InsertMode := FALSE;  w^.blockcursor := TRUE;
+
+	(* Compute a limit which stops us from running off the window.	*)
+
+	WITH w^ DO
+	    IF InScrollingRegion(w) THEN
+		limit := ScrollRegion.right;
+	    ELSE
+		limit := DefaultScrollRegion.right;
+	    END (*IF*);
+	    DEC (limit, FirstColumn + startcolumn);
+	    SavedAttributes := CurrentAttributes;
+	END (*WITH*);
+	IF HIGH(result) < limit THEN
+	    limit := HIGH(result);
+	END (*IF*);
+	IF fieldsize <= limit THEN
+	    limit := fieldsize - 1;
+	END (*IF*);
+
+	(* Preprocessing: for a Nul-terminated string, remove the Nul	*)
+	(* and pad out the string with spaces at the right.  Otherwise	*)
+	(* we get problems if, for example, the Nul is deleted.		*)
+
+	place := 0;
+	LOOP
+	    IF result[place] = CHR(0) THEN
+		FOR k := place TO limit DO
+		    result[k] := Space;
+		END (*FOR*);
+		EXIT (*LOOP*);
+	    END (*IF*);
+	    IF place = limit THEN EXIT(*LOOP*) END(*IF*);
+	    INC (place);
+	END (*LOOP*);
+	FOR k := limit+1 TO HIGH(result) DO
+	    result[k] := CHR(0);
+	END (*FOR*);
+
+	(* Write the string, using reverse video.	*)
+
+	WriteString (w, result);
+	ColourSwap (w, startrow, startcolumn, limit+1);
+	WITH w^ DO
+	    CurrentAttributes := CHR(16*ORD(foreground) + ORD(background));
+	END (*WITH*);
+	place := 0;
+	SetCursor (w, startrow, startcolumn);
+	PutOnTop(w);
+
+	(* Now the main editing loop.	*)
+
+	LOOP
+	    ReadCharWithoutEcho (w, ch);
+	    IF ORD(ch) = 0 THEN				(* control char *)
+		IF HandleControlChar() THEN
+		    EXIT (*LOOP*);
+		END (*IF*);
+	    ELSIF (ch = Esc) OR (ORD(ch) = 13) THEN	(* Esc or Return *)
+		PutBack(ch);  EXIT(*LOOP*);
+	    ELSIF ORD(ch) = 8 THEN			(* delete left *)
+		IF place > 0 THEN
+		    DEC (place);
+		    FOR k := place TO limit-1 DO
+			result[k] := result[k+1];
+		    END (*FOR*);
+		    result[limit] := Space;
+		    RewriteString ();
+		END (*IF*);
+	    ELSIF place <= limit THEN			(* any other char *)
+		IF InsertMode THEN
+		    FOR k := limit TO place+1 BY -1 DO
+			result[k] := result[k-1];
+		    END (*FOR*);
+		    RewriteString ();
+		END (*IF*);
+		result[place] := ch;  WriteChar (w, ch);
+		INC (place);
+	    END(*IF*);
+	END (*LOOP*);
+	ColourSwap (w, startrow, startcolumn, limit+1);
+	w^.blockcursor := SavedCursorType;
+	w^.CurrentAttributes := SavedAttributes;
+    END EditString;
+
+(************************************************************************)
+
+PROCEDURE EditAborted (): BOOLEAN;
+
+    (* Checks the next keyboard input.  Returns TRUE for Escape, FALSE	*)
+    (* for anything else.  Escape or Carriage Return are consumed, any	*)
+    (* other character is returned to the Keyboard module.		*)
+
+    CONST Esc = CHR(01BH);  CR = CHR(0DH);
+
+    VAR ch: CHAR;
+
+    BEGIN
+	ch := InKey();
+	IF ch = Esc THEN RETURN TRUE
+	ELSIF ch = CR THEN RETURN FALSE
+	ELSE
+	    PutBack(ch);  RETURN FALSE;
+	END (*IF*);
+    END EditAborted;
+
+(************************************************************************)
+(*		    MISCELLANEOUS CONTROL OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE EraseLine (w: Window;  option: CARDINAL);
+
+    (* Replaces some or all of the current line, except for the border,	*)
+    (* with space characters.  The window cursor is moved to the	*)
+    (* location of the first erased character.  The options are:	*)
+    (*		0	the whole of the line, except for the border	*)
+    (*		1	from the current cursor position onwards	*)
+    (*		2	from the start to just before the cursor	*)
+    (* If we are inside a scrolling region, then only that part of the	*)
+    (* line inside the scrolling region is affected.			*)
+
+    VAR first, last: ColumnRange;
+	k, firstk, lastk: buffersubscript;
+	NewPosition: CARDINAL;
+
+    BEGIN
+	WITH w^ DO
+	    IF InScrollingRegion(w) THEN
+		first := ScrollRegion.left;  last := ScrollRegion.right;
+	    ELSE
+		first := DefaultScrollRegion.left;
+		last := DefaultScrollRegion.right;
+	    END (*IF*);
+	    IF option = 1 THEN first := column
+	    ELSIF option = 2 THEN last := column - 1
+	    END (*IF*);
+	    IF last >= first THEN
+		firstk := BytesPerRow*row + BytesPerChar*first;
+		lastk := BytesPerRow*row + BytesPerChar*last;
+		FOR k := firstk TO lastk BY BytesPerChar DO
+		    buffer[k] := " ";  buffer[k+1] := CurrentAttributes;
+		END (*FOR*);
+		Obtain (ScreenAccess3);
+		NewPosition := BufferBias + firstk;
+		IF NOT (hidden OR obscured) THEN
+		    FarCopy (Far(ADR(buffer[firstk])),
+			MakePointer(ScreenSeg,NewPosition), lastk-firstk+2);
+		END (*IF*);
+		Release (ScreenAccess3);
+		column := first;  ScreenPosition := NewPosition;
+	    END (*IF*);
+	END (*WITH*);
+    END EraseLine;
+
+(************************************************************************)
+(*			     TERMINATION				*)
+(************************************************************************)
+
+PROCEDURE CloseAllWindows;
+
+    (* Shutdown of this module is done in two phases.  This procedure	*)
+    (* is phase 2, executed after all interrupt handlers have been	*)
+    (* de-installed.  At this stage we can be confident that the only	*)
+    (* possible task switches can be those triggered by an explicit	*)
+    (* kernel call.							*)
+
+    VAR w: Window;  p: DisplayPage;
+
+    BEGIN
+	ReleaseAllLocks;
+
+	FOR p := 0 TO MAX(DisplayPage) DO
+	    LOOP
+		w := TopWindow[p];
+		IF w = NIL THEN EXIT(*LOOP*) END(*IF*);
+
+		(* In phase 1 of the shutdown, we locked w^.access0p5.	*)
+		(* We now want to permanently block any task which is	*)
+		(* still waiting for the access.  The easiest way to do	*)
+		(* this is to destroy and re-create the semaphore.	*)
+
+		DestroySemaphore (w^.access0p5);
+		CreateSemaphore (w^.access0p5, 1);
+		CloseWindow (w);
+
+	    END (*LOOP*);
+
+	END (*FOR*);
+
+    END CloseAllWindows;
+
+(************************************************************************)
+
+PROCEDURE CleanUp;
+
+    (* Phase 1 of module termination.  If termination was caused by an	*)
+    (* error, displays the error and waits for the user to press a key.	*)
+    (* In order to ensure that the error message is not obscured, we	*)
+    (* freeze all windows.						*)
+
+    VAR w: Window;  p: DisplayPage;
+	message: ARRAY [0..57] OF CHAR;
+	
+    BEGIN
+	(* Note that we cannot know which task is running the shutdown	*)
+	(* code, or the point it was up to when termination was		*)
+	(* triggered.  To avoid potential deadlocks, we must throw	*)
+	(* away any locks we are holding.				*)
+
+	ReleaseAllLocks;
+
+	(* Lock all open windows.	*)
+
+	FOR p := 0 TO MAX(DisplayPage) DO
+	    Obtain (StackAccess2);
+	    w := TopWindow[p];
+	    Release (StackAccess2);
+	    WHILE w <> NIL DO
+		Wait (w^.access0p5);
+		w := w^.next;
+	    END (*WHILE*);
+	END (*FOR*);
+
+	(* For abnormal termination, write the error message, and wait	*)
+	(* until the user has responded with a keystroke.		*)
+
+	SetActivePage (0);
+	IF TerminationMessage(message) THEN
+	    OpenSimpleWindow (w, 10, 13, 10, 69);
+	    WriteString (w, message);
+	    PressAnyKey (w);
+	    CloseWindow (w);
+	END (*IF*);
+
+	(* Enable phase 2 of the shutdown. *)
+
+	SetTerminationProcedure (CloseAllWindows);
+
+    END CleanUp;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+VAR j: buffersubscript;  p: DisplayPage;
+
+BEGIN
+    FOR j := 0 TO HIGH(BlankRow) DO
+	BlankRow[j] := " ";
+    END (*FOR*);
+    CreateLock (BlankRowAccess1);
+
+    FOR p := 0 TO MAX(DisplayPage) DO
+	TopWindow[p] := NIL;
+	PhysicalCursor.CursorWindow[p] := NIL;
+	PhysicalCursor.CursorVisible[p] := FALSE;
+    END (*FOR*);
+
+    CreateLock (StackAccess2);
+
+    VideoKind (ScreenSeg, BlackAndWhite);
+
+    CreateLock (ScreenAccess3);
+    CreateLock (PhysicalCursor.access4);
+    CreateSemaphore (InputRequest, 0);
+    CreateTask (KeyTask, 5, "keyboard/windows");
+
+    SetTerminationProcedure (CleanUp);
+    PageChangeProcs := NIL;
+    CreateLock (PageChangeListAccess);
+
+    (* Blank the screen, to erase otherwise annoying background stuff	*)
+    (* left by other programs.						*)
+
+    SetActivePage (DefaultPage);
+    Repaint (DefaultPage, 0,MaxRowNumber,0,MaxColumnNumber);
+
+END Windows.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/new/docread.mod b/examples/Modula-2_Libraries/PMOS/sources/new/docread.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/new/docread.mod
@@ -0,0 +1,283 @@
+MODULE DocRead;
+
+	(********************************************************)
+	(*							*)
+	(*	Program to display documentation files		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	11 December 1994		*)
+	(*  Status:		Just started, incomplete	*)
+	(*							*)
+	(*	At present I'm just playing around with ideas;	*)
+	(*	it would take a lot of work to turn this into	*)
+	(*	a hypertext reader.				*)
+	(*	Thought: we need to distinguish between		*)
+	(*	hypertext files and "raw text" files - e.g. in	*)
+	(*	the latter we should keep the existing line	*)
+	(*	breaks, in the former we should treat carriage	*)
+	(*	return characters like whitespace.		*)
+	(*							*)
+	(*	Such details can however wait until I've done	*)
+	(*	improvements to the menu system, i.e.  for now	*)
+	(*	this is a test program for menus.		*)
+	(*							*)
+	(********************************************************)
+
+FROM TaskControl IMPORT
+    (* proc *)	CreateTask;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType, Rectangle,
+    (* proc *)	OpenWindow, CloseWindow, WriteString, PressAnyKey,
+		WriteChar, WriteLn, WindowLocation;
+
+FROM NumericIO IMPORT
+    (* proc *)	WriteCard;
+
+FROM Menus IMPORT
+    (* type *)	Menu, ItemText, MenuOption, MO, OffEdgeOption,
+    (* proc *)	CreateMenu, PositionMenu, SelectFromMenu, DestroyMenu,
+		SetOptions, OffEdge;
+
+FROM IOErrorCodes IMPORT
+    (* type *)	ErrorCode;
+
+FROM FileSys IMPORT
+    (* type *)	File,
+    (* proc *)	OpenFile, CloseFile, EOF, ReadByte,
+		SetPosition, SavePosition;
+
+(************************************************************************)
+
+TYPE
+    CharSet = SET OF CHAR;
+
+CONST
+    alphanum = CharSet {"A".."Z", "a".."z", "0".."9"};
+
+VAR
+    done: Semaphore;
+
+(************************************************************************)
+(*			FILE DISPLAY PROCEDURES				*)
+(************************************************************************)
+
+PROCEDURE BackSpace (f: File);
+
+    (* Moves backwards by one byte in file f. *)
+
+    VAR dummy: ErrorCode;
+
+    BEGIN
+	dummy := SetPosition (f, SavePosition(f) - 1);
+    END BackSpace;
+
+(************************************************************************)
+
+PROCEDURE SkipBlanks (f: File);
+
+    (* Skips over nonsignificant characters in file f. *)
+
+    CONST BlankChars = CharSet {CHR(0), CHR(10), " "};
+
+    BEGIN
+	WHILE CHAR(ReadByte(f)) IN BlankChars DO
+	    (* nothing *)
+	END (*WHILE*);
+	BackSpace (f);
+    END SkipBlanks;
+
+(************************************************************************)
+
+PROCEDURE ReadWord (f: File;  VAR (*OUT*) word: ARRAY OF CHAR;
+				VAR (*OUT*) terminator: CHAR): CARDINAL;
+
+    (* Reads an alphanumeric string, returns the string in "word" and	*)
+    (* the trailing nonalphanumeric character in "terminator".  The	*)
+    (* function result is the length of "word".				*)
+
+    CONST Nul = CHR(0);
+
+    VAR j: CARDINAL;  ch: CHAR;
+
+    BEGIN
+	SkipBlanks(f);
+	j := 0;  terminator := CHR(0);
+	LOOP
+	    IF j > HIGH(word) THEN EXIT(*LOOP*) END(*IF*);
+	    ch := ReadByte (f);
+	    IF ch IN alphanum THEN
+		word[j] := ch;  INC(j);
+	    ELSE
+		terminator := ch;  word[j] := Nul;  EXIT (*LOOP*);
+	    END (*IF*);
+	END (*LOOP*);
+	RETURN j;
+    END ReadWord;
+
+(************************************************************************)
+
+PROCEDURE DisplayFile (w: Window;  f: File);
+
+    (* Displays file f in window w.  The file and window must already	*)
+    (* be open.								*)
+
+    CONST Space = " ";
+
+    VAR R: Rectangle;
+	row, col, maxrow, maxcol, length: CARDINAL;
+	word: ARRAY [0..79] OF CHAR;
+	terminator: CHAR;
+
+    BEGIN
+	WriteLn (w);
+	WriteString (w, "Procedure DisplayFile not yet written.");
+	R := WindowLocation (w);
+	maxrow := R.bottom - R.top + 1;
+	maxcol := R.right - R.left + 1;
+	row := 1;  col := 0;
+	LOOP
+	    IF EOF(f) THEN EXIT(*LOOP*) END (*IF*);
+	    IF row > maxrow THEN EXIT (*LOOP*) END(*IF*);
+	    length := ReadWord (f, word, terminator);
+	    IF terminator <> Space THEN INC(length) END(*IF*);
+	    IF col+length > maxcol THEN
+		WriteLn (w);  INC (row);  col := 0;
+	    END (*IF*);
+	    WriteString (w, word);
+	    IF terminator <> Space THEN
+		WriteChar (w, terminator);
+	    END (*IF*);
+	    INC (col, length);
+	    IF (word[0] <> CHR(0)) AND (col < maxcol) THEN
+		WriteChar (w, Space);  INC(col);
+	    END (*IF*);
+	END (*LOOP*);
+    END DisplayFile;
+
+(************************************************************************)
+
+PROCEDURE DoDisplay (filename: ARRAY OF CHAR);
+
+    (* Displays the given file. *)
+
+    VAR w: Window;  f: File;  status: ErrorCode;
+
+    BEGIN
+	OpenWindow (w, white, magenta, 5, 20, 0, 79, noframe, nodivider);
+	status := OpenFile (f, filename, FALSE);
+	WriteLn (w);  WriteString (w, "Entered procedure DoDisplay");
+	IF status <> OK THEN
+	    WriteLn (w);  WriteString (w, "Can't open file ");
+	    WriteString (w, filename);
+	ELSE
+	    DisplayFile (w, f);
+	END (*IF*);
+	PressAnyKey (w);
+	CloseFile (f);
+	CloseWindow (w);
+
+    END DoDisplay;
+
+(************************************************************************)
+
+PROCEDURE DisplayTask;
+
+    BEGIN
+	DoDisplay ("..\doc\status.doc");
+	Signal (done);
+    END DisplayTask;
+
+(************************************************************************)
+(*				MENU OPERATIONS				*)
+(*	At present this part of the program is just a test of Menus.	*)
+(************************************************************************)
+
+PROCEDURE Actions2 (option: CARDINAL);
+
+    (* Implements the actions on submenu number 2. *)
+
+    BEGIN
+    END Actions2;
+
+(************************************************************************)
+
+PROCEDURE MenuTask;
+
+    (* Runs as a separate task, picking up menu commands. *)
+
+    VAR topmenu, menu1, menu2: Menu;  w: Window;
+	topmenutext: ARRAY [0..5] OF ItemText;
+	menu1text: ARRAY [0..1] OF ItemText;
+	menu2text: ARRAY [0..2] OF ItemText;
+	result: CARDINAL;
+
+    BEGIN
+	OpenWindow (w, black, white, 21, 24, 50, 79, noframe, nodivider);
+
+	(* Create top-level menu. *)
+
+	topmenutext[0] := "TOP MENU";
+	topmenutext[1] := " \File";
+	topmenutext[2] := " \Options";
+	topmenutext[3] := " dummy\3";
+	topmenutext[4] := " dummy\4";
+	topmenutext[5] := " dummy\5";
+	CreateMenu (topmenu, 5, topmenutext, 5);
+	SetOptions (topmenu, MO{MNoTitle,MNoBorder,MNoClose,MNoKeyBack,
+				MFastSelect});
+	OffEdge (topmenu, stick, return, wrap, wrap);
+	PositionMenu (topmenu, 0, 0, 0, 79);
+
+	(* Create subsidiary menus. *)
+
+	menu1text[0] := "MENU 1";
+	menu1text[1] := "E\xit";
+	CreateMenu (menu1, 1, menu1text, 1);
+	SetOptions (menu1, MO{MNoTitle,MFastSelect});
+	OffEdge (menu1, escape, wrap, stick, escape);
+	PositionMenu (menu1, 1, 3, 0, 10);
+
+	menu2text[0] := "MENU 2";
+	menu2text[1] := "Page \up";
+	menu2text[2] := "Page \down";
+	CreateMenu (menu2, 1, menu2text, 2);
+	SetOptions (menu2, MO{MNoTitle,MFastSelect});
+	OffEdge (menu2, escape, wrap, escape, escape);
+	PositionMenu (menu2, 1, 4, 14, 24);
+
+	REPEAT
+	    result := SelectFromMenu (topmenu);
+	    WriteLn (w);
+	    WriteString (w, "Selected top menu item ");
+	    WriteCard (w, result);
+	    CASE result OF
+		| 1:	result := SelectFromMenu(menu1);
+			result := 1 - result;
+		| 2:	Actions2 (SelectFromMenu(menu2));
+	    END (*CASE*);
+	UNTIL result = 0;
+	DestroyMenu (menu1);
+	DestroyMenu (topmenu);
+	(* PressAnyKey (w); *)
+	CloseWindow (w);
+	Signal (done);
+
+    END MenuTask;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    CreateSemaphore (done, 0);
+    (* CreateTask (DisplayTask, 2, "display task"); *)
+    CreateTask (MenuTask, 3, "menu task");
+    Wait (done);
+    (* Wait (done); *)
+END DocRead.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/new/longadd.mod b/examples/Modula-2_Libraries/PMOS/sources/new/longadd.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/new/longadd.mod
@@ -0,0 +1,196 @@
+MODULE LongAdd;
+
+    (* Quick prototype, crudely tested, undocumented.  PJM 31/8/94. *)
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE;
+
+FROM InOut IMPORT
+    (* proc *)	Write;
+
+(************************************************************************)
+
+TYPE
+    Digit = [0..9];
+
+    DigitPtr = POINTER TO DigitRecord;
+    DigitRecord = RECORD
+			value: Digit;
+			previous, next: DigitPtr;
+		  END (*RECORD*);
+
+    LongNumber = POINTER TO RECORD
+				head, tail: DigitPtr;
+			    END (*RECORD*);
+
+(************************************************************************)
+
+PROCEDURE CreateLongNumber(): LongNumber;
+
+    VAR result: LongNumber;
+
+    BEGIN
+	NEW (result);
+	WITH result^ DO
+	    head := NIL;  tail := NIL;
+	END (*WITH*);
+	RETURN result;
+    END CreateLongNumber;
+
+(************************************************************************)
+
+PROCEDURE InsertAtHead (newelt: DigitPtr;  number: LongNumber);
+
+    (* Inserts a new element at the head of "number"; the caller is	*)
+    (* responsible for filling in the value.				*)
+
+    BEGIN
+	WITH newelt^ DO
+	    previous := NIL;  next := number^.head;
+	END (*WITH*);
+	WITH number^ DO
+	    head := newelt;
+	    IF tail = NIL THEN tail := head END(*IF*);
+	END (*WITH*);
+    END InsertAtHead;
+
+(************************************************************************)
+
+PROCEDURE InsertAtTail (newelt: DigitPtr;  number: LongNumber);
+
+    (* Inserts a new element at the tail of "number"; the caller is	*)
+    (* responsible for filling in the value.				*)
+
+    BEGIN
+	WITH newelt^ DO
+	    previous := number^.tail;  next := NIL;
+	END (*WITH*);
+	WITH number^ DO
+	    tail := newelt;
+	    IF head = NIL THEN head := tail END(*IF*);
+	END (*WITH*);
+    END InsertAtTail;
+
+(************************************************************************)
+
+PROCEDURE StringToLongNumber (s: ARRAY OF CHAR): LongNumber;
+
+    CONST Nul = CHR(0);
+
+    VAR result: LongNumber;
+	j: CARDINAL;  current: DigitPtr;
+
+    BEGIN
+	result := CreateLongNumber();
+	j := 0;
+	WHILE (j <= HIGH(s)) AND (s[j] <> Nul) DO
+	    NEW (current);
+	    current^.value := ORD(s[j]) - ORD("0");
+	    InsertAtTail (current, result);
+	    INC (j);
+	END (*WHILE*);
+	RETURN result;
+    END StringToLongNumber;
+
+(************************************************************************)
+
+PROCEDURE WriteLongNumber (num: LongNumber);
+
+    VAR current: DigitPtr;
+
+    BEGIN
+	current := num^.head;
+	IF current = NIL THEN Write ("0")
+	ELSE
+	    WHILE current <> NIL DO
+		Write (CHR(current^.value+ORD("0")));
+		current := current^.next;
+	    END (*WHILE*);
+	END (*IF*);
+    END WriteLongNumber;
+
+(************************************************************************)
+
+PROCEDURE DigitAdd (x, y: Digit;  sum: DigitPtr;
+					CarryIn: BOOLEAN): BOOLEAN;
+
+    (* Single digit addition.  The function result is the carry out.	*)
+
+    VAR result: CARDINAL;
+
+    BEGIN
+	result := x + y;
+	IF CarryIn THEN INC(result) END(*IF*);
+	IF result < 10 THEN
+	    sum^.value := result;
+	    RETURN FALSE;
+	ELSE
+	    sum^.value := result - 10;
+	    RETURN TRUE;
+	END (*IF*);
+    END DigitAdd;
+
+(************************************************************************)
+
+PROCEDURE Add (first, second: LongNumber): LongNumber;
+
+    (* Adds two numbers.  A bit too complicated, we ought to be able	*)
+    (* to use some hindsight to simplify this.				*)
+
+    VAR result: LongNumber;  shorter, longer, current: DigitPtr;
+	carry: BOOLEAN;
+
+    BEGIN
+	result := CreateLongNumber();
+	longer := first^.tail;
+	shorter := second^.tail;
+	carry := FALSE;
+	WHILE shorter <> NIL DO
+	    IF longer = NIL THEN
+		longer := shorter;  shorter := NIL;
+	    ELSE
+		NEW (current);
+		InsertAtHead (current, result);
+		carry := DigitAdd (shorter^.value, longer^.value,
+						current, carry);
+		shorter := shorter^.previous;  longer := longer^.previous;
+	    END (*IF*);
+	END (*WHILE*);
+
+	(* We've now traversed the shorter input list, but there	*)
+	(* might be some of the longer still left.			*)
+
+	WHILE longer <> NIL DO
+	    NEW (current);
+	    InsertAtHead (current, result);
+	    carry := DigitAdd (0, longer^.value, current, carry);
+	    longer := longer^.previous;
+	END (*WHILE*);
+
+	(* Allow for a final carry. *)
+
+	IF carry THEN
+	    NEW (current);
+	    InsertAtHead (current, result);
+	    current^.value := 1;
+	END (*IF*);
+
+	RETURN result;
+
+    END Add;
+
+(************************************************************************)
+
+VAR first, second, sum: LongNumber;
+
+BEGIN
+
+    (* Test program. *)
+
+    first := StringToLongNumber ("54321");
+    second := StringToLongNumber ("42");
+    sum := Add (first, second);
+    WriteLongNumber (sum);
+
+END LongAdd.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/notdone/fastwind.def b/examples/Modula-2_Libraries/PMOS/sources/notdone/fastwind.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/notdone/fastwind.def
@@ -0,0 +1,203 @@
+DEFINITION MODULE FastWindows;
+
+	(****************************************************************)
+	(*								*)
+	(*	A very crude implementation of screen windows.		*)
+	(*								*)
+	(*	This module has practically all the features of		*)
+	(*	module Windows, but there is a major restriction:	*)
+	(*	we do not bother to look after the problems		*)
+	(*	associated with windows which overlap on the screen.	*)
+	(*	That is, this version is for applications where the	*)
+	(*	the screen is divided up into disjoint regions,		*)
+	(*	such that no open window overlaps another.  (Nothing	*)
+	(*	disastrous happens if they do happen to overlap,	*)
+	(*	except that the screen is not as pretty as it ought	*)
+	(*	to be).  For the majority of applications, this		*)
+	(*	module is inferior to module Windows.  However, it	*)
+	(*	has a speed and memory size advantage over Windows,	*)
+	(*	which might make it suitable for critical applications.	*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	13 February 1991			*)
+	(*  Status:		OK.  Not fully tested.			*)
+	(*								*)
+	(****************************************************************)
+
+CONST
+    MaxRowNumber = 24;
+    MaxColumnNumber = 79;
+
+TYPE
+    Window;	(* is private *)
+    Colour = (black, blue, green, cyan, red, magenta, brown, white,
+		darkgrey, lightblue, lightgreen, lightcyan, lightred,
+		lightmagenta, yellow, intensewhite);
+    RowRange = [0..MaxRowNumber];
+    ColumnRange = [0..MaxColumnNumber];
+    FrameType = (noframe, simpleframe, doubleframe);
+    DividerType = (nodivider, simpledivider, doubledivider);
+
+PROCEDURE OpenWindow (VAR (*OUT*) w: Window;
+			ForegroundColour, BackgroundColour: Colour;
+			firstline, lastline: RowRange;
+			firstcol, lastcol: ColumnRange;
+			FrameDesired: FrameType;
+			DividerDesired: DividerType);
+
+    (* Create a new window.  Note that row and column numbers start	*)
+    (* from 0.  NOTE: If the window has a box drawn around it (the case	*)
+    (* FrameDesired <> noframe), this subtracts from the space		*)
+    (* available for text.						*)
+
+PROCEDURE OpenSimpleWindow (VAR (*OUT*) w: Window;
+			firstline, lastline: RowRange;
+			firstcol, lastcol: ColumnRange);
+
+    (* Identical to OpenWindow, except that you don't get any choice	*)
+    (* about the colours or frame.  The window is white-on-black with	*)
+    (* a simple frame and no dividers for the scrolling region.  This	*)
+    (* version of OpenWindow is useful for those with monochrome	*)
+    (* displays who don't want to be bothered with importing the types	*)
+    (* Colour, FrameType, and DividerType.				*)
+
+PROCEDURE ChangeScrollingRegion (w: Window; firstline, lastline: RowRange);
+
+    (* Changes the scrolling region of window w to the new line		*)
+    (* boundaries given, and sets the cursor of this window to the	*)
+    (* start of the scrolling region.  Row numbers are window-relative;	*)
+    (* that is, line 0 is the top line of the window (which is where	*)
+    (* the border is, unless you have no border).			*)
+
+PROCEDURE PutOnTop (w: Window);
+
+    (* This is a dummy procedure, present only for compatibility with	*)
+    (* applications which were originally written to use Windows.	*)
+
+PROCEDURE CloseWindow (w: Window);
+
+    (* Destroys the window. *)
+
+PROCEDURE SetCursor (w: Window; row: RowRange; column: ColumnRange);
+
+    (* Sets the cursor for window w to the given row and column.  The	*)
+    (* coordinates are window-relative; that is, they start at (0,0) at	*)
+    (* the top left of the window.					*)
+
+PROCEDURE SaveCursor (w: Window; VAR (*OUT*) row: RowRange;
+				 VAR (*OUT*) column: ColumnRange);
+
+    (* Returns the current cursor position.  The coordinates are	*)
+    (* window-relative; that is, they start at (0,0) at the top left of	*)
+    (* the window.							*)
+
+PROCEDURE CursorLeft (w: Window);
+
+    (* Moves the window cursor one position left.  If it falls off the	*)
+    (* left edge of the window, it moves to the right edge in the same	*)
+    (* row.								*)
+
+PROCEDURE CursorRight (w: Window);
+
+    (* Moves the window cursor one position right.  If it falls off the	*)
+    (* right edge of the window, it moves to the left edge in the same	*)
+    (* row.								*)
+
+PROCEDURE CursorUp (w: Window);
+
+    (* Moves the window cursor one position up.  If it falls off the	*)
+    (* top edge of the window, it moves to the bottom edge in the same	*)
+    (* column.								*)
+
+PROCEDURE CursorDown (w: Window);
+
+    (* Moves the window cursor one position down.  If it falls off the	*)
+    (* bottom edge of the window, it moves to the top edge in the same	*)
+    (* column.								*)
+
+PROCEDURE ScrollUp (w: Window);
+
+    (* Scrolls the scrolling region of window w up by one row, filling	*)
+    (* the vacated row with spaces.					*)
+
+PROCEDURE ScrollDown (w: Window);
+
+    (* Scrolls the scrolling region of window w down by one row,	*)
+    (* filling the vacated row with spaces.				*)
+
+PROCEDURE WriteLn (w: Window);
+
+    (* Go to next line in window, scrolling if necessary.  N.B. The	*)
+    (* window does not scroll if you are not in the scrolling region	*)
+    (* at the time of the WriteLn.					*)
+
+PROCEDURE WriteChar (w: Window; ch: CHAR);
+
+    (* Write one character.  Control characters are not given special	*)
+    (* treatment; they produce something visible just like any other	*)
+    (* character.  This procedure never causes a wrap to the next line.	*)
+
+PROCEDURE Write (w: Window; ch: CHAR);
+
+    (* Like WriteChar, but codes in the range 0..31 are treated as	*)
+    (* control characters.  This procedure is not recommended for	*)
+    (* general use, as it leads to obscure programs.  (Instead, do the	*)
+    (* control operations by direct calls to the cursor control		*)
+    (* procedures which are also supplied in this module).  It is	*)
+    (* supplied mainly to help those who are used to the conventions of	*)
+    (* the "standard" Modula 2 I/O modules such as InOut.		*)
+
+PROCEDURE WriteString (w: Window; text: ARRAY OF CHAR);
+
+    (* Write a string of characters, stopping at the first NUL		*)
+    (* character or the end of the array, whichever comes first.	*)
+
+PROCEDURE ReadChar (w: Window;  VAR (*OUT*) ch: CHAR);
+
+    (* Read one character, and echo it.	*)
+
+PROCEDURE UnreadChar (w: Window;  ch: CHAR);
+
+    (* Returns ch back to the keyboard queue, and deletes it from the	*)
+    (* the screen.  It is assumed that the last operation on window w	*)
+    (* was a ReadChar, and that ch was the character returned.  If this	*)
+    (* assumption is violated, there is no guarantee that the behaviour	*)
+    (* of this procedure will be consistent from version to version.	*)
+
+PROCEDURE ReadCharWithoutEcho (w: Window;  VAR (*OUT*) ch: CHAR);
+
+    (* Read one character, but don't echo it.  However, a blinking	*)
+    (* cursor is still displayed to prompt for the character.  (If you	*)
+    (* don't want the blinking cursor, use procedure Keyboard.InKey).	*)
+
+PROCEDURE ReadString (w: Window;  VAR (*OUT*) result: ARRAY OF CHAR);
+
+    (* Reads a character string, terminated by carriage return.		*)
+
+PROCEDURE EditString (w: Window;  VAR (*INOUT*) result: ARRAY OF CHAR);
+
+    (* Reads a character string, where a default result is supplied by	*)
+    (* the caller.  The final result is the state of the string at the	*)
+    (* time where the keyboard user types a carriage return.		*)
+
+PROCEDURE ColourSwap (w: Window; row: RowRange; col: ColumnRange;
+							nchar: CARDINAL);
+
+    (* Switches the foreground and background colours for nchar		*)
+    (* characters, starting at location (row,col).  The row and column	*)
+    (* numbers are window-relative, not absolute screen coordinates.	*)
+    (* This is our colour equivalent of the "reverse video" operation.	*)
+    (* NOTE: This procedure will not wrap around to a new row.		*)
+
+PROCEDURE EraseLine (w: Window; option: CARDINAL);
+
+    (* Erases some or all of the current line (but never the border).	*)
+    (* The erased characters are replaced by space characters.  The	*)
+    (* window cursor is not moved.  If w is not the currently active	*)
+    (* window, the result will not be visible until w is on top again.	*)
+    (* The options are:							*)
+    (*		0	the whole of the line, except for the border	*)
+    (*		1	from the current cursor position onwards	*)
+    (*		2	from the start to just before the cursor	*)
+
+END FastWindows.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/notdone/fastwind.mod b/examples/Modula-2_Libraries/PMOS/sources/notdone/fastwind.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/notdone/fastwind.mod
@@ -0,0 +1,1085 @@
+IMPLEMENTATION MODULE FastWindows;
+
+	(********************************************************)
+	(*							*)
+	(*	A very crude implementation of screen windows.	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	11 August 1989			*)
+	(*  Status:						*)
+	(*	Seems to work, but not fully tested.		*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* proc *)	ADR;
+
+FROM Storage2 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure;
+
+FROM LowLevelIO IMPORT
+    (* proc *)	OutByte;
+
+FROM Conversions IMPORT
+    (* proc *)	HighByte, LowByte;
+
+FROM BIOS IMPORT
+    (* type *)	RegisterPacket,
+    (* proc *)	BIOS;
+
+FROM MemoryModel IMPORT
+    (* proc *)	MakePointer, AddOffset, SubtractOffset;
+
+FROM FastMove IMPORT
+    (* proc *)	Moveup, Movedown;
+
+	(* Remark: We use Movedown in preference to Moveup wherever	*)
+	(* possible, because it is marginally more efficient.  These	*)
+	(* two procedures are equivalent in their final result, except	*)
+	(* for the case (which occurs in scrolling) where the source	*)
+	(* and destination strings overlap in memory.			*)
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey, PutBack;
+
+(************************************************************************)
+
+CONST
+    VideoInt = 16;			(* interrupt number for BIOS	*)
+    BytesPerChar = 2;			(* # bytes/char in video buffer	*)
+    CharsPerRow = MaxColumnNumber + 1;	(* characters per row		*)
+    BytesPerRow = BytesPerChar*CharsPerRow;
+    buffersize = BytesPerRow * (MaxRowNumber+1);
+					(* size in bytes of video buffer*)
+    NormalVideo = 07x;  ReverseVideo = 070x;
+
+(************************************************************************)
+
+TYPE
+    buffersubscript = [0..buffersize - 1];
+
+    Window = POINTER TO WindowData;
+
+	(****************************************************************)
+	(*								*)
+	(* The row and column values stored in this record are actual	*)
+	(* screen row and column, i.e. they are not window-relative.	*)
+	(*								*)
+	(* The ScreenLocation field is a pointer into the hardware	*)
+	(* video buffer.  It can be computed easily from the "row" and	*)
+	(* "column" fields, but it is more convenient to keep this	*)
+	(* technically redundant variable.				*)
+	(*								*)
+	(****************************************************************)
+
+    WindowData = RECORD
+		    frame: FrameType;  divider: DividerType;
+		    ScrollRegion:   RECORD
+					top, bottom: RowRange;
+					left, right: ColumnRange;
+				    END;
+		    FirstRow, LastRow, row: RowRange; 
+		    FirstColumn, LastColumn, column: ColumnRange;
+		    ScreenLocation: POINTER TO CHAR;
+		    foreground, background: Colour;
+		    CurrentAttributes: CHAR;
+		 END (*RECORD*);
+
+(************************************************************************)
+
+VAR
+
+    (* BlackAndWhite is true if we have a monochrome display.		*)
+
+    BlackAndWhite: BOOLEAN;
+
+    (* ScreenSeg is a segment selector for the hardware video buffer,	*)
+    (* and VideoPage is the page number.  (In fact, I don't use		*)
+    (* VideoPage in this version, but it's here to document the way to	*)
+    (* find its value, in case I need it in a future version.)		*)
+    (* CRTCport is the port number to use when addressing the CRT	*)
+    (* controller chip.  It is a variable, because the address depends	*)
+    (* on whether a colour or monochrome interface is installed.	*)
+
+    ScreenSeg: CARDINAL;
+    VideoPage: CARDINAL;
+    CRTCport: CARDINAL;
+
+    (* Registers is a record of register values, to use when		*)
+    (* communicating with the BIOS.					*)
+
+    Registers: RegisterPacket;
+
+    (* BlankRow is set up by the initialisation code as a row of space	*)
+    (* characters.  Note however that the attribute codes need to be	*)
+    (* filled in before each use.					*)
+
+    BlankRow: ARRAY [0..BytesPerRow-1] OF CHAR;
+
+(************************************************************************)
+(*		    MISCELLANEOUS SCREEN OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE SetCursorShape (startline, endline: CARDINAL);
+
+    (* Sets the start and end scan lines for the cursor.  This has to	*)
+    (* be done with a BIOS call, rather than by programming the CRTC	*)
+    (* registers directly, to ensure correct treatment over the variety	*)
+    (* of different video interfaces which could be present.		*)
+
+    VAR BIOSframe: RegisterPacket;
+
+    BEGIN
+	WITH BIOSframe DO
+	    AH := 1;  CH := startline;  CL := endline;
+	END (*WITH*);
+	BIOS (VideoInt, BIOSframe);
+    END SetCursorShape;
+
+(************************************************************************)
+
+PROCEDURE CursorOff;
+
+    (* Turns the cursor on by putting 01 in bits 5 and 4 of the cursor	*)
+    (* start register of the 6845 CRT controller.  Remark: according to	*)
+    (* the documentation, it should be bits 6 and 5; I do not as yet	*)
+    (* have an explanation of this discrepancy.				*)
+
+    BEGIN
+	SetCursorShape (16,0);
+    END CursorOff;
+
+(************************************************************************)
+
+PROCEDURE CursorOn (row: RowRange;  column: ColumnRange);
+
+    (* Displays a blinking screen cursor at the specified position.	*)
+
+    VAR position: CARDINAL;
+
+    BEGIN
+	position := CharsPerRow*row + column;
+	OutByte (CRTCport, 14);	(* the "cursor position higher" register *)
+	OutByte (CRTCport+1, HighByte(position));
+	OutByte (CRTCport, 15);	(* the "cursor position lower" register *)
+	OutByte (CRTCport+1, LowByte(position));
+	IF BlackAndWhite THEN
+	    SetCursorShape (11,12);
+	ELSE
+	    SetCursorShape (6,7);
+	END (*IF*);
+    END CursorOn;
+
+(************************************************************************)
+(*			    SCREEN REFRESHING				*)
+(************************************************************************)
+
+PROCEDURE PutOnTop (w: Window);
+
+    (* This is a dummy procedure, present only for compatibility with	*)
+    (* module Windows.  The essential difference between module Windows	*)
+    (* and the present module is that we do not maintain our windows in	*)
+    (* a stack, and we do not do any screen refreshing (except as	*)
+    (* needed for things like scrolling), since we assume that the	*)
+    (* windows are in disjoint regions on the screen.			*)
+
+    BEGIN
+    END PutOnTop;
+
+(************************************************************************)
+
+PROCEDURE Blank(startrow, endrow: RowRange; startcol, endcol: ColumnRange;
+							attributes: CHAR);
+
+    (* Blanks the given (inclusive) rectangular region on the screen.	*)
+    (* The attribute bytes are also set as specified; this will have no	*)
+    (* immediate effect, but it affects the colour and blinking status	*)
+    (* of characters which will subsequently be written into this	*)
+    (* part of the screen.						*)
+
+    VAR i: RowRange;
+	offset, count: buffersubscript;
+
+    BEGIN
+	FOR offset := 1 TO BytesPerRow-1 BY BytesPerChar DO
+	    BlankRow[offset] := attributes;
+	END (*FOR*);
+	offset := BytesPerRow*startrow + BytesPerChar*startcol;
+	count := BytesPerChar*(endcol - startcol + 1);
+	FOR i := startrow TO endrow DO
+	    Movedown (ADR(BlankRow), MakePointer(ScreenSeg, offset), count);
+	    INC (offset, BytesPerRow);
+	END (*FOR*);
+    END Blank;
+
+(************************************************************************)
+(*			BASIC SCREEN READ AND WRITE			*)
+(************************************************************************)
+
+PROCEDURE PutChar (place: buffersubscript;  ch: CHAR);
+
+    (* Puts character ch at screen offset "place".	*)
+
+    VAR p: POINTER TO CHAR;
+
+    BEGIN
+	p := MakePointer (ScreenSeg, place);
+	p^ := ch;
+    END PutChar;
+
+(************************************************************************)
+(*			    OPENING A WINDOW				*)
+(************************************************************************)
+
+PROCEDURE ChangeScrollingRegion (w: Window;  firstline, lastline: RowRange);
+
+    (* Changes the scrolling region of window w to the new line		*)
+    (* boundaries given, and sets its cursor to the start of the new	*)
+    (* scrolling region.  The line numbers are window-relative.		*)
+
+    VAR horizontal, vertical, leftT, rightT: CHAR;
+	j: ColumnRange;  place: buffersubscript;
+
+    BEGIN
+	(* Although the user specifies window-relative line numbers,	*)
+	(* we use screen-relative numbers internally.  Adjust the	*)
+	(* parameters to take this into account.			*)
+
+	INC (firstline, w^.FirstRow);
+	INC (lastline, w^.FirstRow);
+
+	(* Work out what characters to use for the frame and divider.	*)
+
+	horizontal := 0C4x;  vertical := 0B3x;
+	leftT := 0C3x;  rightT := 0B4x;
+	WITH w^ DO
+	    IF divider = doubledivider THEN
+		horizontal := 0CDx;
+	    END (*IF*);
+	    IF frame = doubleframe THEN
+		vertical := 0BAx;
+		IF divider = doubledivider THEN
+		    leftT := 0CCx;  rightT := 0B9x;
+		ELSE
+		    leftT := 0C7x;  rightT := 0B6x;
+		END (*IF*);
+	    ELSIF divider = doubledivider THEN
+		leftT := 0C6x;  rightT := 0B5x;
+	    END (*IF*);
+
+	    (* Clean up the frame. *)
+
+	    IF frame <> noframe THEN
+
+		(* Remove the left and right T belonging to the	*)
+		(* old divider bars, if necessary.		*)
+
+		IF ScrollRegion.top - 1 > FirstRow THEN
+		    place := BytesPerRow*(ScrollRegion.top - 1)
+					+ BytesPerChar*FirstColumn;
+		    PutChar (place, vertical);
+		    PutChar (place + BytesPerChar*(LastColumn - FirstColumn),
+					vertical);
+		END (*IF*);
+
+		IF ScrollRegion.bottom + 1 < LastRow THEN
+		    place := BytesPerRow*(ScrollRegion.bottom+1)
+					+ BytesPerChar*FirstColumn;
+		    PutChar (place, vertical);
+		    PutChar (place + BytesPerChar*(LastColumn - FirstColumn),
+					vertical);
+		END (*IF*);
+	    END (*IF*);
+
+	    (* Put in the new divider bars.	*)
+
+	    IF divider <> nodivider THEN
+
+		(* Put in the top horizontal bar.	*)
+
+		IF firstline > FirstRow + 1 THEN
+		    place := BytesPerRow*(firstline-1)
+					+ BytesPerChar*FirstColumn;
+		    IF frame <> noframe THEN
+			PutChar (place, leftT);  INC (place, BytesPerChar);
+		    END (*IF*);
+		    FOR j := ScrollRegion.left TO ScrollRegion.right DO
+			PutChar (place, horizontal);  INC(place, BytesPerChar);
+		    END (*FOR*);
+		    IF frame <> noframe THEN
+			PutChar (place, rightT);
+		    END (*IF*);
+		END (*IF*);
+
+		(* Put in the bottom horizontal bar.	*)
+
+		IF lastline < LastRow - 1 THEN
+		    place := BytesPerRow*(lastline+1)
+					+ BytesPerChar*FirstColumn;
+		    IF frame <> noframe THEN
+			PutChar (place, leftT);  INC (place, BytesPerChar);
+		    END (*IF*);
+		    FOR j := ScrollRegion.left TO ScrollRegion.right DO
+			PutChar (place, horizontal); INC(place, BytesPerChar);
+		    END (*FOR*);
+		    IF frame <> noframe THEN
+			PutChar (place, rightT);
+		    END (*IF*);
+		END (*IF*);
+
+	    END (*IF*);
+
+	    (* Finally, update the scrolling region parameters.	*)
+
+	    WITH ScrollRegion DO
+		top := firstline;  bottom := lastline;
+	    END (*WITH*);
+	    SetCursor (w, firstline - FirstRow,
+				ScrollRegion.left - FirstColumn);
+	END (*WITH*);
+    END ChangeScrollingRegion;
+
+(************************************************************************)
+
+PROCEDURE FillInFrame (w: Window);
+
+    (* Makes the box around the window.	*)
+
+    VAR i: RowRange;  j: ColumnRange;
+	corner: ARRAY [1..4] OF CHAR;
+	horizontal, vertical: CHAR;
+	place, offset: buffersubscript;
+
+    BEGIN
+	IF w^.frame = simpleframe THEN
+	    corner[1] := 0DAx;  corner[2] := 0BFx;
+	    corner[3] := 0C0x;  corner[4] := 0D9x;
+	    horizontal := 0C4x;  vertical := 0B3x;
+	ELSE
+	    corner[1] := 0C9x;  corner[2] := 0BBx;
+	    corner[3] := 0C8x;  corner[4] := 0BCx;
+	    horizontal := 0CDx;  vertical := 0BAx;
+	END (*IF*);
+
+	WITH w^ DO
+
+	    offset := BytesPerChar*(LastColumn - FirstColumn);
+	    place := BytesPerRow*FirstRow + BytesPerChar*FirstColumn;
+	    PutChar (place, corner[1]);
+	    PutChar (place+offset, corner[2]);
+	    INC (place, BytesPerRow);
+
+	    FOR i := FirstRow + 1 TO LastRow - 1 DO
+		PutChar (place, vertical);
+		PutChar (place+offset, vertical);
+		INC (place, BytesPerRow);
+	    END (*FOR*);
+
+	    PutChar (place, corner[3]);
+	    PutChar (place+offset, corner[4]);
+
+	    offset := BytesPerRow*(LastRow - FirstRow);
+	    FOR j := FirstColumn + 1 TO LastColumn - 1 DO
+		INC (place, BytesPerChar);
+		PutChar (place-offset, horizontal);
+		PutChar (place, horizontal);
+	    END (*FOR*);
+
+	END (*WITH*);
+    END FillInFrame;
+
+(************************************************************************)
+
+PROCEDURE MakeMonochrome (VAR (*INOUT*) foreground, background: Colour);
+
+    (* Changes the two given colours to a suitable B/W combination.	*)
+
+    BEGIN
+	IF (foreground = black) OR (foreground = darkgrey) THEN
+	    background := white
+	ELSE
+	    IF foreground > white THEN
+		foreground := intensewhite
+	    ELSE
+		foreground := white;
+	    END (*IF*);
+	    background := black;
+	END (*IF*);
+    END MakeMonochrome;
+
+(************************************************************************)
+
+PROCEDURE OpenWindow (VAR (*OUT*) w: Window;
+			ForegroundColour, BackgroundColour: Colour;
+			firstline, lastline: RowRange;
+			firstcol, lastcol: ColumnRange;
+			FrameDesired: FrameType;
+			DividerDesired: DividerType);
+
+    (* Creates a new window, filled initially with space characters.	*)
+
+    VAR i: RowRange;  k: buffersubscript;
+
+    BEGIN
+
+	(* Create the new window, and fill in all its fields.	*)
+
+	NEW (w);
+	WITH w^ DO
+	    foreground := ForegroundColour;  background := BackgroundColour;
+	    IF BlackAndWhite THEN
+		MakeMonochrome (foreground, background);
+	    END (*IF*);
+	    CurrentAttributes := CHR(16*ORD(background) + ORD(foreground));
+	    frame := FrameDesired;  divider := DividerDesired;
+	    FirstRow := firstline;  LastRow := lastline;
+	    FirstColumn := firstcol;  LastColumn := lastcol;
+
+	    (* Set the window contents to all space characters.	*)
+
+	    Blank (firstline, lastline, firstcol, lastcol, CurrentAttributes);
+
+	    (* Set up a default scrolling region.	*)
+
+	    WITH ScrollRegion DO
+		top := FirstRow;  bottom := LastRow;
+		left := FirstColumn;  right := LastColumn;
+	    END (*WITH*);
+
+	    (* Make the frame.	*)
+
+	    IF frame <> noframe THEN
+		FillInFrame(w);
+		WITH ScrollRegion DO
+		    INC (top);  INC (left);  DEC (bottom);  DEC (right);
+		END (*WITH*);
+	    END (*IF*);
+
+	    row := ScrollRegion.top;  column := ScrollRegion.left;
+	    ScreenLocation := MakePointer (ScreenSeg,
+				BytesPerRow*row + BytesPerChar*column);
+	END (*WITH*);
+
+    END OpenWindow;
+
+(************************************************************************)
+
+PROCEDURE OpenSimpleWindow (VAR (*OUT*) w: Window;
+			firstline, lastline: RowRange;
+			firstcol, lastcol: ColumnRange);
+
+    (* Identical to OpenWindow, except that you don't get any choice	*)
+    (* about the colours or frame.  The window is white-on-black with	*)
+    (* a simple frame and no dividers for the scrolling region.  This	*)
+    (* version of OpenWindow is useful for those with monochrome	*)
+    (* displays who don't want to be bothered with importing the types	*)
+    (* Colour, FrameType, and DividerType.				*)
+
+    BEGIN
+	OpenWindow (w, white, black, firstline, lastline,
+			firstcol, lastcol, simpleframe, nodivider);
+    END OpenSimpleWindow;
+
+(************************************************************************)
+(*			    CLOSING A WINDOW				*)
+(************************************************************************)
+
+PROCEDURE CloseWindow (w: Window);
+
+    (* Reclaims the space used for this window, and blanks the part of	*)
+    (* the screen which it occupied.					*)
+
+    VAR p: Window;
+
+    BEGIN
+	WITH w^ DO
+	    Blank (FirstRow, LastRow, FirstColumn, LastColumn, NormalVideo);
+	END (*WITH*);
+	DISPOSE (w);
+    END CloseWindow;
+
+(************************************************************************)
+(*	     	OPERATIONS ON CHARACTER ATTRIBUTES			*)
+(************************************************************************)
+
+PROCEDURE ChangeAttributes (w: Window; r: RowRange; c: ColumnRange;
+				nchar: CARDINAL; newattribute: CHAR);
+
+    (* POSSIBLY OBSOLETE - CHECK THIS LATER.				*)
+    (* Changes nchar characters, starting at location (r,c), to be	*)
+    (* displayed with the given new attribute code.  The row and column	*)
+    (* numbers are window-relative, not absolute screen coordinates.	*)
+
+    VAR k, start: buffersubscript;
+
+    BEGIN
+	WITH w^ DO
+	    start := BytesPerRow*(r+FirstRow)
+			+ BytesPerChar*(c+FirstColumn) + 1;
+	    FOR k := start TO start+BytesPerChar*(nchar-1) BY BytesPerChar DO
+		PutChar (k, newattribute);
+	    END (*FOR*);
+	END (*WITH*);
+    END ChangeAttributes;
+
+(************************************************************************)
+
+PROCEDURE ColourSwap (w: Window; r: RowRange; c: ColumnRange;
+							nchar: CARDINAL);
+
+    (* Switches the foreground and background colours for nchar		*)
+    (* characters, starting at location (r,c).  The row and column	*)
+    (* numbers are window-relative, not absolute screen coordinates.	*)
+    (* This is our colour equivalent of the "reverse video" operation.	*)
+    (* NOTE: This procedure will not wrap around to a new row.		*)
+
+    VAR k, oldattribute: CARDINAL;
+	p: POINTER TO CHAR;
+
+    BEGIN
+	WITH w^ DO
+	    p := MakePointer (ScreenSeg, BytesPerRow*(r+FirstRow)
+				+ BytesPerChar*(c+FirstColumn) + 1);
+	    FOR k := 0 TO nchar-1 DO
+		oldattribute := ORD (p^);
+		p^ := CHR (16*(oldattribute MOD 16)
+					+ (oldattribute DIV 16));
+		p := AddOffset (p, BytesPerChar);
+	    END (*FOR*);
+	END (*WITH*);
+    END ColourSwap;
+
+(************************************************************************)
+(*			    CURSOR OPERATIONS				*)
+(************************************************************************)
+
+PROCEDURE SetCursor (w: Window; r: RowRange; c: ColumnRange);
+
+    (* Sets the cursor for window w to relative row r, column c.	*)
+
+    BEGIN
+	WITH w^ DO
+	    row := r + FirstRow;  column := c + FirstColumn;
+	    ScreenLocation := MakePointer (ScreenSeg,
+				BytesPerRow*row + BytesPerChar*column);
+	END (*WITH*);
+    END SetCursor;
+
+(************************************************************************)
+
+PROCEDURE SaveCursor (w: Window; VAR (*out*) r: RowRange;
+				 VAR (*out*) c: ColumnRange);
+
+    (* Returns the current cursor position of window w.		*)
+
+    BEGIN
+	WITH w^ DO
+	    r := row - FirstRow;  c := column - FirstColumn;
+	END (*WITH*);
+    END SaveCursor;
+
+(************************************************************************)
+
+PROCEDURE CursorLeft (w: Window);
+
+    (* Moves the window cursor one position left.  If it falls off the	*)
+    (* left edge of the window, move to the right edge in the same row.	*)
+
+    BEGIN
+	WITH w^ DO
+	    IF column = FirstColumn THEN
+		column := LastColumn;
+		ScreenLocation := MakePointer (ScreenSeg,
+				BytesPerRow*row + BytesPerChar*column);
+	    ELSE
+		DEC (column);
+		ScreenLocation := SubtractOffset (ScreenLocation,
+							BytesPerChar);
+	    END (*IF*);
+	END (*WITH*);
+    END CursorLeft;
+
+(************************************************************************)
+
+PROCEDURE CursorRight (w: Window);
+
+    (* Moves the window cursor one position right.  If it falls off the	*)
+    (* right edge of the window, move to the left edge in the same row.	*)
+
+    BEGIN
+	WITH w^ DO
+	    IF column = LastColumn THEN
+		column := FirstColumn;
+		ScreenLocation := MakePointer (ScreenSeg,
+				BytesPerRow*row + BytesPerChar*column);
+	    ELSE
+		INC (column);
+		ScreenLocation := AddOffset (ScreenLocation, BytesPerChar);
+	    END (*IF*);
+	END (*WITH*);
+    END CursorRight;
+
+(************************************************************************)
+
+PROCEDURE CursorUp (w: Window);
+
+    (* Moves the window cursor one position up.  If it falls off the	*)
+    (* top edge of the window, it moves to the bottom edge in the same	*)
+    (* column.								*)
+
+    BEGIN
+	WITH w^ DO
+	    IF row = FirstRow THEN
+		row := LastRow;
+		ScreenLocation := MakePointer (ScreenSeg,
+				BytesPerRow*row + BytesPerChar*column);
+	    ELSE
+		DEC (row);
+		ScreenLocation := SubtractOffset (ScreenLocation,
+							BytesPerRow);
+	    END (*IF*);
+	END (*WITH*);
+    END CursorUp;
+
+(************************************************************************)
+
+PROCEDURE CursorDown (w: Window);
+
+    (* Moves the window cursor one position down.  If it falls off the	*)
+    (* bottom edge of the window, it moves to the top edge in the same	*)
+    (* column.								*)
+
+    BEGIN
+	WITH w^ DO
+	    IF row = LastRow THEN
+		row := FirstRow;
+		ScreenLocation := MakePointer (ScreenSeg,
+				BytesPerRow*row + BytesPerChar*column);
+	    ELSE
+		INC (row);
+		ScreenLocation := AddOffset (ScreenLocation,BytesPerRow);
+	    END (*IF*);
+	END (*WITH*);
+    END CursorDown;
+
+(************************************************************************)
+
+PROCEDURE ScrollUp (w: Window);
+
+    (* Scrolls window w up by one line, and space fills the last row.	*)
+
+    VAR line: RowRange;
+	current, below: POINTER TO CHAR;
+	count: CARDINAL;
+
+    BEGIN
+	WITH w^ DO
+	    FOR count := 1 TO BytesPerRow-1 BY BytesPerChar DO
+		BlankRow[count] := CurrentAttributes;
+	    END (*FOR*);
+	    WITH ScrollRegion DO
+		current := MakePointer (ScreenSeg, BytesPerRow*top
+							+ BytesPerChar*left);
+		count := BytesPerChar*(right-left+1);
+		FOR line := top TO bottom-1 DO
+		    below := AddOffset (current, BytesPerRow);
+		    Movedown (below, current, count);
+		    current := below;
+		END (*FOR*);
+		Movedown (ADR(BlankRow),  current, count);
+	    END (*WITH*);
+	END (*WITH*);
+    END ScrollUp;
+
+(************************************************************************)
+
+PROCEDURE ScrollDown (w: Window);
+
+    (* Scrolls window w down by one line.  The first row is filled with	*)
+    (* spaces.								*)
+
+    VAR line: RowRange;
+	current, above: POINTER TO CHAR;
+	count: CARDINAL;
+
+    BEGIN
+	WITH w^ DO
+	    FOR count := 1 TO BytesPerRow-1 BY BytesPerChar DO
+		BlankRow[count] := CurrentAttributes;
+	    END (*FOR*);
+	    WITH ScrollRegion DO
+		current := MakePointer (ScreenSeg, BytesPerRow*bottom
+							+ BytesPerChar*left);
+		count := BytesPerChar*(right-left+1);
+		FOR line := bottom TO top+1 BY -1 DO
+		    above := SubtractOffset (current, BytesPerRow);
+		    Moveup (above, current, count);
+		    current := above;
+		END (*FOR*);
+		Movedown (ADR(BlankRow),  current, count);
+	    END (*WITH*);
+	END (*WITH*);
+    END ScrollDown;
+
+(************************************************************************)
+(*			    MAIN OUTPUT ROUTINES			*)
+(************************************************************************)
+
+PROCEDURE WriteChar (w: Window; ch: CHAR);
+
+    (* Writes one character to window w, and updates the cursor for	*)
+    (* this window.  Characters which fall of the right edge of the	*)
+    (* window are displayed in the rightmost position of the row,	*)
+    (* overwriting what was already there.  This procedure does not	*)
+    (* recognise the concept of a control character.  Every possible	*)
+    (* value of ch produces something readable on the screen.		*)
+
+    BEGIN
+	WITH w^ DO
+	    ScreenLocation^ := ch;
+	    IF column < ScrollRegion.right THEN
+		INC (column);
+		ScreenLocation := AddOffset(ScreenLocation,BytesPerChar);
+	    END (*IF*);
+	END (*WITH*);
+    END WriteChar;
+
+(************************************************************************)
+
+PROCEDURE WriteLn (w: Window);
+
+    (* Moves the cursor of window w to the start of the next row.  If	*)
+    (* we are already at the last row, the window scrolls up.		*)
+
+    BEGIN
+	WITH w^ DO
+	    column := ScrollRegion.left;
+	    IF row = ScrollRegion.bottom THEN
+		ScrollUp (w);
+	    ELSE
+		INC (row);
+	    END (*IF*);
+	    ScreenLocation := MakePointer (ScreenSeg,
+				BytesPerRow*row + BytesPerChar*column);
+	END (*WITH*);
+    END WriteLn;
+
+(************************************************************************)
+
+PROCEDURE WriteString (w: Window; text: ARRAY OF CHAR);
+
+    (* Writes a sequence of characters, terminated either by NUL or by	*)
+    (* the end of the array.						*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	j := 0;
+	LOOP
+	    IF ORD (text[j]) = 0 THEN EXIT (*LOOP*)  END (*IF*);
+	    WriteChar (w, text[j]);  INC (j);
+	    IF j > HIGH (text) THEN EXIT (*LOOP*)  END (*IF*);
+	END (*LOOP*);
+    END WriteString;
+
+(************************************************************************)
+
+PROCEDURE Write (w: Window; ch: CHAR);
+
+    (* A version of procedure WriteChar which looks after some of the	*)
+    (* control characters.						*)
+
+    BEGIN
+	IF ch >= " " THEN WriteChar (w, ch)
+	ELSIF ORD(ch) = 8 THEN CursorLeft(w)
+	ELSIF ORD(ch) = 13 THEN WriteLn(w)
+	ELSE
+	    WriteChar (w, "^");  WriteChar (w, CHR(ORD(ch)+64))
+	END (*IF*);
+    END Write;
+
+(************************************************************************)
+(*				INPUT					*)
+(************************************************************************)
+
+PROCEDURE ReadCharWithoutEcho (w: Window;  VAR (*OUT*) ch: CHAR);
+
+    (* Read one character, displaying a blinking cursor until the	*)
+    (* character has been typed.					*)
+
+    BEGIN
+	CursorOn (w^.row, w^.column);
+	ch := InKey();
+	CursorOff;
+    END ReadCharWithoutEcho;
+
+(************************************************************************)
+
+PROCEDURE ReadChar (w: Window;  VAR (*OUT*) ch: CHAR);
+
+    (* Like ReadCharWithoutEcho, but the input character is echoed.	*)
+
+    BEGIN
+	ReadCharWithoutEcho (w, ch);  Write (w, ch);
+    END ReadChar;
+
+(************************************************************************)
+
+PROCEDURE UnreadChar (w: Window;  ch: CHAR);
+
+    (* Returns ch back to the keyboard queue, and deletes it from the	*)
+    (* the screen.  It is assumed that the last operation on window w	*)
+    (* was a ReadChar, and that ch was the character returned.  If this	*)
+    (* assumption is violated, there is no guarantee that the behaviour	*)
+    (* of this procedure will be consistent from version to version.	*)
+
+    BEGIN
+	PutBack (ch);
+	IF ORD(ch) = 8 THEN
+	    CursorRight (w);
+	ELSE
+	    CursorLeft (w);
+	    IF ORD(ch) = 13 THEN CursorUp(w)
+	    ELSE
+		WriteChar (w, " ");  CursorLeft(w);
+		IF ch < " " THEN 
+		    CursorLeft (w);  WriteChar (w, " ");  CursorLeft (w);
+		END (*IF*);
+	    END (*IF*);
+	END (*IF*);
+    END UnreadChar;
+
+(************************************************************************)
+
+PROCEDURE ReadString (w: Window;  VAR (*out*) result: ARRAY OF CHAR);
+
+    (* Reads a character string, terminated by carriage return.		*)
+
+    VAR j: CARDINAL;  ch: CHAR;
+
+    BEGIN
+	FOR j := 0 TO HIGH(result) DO
+	    result[j] := " ";
+	END (*FOR*);
+	j := 0;
+	LOOP
+	    ReadChar (w, ch);
+	    IF ORD(ch) = 13 THEN
+		result[j] := CHR(0);  EXIT(*LOOP*)
+	    ELSIF ORD(ch) = 8 THEN	(* backspace *)
+		IF j > 0 THEN
+		    CursorLeft(w);  WriteChar(w, " ");  CursorLeft(w);
+		    DEC (j);
+		END (*IF*);
+	    ELSE
+		result[j] := ch;
+		IF j = HIGH(result) THEN EXIT(*LOOP*) END(*IF*);
+		INC (j);
+	    END(*IF*);
+	END (*LOOP*);
+    END ReadString;
+
+(************************************************************************)
+
+PROCEDURE EditString (w: Window;  VAR (*INOUT*) result: ARRAY OF CHAR);
+
+    (* Reads a character string, where a default result is supplied by	*)
+    (* the caller.  The final result is the state of the string at the	*)
+    (* time where the keyboard user types a carriage return.  If the	*)
+    (* user types Esc at any time, then we return with result[0] = Esc.	*)
+
+    CONST Esc = 01Bx;
+
+    VAR j, k: CARDINAL;  ch: CHAR;  limit: ColumnRange;
+	startrow: RowRange;  startcolumn: ColumnRange;
+
+    BEGIN
+	limit := HIGH(result);
+	SaveCursor (w, startrow, startcolumn);
+	WITH w^ DO
+	    IF limit > ScrollRegion.right - FirstColumn - startcolumn THEN
+		limit := ScrollRegion.right - FirstColumn - startcolumn
+	    END (*IF*);
+	END (*WITH*);
+
+	(* Preprocessing: for a Nul-terminated string, remove the Nul	*)
+	(* and pad out the string with spaces at the right.  Otherwise	*)
+	(* we get problems if, for example, the Nul is deleted.		*)
+
+	j := 0;
+	LOOP
+	    IF result[j] = CHR(0) THEN
+		FOR k := j TO limit DO
+		    result[k] := " ";
+		END (*FOR*);
+		EXIT (*LOOP*);
+	    END (*IF*);
+	    IF j = limit THEN EXIT(*LOOP*) END(*IF*);
+	    INC (j);
+	END (*LOOP*);
+	FOR k := limit+1 TO HIGH(result) DO
+	    result[k] := " ";
+	END (*FOR*);
+
+	(* Write the string, using reverse video.	*)
+
+	WriteString (w, result);
+	ColourSwap (w, startrow, startcolumn, limit+1);
+	SetCursor (w, startrow, startcolumn);
+
+	(* Now the main editing loop.	*)
+
+	j := 0;
+	LOOP
+	    ReadCharWithoutEcho (w, ch);
+	    IF ORD(ch) = 0 THEN
+		ReadCharWithoutEcho (w, ch);
+		IF ch = "K" THEN	(* cursor left *)
+		    IF j > 0 THEN
+			CursorLeft(w);
+			DEC (j);
+		    END (*IF*);
+		ELSIF ch = "M" THEN	(* cursor right *)
+		    IF j <= limit THEN
+			CursorRight(w);
+			INC (j);
+		    END (*IF*);
+		ELSIF ch = "G" THEN	(* home *)
+		    j := 0;
+		    SetCursor (w, startrow, startcolumn);
+		ELSIF ch = "O" THEN	(* end *)
+		    j := limit;
+		    SetCursor (w, startrow, startcolumn+j);
+		ELSIF ch = "R" THEN	(* insert *)
+		    FOR k := limit TO j+1 BY -1 DO
+			result[k] := result[k-1];
+		    END (*FOR*);
+		    result[j] := " ";
+		    SetCursor (w, startrow, startcolumn);
+		    WriteString (w, result);
+		    SetCursor (w, startrow, startcolumn+j);
+		ELSIF ch = "S" THEN	(* delete *)
+		    FOR k := j TO limit-1 DO
+			result[k] := result[k+1];
+		    END (*FOR*);
+		    result[limit] := " ";
+		    SetCursor (w, startrow, startcolumn);
+		    WriteString (w, result);
+		    SetCursor (w, startrow, startcolumn+j);
+		END (*IF*);
+	    ELSIF ch = Esc THEN
+		result[0] := Esc;  EXIT(*LOOP*);
+	    ELSIF ORD(ch) = 13 THEN
+		EXIT(*LOOP*)
+	    ELSIF ORD(ch) = 8 THEN	(* backspace *)
+		IF j > 0 THEN
+		    CursorLeft(w);
+		    DEC (j);
+		END (*IF*);
+	    ELSIF j <= limit THEN
+		result[j] := ch;  WriteChar (w, ch);
+		INC (j);
+	    END(*IF*);
+	END (*LOOP*);
+
+	(* Restore the original colours. *)
+
+	ColourSwap (w, startrow, startcolumn, limit+1);
+    END EditString;
+
+(************************************************************************)
+(*		    MISCELLANEOUS CONTROL OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE EraseLine (w: Window;  option: CARDINAL);
+
+    (* Replaces some or all of the current line, except for the border,	*)
+    (* with space characters.  The window cursor is not moved.		*)
+    (* The options are:							*)
+    (*		0	the whole of the line, except for the border	*)
+    (*		1	from the current cursor position onwards	*)
+    (*		2	from the start to just before the cursor	*)
+
+    VAR first, last: ColumnRange;
+	k, firstk, lastk: buffersubscript;
+
+    BEGIN
+	WITH w^ DO
+	    first := FirstColumn;  last := LastColumn;
+	    IF frame <> noframe THEN
+		INC (first);  DEC (last);
+	    END (*IF*);
+	    IF option = 1 THEN first := column
+	    ELSIF option = 2 THEN last := column - 1
+	    END (*IF*);
+	    firstk := BytesPerRow*row + BytesPerChar*first;
+	    lastk := BytesPerRow*row + BytesPerChar*last;
+	    FOR k := firstk TO lastk BY BytesPerChar DO
+		PutChar (k, " ");
+	    END (*FOR*);
+	END (*WITH*);
+    END EraseLine;
+
+(************************************************************************)
+(*			     TERMINATION				*)
+(************************************************************************)
+
+PROCEDURE CleanUp;
+
+    (* Called at program termination.  Turns on the blinking cursor.	*)
+
+    BEGIN
+	CursorOn(0,0);
+    END CleanUp;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+VAR j: buffersubscript;
+
+BEGIN
+
+    (* The BIOS video call 0FH returns the current video state.  From	*)
+    (* this we can work out whether to use colour or mono.		*)
+    (* WARNING: There is an assumption here that the processor is in	*)
+    (* real address mode.  At some stage I should fix up the setting of	*)
+    (* ScreenSeg (via a call to MemoryModel) so that this module will	*)
+    (* work equally well in protected mode.				*)
+
+    ScreenSeg := 0B000H;	(* assume mono initially *)
+    BlackAndWhite := TRUE;
+    WITH Registers DO
+	AH := 0FH;  BIOS (VideoInt, Registers);  VideoPage := BH;
+	IF AL <> 7 THEN		(* must be colour *)
+
+	    ScreenSeg := 0B800H;  BlackAndWhite := FALSE;
+
+	    (* Set the screen to 25*80 colour.	*)
+
+	    AH := 0;  AL := 3;  BIOS (VideoInt, Registers);
+
+	END (*IF*);
+    END (*WITH*);
+
+    IF BlackAndWhite THEN
+	CRTCport := 03B4H;
+    ELSE
+	CRTCport := 03D4H;
+    END (*IF*);
+
+    SetTerminationProcedure (CleanUp);
+    FOR j := 0 TO HIGH(BlankRow) DO
+	BlankRow[j] := " ";
+    END (*FOR*);
+
+    (* Blank the screen, to erase otherwise annoying background stuff	*)
+    (* left by other programs.						*)
+
+    CursorOff;
+    Blank (0,MaxRowNumber,0,MaxColumnNumber, NormalVideo);
+
+END FastWindows.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/notdone/spurious.def b/examples/Modula-2_Libraries/PMOS/sources/notdone/spurious.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/notdone/spurious.def
@@ -0,0 +1,20 @@
+DEFINITION MODULE SpuriousInterrupts;
+
+	(****************************************************************)
+	(*								*)
+	(*	Spurious interrupt handler for operating system.	*)
+	(*								*)
+	(*	Author:		P. Moylan				*)
+	(*	Last edited:	13 February 1991			*)
+	(*	Description:						*)
+	(*		This module contains interrupt handlers for	*)
+	(*		interrupts 0-7 and 11-13, which are not		*)
+	(*		supposed to occur in the present version of my	*)
+	(*		software.  The aim is to detect unexpected	*)
+	(*		interrupts.					*)
+	(*								*)
+	(*	Status:		Working.				*)
+	(*								*)
+	(****************************************************************)
+
+END SpuriousInterrupts.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/notdone/spurious.mod b/examples/Modula-2_Libraries/PMOS/sources/notdone/spurious.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/notdone/spurious.mod
@@ -0,0 +1,243 @@
+IMPLEMENTATION MODULE SpuriousInterrupts;
+
+	(****************************************************************)
+	(*								*)
+	(*	Spurious interrupt handler for operating system.	*)
+	(*								*)
+	(*	Author:		P. Moylan				*)
+	(*	Last edited:	18 March 1991				*)
+	(*	Description:						*)
+	(*		This module contains interrupt handlers for	*)
+	(*		interrupts 0-7 and 11-13, which are not		*)
+	(*		supposed to occur in the present version of my	*)
+	(*		software.  The aim is to detect unexpected	*)
+	(*		interrupts.					*)
+	(*								*)
+	(*	Status:	Seems OK, but not adequately tested.		*)
+	(*								*)
+	(****************************************************************)
+
+FROM LowLevelIO IMPORT
+    (* proc *)	EnterCriticalSection, LeaveCriticalSection,
+		ProcessorStatus;
+
+FROM Interrupts IMPORT
+    (* proc *)	InstallInterruptTask, AcknowledgeInterrupt;
+
+FROM TaskControl IMPORT
+    (* proc *)	WaitForInterrupt;
+
+FROM GlassTTY IMPORT
+    (* proc *)	WriteString, WriteCard, WriteLn, WriteHexWord;
+
+(************************************************************************)
+(*									*)
+(*  Remark: The interrupts which are NOT spurious, i.e. the ones which	*)
+(*  are genuinely used by my software, are:				*)
+(*									*)
+(*		 8	timer						*)
+(*		 9	keyboard					*)
+(*		10	analogue input					*)
+(*		14	floppy disk					*)
+(*		15	printer						*)
+(*									*)
+(*  The analogue input interrupt is a little strange: the hardware	*)
+(*  actually produces an INT 113 (the second request line of interrupt	*)
+(*  controller 2), but then the BIOS maps this back to INT 10.		*)
+(*									*)
+(************************************************************************)
+
+TYPE InterruptNumber = [0..15];
+
+VAR
+
+    (* Array Handler lists the interrupt routines in this module.	*)
+
+    Handler: ARRAY InterruptNumber OF PROC;
+
+(************************************************************************)
+
+PROCEDURE ErrorMessage (number: InterruptNumber);
+
+    (* Puts an error message on the screen.	*)
+
+    BEGIN
+	WriteLn; WriteString ("ERROR: Unexpected interrupt ");
+	WriteCard (number);
+	WriteString ("  Processor status word is ");
+	WriteHexWord (ProcessorStatus());
+    END ErrorMessage;
+
+(************************************************************************)
+
+PROCEDURE Handler0;
+
+    (* Interrupt routine for interrupt #0.	*)
+
+    BEGIN
+	LOOP
+	    WaitForInterrupt(0);  ErrorMessage(0);
+	END (*LOOP*);
+    END Handler0;
+
+(************************************************************************)
+
+PROCEDURE Handler1;
+
+    (* Interrupt routine for interrupt #1.	*)
+
+    BEGIN
+	LOOP
+	    WaitForInterrupt(1);  ErrorMessage(1);
+	END (*LOOP*);
+    END Handler1;
+
+(************************************************************************)
+
+PROCEDURE Handler2;
+
+    (* Interrupt routine for interrupt #2.	*)
+
+    BEGIN
+	LOOP
+	    WaitForInterrupt(2);  ErrorMessage(2);
+	END (*LOOP*);
+    END Handler2;
+
+(************************************************************************)
+
+PROCEDURE Handler3;
+
+    (* Interrupt routine for interrupt #3.	*)
+
+    BEGIN
+	LOOP
+	    WaitForInterrupt(3);  ErrorMessage(3);
+	END (*LOOP*);
+    END Handler3;
+
+(************************************************************************)
+
+PROCEDURE Handler4;
+
+    (* Interrupt routine for interrupt #4.	*)
+
+    BEGIN
+	LOOP
+	    WaitForInterrupt(4);  ErrorMessage(4);
+	END (*LOOP*);
+    END Handler4;
+
+(************************************************************************)
+
+PROCEDURE Handler5;
+
+    (* Interrupt routine for interrupt #5.	*)
+
+    BEGIN
+	LOOP
+	    WaitForInterrupt(5);  ErrorMessage(5);
+	END (*LOOP*);
+    END Handler5;
+
+(************************************************************************)
+
+PROCEDURE Handler6;
+
+    (* Interrupt routine for interrupt #6.	*)
+
+    BEGIN
+	LOOP
+	    WaitForInterrupt(6);  ErrorMessage(6);
+	END (*LOOP*);
+    END Handler6;
+
+(************************************************************************)
+
+PROCEDURE Handler7;
+
+    (* Interrupt routine for interrupt #7.	*)
+
+    BEGIN
+	LOOP
+	    WaitForInterrupt(7);  ErrorMessage(7);
+	END (*LOOP*);
+    END Handler7;
+
+(************************************************************************)
+
+PROCEDURE Handler11;
+
+    (* Interrupt routine for interrupt #11.	*)
+
+    BEGIN
+	LOOP
+	    WaitForInterrupt(11);  ErrorMessage(11);
+	    AcknowledgeInterrupt;
+	END (*LOOP*);
+    END Handler11;
+
+(************************************************************************)
+
+PROCEDURE Handler12;
+
+    (* Interrupt routine for interrupt #12.	*)
+
+    BEGIN
+	LOOP
+	    WaitForInterrupt(12);  ErrorMessage(12);
+	    AcknowledgeInterrupt;
+	END (*LOOP*);
+    END Handler12;
+
+(************************************************************************)
+
+PROCEDURE Handler13;
+
+    (* Interrupt routine for interrupt #13.	*)
+
+    BEGIN
+	LOOP
+	    WaitForInterrupt(13);  ErrorMessage(13);
+	    AcknowledgeInterrupt;
+	END (*LOOP*);
+    END Handler13;
+
+(************************************************************************)
+
+PROCEDURE InitialiseInterruptVectors;
+
+    (* Sets up the interrupt vectors for interrupts 0-7 and 11-13, to	*)
+    (* point to the appropriate interrupt handlers.			*)
+
+    VAR j: InterruptNumber;
+
+    BEGIN
+	EnterCriticalSection;
+	FOR j := 0 TO 7 DO
+	    InstallInterruptTask (j, Handler[j]);
+	END (*FOR*);
+	FOR j := 11 TO 13 DO
+	    InstallInterruptTask (j, Handler[j]);
+	END (*FOR*);
+	LeaveCriticalSection;
+    END InitialiseInterruptVectors;
+
+(************************************************************************)
+
+BEGIN
+    Handler[0] := Handler0;
+    Handler[1] := Handler1;
+    Handler[2] := Handler2;
+    Handler[3] := Handler3;
+    Handler[4] := Handler4;
+    Handler[5] := Handler5;
+    Handler[6] := Handler6;
+    Handler[7] := Handler7;
+
+    Handler[11] := Handler11;
+    Handler[12] := Handler12;
+    Handler[13] := Handler13;
+
+    InitialiseInterruptVectors;
+END SpuriousInterrupts.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/notdone/streams2.def b/examples/Modula-2_Libraries/PMOS/sources/notdone/streams2.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/notdone/streams2.def
@@ -0,0 +1,134 @@
+DEFINITION MODULE Streams2;
+
+	(********************************************************)
+	(*							*)
+	(*	   I/O module: PMOS replacement for the		*)
+	(*	     Streams module in the FTL library		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	18 September 1991		*)
+	(*  Status:		OK				*)
+	(*							*)
+	(*	This module is provided to ease transition	*)
+	(*	problems for some existing programs.  It is	*)
+	(*	not recommended for use with new programs;	*)
+	(*	module Files provides a better alternative.	*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	WORD, ADDRESS;
+
+(************************************************************************)
+
+TYPE
+    STREAM;	(* is private *)
+    Direction = (input, output, inputoutput);
+
+VAR
+    IOResult: CARDINAL;
+
+    (* IOResult indicates the error status of the last operation.	*)
+    (* If there was no error, it has value 0, which is an encrypted	*)
+    (* form of the message "Real Programmers export variables".		*)
+    (* Nonzero values encrypt messages such as "Real Programmers don't	*)
+    (* believe in multitasking" to indicate an error in the last	*)
+    (* operation.  By Murphy's law, the last operation was probably	*)
+    (* on a file being used by some other task.				*)
+
+(************************************************************************)
+
+PROCEDURE Connect (VAR (*OUT*) s:STREAM;  name: ARRAY OF CHAR;
+						dir: Direction): CARDINAL;
+
+    (* Opens a file.  The function result is zero if successful, or	*)
+    (* nonzero to indicate that the operation failed.  To avoid the	*)
+    (* accidental file deletions for which some other systems are	*)
+    (* famous, we create a new file if and only if dir=output.		*)
+
+PROCEDURE Disconnect (VAR (*INOUT*) s:STREAM;  closefile:BOOLEAN);
+
+    (* Closes a file, if closefile is TRUE.  The action when closefile	*)
+    (* is FALSE has not yet been defined.				*)
+
+PROCEDURE WriteWord (s: STREAM;  w: WORD);
+
+    (* Output two bytes.	*)
+
+PROCEDURE WriteChar (s: STREAM;  ch: CHAR);
+
+    (* Output one byte.	*)
+
+PROCEDURE ReadWord (s: STREAM;  VAR (*OUT*) w: WORD);
+
+    (* Read two sequential bytes.	*)
+
+PROCEDURE ReadChar (s: STREAM;  VAR (*OUT*) ch:CHAR);
+
+    (* Read one byte.	*)
+
+PROCEDURE EOS (s: STREAM): BOOLEAN;
+
+    (* Returns TRUE iff at end of file. *)
+
+PROCEDURE Reset (s: STREAM);
+
+    (* Goes to beginning of file.  (This is the default position when	*)
+    (* the file is opened.)  On list device, starts new page.		*)
+
+PROCEDURE SetLongPos (s: STREAM;  Pos: LONGCARD);
+
+    (* Goes to byte position Pos in file.  Start of file is position 0.	*)
+
+PROCEDURE SetPos (s: STREAM;  high, low: CARDINAL);
+
+    (* Same as SetLongPos (s, MakeLong(high, low))	*)
+
+PROCEDURE GetLongPos (s: STREAM;  VAR (*OUT*) Pos: LONGCARD);
+
+    (* Returns the current position, i.e. the byte number of the next	*)
+    (* byte to be read or written.					*)
+
+PROCEDURE GetPos (s: STREAM;  VAR (*OUT*) high, low: CARDINAL);
+
+    (* Same as GetLongPos, but decomposes the result into two words.	*)
+
+PROCEDURE BufferAhead (s: STREAM;  force: BOOLEAN);
+
+    (* So far, has no effect.  In the long term the intention is to	*)
+    (* allow line editing for keyboard input.				*)
+
+PROCEDURE ReadRec (s: STREAM;  buffaddr: ADDRESS;  count: CARDINAL;
+					VAR (*OUT*) reply: INTEGER);
+
+    (* Reads count bytes to memory location buffaddr.  The last		*)
+    (* parameter returns the number of bytes actually read.   A reply	*)
+    (* of -1 indicates an error, in which case the error code may be	*)
+    (* found in variable IOResult.					*)
+
+PROCEDURE WriteRec (s:STREAM;  buffaddr: ADDRESS;  count: CARDINAL;
+					VAR (*OUT*) reply: INTEGER);
+
+    (* Writes count bytes from memory location buffaddr.  The last	*)
+    (* parameter returns the number of bytes actually written.		*)
+    (* A reply of -1 indicates an error, in which case the error code	*)
+    (* may be found in variable IOResult.				*)
+
+PROCEDURE RenameFile (From, To: ARRAY OF CHAR): CARDINAL;
+
+    (* Changes the name of a file.  A full path name is expected.	*)
+    (* Do not specify different devices.				*)
+
+PROCEDURE DeleteFile (name: ARRAY OF CHAR): CARDINAL;
+
+    (* Deletes a file.  A full path name is expected.			*)
+
+PROCEDURE BufferStream (s: STREAM;  BufferSize:CARDINAL);
+
+    (* A no-op at this stage.	*)
+
+PROCEDURE StreamLength (s: STREAM): LONGCARD;
+
+    (* Returns the length of the file in bytes.	*)
+
+END Streams2.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/notdone/streams2.mod b/examples/Modula-2_Libraries/PMOS/sources/notdone/streams2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/notdone/streams2.mod
@@ -0,0 +1,261 @@
+IMPLEMENTATION MODULE Streams2;
+
+        (********************************************************)
+        (*                                                        *)
+        (*           I/O module: PMOS replacement for the                *)
+        (*             Streams module in the FTL library                *)
+        (*                                                        *)
+        (*  Programmer:                P. Moylan                        *)
+        (*  Last edited:        16 September 1991                *)
+        (*  Status:                Being tested                        *)
+        (*                                                        *)
+        (*        Most operations are working.                        *)
+        (*        Random-access operations not yet tested.        *)
+        (*        RenameFile not yet implemented.                        *)
+        (*        DeleteFile not yet implemented.                        *)
+        (*                                                        *)
+        (*        The immediate goal is to use this module as        *)
+        (*        a test bed for working out what features        *)
+        (*        should be added to the Files module.                *)
+        (*                                                        *)
+        (*        In the long term, this module is likely to        *)
+        (*        become obsolete (except as an interface for        *)
+        (*        programs which were using the FTL library        *)
+        (*        module), since it is probable that all desired        *)
+        (*        features will be included in module Files.        *)
+        (*                                                        *)
+        (********************************************************)
+
+FROM Trace IMPORT
+    (* proc *)        NYI;
+
+FROM SYSTEM IMPORT
+    (* proc *)        ADR;
+
+FROM Files IMPORT
+    (* type *)        File,
+    (* proc *)        OpenFile, CloseFile, EOF, ReadByte, ReadRecord,
+                WriteByte, WriteRecord, SetPosition, SavePosition,
+                FileSize;
+
+FROM IOErrorCodes IMPORT
+    (* type *)        ErrorCode;
+
+FROM Logic IMPORT
+    (* proc *)        MakeLong, HighWord, LowWord;
+
+IMPORT HardDisk, Floppy;
+
+(************************************************************************)
+
+TYPE
+    STREAM = File;
+
+(************************************************************************)
+(*                        OPENING AND CLOSING FILES                        *)
+(************************************************************************)
+
+PROCEDURE Connect (VAR (*OUT*) s:STREAM;  name: ARRAY OF CHAR;
+                                                dir: Direction): CARDINAL;
+
+    (* Opens a file.  The function result is zero if successful, or        *)
+    (* nonzero to indicate that the operation failed.                        *)
+
+    BEGIN
+        RETURN ORD (OpenFile (s, name, dir=output));
+    END Connect;
+
+(************************************************************************)
+
+PROCEDURE Disconnect (VAR (*INOUT*) s:STREAM;  closefile:BOOLEAN);
+
+    (* Closes a file, if closefile is TRUE.  The action when closefile        *)
+    (* is FALSE has not yet been defined.                                *)
+
+    BEGIN
+        IF closefile THEN
+            CloseFile (s);
+        END (*IF*);
+    END Disconnect;
+
+(************************************************************************)
+(*                                INPUT                                        *)
+(************************************************************************)
+
+PROCEDURE ReadChar (s: STREAM;  VAR (*OUT*) ch:CHAR);
+
+    (* Read one byte.        *)
+
+    BEGIN
+        ch := ReadByte (s);
+    END ReadChar;
+
+(************************************************************************)
+
+PROCEDURE ReadWord (s: STREAM;  VAR (*OUT*) w: WORD);
+
+    (* Read two sequential bytes.        *)
+
+    VAR reply: INTEGER;
+
+    BEGIN
+        ReadRec (s, ADR(w), 2, reply);
+    END ReadWord;
+
+(************************************************************************)
+
+PROCEDURE BufferAhead (s: STREAM;  force: BOOLEAN);
+
+    (* So far, has no effect.  In the long term the intention is to        *)
+    (* allow line editing for keyboard input.                                *)
+
+    BEGIN
+    END BufferAhead;
+
+(************************************************************************)
+
+PROCEDURE ReadRec (s: STREAM;  buffaddr: ADDRESS;  count: CARDINAL;
+                                        VAR (*OUT*) reply: INTEGER);
+
+    (* Reads count bytes to memory location buffaddr.  The last                *)
+    (* parameter returns the number of bytes actually read.   A reply        *)
+    (* of -1 indicates an error, in which case an error code may be        *)
+    (* found in variable IOResult.                                        *)
+
+    VAR actualcount: CARDINAL;  status: ErrorCode;
+
+    BEGIN
+        status := ReadRecord (s, buffaddr, count, actualcount);
+        IOResult := ORD(status);
+        IF status = OK THEN
+            reply := actualcount;
+        ELSE
+            reply := -1;
+        END (*IF*);
+    END ReadRec;
+
+(************************************************************************)
+(*                                OUTPUT                                        *)
+(************************************************************************)
+
+PROCEDURE WriteWord (s: STREAM;  w: WORD);
+
+    (* Output two bytes.        *)
+
+    VAR dummy: INTEGER;
+
+    BEGIN
+        WriteRec (s, ADR(w), 2, dummy);
+    END WriteWord;
+
+(************************************************************************)
+
+PROCEDURE WriteChar (s: STREAM;  ch: CHAR);
+
+    (* Output one byte.        *)
+
+    BEGIN
+        IOResult := ORD (WriteByte (s, ch));
+    END WriteChar;
+
+(************************************************************************)
+
+PROCEDURE WriteRec (s:STREAM;  buffaddr: ADDRESS;  count: CARDINAL;
+                                        VAR (*OUT*) reply: INTEGER);
+
+    (* Writes count bytes from memory location buffaddr.  The last        *)
+    (* parameter returns the number of bytes actually written.                *)
+    (* A reply of -1 indicates an error, in which case an error code        *)
+    (* may be found in variable IOResult.                                *)
+
+    VAR status: ErrorCode;
+
+    BEGIN
+        status := WriteRecord (s, buffaddr, count);
+        IOResult := ORD(status);
+        IF status = OK THEN
+            reply := count;
+        ELSE
+            reply := -1;
+        END (*IF*);
+    END WriteRec;
+
+(************************************************************************)
+(*                            END-OF-FILE TEST                                *)
+(************************************************************************)
+
+PROCEDURE EOS (s: STREAM): BOOLEAN;
+
+    (* Returns TRUE iff at end of file. *)
+
+    BEGIN
+        RETURN EOF (s);
+    END EOS;
+
+(************************************************************************)
+(*                                RANDOM ACCESS                                *)
+(************************************************************************)
+
+PROCEDURE Reset (s: STREAM);
+
+    (* Goes to beginning of file.  On list device, starts new page.        *)
+
+    BEGIN
+        IOResult := ORD (SetPosition (s, 0));
+    END Reset;
+
+(************************************************************************)
+
+PROCEDURE SetLongPos (s: STREAM;  Pos: LONGCARD);
+
+    (* Goes to byte position Pos in file.  Start of file is position 0.        *)
+
+    BEGIN
+        IOResult := ORD (SetPosition (s, Pos));
+    END SetLongPos;
+
+(************************************************************************)
+
+PROCEDURE SetPos (s: STREAM;  high, low: CARDINAL);
+
+    (* Same as SetLongPos (s, MakeLong(high, low))        *)
+
+    BEGIN
+        IOResult := ORD (SetPosition (s, MakeLong (high, low)));
+    END SetPos;
+
+(************************************************************************)
+
+PROCEDURE GetLongPos (s: STREAM;  VAR (*OUT*) Pos: LONGCARD);
+
+    (* Returns the current position, i.e. the byte number of the next        *)
+    (* byte to be read or written.                                        *)
+
+    BEGIN
+        Pos := SavePosition (s);
+    END GetLongPos;
+
+(************************************************************************)
+
+PROCEDURE GetPos (s: STREAM;  VAR (*OUT*) high, low: CARDINAL);
+
+    (* Same as GetLongPos, but decomposes the result into two words.        *)
+
+    VAR position: LONGCARD;
+
+    BEGIN
+        position := SavePosition (s);
+        high := HighWord (position);  low := LowWord (position);
+    END GetPos;
+
+(************************************************************************)
+
+PROCEDURE StreamLength (s: STREAM): LONGCARD;
+
+    (* Returns the length of the file in bytes.        *)
+
+    BEGIN
+        RETURN FileSize (s);
+    END StreamLength;
+
+END Streams2.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/special/innerker.mod b/examples/Modula-2_Libraries/PMOS/sources/special/innerker.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/special/innerker.mod
@@ -0,0 +1,610 @@
+IMPLEMENTATION MODULE InnerKernel;
+
+	(****************************************************************)
+	(*								*)
+	(*	This is a "generic" version of the InnerKernel module.	*)
+	(*	These procedures would normally be written in assembly	*)
+	(*	language, but for those without access to a suitable	*)
+	(*	assembler the present version can be substituted for	*)
+	(*	the assembly language version.  We try to stick to	*)
+	(*	"standard" Modula-2 as much as possible, so that this	*)
+	(*	module can be ported to another machine or compiler	*)
+	(*	with the minimum of fuss (see notes on porting below).	*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	16 March 1995				*)
+	(*  Status:		Working					*)
+	(*	Interrupt handling is not as efficient as I would like,	*)
+	(*	 but there seems to be no way to improve this given the	*)
+	(*	 limitations of the Wirth-style IOTRANSFER operation.	*)
+	(*								*)
+	(*	Comment: now that I've come up with a better approach	*)
+	(*	 to killing an interrupt task, I might be able to	*)
+	(*	 simplify the handling of interrupt tasks by stripping	*)
+	(*	 off the "shell" part.  This needs more thought.	*)
+	(*								*)
+	(****************************************************************)
+	(*								*)
+	(*  NOTES ON PORTING THIS MODULE TO ANOTHER MACHINE/COMPILER:	*)
+	(*								*)
+	(*   1.	The SYSTEM procedures here are the Wirth-style		*)
+	(*	coroutine support as described in "Programming in	*)
+	(*	Modula-2" by Niklaus Wirth.  The coroutine support in	*)
+	(*	the new ISO standard is significantly different, and	*)
+	(*	requires a different approach.				*)
+	(*	A version of this module which follows the ISO standard	*)
+	(*	is planned but has not yet been developed.		*)
+	(*								*)
+	(*   2.	If speed is a major issue, you will ultimately have to	*)
+	(*	replace this module with an assembly language version.	*)
+	(*	The present version is intended to be an interim	*)
+	(*	solution, although for many uses it may well turn out	*)
+	(*	to be a satisfactory permanent solution.		*)
+	(*								*)
+	(*   3.	With some compilers you will need to change the IMPORT	*)
+	(*	declarations, since the imported procedures are		*)
+	(*	sometimes found in SYSTEM and sometimes in some other	*)
+	(*	module.  Check the documentation for your own libraries.*)
+	(*								*)
+	(*   4.	It is vital that all procedures in this module be	*)
+	(*	executed with interrupts disabled.  The caller normally	*)
+	(*	guarantees this by calls to EnterKernel, but beware of	*)
+	(*	adding things like BIOS calls which would re-enable	*)
+	(*	interrupts.						*)
+	(*								*)
+	(*   5.	A potential trouble spot with some compiler/library	*)
+	(*	packages is that the ALLOCATE and DEALLOCATE procedures	*)
+	(*	might not be re-entrant.  If this is the case on your	*)
+	(*	system, you will have to write your own version of	*)
+	(*	module Storage.						*)
+	(*								*)
+	(*   6.	The present version was developed and tested using	*)
+	(*	TopSpeed Modula-2, DOS version 3.10.  It works well	*)
+	(*	with that package except for one shortcoming: because	*)
+	(*	of the way in which TopSpeed implements module		*)
+	(*	priorities, the TopSpeed versions of TRANSFER and	*)
+	(*	IOTRANSFER treat the interrupt masks at ports 21H and	*)
+	(*	A1H as per-thread resources, rather than as global	*)
+	(*	resources as one would normally require for		*)
+	(*	multitasking applications.  You therefore cannot	*)
+	(*	reliably disable specific devices by setting a bit in	*)
+	(*	the appropriate mask register, since a task switch	*)
+	(*	could lead to that bit being cleared again.  The only	*)
+	(*	place in PMOS where this is known to be a problem is	*)
+	(*	in module Printer.  The problem could be solved by	*)
+	(*	putting code to save/restore the mask registers around	*)
+	(*	every call to TRANSFER and IOTRANSFER, but I have	*)
+	(*	preferred to avoid complicating this module with a fix	*)
+	(*	to a problem which is specific to just one compiler,	*)
+	(*	given that a superior assembly language version of this	*)
+	(*	module is already available to TopSpeed users.		*)
+	(*								*)
+	(****************************************************************)
+
+FROM SYSTEM IMPORT
+    (* proc *)	NEWPROCESS, TRANSFER, IOTRANSFER, EI, DI;
+
+FROM LowLevel IMPORT
+    (* proc *)	MakePointer;
+
+FROM Storage IMPORT
+    (* proc *)	ALLOCATE;
+
+FROM MiscPMOS IMPORT
+    (* proc *)	EnterCriticalSection, LeaveCriticalSection;
+
+FROM ConfigurationOptions IMPORT
+    (* const *)	StackSize;
+
+FROM TerminationControl IMPORT
+    (* proc *)	Crash;
+
+(************************************************************************)
+
+TYPE
+    InterruptNumber = CARDINAL;
+
+    (* The tight restriction on the maximum number of concurrent	*)
+    (* threads is a limitation of the TopSpeed run-time system.  It	*)
+    (* allows up to 32 threads (approx. - I might be out by one or two)	*)
+    (* and we have to distribute these between tasks and interrupt	*)
+    (* shell threads.  With a different compiler you might be able to	*)
+    (* increase the limit.						*)
+
+    ThreadNumber = [0..20];
+
+    GlobalParameterBlock =  RECORD
+				maincode, endcode: PROC;
+				IntEnable: BOOLEAN;
+				selector: TaskSelector;
+			    END (*RECORD*);
+
+VAR
+    (* GlobalParameters is needed when creating a new task; we need to	*)
+    (* transfer information to the task as it starts up, and the only	*)
+    (* way to do this is via global variables.  This is safe in the	*)
+    (* present instance because we do the creation with interrupts	*)
+    (* disabled, and because the first thing we do after creating a	*)
+    (* task is an immediate transfer to that task to let it take its	*)
+    (* own copy of the necessary information.				*)
+
+    GlobalParameters: GlobalParameterBlock;
+
+    (* BackgroundSelector is a selector for the interrupted task, in	*)
+    (* the case where an interrupt task is running.  Task switching to	*)
+    (* and from interrupt tasks is done directly by this module, not by	*)
+    (* the higher-level part of the kernel.  Interrupt tasks are always	*)
+    (* allowed to "run to completion" - that is, to their next call to	*)
+    (* IOTransfer - and nested interrupt handlers are not supported.	*)
+    (* (To support them, we would have to make BackgroundSelector a	*)
+    (* stack rather than a simple variable, and this would impair the	*)
+    (* efficiency of interrupt handlers.)  To ensure this, interrupt	*)
+    (* tasks must never enable interrupts.				*)
+
+    (* When creating a new task, BackgroundSelector is temporarily used	*)
+    (* to identify the creator.  (It would be unwise, for a variety of	*)
+    (* reasons, to create a new task from inside an interrupt task, so	*)
+    (* we don't bother to support that possibility.)			*)
+
+    BackgroundSelector:	TaskSelector;
+
+    (* ThreadTable is an array of selectors for threads that are	*)
+    (* created during module initialisation.  See the comments in the	*)
+    (* initialisation code to see why we need this.			*)
+
+    ThreadTable: ARRAY ThreadNumber OF TaskSelector;
+
+    (* NextThreadNumber is the first available entry in ThreadTable.	*)
+
+    NextThreadNumber: [0..MAX(ThreadNumber)+1];
+
+(************************************************************************)
+(*			THE INTERRUPT TABLE				*)
+(************************************************************************)
+
+CONST
+    IntTableLimit = 9;
+    NoInterrupt = IntTableLimit;
+
+TYPE IntTableIndex = [0..IntTableLimit];
+
+VAR
+    (* TableLoc records the identity of the currently running interrupt	*)
+    (* task, if any.  If the currently running task is not an interrupt	*)
+    (* task, then TableLoc = NoInterrupt.  If it is an interrupt task,	*)
+    (* TableLoc holds the index for the entry in the interrupt table	*)
+    (* which belongs to that task.					*)
+
+    TableLoc: IntTableIndex;
+
+    (* Each entry in the interrupt table describes one interrupt task.	*)
+    (* The "selector" field is for the actual interrupt task, and the	*)
+    (* "ShellSelector" field is for the extra task which we have to	*)
+    (* wrap around the real interrupt task in order to catch the first	*)
+    (* interrupt which arrives after the actual interrupt task has shut	*)
+    (* down.  (This is needed because there is no way to cancel an	*)
+    (* IOTRANSFER.)  The "oldhandler" field is for saving the original	*)
+    (* contents of the interrupt vector.				*)
+
+    IntTable: ARRAY IntTableIndex OF
+		    RECORD
+			IntNumber: CARDINAL;
+			selector, ShellSelector: TaskSelector;
+			oldhandler: PROC;
+		    END (*RECORD*);
+		
+(************************************************************************)
+
+PROCEDURE ClearIntTable;
+
+    (* Clears the interrupt table. *)
+
+    VAR k: IntTableIndex;
+
+    BEGIN
+	FOR k := 0 TO IntTableLimit DO
+	    WITH IntTable[k] DO
+		IntNumber := MAX(CARDINAL);
+		selector := NIL;
+		oldhandler := NULLPROC;
+		ShellSelector := NIL;
+	    END (*WITH*);
+	END (*FOR*);
+    END ClearIntTable;
+    		
+(************************************************************************)
+
+PROCEDURE LocateIntTableEntry (TS: TaskSelector): IntTableIndex;
+    	
+    (* Returns the Interrupt table index for the entry which belongs	*)
+    (* to the given task selector.					*)
+    		
+    VAR k: IntTableIndex;
+    	
+    BEGIN
+	k := 0;
+	WHILE (k < IntTableLimit) AND (IntTable[k].selector <> TS) DO
+	    INC (k);
+	END (*WHILE*);
+	RETURN k;
+    END LocateIntTableEntry;
+    		
+(************************************************************************)
+(*			INTERRUPT HANDLING				*)
+(************************************************************************)
+
+PROCEDURE GenericInterruptHandler;
+
+    (* We create one instance of this thread for each interrupt number.	*)
+    (* Each time an interrupt occurs, the thread is activated and	*)
+    (* switches control to the "real" interrupt task.  That is, this	*)
+    (* thread acts as the intermediary between the Modula-2 standard	*)
+    (* IOTRANSFER operation and our IOTransfer operation.  The reason	*)
+    (* why we have to wrap an extra thread around the user's thread is	*)
+    (* that the Wirth-style IOTRANSFER does not provide any way to	*)
+    (* reset an interrupt vector when killing an interrupt handler; so	*)
+    (* we must provide a "live" interrupt-handling thread, whose stack	*)
+    (* is guaranteed to remain allocated up to and including the time	*)
+    (* of program termination, to handle the first interrupt to arrive	*)
+    (* after the "real" interrupt task has been killed off.		*)
+
+    VAR k: IntTableIndex;
+
+    BEGIN
+	(* Startup code: the global variable TableLoc tells us which	*)
+	(* entry in the interrupt table belongs to us.			*)
+
+	k := TableLoc;
+
+	(* The first time this thread is invoked is during module	*)
+	(* initialisation.  At this stage all we have to do is disable	*)
+	(* processor interrupts (for this thread) and then switch back	*)
+	(* to the initialisation code.					*)
+
+	DI();
+	TRANSFER (IntTable[k].ShellSelector, BackgroundSelector);
+
+	LOOP
+	    (* Go to the "real" interrupt task. *)
+
+	    WITH IntTable[k] DO
+		TRANSFER (ShellSelector, selector);
+	    END (*WITH*);
+
+	    (* We get back here after the interrupt task has executed	*)
+	    (* its IOTransfer.  Go back to the interrupted task. 	*)
+
+	    TableLoc := NoInterrupt;
+	    WITH IntTable[k] DO
+		IOTRANSFER (ShellSelector, BackgroundSelector, IntNumber);
+	    END (*WITH*);
+
+	    (* We wake up here after the interrupt. *)
+
+	    TableLoc := k;
+
+	END (*LOOP*);
+
+    END GenericInterruptHandler;
+
+(************************************************************************)
+(*		    THE "MAIN PROGRAM" FOR ALL TASKS			*)
+(************************************************************************)
+
+PROCEDURE RunTask;
+
+    (* We run one invocation of this for each task. *)
+
+    VAR MainProc, ExitProc: PROC;
+
+    BEGIN
+	(* The first time this thread is invoked is during module	*)
+	(* initialisation.  At this stage all we have to do is disable	*)
+	(* processor interrupts (for this thread) and then switch back	*)
+	(* to the initialisation code.					*)
+
+	DI();
+	TRANSFER (ThreadTable[NextThreadNumber], BackgroundSelector);
+
+	(* The next time we get control is where a user task is		*)
+	(* assigned to this thread.  Copy the global parameters		*)
+	(* immediately, and then go back to the creator of the task.	*)
+
+	WITH GlobalParameters DO
+	    MainProc := maincode;
+	    ExitProc := endcode;
+	    IF IntEnable THEN EI() ELSE DI() END(*IF*);
+	    TRANSFER (selector, BackgroundSelector);
+	END (*WITH*);
+
+	(* When we get the processor back, execute the body of the	*)
+	(* task code.							*)
+
+	MainProc();
+
+	(* Task done, execute its exit code.	*)
+
+	ExitProc();
+
+    END RunTask;
+
+(************************************************************************)
+(*		    THE EXTERNALLY CALLABLE PROCEDURES			*)
+(************************************************************************)
+
+PROCEDURE EnterKernel (): CARDINAL;
+
+    (* Saves the processor flags word, including the current "interrupt	*)
+    (* enable" status, and returns with interrupts disabled.		*)
+    (* NOTE: this procedure and the following one should be used as a	*)
+    (* matched pair.							*)
+
+    BEGIN
+	RETURN EnterCriticalSection();
+    END EnterKernel;
+
+(************************************************************************)
+
+PROCEDURE LeaveKernel (PSW: CARDINAL);
+
+    (* Restores the processor flags word, including the "interrupt	*)
+    (* enable" status.  NOTE: this procedure and the one above should	*)
+    (* be used as a matched pair.					*)
+
+    BEGIN
+	LeaveCriticalSection (PSW);
+    END LeaveKernel;
+
+(************************************************************************)
+
+PROCEDURE NPXsave (selector: FloatSaveSelector);
+
+    (* This procedure is a dummy in the present version; we rely	*)
+    (* on the library TRANSFER and IOTRANSFER to save the floating	*)
+    (* point state.							*)
+
+    BEGIN
+    END NPXsave;
+
+(************************************************************************)
+
+PROCEDURE NPXrestore (selector: FloatSaveSelector);
+
+    (* This procedure is a dummy in the present version; we rely	*)
+    (* on the library TRANSFER and IOTRANSFER to save the floating	*)
+    (* point state.							*)
+
+    BEGIN
+    END NPXrestore;
+
+(************************************************************************)
+
+PROCEDURE TaskInit (StackBase: ADDRESS;  StackSize: CARDINAL;
+			EnableInterrupts: BOOLEAN;
+			TaskExit, StartAddress: PROC): TaskSelector;
+
+    (* Initialises the stack for a new task.  Parameter StackBase	*)
+    (* points to a block of memory which can be used to hold the stack	*)
+    (* (note that this is a pointer to the start of the memory block,	*)
+    (* not to the bottom of the stack); and StackSize is the size of	*)
+    (* this block.  The next parameter specifies whether processor	*)
+    (* interrupts should be enabled when the task is started.		*)
+    (* StartAddress and TaskExit are the start address of the task code	*)
+    (* and the start address of the code to execute when the task	*)
+    (* terminates.  The value returned is a selector for the new task.	*)
+
+    (* Note: in this version the StackBase and StackSize parameters are	*)
+    (* ignored, since we've had to pre-create all threads.  That leads	*)
+    (* to a waste of memory; but that seems to be the price of		*)
+    (* portability, unless someone can come up with a better way to	*)
+    (* create threads (using the more-or-less portable Wirth model)	*)
+    (* without leaving the kernel critical sections unprotected.	*)
+
+    (* Idea: maybe I should go back to my earlier approach, but add	*)
+    (* interrupt mask protection to the tricky sections.		*)
+
+    VAR result: TaskSelector;
+
+    BEGIN
+	IF NextThreadNumber > MAX(ThreadNumber) THEN
+	    Crash ("Too many tasks created.")
+	END (*IF*);
+	WITH GlobalParameters DO
+	    maincode := StartAddress;
+	    endcode := TaskExit;
+	    IntEnable := EnableInterrupts;
+
+	    (* Run the new task just far enough to ensure that the	*)
+	    (* GlobalParameters are copied over.			*)
+
+	    selector := ThreadTable[NextThreadNumber];
+	    INC (NextThreadNumber);
+	    TRANSFER (BackgroundSelector, selector);
+	    RETURN selector;
+
+	END (*WITH*);
+
+    END TaskInit;
+
+(************************************************************************)
+
+PROCEDURE InitMainTask (): TaskSelector;
+
+    (* This procedure is a dummy in the present version; we rely	*)
+    (* on the library TRANSFER and IOTRANSFER to save the floating	*)
+    (* point state.							*)
+
+    BEGIN
+	RETURN NIL;
+    END InitMainTask;
+
+(************************************************************************)
+
+PROCEDURE MakeFloatSaveSelector (selector: TaskSelector): FloatSaveSelector;
+
+    (* This procedure is a dummy in the present version; we rely	*)
+    (* on the library TRANSFER and IOTRANSFER to save the floating	*)
+    (* point state.							*)
+
+    BEGIN
+	RETURN 0;
+    END MakeFloatSaveSelector;
+
+(************************************************************************)
+
+PROCEDURE Transfer (VAR (*OUT*) source: TaskSelector;
+					destination: TaskSelector);
+
+    (* Performs a task switch to the destination task, at the same time	*)
+    (* saving a selector for the outgoing task in variable "source".	*)
+    (* This allows a subsequent call to Transfer to resume the		*)
+    (* original task.  By the time this procedure has returned to the	*)
+    (* caller, then, we are again executing the calling task.		*)
+
+    (* Special case: if this procedure is called by an interrupt task,	*)
+    (* the call is interpreted as a requiring a task switch from the	*)
+    (* interrupted task - i.e. the source parameter must specify the	*)
+    (* interrupted task - to the destination task.  In this case the	*)
+    (* actual switch to the destination task does not happen until the	*)
+    (* interrupt task makes its next call to IOTransfer.  The reason	*)
+    (* for this interpretation is that task switching to and from	*)
+    (* interrupt tasks is managed internally by this module; the	*)
+    (* occurrence of an interrupt is not something that can be		*)
+    (* controlled by the caller.					*)
+
+    BEGIN
+	IF TableLoc = NoInterrupt THEN
+	    TRANSFER (source, destination);
+	ELSE
+	    source := BackgroundSelector;
+	    BackgroundSelector := destination;
+	END (*IF*);
+    END Transfer;
+
+(************************************************************************)
+
+PROCEDURE IOTransfer;
+
+    (* May be called only from an interrupt task.  Performs a task	*)
+    (* switch from the current interrupt task to the task which it	*)
+    (* interrupted.  Unlike Transfer, no parameters are required	*)
+    (* because (a) the selector for the destination task is already	*)
+    (* known to this module, having been saved at the time of the	*)
+    (* interrupt; and (b) selectors for interrupt tasks are maintained	*)
+    (* directly by this module rather than by the caller.		*)
+
+    BEGIN
+	WITH IntTable[TableLoc] DO
+	    TRANSFER (selector, ShellSelector);
+	END (*WITH*);
+
+	(* We return from the TRANSFER when the interrupt occurs. *)
+
+    END IOTransfer;
+
+(************************************************************************)
+
+PROCEDURE StartInterruptTask (TS: TaskSelector; InterruptNumber: CARDINAL);
+
+    (* Starts an interrupt task by running its initialisation section	*)
+    (* - i.e. everything up to the first IOTransfer - and arranging	*)
+    (* that from then on it will be activated by the given interrupt.	*)
+
+    VAR StackBase: ADDRESS;
+	p: POINTER TO PROC;
+
+    BEGIN
+	TableLoc := LocateIntTableEntry (NIL);
+	IF TableLoc = NoInterrupt THEN
+	    Crash ("Too many interrupt tasks.")
+	END (*IF*);
+	WITH IntTable[TableLoc] DO
+	    IntNumber := InterruptNumber;
+	    selector := TS;
+	    p := MakePointer (0, 4*IntNumber);
+	    oldhandler := p^;
+	    TRANSFER (BackgroundSelector, ShellSelector);
+	END (*WITH*);
+
+	(* When we get back here, the "shell" task has completed its	*)
+	(* initialisation, including priming the interrupt vector; and	*)
+	(* the interrupt task has run to its first call to IOTransfer.	*)
+
+    END StartInterruptTask;
+
+(************************************************************************)
+
+PROCEDURE DisconnectFromInterrupt (TS: TaskSelector);
+
+    (* Restores the interrupt vector to which TS was connected to its	*)
+    (* state before TS was established as an interrupt task.  (N.B. The	*)
+    (* result could be chaotic if there was no previous call to		*)
+    (* ConnectToInterrupt.)						*)
+
+    VAR p: POINTER TO PROC;  k: IntTableIndex;
+
+    BEGIN
+	k := LocateIntTableEntry(TS);
+	WITH IntTable[k] DO
+	    p := MakePointer (0, 4*IntNumber);
+	    p^ := oldhandler;
+	END (*WITH*);
+    END DisconnectFromInterrupt;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE CreateThreads;
+
+    (* A shortcoming of the NEWPROCESS procedure is that it creates a	*)
+    (* thread with interrupts initially enabled.  If we created tasks	*)
+    (* at the obvious time - i.e. inside procedure TaskInit - this	*)
+    (* would create a security hole in the kernel, where processor	*)
+    (* interrupts would be momentarily enabled at a time where we're	*)
+    (* executing kernel code that is supposed to be indivisible.	*)
+    (* (Believe me, I've tried the more obvious approach, and it	*)
+    (* crashes the system in a disastrous way.)  Our solution is to	*)
+    (* create all threads and get past the "interrupts enabled" glitch	*)
+    (* _before_ the multitasking kernel is started.  This admittedly is	*)
+    (* a complex solution with all the air of being a kludge, but I	*)
+    (* couldn't think of a better solution (apart from rewriting	*)
+    (* NEWPROCESS, which is effectively what I've done in the assembly	*)
+    (* language version of this module).				*)
+
+    CONST GIHStackSize = 2048;
+
+    VAR StackBase: ADDRESS;
+
+    BEGIN
+	FOR NextThreadNumber := 0 TO MAX(ThreadNumber) DO
+	    ALLOCATE (StackBase, StackSize);
+	    NEWPROCESS (RunTask, StackBase, StackSize,
+					ThreadTable[NextThreadNumber]);
+
+	    (* Run the new thread just far enough to ensure that it	*)
+	    (* disables its interrupts.					*)
+
+	    TRANSFER (BackgroundSelector, ThreadTable[NextThreadNumber]);
+	END (*FOR*);
+	NextThreadNumber := 0;
+
+	(* Now do the same for the interrupt handler shells. *)
+
+	FOR TableLoc := 0 TO MAX(IntTableIndex)-1 DO
+	    ALLOCATE (StackBase, GIHStackSize);
+	    NEWPROCESS (GenericInterruptHandler, StackBase,
+				StackSize, IntTable[TableLoc].ShellSelector);
+	    TRANSFER (BackgroundSelector, IntTable[TableLoc].ShellSelector);
+	END (*FOR*);
+	TableLoc := NoInterrupt;
+
+    END CreateThreads;
+
+(************************************************************************)
+
+BEGIN
+    ClearIntTable;
+    CreateThreads;
+END InnerKernel.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/special/keyboard.mod b/examples/Modula-2_Libraries/PMOS/sources/special/keyboard.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/special/keyboard.mod
@@ -0,0 +1,88 @@
+IMPLEMENTATION MODULE Keyboard;
+
+	(****************************************************************)
+	(*								*)
+	(*	Keyboard input module for use where we want to		*)
+	(*	bypass the normal PMOS keyboard driver - e.g. for	*)
+	(*	running the simple multitasking demonstration, or	*)
+	(*	for cases where we need to avoid conflicts with		*)
+	(*	the debugger.						*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	26 July 1994				*)
+	(*  Status:		Working					*)
+	(*								*)
+	(****************************************************************)
+
+IMPORT IO;
+
+(************************************************************************)
+
+PROCEDURE KeyPressed(): BOOLEAN;
+
+    (* Reports whether a character is available, but does not fetch it.	*)
+
+    BEGIN
+	RETURN IO.KeyPressed();
+    END KeyPressed;
+
+(************************************************************************)
+
+PROCEDURE InKey (): CHAR;
+
+    (* Reads a single character code from the keyboard.	*)
+
+    BEGIN
+	RETURN IO.RdKey();
+    END InKey;
+
+(************************************************************************)
+
+PROCEDURE PutBack (ch: CHAR);
+
+    (* A dummy procedure; feature not available in this version.	*)
+
+    BEGIN
+    END PutBack;
+
+(************************************************************************)
+
+PROCEDURE SetLocks (code: CARDINAL);
+
+    (* A dummy procedure; feature not available in this version.	*)
+
+    BEGIN
+    END SetLocks;
+
+(************************************************************************)
+
+PROCEDURE LockStatus (): CARDINAL;
+
+    (* A dummy procedure; feature not available in this version.	*)
+
+    BEGIN
+	RETURN 0;
+    END LockStatus;
+
+(************************************************************************)
+
+PROCEDURE HotKey (FunctionKey: BOOLEAN;  code: CHAR;  S: Semaphore);
+
+    (* A dummy procedure; feature not available in this version.	*)
+
+    BEGIN
+    END HotKey;
+
+(************************************************************************)
+
+PROCEDURE StuffKeyboardBuffer (ch: CHAR);
+
+    (* A dummy procedure; feature not available in this version.	*)
+
+    BEGIN
+    END StuffKeyboardBuffer;
+
+(************************************************************************)
+
+END Keyboard.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/special/lowlevel.mod b/examples/Modula-2_Libraries/PMOS/sources/special/lowlevel.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/special/lowlevel.mod
@@ -0,0 +1,876 @@
+IMPLEMENTATION MODULE LowLevel;
+
+	(********************************************************)
+	(*							*)
+	(*	   Miscellaneous low-level procedures		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	28 February 1995		*)
+	(*  Status:		Working				*)
+	(*	Exception: the string I/O is not working in	*)
+	(*	the FST case, and for now I don't know how	*)
+	(*	to fix it.  The offending lines are		*)
+	(*	commented out.					*)
+	(*							*)
+	(*	Note that the implementation of this module	*)
+	(*	is heavily compiler-dependent.  This version	*)
+	(*	is a "semi-portable" version, which contains	*)
+	(*	preprocessor directives to choose which code	*)
+	(*	to activate.  Use the PP preprocessor to	*)
+	(*	select the correct version.			*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT BYTE, WORD, ADDRESS (*<FST ,ASSEMBLER >*);
+(*<TopSpeed*) IMPORT SYSTEM, Lib; (*>*)
+(*<TopSpeed1 IMPORT MiscLib; >*)
+(*<FST IMPORT System; >*)
+
+TYPE
+    t02 = [0..2];  t03 = [0..3];
+
+    Table = ARRAY [0..15] OF CARDINAL;
+
+    Word =  RECORD
+		CASE :t03 OF
+		  | 0:	bits: BITSET;
+		  | 1:	low, high: BYTE;
+		  | 2:	w: WORD;
+		  | 3:	c: CARDINAL;
+		END (*CASE*);
+	    END (*RECORD*);
+
+    Double = RECORD
+		CASE :t02 OF
+		  | 0:	low, high: WORD;
+		  | 1:	lw: LONGCARD;
+		  | 2:	a: FarPointer;
+		END (*CASE*);
+	     END (*RECORD*);
+
+(*<TopSpeed*)
+CONST power2 = Table (1, 2, 4, 8, 16, 32, 64, 128, 256, 512,
+			1024, 2048, 4096, 8192, 16384, 32768);
+(*>*)
+
+(*<FST
+VAR power2: Table;
+>*)
+
+(************************************************************************)
+(*			    BITWISE LOGIC				*)
+(************************************************************************)
+
+(*<~TopSpeed3
+
+PROCEDURE IAND (first, second: WORD): WORD;
+
+    (* Bit-by-bit logical AND.	*)
+
+    VAR a, b, result: Word;
+
+    BEGIN
+	a.w := first;  b.w := second;
+	result.bits := a.bits * b.bits;
+	RETURN result.w;
+    END IAND;
+
+(************************************************************************)
+
+PROCEDURE IANDB (first, second: BYTE): BYTE;
+
+    (* Bit-by-bit logical AND for bytes.	*)
+
+    BEGIN
+	RETURN LowByte(IAND(ORD(first), ORD(second)));
+    END IANDB;
+
+(************************************************************************)
+
+PROCEDURE IOR (first, second: WORD): WORD;
+
+    (* Bit-by-bit inclusive OR.	*)
+
+    VAR a, b, result: Word;
+
+    BEGIN
+	a.w := first;  b.w := second;
+	result.bits := a.bits + b.bits;
+	RETURN result.w;
+    END IOR;
+
+(************************************************************************)
+
+PROCEDURE IORB (first, second: BYTE): BYTE;
+
+    (* Bit-by-bit inclusive OR.	*)
+
+    BEGIN
+	RETURN LowByte(IOR(ORD(first), ORD(second)));
+    END IORB;
+
+(************************************************************************)
+
+PROCEDURE IXOR (first, second: WORD): WORD;
+
+    (* Bit-by-bit exclusive OR.	*)
+
+    VAR a, b, result: Word;
+
+    BEGIN
+	a.w := first;  b.w := second;
+	result.bits := a.bits / b.bits;
+	RETURN result.w;
+    END IXOR;
+
+(************************************************************************)
+
+PROCEDURE IXORB (first, second: BYTE): BYTE;
+
+    (* Bit-by-bit exclusive OR.	*)
+
+    BEGIN
+	RETURN LowByte(IXOR(ORD(first), ORD(second)));
+    END IXORB;
+
+(************************************************************************)
+
+PROCEDURE INOT (value: WORD): WORD;
+
+    (* Bit-by-bit Boolean complement.	*)
+
+    BEGIN
+	RETURN WORD(0FFFFH-ORD(value));
+    END INOT;
+
+(************************************************************************)
+
+PROCEDURE INOTB (value: BYTE): BYTE;
+
+    (* Bit-by-bit Boolean complement.	*)
+
+    BEGIN
+	RETURN LowByte(0FFH-ORD(value));
+    END INOTB;
+
+(************************************************************************)
+
+PROCEDURE ROL (value: WORD;  count: CARDINAL): WORD;
+
+    (* Left rotation of "value" by "count" bit positions.	*)
+
+    BEGIN
+	count := count MOD 16;
+	RETURN WORD(ORD(LS(value, count)) + ORD(RS(value, 16-count)));
+    END ROL;
+
+(************************************************************************)
+
+PROCEDURE ROLB (value: BYTE;  count: CARDINAL): BYTE;
+
+    (* Left rotation of "value" by "count" bit positions.	*)
+
+    BEGIN
+	count := count MOD 8;
+	RETURN LowByte(ORD(LSB(value, count)) + ORD(RSB(value, 8-count)));
+    END ROLB;
+
+(************************************************************************)
+
+PROCEDURE LS (value: WORD;  count: CARDINAL): WORD;
+
+    (* Left shift of "value" by "count" bit positions, with zero fill.	*)
+
+    BEGIN
+	IF count > 15 THEN RETURN WORD(0)
+	ELSIF count = 0 THEN RETURN value
+	ELSE
+	    value := IAND (value, WORD(power2[16-count]-1));
+	    RETURN WORD(ORD(value) * power2[count]);
+	END (*IF*);
+    END LS;
+
+(************************************************************************)
+
+PROCEDURE LSB (value: BYTE;  count: CARDINAL): BYTE;
+
+    (* Left shift of "value" by "count" bit positions, with zero fill.	*)
+
+    BEGIN
+	RETURN LowByte (LS(MakeWord(LowByte(0),value), count));
+    END LSB;
+
+(************************************************************************)
+
+PROCEDURE ROR (value: WORD;  count: CARDINAL): WORD;
+
+    (* Right rotation of "value" by "count" bit positions.	*)
+
+    BEGIN
+	count := count MOD 16;
+	RETURN WORD(ORD(RS(value, count)) + ORD(LS(value, 16-count)));
+    END ROR;
+
+(************************************************************************)
+
+PROCEDURE RORB (value: BYTE;  count: CARDINAL): BYTE;
+
+    (* Right rotation of "value" by "count" bit positions.	*)
+
+    BEGIN
+	count := count MOD 8;
+	RETURN LowByte(ORD(RSB(value, count)) + ORD(LSB(value, 8-count)));
+    END RORB;
+
+(************************************************************************)
+
+PROCEDURE RS (value: WORD;  count: CARDINAL): WORD;
+
+    (* Right shift of "value" by "count" bit positions, with zero fill.	*)
+
+    BEGIN
+	(*<TopSpeed (*# save, check(overflow => off) *) >*)
+	IF count > 15 THEN RETURN WORD(0)
+	ELSE RETURN WORD(ORD(value) DIV power2[count]);
+	END (*IF*);
+	(*<TopSpeed (*# restore *) >*)
+    END RS;
+
+(************************************************************************)
+
+PROCEDURE RSB (value: BYTE;  count: CARDINAL): BYTE;
+
+    (* Right shift of "value" by "count" bit positions, with zero fill.	*)
+
+    BEGIN
+	RETURN LowByte (RS(ORD(value), count));
+    END RSB;
+
+(************************************************************************)
+(*			    POINTER OPERATIONS				*)
+(************************************************************************)
+
+PROCEDURE Far (A: ADDRESS): FarPointer;
+
+    (* Converts a pointer to a far pointer. *)
+
+    BEGIN
+	RETURN A;
+    END Far;
+
+(************************************************************************)
+
+PROCEDURE MakePointer (segment, offset: WORD): FarPointer;
+
+    (* Creates a pointer, given the segment and offset within segment.	*)
+
+    VAR value: Double;
+
+    BEGIN
+	value.low := offset;  value.high := segment;
+	RETURN value.a;
+    END MakePointer;
+
+(************************************************************************)
+
+PROCEDURE SEGMENT (A: ADDRESS): WORD;
+
+    (* Returns the segment part of an address.	*)
+
+    VAR value: Double;
+
+    BEGIN
+	value.a := A;
+	RETURN value.high;
+    END SEGMENT;
+
+(************************************************************************)
+
+PROCEDURE FarSEGMENT (A: FarPointer): WORD;
+
+    (* Returns the segment part of an address.	*)
+
+    VAR value: Double;
+
+    BEGIN
+	value.a := A;
+	RETURN value.high;
+    END FarSEGMENT;
+
+(************************************************************************)
+
+PROCEDURE OFFSET (A: ADDRESS): WORD;
+
+    (* Returns the offset part of an address.	*)
+
+    VAR value: Double;
+
+    BEGIN
+	value.a := A;
+	RETURN value.low;
+    END OFFSET;
+
+>*)
+
+(************************************************************************)
+
+PROCEDURE Virtual (PA: LONGCARD): FarPointer;
+
+    (* Converts a physical address to a virtual address, if possible.	*)
+    (* There are no guarantees in the case where there is no such	*)
+    (* virtual address.							*)
+
+    CONST Sixteen = (*<FST 16L >*)  (*<~FST*) 16 (*>*);
+
+    VAR value: Double;
+
+    BEGIN
+	value.low := LowWord(PA MOD Sixteen);
+	value.high := LowWord(PA DIV Sixteen);
+	RETURN value.a;
+    END Virtual;
+
+(************************************************************************)
+
+PROCEDURE Physical (A: ADDRESS): LONGCARD;
+
+    (* Converts a virtual address to a physical address.  Use with care!*)
+
+    VAR value: Double;
+
+    BEGIN
+	value.a := A;
+	(*<TopSpeed*)
+	RETURN 16*VAL(LONGCARD,value.high) + VAL(LONGCARD,value.low);
+	(*>*)
+	(*<FST
+	RETURN 16L*LONG(ORD(value.high)) + LONG(ORD(value.low));
+	>*)
+    END Physical;
+
+(************************************************************************)
+
+(*<~TopSpeed3
+
+PROCEDURE AddOffset (A: ADDRESS;  increment: CARDINAL): ADDRESS;
+
+    (* Returns a pointer to the memory location whose physical address	*)
+    (* is Physical(A)+increment.  In the present version, it is assumed	*)
+    (* that the caller will never try to run off the end of a segment.	*)
+
+    VAR value: Double;
+
+    BEGIN
+	(*<TopSpeed
+	value.a := A;  INC(value.low, increment);
+	RETURN value.a;
+	>*)
+	(*<FST RETURN A+increment; >*)
+    END AddOffset;
+
+(************************************************************************)
+
+PROCEDURE SubtractOffset (A: ADDRESS;  decrement: CARDINAL): ADDRESS;
+
+    (* Like AddOffset, except that we go backwards in memory.  Running	*)
+    (* off the beginning of the segment is an undetected error.		*)
+
+    VAR value: Double;
+
+    BEGIN
+	(*<TopSpeed
+	value.a := A;  DEC(value.low, decrement);
+	RETURN value.a;
+	>*)
+	(*<FST RETURN A-decrement; >*)
+    END SubtractOffset;
+
+(************************************************************************)
+
+PROCEDURE FarAddOffset (A: FarPointer;  increment: CARDINAL): FarPointer;
+
+    (* Like AddOffset, except for the parameter types. *)
+
+    VAR value: Double;
+
+    BEGIN
+	(*<TopSpeed
+	value.a := A;  INC(value.low, increment);
+	RETURN value.a;
+	>*)
+	(*<FST RETURN A+increment; >*)
+    END FarAddOffset;
+
+(************************************************************************)
+
+PROCEDURE FarSubtractOffset (A: FarPointer; decrement: CARDINAL): FarPointer;
+
+    (* Like SubtractOffset, except for the parameter types. *)
+
+    VAR value: Double;
+
+    BEGIN
+	(*<TopSpeed
+	value.a := A;  DEC(value.low, decrement);
+	RETURN value.a;
+	>*)
+	(*<FST RETURN A-decrement; >*)
+    END FarSubtractOffset;
+
+(************************************************************************)
+(*			BYTE/WORD/LONGCARD CONVERSIONS			*)
+(************************************************************************)
+
+PROCEDURE LowByte (w: WORD): BYTE;
+
+    (* Returns the low-order byte of its argument.	*)
+
+    VAR value: Word;
+
+    BEGIN
+	value.w := w;
+	RETURN value.low;
+    END LowByte;
+
+(************************************************************************)
+
+PROCEDURE HighByte (w: WORD): BYTE;
+
+    (* Returns the high-order byte of its argument.	*)
+
+    VAR value: Word;
+
+    BEGIN
+	value.w := w;
+	RETURN value.high;
+    END HighByte;
+
+(************************************************************************)
+
+PROCEDURE MakeWord (high, low: BYTE): WORD;
+
+    (* Combines two bytes into a word.  The first argument becomes the	*)
+    (* most significant byte of the result.				*)
+
+    VAR value: Word;
+
+    BEGIN
+	value.low := low;
+	value.high := high;
+	RETURN value.w;
+    END MakeWord;
+
+(************************************************************************)
+
+PROCEDURE SignExtend (val: BYTE): INTEGER;
+
+    (* Converts a signed 8-bit number to signed integer. *)
+
+    VAR result: INTEGER;
+
+    BEGIN
+	result := ORD(val);
+	IF result > 127 THEN
+	    DEC (result, 256);
+	END (*IF*);
+	RETURN result;
+    END SignExtend;
+
+(************************************************************************)
+
+PROCEDURE LowWord (w: LONGCARD): WORD;
+
+    (* Returns the low-order word of its argument.	*)
+
+    VAR value: Double;
+
+    BEGIN
+	value.lw := w;
+	RETURN value.low;
+    END LowWord;
+
+(************************************************************************)
+
+PROCEDURE HighWord (w: LONGCARD): WORD;
+
+    (* Returns the high-order word of its argument.	*)
+
+    VAR value: Double;
+
+    BEGIN
+	value.lw := w;
+	RETURN value.high;
+    END HighWord;
+
+(************************************************************************)
+
+PROCEDURE MakeLongword (high, low: WORD): LONGCARD;
+
+    (* Combines two words into a longword.  The first argument becomes	*)
+    (* the most significant word of the result.				*)
+
+    VAR value: Double;
+
+    BEGIN
+	value.low := low;
+	value.high := high;
+	RETURN value.lw;
+    END MakeLongword;
+
+(************************************************************************)
+(*			MISCELLANEOUS ARITHMETIC			*)
+(************************************************************************)
+
+PROCEDURE INCV (VAR (*INOUT*) dest: CARDINAL;  src: CARDINAL): BOOLEAN;
+
+    (* Computes dest := dest + src, and returns TRUE iff the addition	*)
+    (* produced a carry.						*)
+
+    BEGIN
+	IF dest > MAX(CARDINAL) - src THEN
+	    DEC (dest, MAX(CARDINAL) - src + 1);
+	    RETURN TRUE;
+	ELSE
+	    INC (dest, src);
+	    RETURN FALSE;
+	END (*IF*);
+    END INCV;
+
+(************************************************************************)
+
+PROCEDURE INCVB (VAR (*INOUT*) dest: BYTE;  src: BYTE): BOOLEAN;
+
+    (* Computes dest := dest + src, and returns TRUE iff the addition	*)
+    (* produced a carry.						*)
+
+    BEGIN
+	IF ORD(dest) > 255 - ORD(src) THEN
+	    dest := LowByte(ORD(dest) - (256 - ORD(src)));
+	    RETURN TRUE;
+	ELSE
+	    dest := LowByte(ORD(dest) + ORD(src));
+	    RETURN FALSE;
+	END (*IF*);
+    END INCVB;
+
+(************************************************************************)
+
+PROCEDURE DECV (VAR (*INOUT*) dest: CARDINAL;  src: CARDINAL): BOOLEAN;
+
+    (* Computes dest := dest - src, and returns TRUE iff the		*)
+    (* subtraction produced a borrow.					*)
+
+    BEGIN
+	IF dest < src THEN
+	    INC (dest, MAX(CARDINAL) - src + 1);  RETURN TRUE;
+	ELSE
+	    DEC (dest, src);  RETURN FALSE;
+	END (*IF*);
+    END DECV;
+
+(************************************************************************)
+
+PROCEDURE DECVB (VAR (*INOUT*) dest: BYTE;  src: BYTE): BOOLEAN;
+
+    (* Computes dest := dest - src, and returns TRUE iff the		*)
+    (* subtraction produced a borrow.					*)
+
+    BEGIN
+	IF dest < src THEN
+	    dest := LowByte(ORD(dest) + (256 - ORD(src)));  RETURN TRUE;
+	ELSE
+	    dest := LowByte(ORD(dest) - ORD(src));
+	    RETURN FALSE;
+	END (*IF*);
+    END DECVB;
+
+(************************************************************************)
+
+PROCEDURE Mul (A, B: CARDINAL): LONGCARD;
+
+    (* Same as A*B, except for the type of the result.  We provide this	*)
+    (* as a general-purpose function since this combination of operands	*)
+    (* is often precisely what is wanted.				*)
+
+    BEGIN
+	RETURN VAL(LONGCARD,A) * VAL(LONGCARD,B);
+    END Mul;
+
+(************************************************************************)
+
+PROCEDURE MulB (A, B: BYTE): CARDINAL;
+
+    (* Same as A*B, except for the type of the result.  We provide this	*)
+    (* as a general-purpose function since this combination of operands	*)
+    (* is often precisely what is wanted.				*)
+
+    BEGIN
+	RETURN ORD(MakeWord(LowByte(0),A)) * ORD(MakeWord(LowByte(0),B));
+    END MulB;
+
+(************************************************************************)
+
+PROCEDURE IMul (A, B: INTEGER): LONGINT;
+
+    (* Like Mul, but signed. *)
+
+    BEGIN
+	RETURN VAL(LONGINT,A) * VAL(LONGINT,B);
+    END IMul;
+
+(************************************************************************)
+
+PROCEDURE IMulB (A, B: BYTE): INTEGER;
+
+    (* Like MulB, but signed. *)
+
+    BEGIN
+	RETURN SignExtend(A) * SignExtend(B);
+    END IMulB;
+
+(************************************************************************)
+
+PROCEDURE DivB (A: CARDINAL;  B: BYTE): BYTE;
+
+    (* Same as A DIV B, except for the type of A.  We provide this as	*)
+    (* a general-purpose function since this combination of operands	*)
+    (* is often precisely what is wanted.				*)
+
+    BEGIN
+	RETURN LowByte(A DIV ORD(MakeWord(LowByte(0),B)));
+    END DivB;
+
+(************************************************************************)
+
+PROCEDURE Div (A: LONGCARD;  B: CARDINAL): CARDINAL;
+
+    (* Same as A DIV B, except for the type of A.  We provide this as	*)
+    (* a general-purpose function since this combination of operands	*)
+    (* is often precisely what is wanted.				*)
+
+    BEGIN
+	RETURN VAL(CARDINAL, A DIV VAL(LONGCARD,B));
+    END Div;
+
+(************************************************************************)
+(*			     BLOCK MOVES				*)
+(************************************************************************)
+
+PROCEDURE Copy (source, destination: ADDRESS;  bytecount: CARDINAL);
+
+    (* Copies an array of bytes from the source address to the		*)
+    (* destination address.  In the case where the two arrays overlap,	*)
+    (* the destination address should be lower in physical memory than	*)
+    (* the source address.						*)
+
+    BEGIN
+	(*<TopSpeed Lib.Move (source, destination, bytecount); >*)
+	(*<FST System.Move (source, destination, bytecount); >*)
+    END Copy;
+
+(************************************************************************)
+
+PROCEDURE FarCopy (source, destination: FarPointer;  bytecount: CARDINAL);
+
+    (* Copies an array of bytes from the source address to the		*)
+    (* destination address.  In the case where the two arrays overlap,	*)
+    (* the destination address should be lower in physical memory than	*)
+    (* the source address.						*)
+
+    BEGIN
+	(*<TopSpeed Lib.Move (source, destination, bytecount); >*)
+	(*<FST System.Move (source, destination, bytecount); >*)
+    END FarCopy;
+
+>*)
+
+(************************************************************************)
+
+PROCEDURE CopyUp (source, destination: FarPointer;  bytecount: CARDINAL);
+
+    (* A variant of Copy which does the move backwards, in order	*)
+    (* to handle the case where the destination address is inside the	*)
+    (* source array.  In this special case Copy cannot be used,		*)
+    (* because it would overwrite data it was about to copy.		*)
+
+    BEGIN
+	(*<TopSpeed*) Lib.Move (source, destination, bytecount); (*>*)
+	(*<FST System.Move (source, destination, bytecount); >*)
+    END CopyUp;
+
+(************************************************************************)
+
+(*<~TopSpeed3
+
+PROCEDURE BlockFill (destination: FarPointer;
+				bytecount: CARDINAL;  value: BYTE);
+
+    (* Fills the destination array with the given value.	*)
+
+    (*<FST VAR p: POINTER TO BYTE;  j: CARDINAL; >*)
+
+    BEGIN
+	(*<TopSpeed Lib.Fill (destination, bytecount, value); >*)
+	(*<FST
+	p := destination;
+	FOR j := 1 TO bytecount DO
+	    p^ := value;  p := AddOffset(p,1);
+	END (*FOR*);
+	>*)
+    END BlockFill;
+
+(************************************************************************)
+
+PROCEDURE BlockFillWord (destination: FarPointer;  wordcount: CARDINAL;
+							value: WORD);
+
+    (* Fills the destination array with the given value.	*)
+
+    (*<FST VAR p: POINTER TO WORD;  j: CARDINAL; >*)
+
+    BEGIN
+	(*<TopSpeed Lib.WordFill (destination, wordcount, value); >*)
+	(*<FST
+	p := destination;
+	FOR j := 1 TO wordcount DO
+	    p^ := value;  p := AddOffset(p, 2);
+	END (*FOR*);
+	>*)
+    END BlockFillWord;
+
+(************************************************************************)
+(*			    INPUT AND OUTPUT				*)
+(************************************************************************)
+
+PROCEDURE OutByte (port: CARDINAL; value: BYTE);
+
+    (* Puts the value out to an output port.	*)
+
+    BEGIN
+	(*<TopSpeed SYSTEM.Out (port, value); >*)
+	(*<FST
+	ASM
+	    MOV DX, port
+	    MOV AL, value
+	    OUT DX, AL
+	END (*ASM*);
+	>*)
+    END OutByte;
+
+(************************************************************************)
+
+PROCEDURE InByte (port: CARDINAL): BYTE;
+
+    (* Reads a byte from an input port.	*)
+
+    (*<FST VAR result: BYTE; >*)
+
+    BEGIN
+	(*<TopSpeed RETURN SYSTEM.In (port); >*)
+	(*<FST
+	ASM
+	    MOV DX, port
+	    IN AL, DX
+	    MOV result, AL
+	END (*ASM*);
+	RETURN result;
+	>*)
+    END InByte;
+
+>*)
+
+(************************************************************************)
+
+PROCEDURE InStringWord (port: CARDINAL;  BufferAddress: ADDRESS;
+						count: CARDINAL);
+
+    (* Reads count words from an input port.	*)
+
+    VAR j: CARDINAL;  p: POINTER TO WORD;
+	lobyte, hibyte: BYTE;
+
+    BEGIN
+	(*<FST
+	ASM
+	    PUSHF
+	    CLI
+	    CLD
+	    MOV CX, count
+	    LES DI, BufferAddress
+	    MOV DX, port
+	    (*REP INSW*)
+	    POPF
+	END (*ASM*);
+	>*)
+
+	(*<TopSpeed1
+	MiscLib.InStringWord (port, BufferAddress, count);
+	>*)
+
+	(*<TopSpeed3*)
+	p := BufferAddress;
+	FOR j := 1 TO count DO
+	    p^ := SYSTEM.InW (port);
+	    Lib.IncAddr (p, 2);
+	END (*FOR*);
+	(*>*)
+    END InStringWord;
+
+(************************************************************************)
+
+PROCEDURE OutStringWord (port: CARDINAL;  BufferAddress: ADDRESS;
+						count: CARDINAL);
+
+    (* Writes count words to an output port.	*)
+
+    VAR j: CARDINAL;  p: POINTER TO WORD;
+
+    BEGIN
+	(*<FST
+	ASM
+	    PUSHF
+	    CLI
+	    CLD
+	    MOV CX, count
+	    LDS SI, BufferAddress
+	    MOV DX, port
+	    (*REP OUTSW*)
+	    POPF
+	END (*ASM*);
+	>*)
+
+	(*<TopSpeed1
+	MiscLib.OutStringWord (port, BufferAddress, count);
+	>*)
+
+	(*<TopSpeed3*)
+	p := BufferAddress;
+	FOR j := 1 TO count DO
+	    SYSTEM.OutW (port, p^);
+	    Lib.IncAddr (p, 2);
+	END (*FOR*);
+	(*>*)
+    END OutStringWord;
+
+(************************************************************************)
+
+(*<FST
+BEGIN
+    power2[0]  := 1;
+    power2[1]  := 2;
+    power2[2]  := 4;
+    power2[3]  := 8;
+    power2[4]  := 16;
+    power2[5]  := 32;
+    power2[6]  := 64;
+    power2[7]  := 128;
+    power2[8]  := 256;
+    power2[9]  := 512;
+    power2[10] := 1024;
+    power2[11] := 2048;
+    power2[12] := 4096;
+    power2[13] := 8192;
+    power2[14] := 16384;
+    power2[15] := 32768;
+>*)
+END LowLevel.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/special/play3s.mod b/examples/Modula-2_Libraries/PMOS/sources/special/play3s.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/special/play3s.mod
@@ -0,0 +1,317 @@
+IMPLEMENTATION MODULE Play3S;
+
+	(********************************************************)
+	(*							*)
+	(*		    3-part music			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	Needs to be customised for the processor	*)
+	(*	model and speed.  See the comments on		*)
+	(*	"Tuning parameters" below.			*)
+	(*							*)
+	(*	Note: won't work satisfactorily under OS/2.	*)
+	(*							*)
+	(********************************************************)
+
+FROM Keyboard IMPORT
+    (* proc *)	KeyPressed;
+
+FROM MiscPMOS IMPORT
+    (* proc *)	EnterCriticalSection, LeaveCriticalSection;
+
+FROM LowLevel IMPORT
+    (* proc *)	HighByte, MakeWord, OutByte;
+
+FROM MATHLIB IMPORT
+    (* proc *)	Sin;
+
+(************************************************************************)
+(*			     TUNING PARAMETERS				*)
+(*									*)
+(*	The constant "LowestInterval" may need to be adjusted to	*)
+(*	suit your processor speed.  It controls the frequency of the	*)
+(*	lowest note played.  Adjust it upwards if all notes sound	*)
+(*	too low, or downwards if all notes sound too high.  Note that	*)
+(*	making it too high will make the very highest notes		*)
+(*	unplayable because of aliasing effects.  On no account should	*)
+(*	this constant be set greater than 900.				*)
+(*									*)
+(*	The constant TimeScale controls the note durations.  It also	*)
+(*	needs to be adjusted to compensate for processor speed.		*)
+(*									*)
+(*	The values I've found that sound about right are:		*)
+(*									*)
+(*				LowestInterval		TimeScale	*)
+(*		33MHz 486:	   60.0			   60		*)
+(*		DX2/50:		   60.0 (?)		  110		*)
+(*									*)
+(*	These are rough values only.  I've made no attempt to tune to	*)
+(*	any sort of absolute reference.  Note that the "best" value	*)
+(*	for LowestInterval depends not only on processor speed but	*)
+(*	also on what sort of speaker is installed on the machine.	*)
+(*	A certain amount of tweaking is needed simply because the	*)
+(*	speaker was not really designed for playing music.		*)
+(*									*)
+(************************************************************************)
+
+CONST
+    LowestInterval = 60.0;
+    TimeScale = 110;
+
+TYPE Note = SHORTCARD [0..63];
+
+(************************************************************************)
+(*				GLOBAL DATA				*)
+(************************************************************************)
+
+VAR
+    (* NoteToIntervalMap takes a note code and translates it to the	*)
+    (* step amount to be used in stepping through a WaveForm array.	*)
+
+    NoteToIntervalMap: ARRAY Note OF CARDINAL;
+
+    (* CurrentDuration says how long to play each note. *)
+
+    CurrentDuration: CARDINAL;
+
+    (* Table defining one period of the waveform to be played. *)
+
+    Wave: ARRAY SHORTCARD OF SHORTCARD;
+
+    (* The following three variables are subscripts into the waveform	*)
+    (* table.  To be more precise, the high-order byte is used as a	*)
+    (* subscript, with the low-order byte acting as a non-integer	*)
+    (* part of the subscript.						*)
+
+    Pointer1, Pointer2, Pointer3: CARDINAL;
+
+(************************************************************************)
+(*			SOME TECHNICAL DETAILS				*)
+(*									*)
+(* The speaker is controlled by the two low-order bits of port 97.	*)
+(* Bit 0 enables the timer output to the speaker, and bit 1 turns the	*)
+(* speaker on.  This module does not use the timer, because all that	*)
+(* can do is create fixed-frequency square waves, and we want more	*)
+(* flexible waveform control.  What we do instead is control the	*)
+(* speaker by direct manipulation of bit 1.  By using pulse-width	*)
+(* modulation techniques, we achieve the equivalent of 3-bit analogue	*)
+(* output.  (The choice of 3 bits is the result of a compromise.  More	*)
+(* bits give better resolution, but reduce the sampling rate to the	*)
+(* point where spurious high-frequency components in the signal become	*)
+(* too obvious.  I've tried this with 4 bits, and my subjective		*)
+(* judgment is that the result is not quite as good as with 3 bits.)	*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE Play3Notes (note1, note2, note3: SHORTCARD);
+
+    (* Plays the three notes simultaneously. *)
+
+    CONST off = 0CH;  on = off + 2;
+
+    VAR savedPSW, interval1, interval2, interval3: CARDINAL;
+	time, t2: CARDINAL;  level: SHORTCARD;
+
+    BEGIN
+	interval1 := NoteToIntervalMap[note1];
+	interval2 := NoteToIntervalMap[note2];
+	interval3 := NoteToIntervalMap[note3];
+
+	savedPSW := EnterCriticalSection();
+
+	FOR t2 := 0 TO TimeScale DO
+	    FOR time := 0 TO CurrentDuration DO
+
+		(* In the following incrementations, integer overflow	*)
+		(* is not an error - we want the pointers to wrap.	*)
+
+		(*# save, check(overflow => off) *)
+		INC (Pointer1, interval1);
+		INC (Pointer2, interval2);
+		INC (Pointer3, interval3);
+		(*# restore *)
+
+		level := Wave[HighByte(Pointer1)] + Wave[HighByte(Pointer2)]
+				+ Wave[HighByte(Pointer3)];
+
+		(* Now for the tricky part.  What we would like to do	*)
+		(* is to put out this 8-bit level to the speaker; but	*)
+		(* the speaker accepts only a 1-bit output, so we have	*)
+		(* to compromise.  In the present version, we put out a	*)
+		(* PWM signal whose average is based on the high-order	*)
+		(* three bits of the level.  If we do this in assembly	*)
+		(* language we can go to four or five significant bits,	*)
+		(* but my experience has been that the assembly		*)
+		(* language version does not sound any better.		*)
+
+		CASE level DIV 32 OF
+		|  0:	OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+		|  1:	OutByte (97, on);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+		|  2:	OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+		|  3:	OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+		|  4:	OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+		|  5:	OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, off);
+			OutByte (97, off);
+			OutByte (97, off);
+		|  6:	OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, off);
+			OutByte (97, off);
+		|  7:	OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, on);
+			OutByte (97, off);
+		END (*CASE*);
+
+	    END (*FOR*);
+	END (*FOR*);
+
+	LeaveCriticalSection (savedPSW);
+
+    END Play3Notes;
+
+(************************************************************************)
+
+PROCEDURE Play (VAR (*IN*) A: ARRAY OF BYTE);
+
+    (* Plays the music encoded in array A.  The encoding is explained	*)
+    (* in the comments in the definition module.			*)
+
+    VAR j: CARDINAL;  datum: SHORTCARD;
+
+    BEGIN
+	j := 0;
+	LOOP
+	    IF (j > HIGH(A)) OR KeyPressed() THEN EXIT(*LOOP*) END(*IF*);
+	    datum := A[j];  INC(j);
+	    IF datum < 64 THEN
+		Play3Notes (datum, A[j], A[j+1]);
+		INC (j, 2);
+	    ELSE
+		CASE datum OF
+		  |  253:	(* change duration relative *)
+			CurrentDuration := CurrentDuration*CARDINAL(A[j])
+						DIV CARDINAL(A[j+1]);
+			INC (j, 2);
+		  |  254:	(* change duration absolute *)
+			CurrentDuration := MakeWord (A[j+1], A[j]);
+			INC (j, 2);
+		  |  255:	(* end of music *)
+			EXIT (*LOOP*);
+		  |  ELSE
+			INC (j, 2);
+
+		END (*CASE*);
+	    END (*IF*);
+	END (*LOOP*);
+
+	(* Turn off the speaker.	*)
+
+	OutByte (97, 0CH);
+
+    END Play;
+
+(************************************************************************)
+(*				INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE SetupArrays;
+
+    (* Initialises the global data. *)
+
+    CONST PI = 3.141592653589793240;
+	  freqstep = 1.057298094605;	(* 2^(1/12) *)
+
+    VAR step: LONGREAL;
+	j: SHORTCARD;  note: Note;
+
+    BEGIN
+	(* Create the note-to-interval map. *)
+
+	step := LowestInterval;
+	NoteToIntervalMap[0] := 0;
+	FOR note := 1 TO MAX(Note) DO
+	    NoteToIntervalMap[note] := VAL(CARDINAL, step);
+	    step := step*freqstep;
+	END (*FOR*);
+
+	(* Create the waveform array. *)
+
+	(* Use this code if a sine wave is desired. *)
+(*
+	FOR j := 0 TO 255 DO
+	    Wave[j] := VAL(SHORTCARD,
+			42.0*(1.0 + Sin(VAL(LONGREAL,j)*PI/128.0)));
+	END (*FOR*);
+*)
+	(* Alternative: use this to get a square wave. *)
+
+	FOR j := 0 TO 127 DO
+	    Wave[j] := 85;
+	END (*FOR*);
+
+	FOR j := 128 TO 255 DO
+	    Wave[j] := 0;
+	END (*FOR*);
+
+    END SetupArrays;
+
+(************************************************************************)
+
+BEGIN
+    CurrentDuration := 100;
+    Pointer1 := 0;  Pointer2 := 0;  Pointer3 := 0;
+    SetupArrays;
+END Play3S.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/DEMO1.MOD b/examples/Modula-2_Libraries/PMOS/sources/tests/DEMO1.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/DEMO1.MOD
@@ -0,0 +1,10 @@
+MODULE Demo1;
+
+FROM Demo2 IMPORT P;
+
+VAR y: CARDINAL;
+
+BEGIN
+    y := P(3);
+END Demo1.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/DEMO2.MOD b/examples/Modula-2_Libraries/PMOS/sources/tests/DEMO2.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/DEMO2.MOD
@@ -0,0 +1,19 @@
+IMPLEMENTATION MODULE Demo2;
+
+FROM Semaphores IMPORT
+    (* type *)  Semaphore,
+    (* proc *)  CreateSemaphore;
+
+VAR x: CARDINAL;
+    S: Semaphore;
+
+PROCEDURE P(v: CARDINAL): CARDINAL;
+    BEGIN
+        RETURN v+1;
+    END P;
+
+BEGIN
+    x := 0;
+    CreateSemaphore (S, 1);
+END Demo2.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/TEST1.MOD b/examples/Modula-2_Libraries/PMOS/sources/tests/TEST1.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/TEST1.MOD
@@ -0,0 +1,6 @@
+MODULE test1;
+
+IMPORT demo;
+
+END test1.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/TESTABC.MOD b/examples/Modula-2_Libraries/PMOS/sources/tests/TESTABC.MOD
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/TESTABC.MOD
@@ -0,0 +1,14 @@
+MODULE TestABC;
+
+FROM IO IMPORT
+    (* proc *)  WrStr, WrLn;
+
+VAR x: CARDINAL;
+
+BEGIN
+    x := 1;
+    WrStr ("Hello");
+    WrLn;
+    INC (x);
+END TestABC.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/booltest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/booltest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/booltest.mod
@@ -0,0 +1,16 @@
+MODULE BoolTest;
+
+(* This test shows that TRUE=1, FALSE=0. *)
+(* (By examination of the compiled code). *)
+(* In tests, TRUE=nonzero *)
+
+VAR x: BOOLEAN;
+
+BEGIN
+    x := TRUE;
+    x := FALSE;
+    IF x THEN
+	x := NOT x;
+    END (*IF*)
+END BoolTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/copyfile.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/copyfile.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/copyfile.mod
@@ -0,0 +1,169 @@
+MODULE CopyFile;
+
+	(****************************************************************)
+	(*								*)
+	(*		Program to copy a file and list it.		*)
+	(*								*)
+	(*	This is a test program, whose only function is to help	*)
+	(*	in defining and testing the Files module.		*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	4 March 1995				*)
+	(*  Status:		Working					*)
+	(*								*)
+	(*	There is however a persistent problem caused by the	*)
+	(*	directory cacheing done by MS-DOS: after a file is	*)
+	(*	created on the hard disk by the PMOS file system,	*)
+	(*	MS-DOS will remain ignorant of its existence, and may	*)
+	(*	even corrupt the disk structure by continuing to rely	*)
+	(*	on its obsolete copies of the directory and FAT.	*)
+	(*	For a floppy this problem is solved by typing ^C to	*)
+	(*	the DOS command prompt, but for hard disk files the	*)
+	(*	only solutions I've found are either to run Windows	*)
+	(*	or to re-boot the machine immediately after running	*)
+	(*	the PMOS program.					*)
+	(*								*)
+	(****************************************************************)
+
+FROM Trace IMPORT
+    (* proc *)	TraceOn, InTrace, OutTrace;
+
+FROM Files IMPORT
+    (* type *)	File,
+    (* proc *)	OpenFile, CloseFile, EOF, ReadByte, WriteByte;
+
+FROM IOErrorCodes IMPORT
+    (* type *)	ErrorCode,
+    (* proc *)	TranslateErrorCode;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType, RowRange, ColumnRange,
+    (* proc *)	OpenWindow, CloseWindow, ChangeScrollingRegion,
+		WriteString, EditString, WriteLn, Write,
+		SaveCursor, SetCursor, ReadCharWithoutEcho, PressAnyKey;
+
+FROM NumericIO IMPORT
+    (* proc *)	WriteCard;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey, PutBack;
+
+IMPORT Floppy;
+
+(*IMPORT HardDisk;*)
+
+(************************************************************************)
+
+PROCEDURE CopyAndList (w: Window;  source, destination: File);
+
+    (* Copies file "source" to new file "destination", also writing the	*)
+    (* contents to window w.						*)
+
+    CONST CR = CHR(13);
+
+    VAR ch: CHAR;  linecount: CARDINAL;  status: ErrorCode;
+	errbuf: ARRAY [0..39] OF CHAR;
+
+    BEGIN
+	InTrace ("CopyAndList");
+	linecount := 0;  status := OK;
+	WHILE (status = OK) AND NOT EOF(source) DO
+	    ch := ReadByte (source);
+	    status := WriteByte (destination, ch);
+	    IF status <> OK THEN
+		WriteLn (w);
+		WriteString (w, ">>>ERROR: Write failure.  Status = ");
+		TranslateErrorCode (status, errbuf);
+		WriteString (w, errbuf);
+		WriteLn (w);
+	    ELSIF ch = CR THEN
+		WriteLn(w);
+		INC (linecount);
+		IF linecount = 22 THEN
+		    WriteString (w, "                     -- More --");
+		    ReadCharWithoutEcho (w, ch);
+		    WriteLn (w);
+		    linecount := 0;
+		END (*IF*);
+	    ELSE Write (w, ch)
+	    END (*IF*);
+	END (*WHILE*);
+	WriteString (w, "----------------- End of File -----------------");
+	ReadCharWithoutEcho (w, ch);
+	OutTrace ("CopyAndList");
+    END CopyAndList;
+
+(************************************************************************)
+
+PROCEDURE OpenAFile (w: Window;  VAR (*OUT*) f: File;  newfile: BOOLEAN)
+								: BOOLEAN;
+
+    (* Prompts for a file name from the keyboard, opens that file for	*)
+    (* input.  Returns TRUE if successful.				*)
+
+    CONST CR = CHR(13);  Esc = CHR(27);
+
+    VAR FileName: ARRAY [0..79] OF CHAR;
+	ch: CHAR;  status: ErrorCode;
+	oldrow, oldcol: CARDINAL;
+	errbuf: ARRAY [0..39] OF CHAR;
+
+    BEGIN
+	InTrace ("OpenAFile");
+	SaveCursor (w, oldrow, oldcol);
+	FileName := "";
+	LOOP
+	    SetCursor (w, oldrow, oldcol);
+	    WriteString (w, "file: ");
+	    EditString (w, FileName, 79);
+	    ch := InKey();
+	    IF ch = Esc THEN RETURN FALSE;
+	    ELSIF ch <> CR THEN PutBack(ch);
+	    END (*IF*);
+	    status := OpenFile (f, FileName, newfile);
+	    IF status = OK THEN
+		RETURN TRUE;
+	    END (*IF*);
+	    SetCursor (w, oldrow+1, oldcol);
+	    TranslateErrorCode (status, errbuf);
+	    WriteString (w, errbuf);
+	END (*LOOP*);
+	OutTrace ("OpenAFile");
+    END OpenAFile;
+
+(************************************************************************)
+
+PROCEDURE RunTheTest;
+
+    VAR w: Window;  source, destination: File;
+
+    BEGIN
+	InTrace ("RunTheTest");
+	OpenWindow (w, green, brown, 0, 24, 0, 79, noframe, doubledivider);
+	WriteString (w, "Copy from ");
+	IF OpenAFile (w, source, FALSE) THEN
+	    WriteLn (w);
+	    WriteString (w, " to ");
+	    IF OpenAFile (w, destination, TRUE) THEN
+		WriteLn (w);
+		ChangeScrollingRegion (w, 2, 24);
+		CopyAndList (w, source, destination);
+		PressAnyKey (w);
+		CloseFile (destination);
+	    END (*IF*);
+	    CloseFile (source);
+	END (*IF*);
+	PressAnyKey (w);
+	CloseWindow (w);
+	OutTrace ("RunTheTest");
+    END RunTheTest;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+(*    TraceOn (18,24,0,39); *)
+    RunTheTest;
+END CopyFile.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/delaytes.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/delaytes.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/delaytes.mod
@@ -0,0 +1,142 @@
+MODULE DelayTest;
+
+	(********************************************************)
+	(*							*)
+	(*	Test of how well we can read back the count	*)
+	(*	of the timer that normally drives the speaker.	*)
+	(*							*)
+	(*	This program doesn't produce any output, I	*)
+	(*	rely on the debugger to look at the results.	*)
+	(*							*)
+	(*	Programmer:	P. Moylan			*)
+	(*	Last edited:	5 March 1995			*)
+	(*	Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* proc *)	BYTE, ADR;
+
+FROM LowLevel IMPORT
+    (* proc *)	InByte, OutByte, LowByte, HighByte, MakeWord, IANDB, IORB;
+
+(************************************************************************)
+
+VAR
+    Sample: ARRAY [0..1000] OF BYTE;
+
+(************************************************************************)
+
+PROCEDURE SpeakerOff;
+
+    (* Turns off both the timer gate and the speaker.	*)
+
+    BEGIN
+	OutByte (97, IANDB(InByte (97), 0FCH));
+    END SpeakerOff;
+
+(************************************************************************)
+
+PROCEDURE SpeakerOn;
+
+    (* Turns on the speaker and enables the timer gate.	*)
+
+    BEGIN
+	OutByte (97, IORB(InByte (97), 3));
+    END SpeakerOn;
+
+(************************************************************************)
+
+PROCEDURE EnableTimerGate;
+
+    (* Enables the timer gate without turning on the speaker.	*)
+
+    BEGIN
+	OutByte (97, IORB(IANDB(InByte (97), 0FCH), 1));
+    END EnableTimerGate;
+
+(************************************************************************)
+
+PROCEDURE RunTheTest;
+
+    CONST TimerControlPort = 67;  channel2 = 66;
+
+    VAR j: CARDINAL;  CycleCount: BYTE;
+
+    BEGIN
+	CycleCount := 64;
+
+	(*SpeakerOn;*)	(* As a check that the count's not too high	*)
+	EnableTimerGate;
+
+	(* The control byte sent to the timer control port specifies:	*)
+	(* timer #2, one count bytes to follow, and mode 2.  CycleCount	*)
+	(* specifies the frequency, via the formula			*)
+	(* freq = 1193180/CycleCount.  This gives a frequency range of	*)
+	(* 18.2 Hz (count=65535) to 1.193 MHz.				*)
+	(* The bit assignments in the control byte are as follows:	*)
+	(*	7-6	timer # (0, 1, or 2) (3 is for readback)	*)
+	(*	5-4	00=different command, 01=low count byte to	*)
+	(*		follow, 10=high count byte to follow, 11=two	*)
+	(*		count bytes to follow (low order first)		*)
+	(*	3-1	mode						*)
+	(*	0	0=binary, 1=BCD					*)
+	(* The results for different modes are:				*)
+	(*	0,1	counts down to 0, then continues counting	*)
+	(*		down from 65535					*)
+	(*	2	counts down to 0, then restarts cycle with	*)
+	(*		original count.					*)
+	(*	3	(square wave) counts down to zero by twos,	*)
+	(*		flips output and counts down to zero again,	*)
+	(*		then restarts the cycle with original count.	*)
+	(*	4	much the same as mode 1.  The difference is	*)
+	(*		in hardware triggering, but for our present	*)
+	(*		purposes that difference is irrelevant.		*)
+	(*	5	counts down from some random number, ignores	*)
+	(*		initial count.  I guess this is waiting for	*)
+	(*		an external trigger.				*)
+	(*	6	same as mode 2.					*)
+	(*	7	same as mode 3.					*)
+
+	OutByte (TimerControlPort, 094H);
+	OutByte (channel2, CycleCount);
+
+	(* Now read back the count, as fast as we can go. *)
+
+	FOR j := 0 TO HIGH(Sample) DO
+
+	    (* The "counter latch" command, to take a copy of the	*)
+	    (* current count in timer #2, would be an 80H sent to the	*)
+	    (* control port.  Since the count is always a one-byte	*)
+	    (* quantity in our tests, we can save some time by skipping	*)
+	    (* the "latch" step.					*)
+
+	    (*OutByte (TimerControlPort, 80H);*)
+	    Sample[j] := InByte (channel2);
+
+	END (*FOR*);
+
+	(* Result of test (obtained by looking with VID): on my DX/2	*)
+	(* and using mode 3, each sample differed by 14, i.e. the	*)
+	(* count changed by 14 in the time it took to get around the	*)
+	(* loop.  The jitter was about plus or minus 2.			*)
+	(* Removing run-time checks had negligible effect.		*)
+	(* Going to mode 2, using a one-byte counter, and setting all	*)
+	(* options to "fastest possible" got me to the point where	*)
+	(* the decrement was usually 2 and sometimes 3.  I don't think	*)
+	(* I can go any faster except by going to assembly language	*)
+	(* - and even then it won't be very much faster.		*)
+	(* Somewhat surprisingly, turning turbo mode off doesn't seem	*)
+	(* to affect the results very much - I don't understand this.	*)
+
+    END RunTheTest;
+
+(************************************************************************)
+(*			MODULE INITIALISATION				*)
+(************************************************************************)
+
+BEGIN
+    RunTheTest;
+    SpeakerOff;
+END DelayTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/diskpatc.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/diskpatc.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/diskpatc.mod
@@ -0,0 +1,477 @@
+MODULE DiskPatch;
+
+	(********************************************************)
+	(*							*)
+	(*		Low-level disk utility.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	5 March 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	Ultimately, this could become a utility for	*)
+	(*	checking and patching the contents of floppy	*)
+	(*	OR hard disks.  For now, it is just a test	*)
+	(*	of the device drivers.				*)
+	(*							*)
+	(*	Getting inconsistent results towards the end	*)
+	(*	of the hard disk: sector sometimes found, and	*)
+	(*	sometimes not.  However, this is in an area	*)
+	(*	which is officially beyond the disk capacity.	*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE,
+    (* proc *)	ADR;
+
+FROM Trace IMPORT
+    (* proc *)	TraceOn, NYI, Pause, InTrace, OutTrace;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey, PutBack;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, ChangeScrollingRegion, CloseWindow,
+		WriteString, WriteChar, WriteLn, ScrollUp, ScrollDown,
+		ColourSwap, SetCursor, EditString;
+
+FROM NumericIO IMPORT
+    (* proc *)	ReadCard, WriteCard, WriteHexByte, WriteHexWord,
+		WriteHexLongword, EditHexLongword;
+
+FROM Devices IMPORT
+    (* type *)	Device, BlockNumberType,
+    (* proc *)	IdentifyDevice, ReadPhysicalBlock;
+
+FROM IOErrorCodes IMPORT
+    (* type *)	ErrorCode,
+    (* proc *)	TranslateErrorCode;
+
+(*IMPORT HardDisk;*)
+
+IMPORT Floppy;
+
+(************************************************************************)
+
+CONST Esc = CHR(27);
+
+CONST
+    (* MaxRow is the ending row number of the data area of the screen	*)
+    (* window.								*)
+
+    MaxRow = 18;
+
+TYPE BufferSubscript = [0..511];
+
+(************************************************************************)
+(*									*)
+(*  Essentially the whole of this module consists of procedures to	*)
+(*  manipulate the data in a single block buffer, and to display it in	*)
+(*  a fixed screen window.  Therefore, we might as well make this	*)
+(*  information global to the module.					*)
+(*									*)
+(************************************************************************)
+
+VAR
+
+    (*  The fields in Display are:					*)
+    (*		window:	the screen window.				*)
+    (*		row, column: the current screen coordinates.		*)
+    (*		ExtraAtTop: the number of rows which have scrolled off	*)
+    (*			the top of the screen.				*)
+    (*		ExtraAtBottom: the number of rows which failed to fit	*)
+    (*			at the bottom of the screen.			*)
+
+    Display: RECORD
+		window: Window;
+		row: [0..MaxRow];
+		column: [0..15];
+		ExtraAtTop, ExtraAtBottom: CARDINAL;
+	     END (*RECORD*);
+
+    (*  The record called "CurrentBlock" has fields:			*)
+    (*		ByteNumber: the number of the byte within the block	*)
+    (*		data:	actual data for the disk block on which we are	*)
+    (*			currently operating.				*)
+
+    CurrentBlock:   RECORD
+			ByteNumber: BufferSubscript;
+			data: ARRAY BufferSubscript OF BYTE;
+		    END (*RECORD*);
+
+(************************************************************************)
+(*			BASIC DISPLAY OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE Highlight;
+
+    (* Highlights the currently selected byte on the display.	*)
+
+    BEGIN
+	InTrace ("Highlight");
+	WITH Display DO
+	    ColourSwap (window, row+3, 3*column+8, 2);
+	    ColourSwap (window, row+3, column+60, 1);
+	    SetCursor (window, 1, 37);
+	    WriteHexWord (window, CurrentBlock.ByteNumber);
+	END (*WITH*);
+	OutTrace ("Highlight");
+    END Highlight;
+
+(************************************************************************)
+
+PROCEDURE Unhighlight;
+
+    (* Removes the highlighting of the currently selected byte.	*)
+
+    BEGIN
+	InTrace ("Unhighlight");
+	Highlight;
+	OutTrace ("Unhighlight");
+    END Unhighlight;
+
+(************************************************************************)
+
+PROCEDURE DisplayRow (j: CARDINAL);
+
+    (* Displays row j of the Buffer.  (One row is 16 bytes).	*)
+
+    VAR k: [0..15];
+	Base: CARDINAL;
+
+    BEGIN
+	SetCursor (Display.window, j+3, 1);
+	Base := 16*(j+Display.ExtraAtTop);
+
+	(* Write the address of the first byte in the row.	*)
+
+	WriteHexWord (Display.window, Base);  WriteString (Display.window, ":  ");
+
+	(* Write 16 bytes in hexadecimal.	*)
+
+	FOR k := 0 TO 15 DO
+	    WriteHexByte (Display.window, CurrentBlock.data[Base+k]);
+	    WriteChar (Display.window, " ");
+	END (*FOR*);
+	WriteString (Display.window, "    ");
+
+	(* Now the same information in character form.	*)
+
+	FOR k := 0 TO 15 DO
+	    WriteChar (Display.window, CHR (CurrentBlock.data[Base+k]));
+	END (*FOR*);
+    END DisplayRow;
+
+(************************************************************************)
+
+PROCEDURE InitialDisplay;
+
+    (* Displays the beginning of the buffer (a display of the whole	*)
+    (* buffer would not fit onto the screen.				*)
+
+    VAR j: [0..MaxRow-2];
+
+    BEGIN
+	InTrace ("InitialDisplay");
+	WITH Display DO
+	    row := 0;  column := 0;  ExtraAtTop := 0;
+	    ExtraAtBottom := MAX(BufferSubscript) DIV 16 - MaxRow + 2;
+	END (*WITH*);
+	CurrentBlock.ByteNumber := 0;
+	FOR j := 0 TO MaxRow-2 DO
+	    DisplayRow (j);
+	END (*FOR*);
+	Highlight;
+	OutTrace ("InitialDisplay");
+    END InitialDisplay;
+
+(************************************************************************)
+
+PROCEDURE ShiftDisplayUp;
+
+    (* Moves the display up one row, adding a new row at the bottom.	*)
+    (* Exception: nothing happens if there is no new row to add.	*)
+
+    VAR MaxRowMinusTwo: CARDINAL;
+
+    BEGIN
+	InTrace ("ShiftDisplayUp");
+	WITH Display DO
+	    IF ExtraAtBottom > 0 THEN
+		ScrollUp (window);
+		INC (ExtraAtTop);  DEC (ExtraAtBottom);
+		INC (CurrentBlock.ByteNumber, 16);
+
+		(* The following seemingly indirect way of proceeding	*)
+		(* is to compensate for an unexplained intermittent	*)
+		(* crash of the compiler.  It is very hard to pin down	*)
+		(* the exact circumstances of the crash, because it is	*)
+		(* not always repeatable, but it seems to be related to	*)
+		(* using a constant as an actual procedure parameter.	*)
+
+		MaxRowMinusTwo := MaxRow - 2;
+		DisplayRow (MaxRowMinusTwo);
+	    END (*IF*);
+	END (*WITH*);
+	OutTrace ("ShiftDisplayUp");
+    END ShiftDisplayUp;
+
+(************************************************************************)
+
+PROCEDURE ShiftDisplayDown;
+
+    (* Moves the display down one row, adding a new row at the top.	*)
+    (* Exception: nothing happens if there is no new row to add.	*)
+
+    BEGIN
+	InTrace ("ShiftDisplayDown");
+	WITH Display DO
+	    IF ExtraAtTop > 0 THEN
+		ScrollDown (window);
+		DEC (ExtraAtTop);  INC (ExtraAtBottom);
+		DEC (CurrentBlock.ByteNumber, 16);
+		DisplayRow (0);
+	    END (*IF*);
+	END (*WITH*);
+	OutTrace ("ShiftDisplayDown");
+    END ShiftDisplayDown;
+
+(************************************************************************)
+(*			      CURSOR MOVEMENTS				*)
+(************************************************************************)
+
+PROCEDURE CursorUp (lines: CARDINAL);
+
+    (* Moves the cursor up by the given number of rows.	*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	WITH Display DO
+	    FOR j := 1 TO lines DO
+		IF row = 0 THEN ShiftDisplayDown
+		ELSE
+		    DEC (row);  DEC (CurrentBlock.ByteNumber, 16);
+		END (*IF*);
+	    END (*FOR*);
+	END (*WITH*);
+    END CursorUp;
+
+(************************************************************************)
+
+PROCEDURE CursorDown (lines: CARDINAL);
+
+    (* Moves the cursor down by the given number of rows.	*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	WITH Display DO
+	    FOR j := 1 TO lines DO
+		IF row = MaxRow-2 THEN ShiftDisplayUp
+		ELSE
+		    INC (row);  INC (CurrentBlock.ByteNumber, 16);
+		END (*IF*);
+	    END (*FOR*);
+	END (*WITH*);
+    END CursorDown;
+
+(************************************************************************)
+
+PROCEDURE CursorLeft;
+
+    (* Moves the cursor one byte left.	*)
+
+    BEGIN
+	WITH Display DO
+	    IF column = 0 THEN
+		IF CurrentBlock.ByteNumber > 0 THEN
+		    column := 15;  INC (CurrentBlock.ByteNumber, 15);
+		    CursorUp(1);
+		END (*IF*);
+	    ELSE
+		DEC (column);  DEC (CurrentBlock.ByteNumber);
+	    END (*IF*);
+	END (*WITH*);
+    END CursorLeft;
+
+(************************************************************************)
+
+PROCEDURE CursorRight;
+
+    (* Moves the cursor one byte right.	*)
+
+    BEGIN
+	WITH Display DO
+	    IF column = 15 THEN
+		IF CurrentBlock.ByteNumber < MAX(BufferSubscript) THEN
+		    column := 0;  DEC (CurrentBlock.ByteNumber, 15);
+		    CursorDown(1);
+		END (*IF*);
+	    ELSE
+		INC (column);  INC (CurrentBlock.ByteNumber);
+	    END (*IF*);
+	END (*WITH*);
+    END CursorRight;
+
+(************************************************************************)
+
+PROCEDURE Home;
+
+    (* Moves the cursor to the beginning of the row.	*)
+
+    BEGIN
+	WITH Display DO
+	    DEC (CurrentBlock.ByteNumber, column);  column := 0;
+	END (*WITH*);
+    END Home;
+
+(************************************************************************)
+
+PROCEDURE GoToEnd;
+
+    (* Moves the cursor to the end of the row.	*)
+
+    BEGIN
+	WITH Display DO
+	    INC (CurrentBlock.ByteNumber, 15-column);  column := 15;
+	END (*WITH*);
+    END GoToEnd;
+
+(************************************************************************)
+
+PROCEDURE CursorMovements (VAR (*INOUT*) nextchar: CHAR);
+
+    (* Moves the cursor around the data buffer as directed by keyboard	*)
+    (* input.  On entry, nextchar holds the first keyboard character.	*)
+    (* On exit, nextchar holds the first input character which this	*)
+    (* procedure does not recognise.					*)
+
+    CONST Nul = CHR(0);  pagejump = 10;
+
+    BEGIN
+	InTrace ("CursorMovements");
+	LOOP
+	    IF nextchar = Nul THEN
+		nextchar := InKey();
+		Unhighlight;
+		IF nextchar = "K" THEN		(* cursor left *)
+		    CursorLeft;
+		ELSIF nextchar = "M" THEN	(* cursor right *)
+		    CursorRight;
+		ELSIF nextchar = "H" THEN	(* cursor up *)
+		    CursorUp (1);
+		ELSIF nextchar = "P" THEN	(* cursor down *)
+		    CursorDown (1);
+		ELSIF nextchar = "I" THEN	(* page up *)
+		    CursorUp (pagejump);
+		ELSIF nextchar = "Q" THEN	(* page down *)
+		    CursorDown (pagejump);
+		ELSIF nextchar = "G" THEN	(* home *)
+		    Home;
+		ELSIF nextchar = "O" THEN	(* end *)
+		    GoToEnd;
+		ELSE
+		    Highlight;
+		    EXIT (*LOOP*);
+		END (*IF*);
+		Highlight;
+		nextchar := InKey();
+	    ELSE
+		EXIT (*LOOP*);
+	    END (*IF*);
+	END (*LOOP*);
+	OutTrace ("CursorMovements");
+    END CursorMovements;
+
+(************************************************************************)
+(*			THE MAIN BLOCK OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE OperateOn (drive: CHAR;  BlockNumber: BlockNumberType);
+
+    VAR nextchar: CHAR;  status: ErrorCode;
+	device: Device;  unit: CARDINAL;
+	string: ARRAY [0..31] OF CHAR;
+
+    BEGIN
+	IdentifyDevice (drive, device, unit);
+	status := ReadPhysicalBlock (device, unit, BlockNumber,
+						ADR(CurrentBlock.data));
+	OpenWindow (Display.window,green,black,0,MaxRow+2,0,79,
+						simpleframe,doubledivider);
+	WriteString (Display.window, "Drive ");
+	WriteChar (Display.window, drive);
+	WriteString (Display.window, "     Block ");
+	WriteHexLongword (Display.window, BlockNumber);
+	WriteString (Display.window, "     Byte");
+	WriteString (Display.window, "           status = ");
+	TranslateErrorCode (status, string);
+	WriteString (Display.window, string);
+	ChangeScrollingRegion (Display.window, 3, MaxRow+1);
+	InitialDisplay;
+	nextchar := InKey();
+	REPEAT
+	    CursorMovements (nextchar);
+	    IF nextchar <> Esc THEN
+		nextchar := InKey();
+	    END (*IF*);
+	UNTIL nextchar = Esc;
+	(*Pause;*)
+	CloseWindow (Display.window);
+    END OperateOn;
+
+(************************************************************************)
+
+PROCEDURE MainMenu;
+
+    CONST CR = CHR(13);
+
+    VAR w: Window;  drivename: ARRAY [0..0] OF CHAR;
+	drive, ch: CHAR;  BlockNumber: BlockNumberType;
+
+    BEGIN
+	OpenWindow (w,white,red,0,4,0,35,simpleframe,nodivider);
+	WriteString (w, "Test of hard disk read operations");
+	BlockNumber := 0;  drive := "C";
+	SetCursor (w, 2, 1);
+	WriteString (w, "Drive: C   Block number: 00000000");
+	LOOP
+	    SetCursor (w, 2, 8);
+	    drivename[0] := drive;
+	    EditString (w, drivename, 1);
+
+	    ch := InKey();
+	    IF ch = Esc THEN EXIT(*LOOP*)
+	    ELSIF ch <> CR THEN PutBack(ch);
+	    END (*IF*);
+
+	    drive := CAP(drivename[0]);
+	    IF (drive < "A") OR (drive > "D") THEN EXIT(*LOOP*) END(*IF*);
+	    SetCursor (w, 2, 26);
+	    EditHexLongword (w, BlockNumber);
+	    IF BlockNumber = 0FFFFFFFFH THEN EXIT(*LOOP*) END(*IF*);
+
+	    ch := InKey();
+	    IF ch = Esc THEN EXIT(*LOOP*)
+	    ELSIF ch <> CR THEN PutBack(ch);
+	    END (*IF*);
+
+	    OperateOn (drive, BlockNumber);
+	    SetCursor (w, 3, 1);
+	    WriteString (w, "Finished with block ");
+	    WriteHexLongword (w, BlockNumber);
+	END (*LOOP*);
+	CloseWindow (w);
+    END MainMenu;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+(*    TraceOn (15,24,0,79,1); *)
+    MainMenu;
+END DiskPatch.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/dontpani.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/dontpani.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/dontpani.mod
@@ -0,0 +1,99 @@
+MODULE DontPanic;
+
+	(********************************************************)
+	(*							*)
+	(*		Simple test of screen output		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	20 January 1993			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM Windows IMPORT
+    (* type *)	Window, RowRange, ColumnRange, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, WriteString, WriteLn;
+
+(************************************************************************)
+
+TYPE DisplayString = ARRAY ColumnRange OF CHAR;
+
+(************************************************************************)
+
+PROCEDURE WriteTheMessage;
+
+    CONST blob = CHR(219);
+
+    VAR w: Window;  j, k: CARDINAL;
+	line: ARRAY RowRange OF DisplayString;
+
+    BEGIN
+	OpenWindow (w, red, green, 0, 24, 0, 79, noframe, nodivider);
+	FOR j := 0 TO MAX(RowRange) DO
+	    line[j] := "";
+	END (*FOR*);
+
+	line[3] :=
+"           ******        ****      **     **    **   ************";
+	line[4] :=
+"           **   **      *    *     ***    **     *        **     ";
+	line[5] :=
+"           **    **    **    **    ****   **              **     ";
+	line[6] :=
+"           **    **   **      **   ** **  **              **     ";
+	line[7] :=
+"           **    **   **      **   **  ** **              **     ";
+	line[8] :=
+"           **    **    **    **    **   ****              **     ";
+	line[9] :=
+"           **   **      *    *     **    ***              **     ";
+	line[10] :=
+"           ******        ****      **     **              **     ";
+
+	line[13] :=
+"          ******         *        **     **    ****      ******* ";
+	line[14] :=
+"          **   **       ***       ***    **     **      *      **";
+	line[15] :=
+"          **    **     ** **      ****   **     **     **        ";
+	line[16] :=
+"          **   **     **   **     ** **  **     **     **        ";
+	line[17] :=
+"          ******     **     **    **  ** **     **     **        ";
+	line[18] :=
+"          **        ***********   **   ****     **     **        ";
+	line[19] :=
+"          **       **         **  **    ***     **      *      **";
+	line[20] :=
+"          **      **           ** **     **    ****      ******* ";
+
+	FOR j := 0 TO MAX(RowRange) DO
+	    FOR k := 0 TO MAX(ColumnRange) DO
+		IF line[j][k] = "*" THEN
+		    line[j][k] := blob;
+		END (*IF*);
+	    END (*FOR*);
+	END (*FOR*);
+
+	WriteString (w, line[0]);
+	FOR j := 1 TO MAX(RowRange) DO
+	    WriteLn (w); WriteString(w, line[j]);
+	END (*FOR*);
+
+	FOR j := 0 TO 32767 DO
+	    FOR k := 0 TO 1000 DO
+		(* Nothing *)
+	    END (*FOR*);
+	END (*FOR*);
+
+	CloseWindow(w);
+    END WriteTheMessage;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    WriteTheMessage;
+END DontPanic.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/edittest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/edittest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/edittest.mod
@@ -0,0 +1,163 @@
+MODULE EditTest;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of module ScreenEditor		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	14 December 1994		*)
+	(*  Status:		Working but incomplete		*)
+	(*							*)
+	(*	This program tests only a subset of the		*)
+	(*	options supported by ScreenEditor.  More	*)
+	(*	work needed on further tests.			*)
+	(*							*)
+	(********************************************************)
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, SetCursor, WriteString, PressAnyKey;
+
+FROM NumericIO IMPORT
+    (* proc *)	WriteRJCard;
+
+FROM RealIO IMPORT
+    (* proc *)	WriteReal;
+
+FROM Menus IMPORT
+    (* type *)	Menu, ItemText, MenuOption, MO,
+    (* proc *)	CreateMenu, SetOptions;
+
+FROM ScreenEditor IMPORT
+    (* type *)	Structure,
+    (* proc *)	CardinalField, RealField, MenuField, Combine, MakeArray,
+		ScreenEdit;
+
+(************************************************************************)
+
+CONST maxsubscript = 10;
+
+TYPE
+    subscript = [1..maxsubscript];
+    TestRecord = RECORD
+		    part1: REAL;
+		 END (*RECORD*);
+
+VAR
+    TestData: ARRAY subscript OF TestRecord;
+
+(************************************************************************)
+
+PROCEDURE CreateAMenu(): Menu;
+
+    (* Creates a menu. *)
+
+    VAR menu: Menu;
+	menutext: ARRAY [0..25] OF ItemText;
+
+    BEGIN
+	menutext[0] := "MENU 1";
+	menutext[1] := "The";
+	menutext[2] := "quick";
+	menutext[3] := "brown";
+	menutext[4] := "fox";
+	menutext[5] := "jumps";
+	menutext[6] := "over";
+	menutext[7] := "the";
+	menutext[8] := "lazy";
+	menutext[9] := "dog";
+	menutext[10] := "Now";
+	menutext[11] := "is";
+	menutext[12] := "the";
+	menutext[13] := "time";
+	menutext[14] := "for";
+	menutext[15] := "all";
+	menutext[16] := "good";
+	menutext[17] := "men";
+	menutext[18] := "to";
+	menutext[19] := "come";
+	menutext[20] := "to";
+	menutext[21] := "the";
+	menutext[22] := "aid";
+	menutext[23] := "of";
+	menutext[24] := "the";
+	menutext[25] := "party";
+	CreateMenu (menu, 3, menutext, 25);
+	SetOptions (menu, MO{MNoBorder});
+	RETURN menu;
+    END CreateAMenu;
+
+(****************************************************************)
+
+PROCEDURE RunTheTest;
+
+    VAR w: Window;  R, S, count: Structure;  abort: BOOLEAN;
+	x: CARDINAL;  y: REAL;  z: REAL;  graphics: BOOLEAN;
+	menuvar: CARDINAL;  row: CARDINAL;
+
+    BEGIN
+	OpenWindow (w, black, green, 1, 18, 10, 69, simpleframe, nodivider);
+
+	(* Start with a structure containing a few simple variables. *)
+
+	x := 1234;  y := 3.14159;  graphics := FALSE;
+	SetCursor (w, 3, 2);  WriteString (w, "x      [");
+	SetCursor (w, 3, 18);  WriteString (w, "]");
+	SetCursor (w, 5, 2);  WriteString (w, "y      [");
+	SetCursor (w, 5, 20);  WriteString (w, "]");
+	SetCursor (w, 5, 30);  WriteString (w, "z      [");
+	SetCursor (w, 5, 50);  WriteString (w, "]");
+	(*
+	SetCursor (w, 7, 2);  WriteString (w, "graphics");
+	SetCursor (w, 7, 10);  WriteString (w, "OFF");
+	*)
+
+	R := CardinalField (x, 3, 10, 8);
+	Combine (R, RealField (z, 5, 40, 10));
+	Combine (R, RealField (y, 5, 10, 10));
+
+   (*	AddBooleanField (S, graphics, 7, 10, "NO", "YES");  *)
+
+   (*	ScreenEdit (w, R, abort);   *)
+
+	(* Include elements of an array. *)
+
+	Combine (R, RealField (TestData[1].part1, 1, 3, 10));
+	Combine (R, RealField (TestData[2].part1, 2, 3, 10));
+
+	(* Add a menu field. *)
+
+	menuvar := 2;
+	Combine (R, MenuField (menuvar, 7, 5, 6, 30, CreateAMenu()));
+
+	(* Go to it: do some editing. *)
+
+	ScreenEdit (w, R, abort);
+
+	SetCursor (w, 14, 1);  WriteString (w, "x, y, z = ");
+	WriteRJCard (w, x, 8);  WriteString (w, ", ");
+	WriteReal (w, y, 10);  WriteString (w, ", ");
+	WriteReal (w, z, 10);
+	SetCursor (w, 15, 1);  WriteString (w, "graphics is o");
+	IF graphics THEN WriteString (w, "n");
+	ELSE WriteString (w, "ff");
+	END (*IF*);
+
+	(* Test 3: repeating structure. *)
+(*
+	S := MakeArray (R, maxsubscript, SIZE(TestRecord), 1, 0);
+	ScreenEdit (w, S);
+*)
+	PressAnyKey (w);
+	PressAnyKey (w);
+	CloseWindow (w);
+    END RunTheTest;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    RunTheTest;
+END EditTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/flttest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/flttest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/flttest.mod
@@ -0,0 +1,35 @@
+MODULE FltTest;
+    (* The sole purpose of this module is to let me check what the	*)
+    (* TopSpeed floating point library is doing to corrupt the stack	*)
+    (* segment.								*)
+    (* Conclusion so far: locations ss:[0001] to ss:[0004] inclusive	*)
+    (* are being used by Exp and Sqrt; so we're forced to make sure	*)
+    (* that those locations are actually within the task stack space.	*)
+
+FROM SYSTEM IMPORT NEWPROCESS, TRANSFER;
+FROM MATHLIB IMPORT Log, Tan, Sqrt, Exp;
+
+VAR x, y: LONGREAL;
+    P0, P1: ADDRESS;
+    WkSpace: ARRAY [0..2047] OF CHAR;
+
+PROCEDURE proc1;
+    VAR x, y: LONGREAL;
+    BEGIN
+	y := 1.0;
+	x := Log(y);
+	x := Tan(y);
+	x := Sqrt(y);
+	TRANSFER (P1,P0);
+    END proc1;
+
+BEGIN
+    NEWPROCESS (proc1, ADR(WkSpace), SIZE(WkSpace), P1);
+    y := 1.0;
+    x := Exp (y);
+    x := Log(-5.0);
+    x := Tan(y);
+    x := Sqrt(y);
+    TRANSFER (P0,P1);
+END FltTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/graftst1.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/graftst1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/graftst1.mod
@@ -0,0 +1,372 @@
+MODULE Graftst1;
+
+	(****************************************************************)
+	(*								*)
+	(*		Test of Graphics module.			*)
+	(*								*)
+	(*	NOTE: This program is not intended as a "final		*)
+	(*	product" whose code is static.  It's a collection	*)
+	(*	of small tests which can be commented or uncommented	*)
+	(*	as needed - or modified, as needed - depending on	*)
+	(*	what aspect of the screen graphics is being tested	*)
+	(*	at the time.						*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	18 March 1995				*)
+	(*  Status:		OK					*)
+	(*	Can draw points, lines, and characters for the three	*)
+	(*	CGA modes, EGA modes 13-16, Hercules monochrome, VGA	*)
+	(*	modes 17-19, and all of the SVGA modes which I have	*)
+	(*	been able to test (except for the modes with 24-bit	*)
+	(*	colour; I haven't yet thought of a fast way to support	*)
+	(*	24-bit modes.)						*)
+	(*								*)
+	(* For mode definitions and support status, see Graphics.DEF.	*)
+	(*								*)
+	(****************************************************************)
+
+FROM ScreenGeometry IMPORT
+    (* type *)	Rectangle;
+
+FROM Graphics IMPORT
+    (* proc *)	SetMode, SetDefaultMode, PlotDot, PlotLine, PlotRectangle,
+		DrawChar, PlotString, GetScreenShape, Fill, ACopy;
+
+FROM Conversions IMPORT
+    (* proc *)	CardinalToString;
+
+FROM IO IMPORT
+    (* proc *)	RdKey;
+
+IMPORT GlassTTY;
+
+(************************************************************************)
+
+VAR Xmax, Ymax, MaxColour: CARDINAL;
+
+(************************************************************************)
+
+PROCEDURE Pause;
+
+    (* Waits until a key is struck on the keyboard.	*)
+
+    VAR dummy: CHAR;
+
+    BEGIN
+	dummy := RdKey();
+    END Pause;
+
+(************************************************************************)
+
+PROCEDURE CentreCross (x, y, colour: CARDINAL);
+
+    (* Plots a cross at position (x,y), using PlotLine.	*)
+
+    BEGIN
+	PlotLine (x-5,y,x+5,y,colour);
+	PlotLine (x,y-5,x,y+5,colour);
+    END CentreCross;
+
+(************************************************************************)
+
+PROCEDURE ShortLines (y, colour: CARDINAL);
+
+    (* Plots some short lines, using point graphics.	*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+
+	FOR j := 0 TO 7 DO
+	    PlotDot (0,y-j,colour);
+	END (*FOR*);
+	FOR j := 0 TO 15 DO
+	    PlotDot (10,y-j,colour);
+	END (*FOR*);
+	FOR j := 0 TO 31 DO
+	    PlotDot (20,y-j,colour);
+	END (*FOR*);
+	FOR j := 0 TO 63 DO
+	    PlotDot (30,y-j,colour);
+	END (*FOR*);
+	FOR j := 0 TO 127 DO
+	    PlotDot (40,y-j,colour);
+	END (*FOR*);
+(*
+	FOR j := 0 TO 255 DO
+	    PlotDot (50,y-j,colour);
+	END (*FOR*);
+	FOR j := 0 TO 479 DO
+	    PlotDot (60,y-j,colour);
+	END (*FOR*);
+*)
+	FOR j := 0 TO 319 DO
+	    PlotDot (j,y,colour);
+	END (*FOR*);
+    END ShortLines;
+
+(************************************************************************)
+
+PROCEDURE DiagonalLine (colour: CARDINAL);
+
+    (* Plots a diagonal line, using point graphics.	*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	FOR j := 0 TO 99 DO
+	    PlotDot (2*j,j,colour);
+	END (*FOR*);
+    END DiagonalLine;
+
+(************************************************************************)
+
+PROCEDURE PointTest (colour: CARDINAL);
+
+    (* Plots a diagonal line, waits for a key to be struck, and then	*)
+    (* erases the line.  This test provides a quick verification	*)
+    (* that something really does appear on the screen, i.e. that a	*)
+    (* suitable mode is set and that PlotDot works.			*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	DiagonalLine (colour);
+	Pause;
+	DiagonalLine (0);
+    END PointTest;
+
+(************************************************************************)
+
+PROCEDURE Diamond (colour: CARDINAL);
+
+    (* Plots a diamond shape, using PlotLine.	*)
+
+    BEGIN
+	PlotLine (15,Ymax DIV 2,Xmax DIV 2,15,colour);
+	PlotLine (Xmax DIV 2,15,Xmax-15,Ymax DIV 2,colour);
+	PlotLine (Xmax-15,Ymax DIV 2,Xmax DIV 2,Ymax-15,colour);
+	PlotLine (Xmax DIV 2,Ymax-15,15,Ymax DIV 2,colour);
+    END Diamond;
+
+(************************************************************************)
+
+PROCEDURE LineTest (colour: CARDINAL);
+
+    (* Plots a diamond shape, then erases it.  This is a test that	*)
+    (* PlotLine works.							*)
+
+    BEGIN
+	Diamond (colour);
+	Pause;
+	Diamond (0);
+    END LineTest;
+
+(************************************************************************)
+
+PROCEDURE TextTest (colour: CARDINAL);
+
+    (* Checks whether DrawChar works.	*)
+
+    BEGIN
+	DrawChar ("F", 100, 50, colour);
+	Pause;
+    END TextTest;
+
+(************************************************************************)
+
+PROCEDURE FillTest (colour: CARDINAL);
+
+    (* Checks whether Fill works.	*)
+
+    BEGIN
+	Fill (Xmax DIV 2 - 15, Ymax DIV 2 - 15,
+		Xmax DIV 2 + 15, Ymax DIV 2 + 15, colour);
+    END FillTest;
+
+(************************************************************************)
+
+PROCEDURE CopyTest;
+
+    (* Fills a region, and then copies most of it. *)
+
+    CONST
+	colour1 = 2;  colour2 = 1;
+	width = 31;  height = 25;
+	dx = 0;  dy = 33;
+
+    VAR R: Rectangle;
+	x0, y0, x1, y1: CARDINAL;
+
+    BEGIN
+	x0 := 7*Xmax DIV 8;  y0 := Ymax DIV 8;
+	x1 := x0+width-1;  y1 := y0+height-1;
+	Fill (x0+1, y0+1, x1-1, y1-1, colour1);
+	Fill (x0+5, y0+5, x1-5, y1-5, colour2);
+	WITH R DO
+	    left := x0;  right := x1;
+	    bottom := y0;  top := y1;
+	END (*WITH*);
+	PlotRectangle (R, colour2);
+	WITH R DO
+	    DEC(left,2);  INC(right,2);
+	    DEC(bottom,2);  INC(top,2);
+	END (*WITH*);
+	PlotRectangle (R, colour2);
+	(*Pause;*)
+	ACopy (x0, y1, width, height, dx, dy);
+	(*Pause;*)
+    END CopyTest;
+
+(************************************************************************)
+
+(************************************************************************)
+
+PROCEDURE ColourDisplay;
+
+    (* This is useful mainly for the many-colour modes, to give a feel	*)
+    (* for what the colour range is.					*)
+
+    VAR x, y, c: CARDINAL;
+
+    BEGIN
+	x := 0;  y := Ymax;
+	FOR c := 0 TO MaxColour DO
+	    PlotDot (x, y, c);
+	    IF x < Xmax THEN INC(x);
+	    ELSE
+		x := 0;  DEC (y);
+	    END (*IF*);
+	END (*FOR*);
+	Pause;
+    END ColourDisplay;
+
+(************************************************************************)
+
+PROCEDURE Title (mode, messx, messy, colour: CARDINAL);
+
+    (* Writes a title message for the given mode.  The last three	*)
+    (* parameters say where on the screen to put the message and what	*)
+    (* colour to write it in.						*)
+
+    VAR Message: ARRAY [0..25] OF CHAR;
+	StringBuffer: ARRAY [0..4] OF CHAR;
+	k: [0..4];  count: [0..26];
+
+    BEGIN
+	Message := "MODE xxx   XXXXxYYYYxCCCCC";
+	count := 5;
+	CardinalToString (mode, StringBuffer, 3);
+	FOR k := 0 TO 2 DO
+	    IF StringBuffer[k] <> " " THEN
+		Message[count] := StringBuffer[k];  INC (count);
+	    END (*IF*);
+	END (*FOR*);
+	Message[count] := " ";  INC (count);
+	Message[count] := " ";  INC (count);
+	CardinalToString (Xmax+1, StringBuffer, 4);
+	FOR k := 0 TO 3 DO
+	    IF StringBuffer[k] <> " " THEN
+		Message[count] := StringBuffer[k];  INC (count);
+	    END (*IF*);
+	END (*FOR*);
+	Message[count] := "x";  INC (count);
+	CardinalToString (Ymax+1, StringBuffer, 4);
+	FOR k := 0 TO 3 DO
+	    IF StringBuffer[k] <> " " THEN
+		Message[count] := StringBuffer[k];  INC (count);
+	    END (*IF*);
+	END (*FOR*);
+	Message[count] := "x";  INC (count);
+	IF MaxColour = MAX(CARDINAL) THEN
+	    StringBuffer := "65536";
+	ELSE
+	    CardinalToString (MaxColour+1, StringBuffer, 5);
+	END (*IF*);
+	FOR k := 0 TO 4 DO
+	    IF StringBuffer[k] <> " " THEN
+		Message[count] := StringBuffer[k];  INC (count);
+	    END (*IF*);
+	END (*FOR*);
+	PlotString (Message, messx, messy, count, colour);
+    END Title;
+
+(************************************************************************)
+
+PROCEDURE RunTheTest;
+
+    (* Runs us through a sequence of tests.	*)
+
+    TYPE ModeSet = SET OF [0..511];
+
+    CONST
+	NonGraphicsModes = ModeSet {0..3, 7..12, 264..268};
+	BasicModes = ModeSet {4..6, 13..19};
+	WorkingVesaModes = ModeSet {256, 257, 259, 272, 273, 275, 276};
+	WorkingModes = BasicModes + WorkingVesaModes;
+	BadSynchOnTrident = ModeSet {106,258,260};
+	ModesWhichMyTridentWontSupport = ModeSet {261,269,270,278,279,281,
+						282,354};
+	ExtraModes = ModeSet {368,369};
+
+	TridentVesaModes = WorkingVesaModes + BadSynchOnTrident + ExtraModes;
+	TridentModes = BasicModes + TridentVesaModes;
+
+	ATIVesaModes = ModeSet {106, 256..259, 260};
+	ATIExtraModes = ModeSet {83..85, 97..99};
+	ATIFailingModes = ModeSet {99, 259};
+	ATIModes = BasicModes + ATIExtraModes + ATIVesaModes;
+
+	S3VesaModes = ModeSet {257..261, 272..274};
+	S3OK = ModeSet {257};
+
+	(* The list below shows modes which have been dropped from the	*)
+	(* tests because they have been found to duplicate the function	*)
+	(* of modes already in one of the lists above.  (This is for	*)
+	(* my Trident adaptor.)						*)
+
+	Duplicates = ModeSet {348..351, 362, 372..375};
+
+    VAR j, colour, CharHeight: CARDINAL;
+
+    BEGIN
+	(*FOR j := 0 TO 511 DO*)
+	FOR j := 85 TO 85 DO
+	    (* IF j IN ModesToTest + ExtraModes THEN *)
+	    (* IF j IN S3VesaModes-S3OK THEN *)
+	    IF j IN ATIModes (* - BasicModes*) - ATIFailingModes THEN
+(*
+		SetMode (3);
+		GlassTTY.WriteLn;
+		GlassTTY.WriteString ("Now about to test mode ");
+		GlassTTY.WriteCard (j);
+		Pause;
+*)
+		SetMode (j, TRUE);
+		GetScreenShape (Xmax, Ymax, MaxColour, CharHeight);
+		IF MaxColour = 1 THEN colour := 1;
+		ELSIF MaxColour > 255 THEN colour := 3;
+		ELSE colour := 2;
+		END (*IF*);
+		Title (j, 30, 5, colour);
+		Title (j, Xmax-210, Ymax-15, colour);
+		ShortLines (Ymax, colour);
+		FillTest (colour);
+		CentreCross (Xmax DIV 2, Ymax DIV 2, colour-1);
+		PointTest (colour);
+		CopyTest;
+		LineTest (colour);
+		(* TextTest (colour); *)
+		(* ColourDisplay; *)
+	    END (*IF*);
+	END (*FOR*);
+    END RunTheTest;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    RunTheTest;
+END Graftst1.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/gtxttest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/gtxttest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/gtxttest.mod
@@ -0,0 +1,65 @@
+MODULE GTxtTest;
+
+	(********************************************************)
+	(*							*)
+	(*	Test of text operations in graphics window	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	30 December 1994		*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM GWindows IMPORT
+    (* type *)	Window, BorderType,
+    (* proc *)	WriteChar, WriteString, WriteLn,
+		OpenWindow, CloseWindow;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey;
+
+(************************************************************************)
+
+PROCEDURE Pause (w: Window);
+
+    VAR dummy: CHAR;
+
+    BEGIN
+	WriteLn (w);
+	WriteString (w, "Press any key to continue");
+	dummy := InKey();
+    END Pause;
+
+(************************************************************************)
+
+PROCEDURE RunTheTest;
+
+    CONST TestLength = 3000;
+
+    VAR w: Window;  j: CARDINAL;  ch: CHAR;
+
+    BEGIN
+	OpenWindow (w, 0, 0, 620, 400, 0, 2, double);
+	WriteString (w,'Test of text operations in a graphics window.');
+	Pause (w);
+	WriteLn(w);
+
+	ch := CHR(0);
+	FOR j := 0 TO TestLength DO
+	    WriteChar (w, ch);
+	    IF ch = MAX(CHAR) THEN ch := CHR(0)
+	    ELSE INC(ch)
+	    END (*IF*);
+	END (*FOR*);
+
+	Pause (w);
+	CloseWindow (w);
+
+    END RunTheTest;
+
+(************************************************************************)
+
+BEGIN
+    RunTheTest;
+END GTxtTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/gwtest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/gwtest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/gwtest.mod
@@ -0,0 +1,82 @@
+MODULE GWTest;
+
+	(********************************************************)
+	(*							*)
+	(*	Very elementary test of GWindows: opens some	*)
+	(*	graphics windows, and then closes them.  The	*)
+	(*	purpose is to check the tiling algorithms.	*)
+	(*							*)
+	(*	(If you run this program "as is", all you'll	*)
+	(*	see is a brief flash on the screen.)		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	5 March 1995			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM GWindows IMPORT
+    (* type *)	Window, BorderType,
+    (* proc *)	OpenWindow, WriteString, CloseWindow;
+
+FROM Graphics IMPORT
+    (* proc *)	SetMode, GraphicsOff;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey;
+
+(************************************************************************)
+(*		    "PRESS ANY KEY TO CONTINUE"				*)
+(************************************************************************)
+
+PROCEDURE Pause;
+
+    VAR dummy: CHAR;  w: Window;
+
+    BEGIN
+	OpenWindow(w,280,30,510,45,0,3,single);
+	WriteString (w, "  Press any key to continue");
+	dummy := InKey();
+	CloseWindow (w);
+    END Pause;
+
+(************************************************************************)
+
+PROCEDURE DebugPause (message: ARRAY OF CHAR);
+
+    VAR dummy: CHAR;
+
+    BEGIN
+(*
+	GlassTTY.SetCursor (24, 0);
+	GlassTTY.WriteString (message);
+	dummy := InKey();
+*)
+    END DebugPause;
+
+(************************************************************************)
+
+PROCEDURE RunTheTest;
+
+    VAR w1, w2, w3, w4: Window;
+
+    BEGIN
+	DebugPause ("About to open first window");
+	OpenWindow(w1,300,100,600,260,4,7,single);
+	OpenWindow(w2,20,20,400,180,0,2,single);
+	OpenWindow(w3,50,120,500,140,0,3,double);
+	OpenWindow(w4,350,10,370,300,0,5,single);
+	CloseWindow (w1);
+	CloseWindow (w2);
+	CloseWindow (w3);
+	CloseWindow (w4);
+    END RunTheTest;
+
+(************************************************************************)
+
+BEGIN
+    (* SetMode(3,TRUE); *)
+    (* GraphicsOff (TRUE); *)
+    RunTheTest;
+END GWTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/incvtst.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/incvtst.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/incvtst.mod
@@ -0,0 +1,22 @@
+MODULE INCVtst;
+
+FROM LowLevel IMPORT INCV, DECV;
+
+FROM Keyboard IMPORT InKey;
+
+FROM GlassTTY IMPORT WriteString, WriteCard, WriteLn;
+
+VAR x, y: CARDINAL;  dummy: CHAR;
+
+BEGIN
+    x := 40000;  y := 30000;
+    IF INCV (x,y) THEN WriteString ("Overflow ");  END(*IF*);
+    WriteCard (x);  WriteString ("   ");  WriteCard (y);
+    WriteLn;
+    x := 40000;  y := 30000;
+    IF DECV (x,y) THEN WriteString ("Underflow ");  END(*IF*);
+    WriteCard (x);  WriteString ("   ");  WriteCard (y);
+    WriteLn;
+    dummy := InKey();
+END INCVtst.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/inittest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/inittest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/inittest.mod
@@ -0,0 +1,44 @@
+MODULE InitTest;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of module initialisation		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	23 March 1995			*)
+	(*  Status:		Problems, see below		*)
+	(*							*)
+	(*	This module doesn't actually do anything.	*)
+	(*	All the action is in the initialisation		*)
+	(*	code of the imported modules.			*)
+	(*							*)
+	(*	Bug: although this program works normally	*)
+	(*	when we press a key to terminate (as intended),	*)
+	(*	it can crash if Ctrl/Alt/Del is used to		*)
+	(*	terminate it.  As far as I can work out, the	*)
+	(*	problem occurs only if the INT33 mouse module	*)
+	(*	is used, and the installed mouse driver is a	*)
+	(*	Microsoft mouse driver.				*)
+	(*							*)
+	(********************************************************)
+
+FROM Keyboard IMPORT KeyPressed;
+FROM Trace IMPORT Pause;
+IMPORT TimeOfDay;
+IMPORT Floppy;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+VAR j: INTEGER;
+
+BEGIN
+    Pause;
+(*
+    REPEAT
+	j := -j;
+    UNTIL KeyPressed();
+*)
+END InitTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/kbtest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/kbtest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/kbtest.mod
@@ -0,0 +1,68 @@
+MODULE KBtest;
+
+	(****************************************************************)
+	(*								*)
+	(*			Test of keyboard driver.		*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	24 July 1994				*)
+	(*  Status:		Working					*)
+	(*								*)
+	(****************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE;
+
+FROM GlassTTY IMPORT
+    (* proc *)	WriteString, WriteLn, WriteHexByte, SetCursor;
+
+FROM KTrace IMPORT
+    (* proc *)	InTrace, OutTrace, TraceOn;
+
+FROM KBdriver IMPORT
+    (* proc *)	GetScanCode;
+(*
+IMPORT SpuriousInterrupts;
+*)
+
+IMPORT Timer;
+
+
+(************************************************************************)
+
+PROCEDURE RunTheTest;
+
+    (* Keeps reading scan codes, and writing them on the screen in	*)
+    (* hexadecimal, until an Esc character is detected.			*)
+
+    VAR code: BYTE;
+
+    BEGIN
+	InTrace ("RunTheTest");
+	SetCursor (0,0);
+	WriteString ("Test of keyboard driver.");
+	WriteString ("  To exit, use the Esc key.");
+	WriteLn;
+	REPEAT
+	    code := GetScanCode ();
+	    WriteString ("Scan code = ");
+	    WriteHexByte (code);
+	    WriteLn;
+	UNTIL code = BYTE(081H);
+
+	(* Remark: 081H is the code for releasing the Esc key.	*)
+
+	WriteString ("End of test.");
+	WriteLn;
+	OutTrace ("RunTheTest");
+    END RunTheTest;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+    BEGIN
+(*	TraceOn; *)
+	RunTheTest;
+    END KBtest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/keytest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/keytest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/keytest.mod
@@ -0,0 +1,76 @@
+MODULE KeyTest;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of keyboard driver.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	24 July 1994			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM GlassTTY IMPORT
+    (* proc *)	WriteString, WriteLn, WriteChar, SetCursor;
+
+FROM KTrace IMPORT
+    (* proc *)	InTrace, OutTrace, TraceOn;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey;
+(*
+IMPORT SpuriousInterrupts;
+*)
+IMPORT Timer;
+
+(************************************************************************)
+
+PROCEDURE RunTheTest;
+
+    (* Keeps reading characters, and writing them on the screen, until	*)
+    (* the Esc key has been typed twice in succession.			*)
+
+    CONST Esc = CHR(27);
+
+    VAR code: CHAR;  count: CARDINAL;  EscDetected: BOOLEAN;
+
+    BEGIN
+	InTrace ("RunTheTest");
+	SetCursor (0,0);  WriteString ("Test of keyboard driver.");
+	WriteString ("  To exit, hit the Esc key TWICE.");
+	WriteLn;
+	count := 0;
+	LOOP
+	    code := InKey();
+	    IF code = Esc THEN
+		IF EscDetected THEN EXIT(*LOOP*)
+		ELSE EscDetected := TRUE
+		END (*IF*);
+	    ELSE EscDetected := FALSE;
+	    END (*IF*);
+	    IF code = CHR(13) THEN
+		WriteLn;  count := 0;
+	    ELSE
+		WriteChar (code);
+		INC (count);
+		IF count = 80 THEN
+		    WriteLn; count := 0;
+		END (*IF*);
+	    END(*IF*);
+	END (*LOOP*);
+
+	WriteLn;
+	WriteString ("End of test.");
+	WriteLn;
+	OutTrace ("RunTheTest");
+    END RunTheTest;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+    BEGIN
+(*	TraceOn (15, 24, 0, 79);*)
+	RunTheTest;
+    END KeyTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/ledlite.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/ledlite.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/ledlite.mod
@@ -0,0 +1,94 @@
+MODULE LedLite;
+
+	(********************************************************)
+	(*							*)
+	(*	Test program to display a pattern on the	*)
+	(*		    keyboard LEDs			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	20 January 1993			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM KBdriver IMPORT
+    (* proc *)	PutLEDs, CheckScanCode, ClearLED;
+
+FROM Timer IMPORT
+    (* proc *)	Sleep;
+
+FROM LowLevel IMPORT
+    (* proc *)	IAND;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure;
+
+(************************************************************************)
+
+VAR
+    GoingLeft: BOOLEAN;
+
+(************************************************************************)
+(*	THIS PROCEDURE DEFINES THE SEQUENCE OF THE PATTERN		*)
+(************************************************************************)
+
+PROCEDURE Next (x: CARDINAL): CARDINAL;
+
+    (* Produces the next number in the sequence to be displayed.	*)
+    (* Alter this code to change the pattern sequence.			*)
+
+    BEGIN
+	IF GoingLeft THEN
+	    IF x >= 4 THEN GoingLeft := FALSE END (*IF*)
+	ELSE
+	    IF x = 1 THEN GoingLeft := TRUE; END (*IF*);
+	END (*IF*);
+	IF GoingLeft THEN
+	    IF x = 0 THEN x := 1 ELSE x := 2*x END (*IF*);
+	ELSE
+	    x := x DIV 2;
+	END (*IF*);
+	RETURN x;
+    END Next;
+
+(************************************************************************)
+(*			     MAIN PROCEDURE				*)
+(************************************************************************)
+
+PROCEDURE Display;
+
+    (* Displays a pattern on the keyboard LEDs.  *)
+
+    CONST delay = 400;	(* milliseconds *)
+	  EscRelease = BYTE(081H);	(* scan code for Esc key release *)
+
+    VAR x: CARDINAL;
+
+    BEGIN
+	x := 1;  GoingLeft := TRUE;
+	REPEAT
+	    PutLEDs (BYTE(IAND(x,7)));
+	    Sleep (delay);
+	    x := Next (x);
+	UNTIL CheckScanCode() = EscRelease;
+    END Display;
+
+(************************************************************************)
+(*			     FINAL CLEANUP				*)
+(************************************************************************)
+
+PROCEDURE ClearAllLEDs;
+
+    BEGIN
+	ClearLED (7);
+    END ClearAllLEDs;
+
+(************************************************************************)
+(*			     MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    SetTerminationProcedure (ClearAllLEDs);
+    Display;
+END LedLite.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/lltest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/lltest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/lltest.mod
@@ -0,0 +1,74 @@
+MODULE LLTest;
+
+	(********************************************************)
+	(*							*)
+	(*	Test of some functions in module LowLevel	*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	11 March 1995			*)
+	(*  Status:		OK				*)
+	(*	All results appear to be correct for the	*)
+	(*	Small memory model (which, for now, is the	*)
+	(*	only one that I need to check).			*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	ADDRESS,
+    (* proc *)	ADR;
+
+FROM Types IMPORT
+    (* type *)	FarPointer;
+
+FROM LowLevel IMPORT
+    (* proc *)	Far, SEGMENT, FarSEGMENT, OFFSET, MakePointer, Physical,
+		Virtual, AddOffset, SubtractOffset, FarAddOffset,
+		FarSubtractOffset, Copy, FarCopy;
+
+VAR G: CARDINAL;
+
+(************************************************************************)
+
+PROCEDURE BasicTest;
+
+    VAR L, seg, off: CARDINAL;  phys: LONGCARD;
+	p: ADDRESS;  fp: FarPointer;
+
+    BEGIN
+	p := ADR(L);
+	fp := Far(p);
+	seg := SEGMENT(p);
+	off := OFFSET (p);
+	fp := MakePointer (seg, off);
+	seg := FarSEGMENT(fp);
+	phys := Physical(p);
+	fp := Virtual(phys);
+	p := AddOffset (p, 1);
+	p := SubtractOffset (p, 1);
+	fp := FarAddOffset (fp, 1);
+	fp := FarSubtractOffset (fp, 1);
+    END BasicTest;
+
+(************************************************************************)
+
+PROCEDURE CopyTest;
+
+    VAR src, dst: ARRAY [0..15] OF CHAR;
+	j: CARDINAL;
+
+    BEGIN
+	FOR j := 0 TO 15 DO src[j] := CHR(j+ORD('A')); END (*FOR*);
+	Copy (ADR(src), ADR(dst), 16);
+	FOR j := 0 TO 15 DO src[j] := CHR(j+ORD('a')); END (*FOR*);
+	FarCopy (Far(ADR(src)), Far(ADR(dst)), 16);
+    END CopyTest;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    BasicTest;
+    CopyTest;
+END LLTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/mboxtest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/mboxtest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/mboxtest.mod
@@ -0,0 +1,120 @@
+MODULE MBoxTest;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of the mailbox facility		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 June 1993			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM Mailboxes IMPORT
+    (* type *)	Mailbox,
+    (* proc *)	CreateMailbox, SendMessage, ReceiveMessage;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, WriteString, WriteLn, ReadChar;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM TaskControl IMPORT
+    (* proc *)	CreateTask;
+
+(************************************************************************)
+
+CONST MessageLimit = 20;
+      Esc = CHR(27);
+
+TYPE MessageBuffer = ARRAY [0..MessageLimit-1] OF CHAR;
+
+VAR MB: Mailbox;
+    TaskDone: Semaphore;
+
+(************************************************************************)
+
+PROCEDURE ReadString (w: Window;  VAR (*OUT*) buffer: ARRAY OF CHAR;
+					VAR (*OUT*) length: CARDINAL);
+
+    (* Reads a string from the keyboard, and reports its length.	*)
+    (* Returns when a carriage return or escape is read, or if the	*)
+    (* buffer is full.  If an escape character is read, the preceding	*)
+    (* input is abandoned and we return with the escape as a		*)
+    (* one-character string.						*)
+
+    VAR ch: CHAR;
+
+    BEGIN
+	length := 0;
+	LOOP
+	    ReadChar (w, ch);
+	    IF ch = CHR(13) THEN EXIT(*LOOP*) END(*IF*);
+	    buffer[length] := ch;  INC(length);
+	    IF ch = Esc THEN
+		buffer[0] := Esc;  length := 1;
+		EXIT (*LOOP*);
+	    END(*IF*);
+	    IF length > HIGH(buffer) THEN EXIT(*LOOP*) END(*IF*);
+	END (*LOOP*);
+    END ReadString;
+
+(************************************************************************)
+
+PROCEDURE Producer;
+
+    VAR w: Window;  buffer: MessageBuffer;  length: CARDINAL;
+
+    BEGIN
+	OpenWindow (w, blue, cyan, 8, 16, 0, 39, simpleframe, nodivider);
+	REPEAT
+	    ReadString (w, buffer, length);
+	    IF NOT SendMessage (MB, ADR(buffer), length) THEN
+		WriteString (w, "Send failure!");
+		WriteLn (w);
+	    END (*IF*);
+	UNTIL buffer[0] = Esc;
+	CloseWindow (w);
+	Signal (TaskDone);
+    END Producer;
+
+(************************************************************************)
+
+PROCEDURE Consumer;
+
+    VAR w: Window;  buffer: MessageBuffer;  length: CARDINAL;
+
+    BEGIN
+	OpenWindow (w, white, magenta, 8, 16, 40, 79, simpleframe, nodivider);
+	LOOP
+	    WriteLn (w);
+	    length := ReceiveMessage (MB, buffer, 5000);
+	    IF length = 0 THEN
+		WriteString (w, "Empty message received!");
+	    ELSIF buffer[0] = Esc THEN
+		EXIT (*LOOP*);
+	    END (*IF*);
+	    IF length < MessageLimit THEN
+		buffer[length] := CHR(0);
+	    END (*IF*);
+	    WriteString (w, buffer);
+	END (*LOOP*);
+	CloseWindow (w);
+	Signal (TaskDone);
+    END Consumer;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    MB := CreateMailbox (MessageLimit);
+    CreateSemaphore (TaskDone, 0);
+    CreateTask (Producer, 1, "Producer");
+    CreateTask (Consumer, 1, "Consumer");
+    Wait (TaskDone);  Wait (TaskDone);
+END MBoxTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/ortest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/ortest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/ortest.mod
@@ -0,0 +1,82 @@
+MODULE ORtest;
+
+FROM Windows IMPORT
+	Window, Colour, FrameType, DividerType,
+	OpenWindow, CloseWindow, WriteString, WriteLn, PressAnyKey;
+
+FROM NumericIO IMPORT
+	WriteHexWord, WriteHexByte, WriteRJCard;
+
+FROM LowLevel IMPORT
+	IOR, IORB, IXOR, IXORB, LS;
+
+(*******************************************************************)
+
+VAR w: Window;
+
+(*******************************************************************)
+
+PROCEDURE TestIOR (x, y: CARDINAL);
+
+    BEGIN
+	WriteLn (w);
+	WriteHexWord (w, x);  WriteString (w, " IOR ");
+	WriteHexWord (w, y);  WriteString (w, " = ");
+	WriteHexWord (w, IOR(x,y));
+    END TestIOR;
+
+(*******************************************************************)
+
+PROCEDURE TestIXOR (x, y: CARDINAL);
+
+    BEGIN
+	WriteLn (w);
+	WriteHexWord (w, x);  WriteString (w, " IXOR ");
+	WriteHexWord (w, y);  WriteString (w, " = ");
+	WriteHexWord (w, IXOR(x,y));
+    END TestIXOR;
+
+(*******************************************************************)
+
+PROCEDURE TestIORB (x, y: SHORTCARD);
+
+    BEGIN
+	WriteLn (w);
+	WriteHexByte (w, x);  WriteString (w, " IORB ");
+	WriteHexByte (w, y);  WriteString (w, " = ");
+	WriteHexByte (w, IORB(x,y));
+    END TestIORB;
+
+(*******************************************************************)
+
+PROCEDURE LStest;
+
+    VAR datum, j: CARDINAL;
+
+    BEGIN
+	datum := 1234;
+	FOR j := 0 TO 16 DO
+	    WriteLn (w);
+	    WriteRJCard (w, j, 3);
+	    WriteString (w, "   ");
+	    WriteHexWord (w, LS(datum, j));
+	END (*FOR*);
+    END LStest;
+
+(*******************************************************************)
+
+BEGIN
+    OpenWindow (w, blue, cyan, 0, 24, 0, 79, noframe, nodivider);
+    WriteString (w, "Test of IOR");
+    TestIOR (5, 19);
+    TestIOR (055AAH, 01234H);
+    TestIORB (5, 19);
+    TestIORB (012H, 089H);
+    TestIXOR (5, 19);
+    TestIXOR (012H, 089H);
+    PressAnyKey (w);
+    LStest;
+    PressAnyKey (w);
+    CloseWindow (w);
+END ORtest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/playtest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/playtest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/playtest.mod
@@ -0,0 +1,58 @@
+MODULE PlayTest;
+
+	(********************************************************)
+	(*							*)
+	(*		Basic test of 3-part music		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM Play3S IMPORT
+    (* proc *)	Play;
+
+(************************************************************************)
+
+TYPE
+    subscript = [0..191];
+    MusicArray = ARRAY subscript OF SHORTCARD;
+
+CONST
+    TestData = MusicArray (
+    			 1, 0, 0,  2, 0, 0,  3, 0, 0,  4, 0, 0,  5, 0, 0,
+			 6, 0, 0,  7, 0, 0,  8, 0, 0,  9, 0, 0, 10, 0, 0,
+			11, 0, 0, 12, 0, 0, 13, 0, 0, 14, 0, 0, 15, 0, 0,
+			16, 0, 0, 17, 0, 0, 18, 0, 0, 19, 0, 0, 20, 0, 0,
+			21, 0, 0, 22, 0, 0, 23, 0, 0, 24, 0, 0, 25, 0, 0,
+			26, 0, 0, 27, 0, 0, 28, 0, 0, 29, 0, 0, 30, 0, 0,
+			31, 0, 0, 32, 0, 0, 33, 0, 0, 34, 0, 0, 35, 0, 0,
+			36, 0, 0, 37, 0, 0, 38, 0, 0, 39, 0, 0, 40, 0, 0,
+			41, 0, 0, 42, 0, 0, 43, 0, 0, 44, 0, 0, 45, 0, 0,
+			46, 0, 0, 47, 0, 0, 48, 0, 0, 49, 0, 0, 50, 0, 0,
+			51, 0, 0, 52, 0, 0, 53, 0, 0, 54, 0, 0, 55, 0, 0,
+			56, 0, 0, 57, 0, 0, 58, 0, 0, 59, 0, 0, 60, 0, 0,
+			61, 0, 0, 62, 0, 0, 63, 0, 0, 255, 0, 0);
+
+VAR Data: MusicArray;
+
+(************************************************************************)
+
+PROCEDURE RunTheTest;
+
+    (* Plays some 3-part music. *)
+
+    BEGIN
+	Data := TestData;
+	Play (Data);
+    END RunTheTest;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    RunTheTest;
+END PlayTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/printert.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/printert.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/printert.mod
@@ -0,0 +1,114 @@
+MODULE PrinterTest;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of printer driver.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	26 February 1993		*)
+	(*  Status:						*)
+	(*	Basic tests complete.				*)
+	(*							*)
+	(********************************************************)
+
+FROM GlassTTY IMPORT
+    (* proc *)	WriteString, WriteLn;
+
+FROM KTrace IMPORT
+    (* proc *)	InTrace, OutTrace, TraceOn, NYI;
+
+FROM Printer IMPORT
+    (* proc *)	PrintChar;
+
+(************************************************************************)
+
+PROCEDURE PrintString (text: ARRAY OF CHAR);
+
+    (* Prints from array text until NUL or end of array.	*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	InTrace ("PrintString");
+	j := 0;
+	LOOP
+	    IF text[j] = CHR(0) THEN EXIT(*LOOP*) END (*IF*);
+	    PrintChar (text[j]);
+	    IF j = HIGH(text) THEN EXIT(*LOOP*) END (*IF*);
+	    INC (j);
+	END (*LOOP*);
+	OutTrace ("PrintString");
+    END PrintString;
+
+(************************************************************************)
+
+PROCEDURE PrintEOL;
+
+    (* Sends a carriage return and line feed to the printer.  Note that	*)
+    (* the printer might not print unterminated lines, because of its	*)
+    (* internal buffering.						*)
+
+    BEGIN
+	PrintChar (CHR(13));  PrintChar(CHR(10));
+    END PrintEOL;
+
+(************************************************************************)
+
+PROCEDURE RunTheTest;
+
+    (* Prints a short test message, and then runs through every		*)
+    (* printable character code.					*)
+    (* Codes CHR(0) to CHR(31) are not tested, since it is hard in such	*)
+    (* a test, because of possible sequence dependence, to interpret	*)
+    (* the results.							*)
+
+    VAR ch: CHAR;
+
+    BEGIN
+	InTrace ("RunTheTest");
+	WriteString ("Test of printer driver.");
+	WriteLn;
+
+	PrintString ("Test message.");
+	PrintEOL;
+	PrintString ("A somewhat longer line, to check the buffering.");
+	PrintEOL;
+	PrintString ("Third line of test message.");
+	PrintEOL;
+	PrintString ("ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789 .,;");
+	PrintEOL;
+
+	FOR ch := CHR(32) TO CHR(63) DO
+	    PrintChar (ch);
+	END (*FOR*);
+	PrintEOL;
+
+	FOR ch := CHR(64) TO CHR(127) DO
+	    PrintChar (ch);
+	END (*FOR*);
+	PrintEOL;
+
+	FOR ch := CHR(128) TO CHR(191) DO
+	    PrintChar (ch);
+	END (*FOR*);
+	PrintEOL;
+
+	FOR ch := CHR(192) TO CHR(255) DO
+	    PrintChar (ch);
+	END (*FOR*);
+	PrintEOL;
+
+	WriteString ("End of test.");
+	WriteLn;
+	OutTrace ("RunTheTest");
+    END RunTheTest;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+    BEGIN
+(*	TraceOn;*)
+	RunTheTest;
+    END PrinterTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/rantest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/rantest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/rantest.mod
@@ -0,0 +1,118 @@
+MODULE RanTest;
+
+	(********************************************************)
+	(*							*)
+	(*	    Test of random number generator		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	17 March 1995			*)
+	(*  Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM Random IMPORT
+    (* proc *)	RANDOM, Randomize;
+
+FROM RandCard IMPORT
+    (* var  *)	seed;
+
+FROM Windows IMPORT
+    (* type *)	Window,
+    (* proc *)	OpenSimpleWindow, CloseWindow, WriteString, WriteLn,
+		PressAnyKey;
+
+FROM NumericIO IMPORT
+    (* proc *)	WriteCard, WriteRJLongCard;
+
+FROM RealIO IMPORT
+    (* proc *)	WriteReal;
+
+(************************************************************************)
+(*				SPEED TEST				*)
+(************************************************************************)
+
+PROCEDURE SpeedTest (TestSize: CARDINAL);
+
+    (* Generates a lot of random numbers.  Relies on the keyboard user	*)
+    (* having a stopwatch, because the timing is not built into this	*)
+    (* module.								*)
+
+    VAR j: CARDINAL;  result: REAL;
+
+    BEGIN
+	FOR j := 1 TO TestSize DO
+	    result := RANDOM();
+	END (*FOR*);
+    END SpeedTest;
+
+(************************************************************************)
+(*			    PLAUSIBILITY TESTS				*)
+(************************************************************************)
+
+PROCEDURE TenThousandTest (w: Window);
+
+    (* Starting with seed = 1, after 10000 calls we should end up with	*)
+    (* seed = 1043618065.						*)
+
+    VAR j: CARDINAL;  dummy: REAL;
+
+    BEGIN
+	Randomize(1);
+	FOR j := 1 TO 10000 DO dummy := RANDOM(); END (*FOR*);
+	WriteString (w, "The current value of seed is ");
+	WriteRJLongCard (w, seed, 11);
+	WriteString (w, ".  It should be 1043618065");
+	WriteLn (w);
+    END TenThousandTest;
+
+(************************************************************************)
+
+PROCEDURE DisplayNumbers (w: Window);
+
+    CONST TestSize = 100;
+
+    VAR j: CARDINAL;  result: REAL;
+
+    BEGIN
+	WriteString (w, "Start of plausibility test");  WriteLn (w);
+	FOR j := 1 TO TestSize DO
+	    result := RANDOM();
+	    WriteReal (w, result, 6);
+	    IF j MOD 8 <> 0 THEN
+		WriteString (w, "  ");
+	    ELSE
+		WriteLn (w);
+	    END (*IF*);
+	END (*FOR*);
+	WriteLn (w);
+	WriteString (w, "End of plausibility test");  WriteLn (w);
+    END DisplayNumbers;
+
+(************************************************************************)
+
+PROCEDURE RunTheTests;
+
+    CONST TestSize = 50000;
+
+    VAR w: Window;
+
+    BEGIN
+	OpenSimpleWindow (w, 0, 24, 0, 79);
+	DisplayNumbers (w);  TenThousandTest (w);
+	WriteString (w, "Start of speed test");  WriteLn (w);
+	PressAnyKey (w);
+	SpeedTest (TestSize);
+	WriteString (w, "End of speed test, ");
+	WriteCard (w, TestSize);  WriteString (w, " numbers generated");
+	WriteLn (w);
+	PressAnyKey (w);  CloseWindow (w);
+    END RunTheTests;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    RunTheTests;
+END RanTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/realtest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/realtest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/realtest.mod
@@ -0,0 +1,138 @@
+MODULE RealTest;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of real I/O using windows.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	10 October 1992			*)
+	(*  Status:						*)
+	(*	Was working with FTL - see below - but still	*)
+	(*	bugs in the TopSpeed version, possibly to do	*)
+	(*	with LongTrunc but maybe because of an E	*)
+	(*	format problem.					*)
+	(*							*)
+	(*	Working, still running various tests.		*)
+	(*	I have noticed the following faults:		*)
+	(*	1. Precision error: 123.456E7 is converted	*)
+	(*	   to 1234599...				*)
+	(*	2. 0.1E-8 is written as 0E-8 when the field	*)
+	(*	   size is 4 or 5.  I haven't yet decided	*)
+	(*	   whether to call this an error.		*)
+	(*							*)
+	(********************************************************)
+
+FROM Trace IMPORT
+    (* proc *)	NYI, Pause, TraceOn;
+
+FROM Conversions IMPORT
+    (* proc *)	StringToLongReal;
+
+FROM RealIO IMPORT
+    (* proc *)	WriteLongReal, ReadLongReal;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, WriteLn, WriteString;
+
+(********************************************************************)
+
+PROCEDURE StringTest (w: Window);
+
+    (* Check that procedure StringToReal works.	*)
+
+    PROCEDURE Test (TestString: ARRAY OF CHAR);
+
+	VAR value: LONGREAL;
+
+	BEGIN
+	    value := StringToLongReal (TestString);
+	    WriteString (w, TestString);  WriteString (w, " = ");
+	    WriteLongReal (w, value, 10);  WriteLn (w);
+	END Test;
+
+    BEGIN
+	WriteString (w, "Now testing StringToLongReal.");  WriteLn (w);
+	Test ("123.456");
+	Test ("50000000000");
+	Test ("0.00009999");
+	Test ("   .00009999");
+	Test ("   .000099999");
+	Test ("000.001");
+	Test ("0");
+	Test ("123");
+	Test ("123.456E7");
+	Test ("123.456E-7");
+    END StringTest;
+
+(********************************************************************)
+
+PROCEDURE InputTest (w: Window);
+
+    VAR result: LONGREAL;
+
+    BEGIN
+	WriteString (w, "Now testing ReadLongReal.");  WriteLn (w);
+	REPEAT
+	    result := ReadLongReal (w);  WriteString (w, " = ");
+	    WriteLongReal (w, result, 10);  WriteLn (w);
+	UNTIL result = 0.0;
+	Pause;
+    END InputTest;
+
+(********************************************************************)
+
+PROCEDURE OutputTest (w: Window);
+
+    VAR	x: LONGREAL;
+	j: CARDINAL;
+
+    BEGIN
+	WriteString (w, "   0.0 = ");  WriteLongReal (w, 0.0, 8);  WriteLn(w);
+	WriteString (w, "   1.0 = ");  WriteLongReal (w, 1.0, 8);  WriteLn(w);
+	WriteString (w, "  10.0 = ");  WriteLongReal (w, 10.0, 8);  WriteLn(w);
+	WriteString (w, " 1.005 = ");  WriteLongReal (w, 1.005, 8);  WriteLn(w);
+	WriteString (w, "1.0052 = ");  WriteLongReal (w, 1.0052, 8);  WriteLn(w);
+	Pause;
+	WriteString (w, "1.1 = ");  WriteLongReal (w, 1.1, 8);  WriteLn(w);
+	WriteString (w, "1.5 = ");  WriteLongReal (w, 1.5, 8);  WriteLn(w);
+
+	Pause;
+
+	x := 3.14159265;
+	FOR j := 12 TO 1 BY -1 DO
+	    WriteLongReal (w, x, j);  WriteLn(w);  Pause;
+	END (*FOR*);
+
+	FOR j := 14 TO 1 BY -1 DO
+	    WriteLongReal (w, 12345678.0, j);
+	    WriteLn (w);
+	    Pause;
+	    WriteLongReal (w, 0.0000000012345, j);  WriteLn (w);
+	    Pause;
+	END (*FOR*);
+    END OutputTest;
+
+(********************************************************************)
+
+PROCEDURE RunTheTest;
+
+    VAR w: Window;
+
+    BEGIN
+	OpenWindow (w, black, white, 10, 20, 0, 40, simpleframe, nodivider);
+	OutputTest (w);
+	StringTest (w);
+	InputTest (w);
+	Pause;
+	CloseWindow (w);
+
+    END RunTheTest;
+
+(********************************************************************)
+
+BEGIN
+ (*   TraceOn (0, 10, 5, 40);  *)
+    RunTheTest;
+END RealTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/sematest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/sematest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/sematest.mod
@@ -0,0 +1,181 @@
+MODULE SemaTest;
+
+	(********************************************************)
+	(*							*)
+	(*	Test program to check that the semaphore	*)
+	(*	operations work.				*)
+	(*							*)
+	(*	Programmer:	P. Moylan			*)
+	(*	Last edited:	9 February 1995    	      	*)
+	(*							*)
+	(*	Description:	Runs a pair of tasks in a	*)
+	(*		simple producer/consumer relationship.	*)
+	(*					                *)
+	(*	Status:						*)
+	(*		Working, except for a bug in		*)
+	(*		tracing: attempting to trace kernel	*)
+	(*		causes infinite recursion.  For now	*)
+	(*		kernel tracing has been removed, but	*)
+	(*		given the intended use of this program	*)
+	(*		we should find a mechanism for kernel	*)
+	(*		tracing.				*)
+	(*							*)
+	(********************************************************)
+
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, WriteString, WriteLn, Write,
+		PressAnyKey, ReadChar;
+
+FROM Trace IMPORT
+    (* proc *)	TraceOn;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM TaskControl IMPORT
+    (* proc *)	CreateTask, TaskExit;
+
+FROM CircularBuffers IMPORT
+    (* type *)	CircularBuffer,
+    (* proc *)	CreateBuffer, PutBuffer, GetBuffer;
+
+(************************************************************************)
+
+CONST Esc = CHR(01BH);
+
+VAR
+
+    (* The consumer and producer tasks will communicate through a	*)
+    (* circular buffer called "pipe".					*)
+
+    pipe: CircularBuffer;
+
+    (* logwindow is a screen window used for status messages.		*)
+
+    logwindow: Window;
+
+    (* The "finished" semaphore is needed so the main task will know	*)
+    (* when the consumer and producer tasks have both exited.		*)
+
+    finished: Semaphore;
+
+(************************************************************************)
+(*			THE PRODUCER AND CONSUMER TASKS			*)
+(************************************************************************)
+
+PROCEDURE Producer;
+
+    (* The producer task.  Takes input from the keyboard, sends it to	*)
+    (* the intertask buffer where it will be picked up by the consumer	*)
+    (* task.  Exits when a second Esc key is received (the first is	*)
+    (* sent to the consumer task).					*)
+
+    VAR datum: CHAR;  EscSent: BOOLEAN;
+	pwindow: Window;
+
+    BEGIN
+	OpenWindow (pwindow, red, green, 4, 11, 0, 39, simpleframe, nodivider);
+	WriteString (pwindow, "Starting producer task.");
+	WriteLn (pwindow);
+	EscSent := FALSE;
+
+	LOOP
+	    ReadChar (pwindow, datum);
+	    IF datum = Esc THEN
+		IF EscSent THEN EXIT(*LOOP*) END (*IF*);
+		EscSent := TRUE;
+	    END (*IF*);
+	    PutBuffer (pipe, datum);
+	END (*LOOP*);
+
+	WriteString (pwindow, "Producer task is now terminating.");
+	WriteLn (pwindow);
+	CloseWindow (pwindow);
+	Signal (finished);
+	TaskExit;
+    END Producer;
+
+(************************************************************************)
+
+PROCEDURE Consumer;
+
+    (* The consumer task.  Takes input from the intertask buffer and	*)
+    (* prints it, changing lower case letters to upper case.		*)
+    (* Exits when an Esc character has been received.			*)
+
+    VAR datum: CHAR;
+	cwindow: Window;
+
+    BEGIN
+	OpenWindow (cwindow, blue, cyan, 7,14, 30,69, simpleframe, nodivider);
+	WriteString (cwindow, "Starting consumer task.");
+	WriteLn (cwindow);
+	LOOP
+	    datum := GetBuffer(pipe);
+	    IF (datum >= 'a') AND (datum <= 'z') THEN
+		datum := CHR (ORD(datum)-ORD('a')+ORD('A'))
+	    END (*IF*);
+	    IF datum = Esc THEN EXIT(*LOOP*) END(*IF*);
+	    Write (cwindow, datum);
+	END (*LOOP*);
+	WriteLn (cwindow);
+	WriteString (cwindow, "Consumer task is now terminating.");
+	WriteLn (cwindow);
+	CloseWindow (cwindow);
+	Signal (finished);
+	TaskExit;
+    END Consumer;
+
+(************************************************************************)
+(*			    THE TEST PROCEDURE				*)
+(************************************************************************)
+
+PROCEDURE RunTheTest;
+
+    CONST ProducerPriority = 1; ConsumerPriority = 1;
+
+    VAR taskcount: CARDINAL;
+
+    BEGIN
+	CreateBuffer (pipe, 8);
+	CreateSemaphore (finished, 0);
+	taskcount := 0;
+
+	CreateTask (Consumer, ConsumerPriority, "Consumer");
+	INC (taskcount);
+	WriteString (logwindow, "Have created consumer task.");
+	WriteLn (logwindow);
+
+	CreateTask (Producer, ProducerPriority, "Producer");
+	INC (taskcount);
+	WriteString (logwindow, "Have created producer task.");
+	WriteLn (logwindow);
+
+	WHILE taskcount > 0 DO
+	    Wait (finished);  DEC(taskcount);
+	END (*WHILE*);
+
+	WriteString (logwindow,
+			"All tasks terminated - back in RunTheTest.");
+	WriteLn (logwindow);
+    END RunTheTest;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+    BEGIN
+	(*TraceOn (10, 24, 0, 79, 50);*)
+	OpenWindow (logwindow, white, black, 0, 3, 0, 49,
+					noframe, nodivider);
+	WriteString (logwindow, "Test of semaphore operations.");
+	WriteLn (logwindow);
+	RunTheTest;
+	WriteString (logwindow, "End of test.");
+	PressAnyKey (logwindow);
+	CloseWindow (logwindow);
+    END SemaTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/serialte.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/serialte.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/serialte.mod
@@ -0,0 +1,142 @@
+MODULE SerialTest;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of Serial I/O			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	16 February 1994		*)
+	(*  Status:		Seems to be working.		*)
+	(*			Not fully tested.		*)
+	(*							*)
+	(********************************************************)
+
+FROM TaskControl IMPORT
+    (* proc *)	CreateTask;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM SerialIO IMPORT
+    (* type *)	Parity,
+    (* proc *)	InitSerialChannel, ReadSerial, WriteSerial;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, ChangeScrollingRegion, CloseWindow,
+		WriteString, ReadChar, Write;
+
+(************************************************************************)
+
+VAR TaskDone: Semaphore;
+
+(************************************************************************)
+
+PROCEDURE COM1OutputTask;
+
+    CONST Esc = CHR(27);
+
+    VAR w1: Window;  ch: CHAR;
+
+    BEGIN
+	OpenWindow (w1, blue, cyan, 8, 15, 0, 39, simpleframe, doubledivider);
+	WriteString (w1, "Output to COM1");
+	ChangeScrollingRegion (w1, 3, 6);
+
+	LOOP
+	    ReadChar (w1, ch);
+	    IF ch = Esc THEN EXIT(*LOOP*) END(*IF*);
+	    WriteSerial (1, ch);
+	END (*LOOP*);
+
+	CloseWindow (w1);
+	Signal (TaskDone);
+
+    END COM1OutputTask;
+
+(************************************************************************)
+
+PROCEDURE COM2OutputTask;
+
+    CONST Esc = CHR(27);
+
+    VAR w1: Window;  ch: CHAR;
+
+    BEGIN
+	OpenWindow (w1, white, magenta, 8, 15, 40, 79, simpleframe, doubledivider);
+	WriteString (w1, "Output to COM2");
+	ChangeScrollingRegion (w1, 3, 6);
+
+	LOOP
+	    ReadChar (w1, ch);
+	    IF ch = Esc THEN EXIT(*LOOP*) END(*IF*);
+	    WriteSerial (2, ch);
+	END (*LOOP*);
+
+	CloseWindow (w1);
+	Signal (TaskDone);
+
+    END COM2OutputTask;
+
+(************************************************************************)
+
+PROCEDURE COM1InputTask;
+
+    VAR w2: Window;  ch: CHAR;
+
+    BEGIN
+	OpenWindow (w2, white, magenta, 0, 7, 0, 39, simpleframe, doubledivider);
+	WriteString (w2, "Input from COM1");
+	ChangeScrollingRegion (w2, 3, 6);
+
+	LOOP
+	    ReadSerial (1, ch);
+	    Write (w2, ch);
+	END (*LOOP*);
+
+    END COM1InputTask;
+
+(************************************************************************)
+
+PROCEDURE COM2InputTask;
+
+    VAR w2: Window;  ch: CHAR;
+
+    BEGIN
+	OpenWindow (w2, blue, cyan, 0, 7, 40, 79, simpleframe, doubledivider);
+	WriteString (w2, "Input from COM2");
+	ChangeScrollingRegion (w2, 3, 6);
+
+	LOOP
+	    ReadSerial (2, ch);
+	    Write (w2, ch);
+	END (*LOOP*);
+
+    END COM2InputTask;
+
+(************************************************************************)
+
+PROCEDURE RunTheTest;
+
+    BEGIN
+	CreateTask (COM1OutputTask, 1, "COM1 output");
+	CreateTask (COM1InputTask, 1, "COM1 input");
+	CreateTask (COM2OutputTask, 1, "COM2 output");
+	CreateTask (COM2InputTask, 1, "COM2 input");
+	Wait (TaskDone);  Wait (TaskDone);
+    END RunTheTest;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    (* The following parameters seem to be appropriate for the mouse.	*)
+
+    InitSerialChannel (1, 9600, 8, NoParity, 1);
+    InitSerialChannel (2, 2400, 8, OddParity, 2);
+    CreateSemaphore (TaskDone, 0);
+    RunTheTest;
+END SerialTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/sort1.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/sort1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/sort1.mod
@@ -0,0 +1,284 @@
+MODULE Sort1;
+
+	(********************************************************)
+	(*							*)
+	(*		    File sort program			*)
+	(*							*)
+	(*	This is a test of the PMOS file system, so	*)
+	(*	we're not particularly concerned about the	*)
+	(*	efficiency of the sorting algorithm.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	17 March 1995			*)
+	(*  Status:		Working, but incredibly slow	*)
+	(*							*)
+	(********************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	ADDRESS,
+    (* proc *)	ADR;
+
+FROM Trace IMPORT
+    (* proc *)	NYI;
+
+FROM Files IMPORT
+    (* type *)	File,
+    (* proc *)	OpenFile, CloseFile, ReadRecord, WriteRecord, EOF,
+		FileSize, SetPosition;
+
+IMPORT (*HardDisk,*) Floppy;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, Write, WriteString, WriteLn,
+		EditString, EditAborted, PressAnyKey;
+
+FROM NumericIO IMPORT
+    (* proc *)	ReadBufferedCardinal, WriteAddress, WriteLongCard;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM IOErrorCodes IMPORT
+    (* type *)	ErrorCode,
+    (* proc *)	TranslateErrorCode;
+
+(************************************************************************)
+
+CONST testing = TRUE;
+      testingSP = FALSE;
+
+TYPE BufferPointer = POINTER TO ARRAY [0..MAX(CARDINAL)-1] OF CHAR;
+
+VAR debug: Window;
+
+(************************************************************************)
+
+PROCEDURE greater (first, second: BufferPointer;  recordsize: CARDINAL)
+								: BOOLEAN;
+
+    (* Tests for first^ > second^.	*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	j := 0;
+	LOOP
+	    IF first^[j] > second^[j] THEN RETURN TRUE END(*IF*);
+	    IF first^[j] < second^[j] THEN RETURN FALSE END(*IF*);
+	    INC (j);
+	    IF j >= recordsize THEN RETURN FALSE END(*IF*);
+	END (*LOOP*);
+    END greater;
+
+(************************************************************************)
+
+PROCEDURE PutRecord (f: File;  dataptr: BufferPointer;  recordsize: CARDINAL)
+								: ErrorCode;
+
+    (* Inserts a new record into file f. *)
+
+    VAR limit, place: LONGCARD;  count: CARDINAL;
+	OriginalBufptr, bufptr, temp: BufferPointer;
+	status: ErrorCode;
+
+    BEGIN
+	limit := FileSize(f);  place := 0;
+	ALLOCATE (OriginalBufptr, recordsize);
+	IF testing THEN
+	    WriteLn (debug);
+	    WriteString (debug, "Allocated buffer at ");
+	    WriteAddress (debug, OriginalBufptr);
+	END (*IF*);
+	bufptr := OriginalBufptr;
+	status := OK;
+
+	(* Work out where to do the insertion. *)
+
+	LOOP
+	    IF place >= limit THEN EXIT(*LOOP*) END(*IF*);
+	    IF testingSP THEN
+		WriteLn (debug);  WriteString (debug, "Setting position to ");
+		WriteLongCard (debug, place);
+		PressAnyKey (debug);
+	    END (*IF*);
+	    status := SetPosition (f, place);
+(*
+	    IF testingSP THEN
+		WriteLn (debug);  WriteString (debug, "Return from SetPosition");
+		PressAnyKey (debug);
+	    END (*IF*);
+*)
+	    IF status = OK THEN
+		status := ReadRecord (f, bufptr, recordsize, count);
+	    END (*IF*);
+	    IF status <> OK THEN EXIT(*LOOP*) END (*IF*);
+	    IF greater (bufptr, dataptr, recordsize) THEN
+		EXIT (*LOOP*);
+	    END (*IF*);
+	    INC (place, LONGCARD(recordsize));
+	END (*LOOP*);
+
+	IF testing THEN
+	    WriteLn (debug);  WriteString (debug, "Inserting record at ");
+	    WriteLongCard (debug, place);
+	END (*IF*);
+
+	IF status <> OK THEN
+	    DEALLOCATE (OriginalBufptr, recordsize);
+	    RETURN status;
+	END(*IF*);
+
+	(* Shift all the existing records, and insert the new one. *)
+
+	LOOP
+	    (* dataptr^ is the record to be inserted at the current	*)
+	    (* file position, and bufptr^ is the record which it has	*)
+	    (* displaced.						*)
+
+	    IF testingSP THEN
+		WriteLn (debug);  WriteString (debug, "Setting position to ");
+		WriteLongCard (debug, place);
+		PressAnyKey (debug);
+	    END (*IF*);
+	    status := SetPosition (f, place);
+(*
+	    IF testingSP THEN
+		WriteLn (debug);  WriteString (debug, "Return from SetPosition");
+		PressAnyKey (debug);
+	    END (*IF*);
+*)
+	    IF status = OK THEN
+		status := WriteRecord (f, dataptr, recordsize);
+	    END (*IF*);
+	    IF status <> OK THEN EXIT(*LOOP*) END (*IF*);
+	    IF place >= limit THEN EXIT(*LOOP*) END(*IF*);
+
+	    (* Swap the buffer pointers, so that dataptr^ will then be	*)
+	    (* the last record which we read and which still has to	*)
+	    (* be re-inserted.						*)
+
+	    temp := dataptr;  dataptr := bufptr;  bufptr := temp;
+	    INC (place, LONGCARD(recordsize));
+	    IF testingSP THEN
+		WriteLn (debug);  WriteString (debug, "Setting position to ");
+		WriteLongCard (debug, place);
+		PressAnyKey (debug);
+	    END (*IF*);
+	    status := SetPosition (f, place);
+(*
+	    IF testingSP THEN
+		WriteLn (debug);  WriteString (debug, "Return from SetPosition");
+		PressAnyKey (debug);
+	    END (*IF*);
+*)
+	    IF status = OK THEN
+		status := ReadRecord (f, bufptr, recordsize, count);
+	    END (*IF*);
+	    IF status <> OK THEN EXIT(*LOOP*) END (*IF*);
+	END (*LOOP*);
+
+	DEALLOCATE (OriginalBufptr, recordsize);
+	RETURN status;
+    END PutRecord;
+
+(************************************************************************)
+
+PROCEDURE InsertionSort;
+
+    (* Reads a file sequentially, creates a sorted version in a new	*)
+    (* file.  For now, we are using an insertion sort method.		*)
+
+    VAR infile, outfile: File;  log, w: Window;
+	j: CARDINAL;  count: CARDINAL;
+	name, errbuf: ARRAY [0..40] OF CHAR;
+	status: ErrorCode;
+	BufSize: CARDINAL;
+	Bufptr: BufferPointer;
+
+    BEGIN
+	BufSize := 20;
+	OpenWindow (w, white, black, 0, 16, 0, 79,
+					noframe, nodivider);
+	OpenWindow (log, white, black, 17, 24, 0, 79,
+					simpleframe, nodivider);
+	WriteString (log, "I/O Test Program (slow!): should produce a sorted file");
+	WriteLn (log);
+	WriteString (log, "Source file name (full path name): ");
+	name := "A:\UNSORTED.DAT";
+	EditString (log, name, SIZE(name));
+	IF EditAborted() THEN
+	    WriteLn (log);
+	    WriteString (log, "Operation aborted at user request");
+	ELSE
+	    status := OpenFile (infile, name, FALSE);
+	    IF status = OK THEN
+		WriteLn (log);
+		WriteString (log, "Copy to file (full path name): ");
+		name := "A:TEST1.TMP";
+		EditString (log, name, SIZE(name));
+		IF EditAborted() THEN
+		    WriteLn (log);
+		    WriteString (log, "Operation aborted at user request");
+		ELSE
+		    status := OpenFile (outfile, name, TRUE);
+		    IF status = OK THEN
+			WriteLn (log);  WriteString (log, "Record size: ");
+			BufSize := ReadBufferedCardinal (log, 4);
+			ALLOCATE (Bufptr, BufSize);
+			WHILE NOT EOF(infile) DO
+			    status := ReadRecord (infile, Bufptr, BufSize, count);
+			    IF status <> OK THEN
+				WriteLn (log);  WriteString (log, "Read Error!");
+			    ELSIF count > 0 THEN
+				FOR j := 0 TO count-1 DO
+				    Write (w, Bufptr^[j]);
+				END (*FOR*);
+				status := PutRecord (outfile, Bufptr, BufSize);
+				IF status <> OK THEN
+				    WriteLn (log);  WriteString (log, "Write Error!");
+				END (*IF*);
+				    END (*IF*);
+			END (*WHILE*);
+			IF testing THEN
+			    WriteLn (debug);
+			    WriteString (debug, "Have written last record");
+			END (*IF*);
+			DEALLOCATE (Bufptr, BufSize);
+		    ELSE
+			WriteLn (log);  WriteString (log, "Could not open output file");
+			WriteLn (log);  WriteString (log, "Error code ");
+			TranslateErrorCode (status, errbuf);
+			WriteString (log, errbuf);
+		    END (*IF successfully opened output file*);
+
+		    IF testing THEN
+			WriteLn (debug);  WriteString (debug, "Calling CloseFile");
+		    END (*IF*);
+		    CloseFile (outfile);
+		END (*IF EditAborted*);
+	    ELSE
+		WriteLn (log);  WriteString (log, "Could not open input file");
+		WriteLn (log);  WriteString (log, "Error code ");
+		TranslateErrorCode (status, errbuf);
+		WriteString (log, errbuf);
+	    END (*IF successfully opened input file*);
+	    CloseFile (infile);
+	    WriteLn (log);  WriteString (log, "End of Sort");
+	    PressAnyKey (log);
+	END (*IF EditAborted*);
+	CloseWindow (w);  CloseWindow (log);
+    END InsertionSort;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    IF testing OR testingSP THEN
+	OpenWindow (debug, white, black, 12, 16, 0, 79,
+					simpleframe, nodivider);
+    END (*IF*);
+    InsertionSort;
+END Sort1.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/sort2.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/sort2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/sort2.mod
@@ -0,0 +1,296 @@
+MODULE Sort2;
+
+	(********************************************************)
+	(*							*)
+	(*		    File sort program			*)
+	(*							*)
+	(*	This is a test of the PMOS file system, so	*)
+	(*	we're not particularly concerned about the	*)
+	(*	efficiency of the sorting algorithm.		*)
+	(*	However, it's better than Sort1.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	17 March 1995			*)
+	(*  Status:		Working, but a bit slow		*)
+	(*	Runs a lot faster when module Files replaced	*)
+	(*	by FileSys.  This is certainly due to		*)
+	(*	insufficient cacheing; most probably the main	*)
+	(*	problem is the conservative FAT updating in	*)
+	(*	module Directories.				*)
+	(*							*)
+	(********************************************************)
+
+FROM Files IMPORT
+    (* type *)	File,
+    (* proc *)	OpenFile, CloseFile, ReadRecord, WriteRecord, EOF,
+		FileSize, SetPosition;
+
+IMPORT (*HardDisk,*) Floppy;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, Write, WriteString, WriteLn,
+		EditString, EditAborted, PressAnyKey;
+
+FROM NumericIO IMPORT
+    (* proc *)	ReadBufferedCardinal;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM IOErrorCodes IMPORT
+    (* type *)	ErrorCode,
+    (* proc *)	TranslateErrorCode;
+
+(************************************************************************)
+
+CONST testing = TRUE;
+
+TYPE BufferPointer = POINTER TO ARRAY [0..0] OF CHAR;
+
+VAR debug: Window;
+
+(************************************************************************)
+
+PROCEDURE less (first, second: BufferPointer;  recordsize: CARDINAL)
+								: BOOLEAN;
+
+    (* Tests for first^ < second^.	*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	j := 0;
+	LOOP
+	    (*# save, check(index=>off) *)
+	    IF first^[j] > second^[j] THEN RETURN FALSE END(*IF*);
+	    IF first^[j] < second^[j] THEN RETURN TRUE END(*IF*);
+	    (*# restore *)
+	    INC (j);
+	    IF j >= recordsize THEN RETURN FALSE END(*IF*);
+	END (*LOOP*);
+    END less;
+
+(************************************************************************)
+
+PROCEDURE FindInsertionPoint (f: File;  dataptr: BufferPointer;
+		recsize: CARDINAL;  VAR (*OUT*) place: LONGCARD): ErrorCode;
+
+    (* Returns (assuming result is OK) with place equal to the point in	*)
+    (* file f where dataptr^ should be inserted.			*)
+
+    VAR low, mid, high, recordsize: LONGCARD;  count: CARDINAL;
+	bufptr: BufferPointer;
+	status: ErrorCode;
+
+    BEGIN
+	ALLOCATE (bufptr, recsize);
+	status := OK;
+	recordsize := LONGCARD(recsize);
+
+	low := 0;  high := FileSize(f) DIV recordsize;
+	LOOP
+	    IF high = low THEN EXIT (*LOOP*) END(*IF*);
+	    mid := (low+high) DIV 2;
+	    status := SetPosition (f, recordsize*mid);
+	    IF status = OK THEN
+		status := ReadRecord (f, bufptr, recsize, count);
+	    END (*IF*);
+	    IF status <> OK THEN EXIT(*LOOP*) END (*IF*);
+	    IF less (bufptr, dataptr, recsize) THEN
+		low := mid + 1;
+	    ELSE
+		high := mid;
+	    END (*IF*);
+	END (*LOOP*);
+
+	place := recordsize*low;
+	DEALLOCATE (bufptr, recsize);
+	RETURN status;
+
+    END FindInsertionPoint;
+
+(************************************************************************)
+
+PROCEDURE ShiftData (f: File;  place: LONGCARD;  amount: CARDINAL): ErrorCode;
+
+    (* Creates a gap in file f, by shifting the contents from position	*)
+    (* place onwards by amount bytes.  It is assumed (because of the	*)
+    (* logic of the rest of the program) that the size of f is already	*)
+    (* an integral multiple of amount.					*)
+
+    CONST buffersize = 4096;
+
+    VAR bufptr: BufferPointer;  oldpos, remaining: LONGCARD;
+	status: ErrorCode;  dummy: CARDINAL;
+
+    BEGIN
+	ALLOCATE (bufptr, buffersize);
+	oldpos := FileSize (f);
+	remaining := oldpos - place;
+	status := OK;
+
+	LOOP
+	    IF remaining < buffersize THEN EXIT(*LOOP*) END(*IF*);
+	    DEC (oldpos, buffersize);
+	    status := SetPosition (f, oldpos);
+	    IF status = OK THEN
+		status := ReadRecord (f, bufptr, buffersize, dummy);
+	    END (*IF*);
+	    IF status <> OK THEN EXIT(*LOOP*) END (*IF*);
+	    status := SetPosition (f, oldpos+LONGCARD(amount));
+	    IF status = OK THEN
+		status := WriteRecord (f, bufptr, buffersize);
+	    END (*IF*);
+	    IF status <> OK THEN EXIT(*LOOP*) END (*IF*);
+	    DEC (remaining, buffersize);
+	END (*LOOP*);
+
+	(* We still have to move a chunk at the beginning.	*)
+
+	IF (status = OK) AND (remaining > 0) THEN
+	    status := SetPosition (f, place);
+	    IF status = OK THEN
+		status := ReadRecord (f, bufptr, CARDINAL(remaining), dummy);
+	    END (*IF*);
+	    IF status = OK THEN
+		status := SetPosition (f, place+LONGCARD(amount));
+	    END (*IF*);
+	    IF status = OK THEN
+		status := WriteRecord (f, bufptr, CARDINAL(remaining));
+	    END (*IF*);
+	END (*IF*);
+
+	DEALLOCATE (bufptr, buffersize);
+	RETURN status;
+
+    END ShiftData;
+
+(************************************************************************)
+
+PROCEDURE InsertRecord (f: File;  dataptr: BufferPointer;
+					recordsize: CARDINAL): ErrorCode;
+
+    (* Inserts a new record into file f. *)
+
+    VAR place: LONGCARD;
+	status: ErrorCode;
+
+    BEGIN
+	status := FindInsertionPoint (f, dataptr, recordsize, place);
+	IF status = OK THEN
+	    status := ShiftData (f, place, recordsize);
+	END (*IF*);
+	IF status = OK THEN
+	    status := SetPosition (f, place);
+	END (*IF*);
+	IF status = OK THEN
+	    status := WriteRecord (f, dataptr, recordsize);
+	END (*IF*);
+	RETURN status;
+    END InsertRecord;
+
+(************************************************************************)
+
+PROCEDURE InsertionSort;
+
+    (* Reads a file sequentially, creates a sorted version in a new	*)
+    (* file.  For now, we are using an insertion sort method.		*)
+
+    VAR infile, outfile: File;  log, w: Window;
+	j: CARDINAL;  count: CARDINAL;
+	name, errbuf: ARRAY [0..40] OF CHAR;
+	status: ErrorCode;
+	BufSize: CARDINAL;
+	Bufptr: BufferPointer;
+
+    BEGIN
+	BufSize := 20;
+	OpenWindow (w, white, black, 0, 16, 0, 79,
+					noframe, nodivider);
+	OpenWindow (log, white, black, 17, 24, 0, 79,
+					simpleframe, nodivider);
+	WriteString (log, "I/O Test Program: should produce a sorted file");
+	WriteLn (log);
+	WriteString (log, "Source file name (full path name): ");
+	name := "C:\PMOS\TESTS\UNSORTED.DAT";
+	EditString (log, name, SIZE(name));
+	IF EditAborted() THEN status := OperationAborted
+	ELSE status := OpenFile (infile, name, FALSE);
+	END (*IF*);
+	IF status = OK THEN
+	    WriteLn (log);
+	    WriteString (log, "Copy to file (full path name): ");
+	    name := "A:TEST1.TMP";
+	    EditString (log, name, SIZE(name));
+	    IF EditAborted() THEN status := OperationAborted
+	    ELSE status := OpenFile (outfile, name, TRUE);
+	    END (*IF*);
+	    IF status = OK THEN
+		WriteLn (log);  WriteString (log, "Record size: ");
+		BufSize := ReadBufferedCardinal (log, 4);
+		ALLOCATE (Bufptr, BufSize);
+		WHILE NOT EOF(infile) DO
+		    IF testing THEN
+			WriteLn (debug);
+			WriteString (debug, "About to read a record");
+		    END (*IF*);
+		    status := ReadRecord (infile, Bufptr, BufSize, count);
+		    IF testing THEN
+			WriteLn (debug);
+			WriteString (debug, "Read one record");
+		    END (*IF*);
+		    IF status <> OK THEN
+			WriteLn (log);  WriteString (log, "Read Error!");
+		    ELSIF count > 0 THEN
+			FOR j := 0 TO count-1 DO
+			    (*# save, check(index=>off) *)
+			    Write (w, Bufptr^[j]);
+			    (*# restore *)
+			END (*FOR*);
+			status := InsertRecord (outfile, Bufptr, BufSize);
+			IF status <> OK THEN
+			    WriteLn (log);  WriteString (log, "Write Error!");
+			END (*IF*);
+		    END (*IF*);
+		END (*WHILE*);
+		IF testing THEN
+		    WriteLn (debug);
+		    WriteString (debug, "Have written last record");
+		END (*IF*);
+		DEALLOCATE (Bufptr, BufSize);
+	    ELSE
+		WriteLn (log);  WriteString (log, "Could not open output file");
+		WriteLn (log);  WriteString (log, "Error code ");
+		TranslateErrorCode (status, errbuf);
+		WriteString (log, errbuf);
+	    END (*IF successfully opened output file*);
+
+	    IF testing THEN
+		WriteLn (debug);  WriteString (debug, "Calling CloseFile");
+	    END (*IF*);
+	    CloseFile (outfile);
+	ELSE
+	    WriteLn (log);  WriteString (log, "Could not open input file");
+	    WriteLn (log);  WriteString (log, "Error code ");
+	    TranslateErrorCode (status, errbuf);
+	    WriteString (log, errbuf);
+	END (*IF successfully opened input file*);
+	CloseFile (infile);
+	WriteLn (log);  WriteString (log, "End of Sort");
+	PressAnyKey (log);
+	CloseWindow (w);  CloseWindow (log);
+    END InsertionSort;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    IF testing THEN
+	OpenWindow (debug, white, black, 12, 16, 0, 79,
+					simpleframe, nodivider);
+    END (*IF*);
+    InsertionSort;
+END Sort2.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/sort3.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/sort3.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/sort3.mod
@@ -0,0 +1,122 @@
+MODULE Sort3;
+
+	(********************************************************)
+	(*							*)
+	(*		    File sort program			*)
+	(*							*)
+	(*	This is a test of the FileSort module.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	11 May 1994			*)
+	(*  Status:		Working				*)
+	(*	FileSort still not as efficient as I want.	*)
+	(*							*)
+	(********************************************************)
+
+FROM FileSort IMPORT
+    (* proc *)	InplaceSort;
+
+FROM FileSys IMPORT
+    (* type *)	File,
+    (* proc *)	OpenFile, CloseFile, FileSize;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, Write, WriteString, WriteLn,
+		EditString, EditAborted, PressAnyKey;
+
+FROM NumericIO IMPORT
+    (* proc *)	EditCardinal;
+
+FROM IOErrorCodes IMPORT
+    (* type *)	ErrorCode,
+    (* proc *)	TranslateErrorCode;
+
+(************************************************************************)
+
+CONST testing = TRUE;
+
+TYPE BufferPointer = POINTER TO ARRAY [0..0] OF CHAR;
+
+VAR debug: Window;
+    RecordSize: CARDINAL;
+
+(************************************************************************)
+
+PROCEDURE GEproc (first, second: BufferPointer): BOOLEAN;
+
+    (* Tests for first^ >= second^.	*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	j := 0;
+	LOOP
+	    (*# save, check(index=>off) *)
+	    IF first^[j] > second^[j] THEN RETURN TRUE END(*IF*);
+	    IF first^[j] < second^[j] THEN RETURN FALSE END(*IF*);
+	    (*# restore *)
+	    INC (j);
+	    IF j >= RecordSize THEN RETURN TRUE END(*IF*);
+	END (*LOOP*);
+    END GEproc;
+
+(************************************************************************)
+
+PROCEDURE DoTheSort;
+
+    (* Opens the data file, and uses the FileSort module to sort it.	*)
+
+    VAR datafile: File;  log, w: Window;
+	name: ARRAY [0..40] OF CHAR;
+	status: ErrorCode;
+
+    BEGIN
+	RecordSize := 20;
+	OpenWindow (w, white, black, 0, 16, 0, 79,
+					noframe, nodivider);
+	OpenWindow (log, white, black, 17, 24, 0, 79,
+					simpleframe, nodivider);
+	WriteString (log, "Test of in-place file sort algorithm");
+	WriteLn (log);
+	WriteString (log, "File name (full path name): ");
+	name := "B:TEST.DAT";
+	EditString (log, name, SIZE(name));
+	IF EditAborted() THEN status := OperationAborted
+	ELSE status := OpenFile (datafile, name, FALSE);
+	END (*IF*);
+	IF status = OK THEN
+	    WriteLn (log);  WriteString (log, "Record size: ");
+	    EditCardinal (log, RecordSize, 4);
+	    InplaceSort (datafile, 0,
+			(FileSize(datafile) DIV VAL(LONGCARD,RecordSize)) - 1,
+			RecordSize, 0, GEproc);
+	ELSE
+	    WriteLn (log);  WriteString (log, "Could not open data file");
+	    WriteLn (log);  WriteString (log, "Error code ");
+	    TranslateErrorCode (status, name);
+	    WriteString (log, name);
+	END (*IF successfully opened file*);
+
+	IF testing THEN
+	    WriteLn (debug);  WriteString (debug, "Calling CloseFile");
+	END (*IF*);
+	CloseFile (datafile);
+	WriteLn (log);  WriteString (log, "End of Sort");
+	PressAnyKey (log);
+	CloseWindow (w);  CloseWindow (log);
+
+    END DoTheSort;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    IF testing THEN
+	OpenWindow (debug, white, black, 12, 16, 0, 79,
+					simpleframe, nodivider);
+    END (*IF*);
+    DoTheSort;
+END Sort3.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/sorttest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/sorttest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/sorttest.mod
@@ -0,0 +1,113 @@
+MODULE SortTest;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of module QuickSort		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	6 March 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM QuickSortModule IMPORT
+    (* proc *)	QuickSort;
+
+FROM RandCard IMPORT
+    (* proc *)	RandCardinal;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, WriteLn, PressAnyKey,
+		WriteString, OpenSimpleWindow;
+
+FROM NumericIO IMPORT
+    (* proc *)	WriteRJLongCard;
+
+(************************************************************************)
+
+CONST testing = TRUE;
+VAR debug: Window;
+
+TYPE
+    Datum = LONGCARD;
+    DataPtr = POINTER TO Datum;
+
+(************************************************************************)
+
+PROCEDURE GreaterOrEqual (p1, p2: DataPtr): BOOLEAN;
+
+    (* Comparison of two data elements.  Returns TRUE iff p1^ >= p2^.	*)
+
+    BEGIN
+(*
+	IF testing THEN
+	    WriteLn (debug);  WriteString (debug, "Comparing ");
+	    WriteRJCard (debug, p1^, 8);
+	    WriteRJCard (debug, p2^, 8);
+	END (*IF*);
+*)
+	RETURN p1^ >= p2^;
+    END GreaterOrEqual;
+
+(************************************************************************)
+
+PROCEDURE RunTheTest;
+
+    CONST TestSize = 300;
+
+    VAR data: ARRAY [0..TestSize-1] OF Datum;
+	w: Window;
+	j: CARDINAL;
+
+    BEGIN
+	OpenWindow (w, cyan, blue, 0, 24, 0, 79,
+					noframe, nodivider);
+
+	(* Generate some test data *)
+
+	FOR j := 0 TO TestSize-1 DO
+	    data[j] := RandCardinal();
+	END (*FOR*);
+
+	(* Write out the test data *)
+
+	WriteLn (w);  WriteString (w, "Original data");
+	FOR j := 0 TO TestSize-1 DO
+	    IF j MOD 5 = 0 THEN
+		WriteLn (w);
+	    END (*IF*);
+	    WriteRJLongCard (w, data[j], 14);
+	END (*FOR*);
+	WriteLn (w);
+	PressAnyKey (w);
+
+	(* Perform the sort *)
+
+	QuickSort (data, TestSize-1, SIZE(Datum), GreaterOrEqual);
+
+	(* Write out the sorted array *)
+
+	WriteLn (w);  WriteString (w, "Sorted data");
+	FOR j := 0 TO TestSize-1 DO
+	    IF j MOD 5 = 0 THEN
+		WriteLn (w);
+	    END (*IF*);
+	    WriteRJLongCard (w, data[j], 14);
+	END (*FOR*);
+
+	PressAnyKey (w);
+	CloseWindow (w);
+    END RunTheTest;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    IF testing THEN
+	OpenSimpleWindow (debug, 8, 15, 0, 79);
+    END (*IF*);
+    RunTheTest;
+END SortTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/soundtst.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/soundtst.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/soundtst.mod
@@ -0,0 +1,102 @@
+MODULE SoundTst;
+
+	(********************************************************)
+	(*							*)
+	(*	Test of module SoundEffects.			*)
+	(*							*)
+	(*	Programmer:	P. Moylan			*)
+	(*	Last edited:	16 August 1993			*)
+	(*	Status:						*)
+	(*	    Seems to be working.			*)
+	(*							*)
+	(********************************************************)
+
+FROM Trace IMPORT
+    (* proc *)	Pause, TraceOn, InTrace, OutTrace;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, SetCursor;
+
+FROM NumericIO IMPORT
+    (* proc *)	WriteCard;
+
+FROM SoundEffects IMPORT
+    (* type *)	Note,
+    (* proc *)	Beep, Play;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait;
+
+(************************************************************************)
+
+PROCEDURE Test1;
+
+    (* Performs a simple beep.	*)
+
+    BEGIN
+	InTrace ("Test1");
+	Beep;
+	OutTrace ("Test1");
+    END Test1;
+
+(************************************************************************)
+
+PROCEDURE Test2;
+
+    (* Plays a short sequence of notes.	*)
+
+    CONST max = 10;
+
+    VAR tune: ARRAY [0..max] OF Note;
+	j: [0..max];
+	done: Semaphore;
+
+    BEGIN
+	InTrace ("Test2");
+	CreateSemaphore (done, 0);
+	FOR j := 0 TO max DO tune[j].duration := 200;  END (*FOR*);
+	tune[0].period := 600;
+	tune[1].period := 500;
+	tune[2].period := 1;
+	tune[3].period := 700;
+	tune[4].period := 500;
+	tune[5].period := 800;
+
+	tune[6].duration := 0;
+
+	Play (tune, done);  Wait (done);
+	OutTrace ("Test2");
+    END Test2;
+
+(************************************************************************)
+
+PROCEDURE WaitAWhile;
+
+    (* Does nothing, but does it slowly.	*)
+
+    VAR j: CARDINAL;
+	w: Window;
+
+    BEGIN
+	InTrace ("WaitAWhile");
+	OpenWindow (w, yellow, green, 12, 14, 50, 69,
+					simpleframe, nodivider);
+	FOR j := 0 TO 5000 DO
+	    SetCursor (w, 1, 1);
+	    WriteCard (w, j);
+	END (*FOR*);
+	CloseWindow (w);
+	OutTrace ("WaitAWhile");
+    END WaitAWhile;
+
+(************************************************************************)
+
+BEGIN
+    TraceOn (11, 24, 0, 79, 1);
+    Test1;
+    Test2;
+    WaitAWhile;
+END SoundTst.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/testcalc.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/testcalc.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/testcalc.mod
@@ -0,0 +1,25 @@
+MODULE TestCalculator;
+
+	(************************************************)
+	(*						*)
+	(*	Test of my calculator module.		*)
+	(*						*)
+	(*  Programmer:		P. Moylan		*)
+	(*  Last edited:	6 September 1993	*)
+	(*  Status:		OK			*)
+	(*						*)
+	(************************************************)
+(*
+FROM Trace IMPORT
+    (* proc *)	NYI, InTrace, OutTrace, TraceOn;
+*)
+FROM Calculator IMPORT
+    (* proc *)	RunCalculator;
+
+(************************************************************************)
+
+BEGIN
+(*    TraceOn (10, 24, 0, 39); *)
+    RunCalculator;
+END TestCalculator.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/testmous.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/testmous.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/testmous.mod
@@ -0,0 +1,276 @@
+MODULE TestMouse;
+
+	(****************************************************************)
+	(*								*)
+	(*		    Test of the Mouse module			*)
+	(*	Demonstrates simple use of the mouse and event handler	*)
+	(*								*)
+	(*	Author:		P.D. Terry, Rhodes University,		*)
+	(*			 Sun  01-10-1993			*)
+	(*	Modified by:	Peter Moylan				*)
+	(*			(to run with PMOS and TopSpeed v3)	*)
+	(*	Last edited:	16 March 1995				*)
+	(*	Status:		Working					*)
+	(*								*)
+	(*	    Two known but minor bugs:				*)
+	(*	     1.	(Fixed)						*)
+	(*	     2.	Mouse cursor disappears if you leave it sitting	*)
+	(*		at a screen location which is being rewritten.	*)
+	(*	    Problem #2 is fixed in this program by surrounding	*)
+	(*	    every screen write by "HideMouseCursor" and		*)
+	(*	    "ShowMouseCursor" operations; but a general		*)
+	(*	    solution would probably require modifications to my	*)
+	(*	    Windows module, and I'm reluctant to take such a	*)
+	(*	    step because in principle module Windows should not	*)
+	(*	    need to know anything about mice.			*)
+	(*								*)
+	(****************************************************************)
+
+FROM Mouse IMPORT
+    (* type *)	Buttons, ButtonSet, Events, EventSet,
+    (* proc *)	ResetMouse, InstallEventHandler, GetTextMouseStatus,
+		HideMouseCursor, ShowMouseCursor;
+
+	(* Note to users of PMOS version 2.0: in version 2.0 module	*)
+	(* TaskControl does not support the Lock datatype.  To resolve	*)
+	(* this, either upgrade to version 2.1 or replace every Lock	*)
+	(* by a Semaphore.						*)
+
+FROM TaskControl IMPORT
+    (* type *)	Lock,
+    (* proc *)	CreateTask, CreateLock, Obtain, Release;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM SoundEffects IMPORT
+    (* proc *)	Beep;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+		RowRange, ColumnRange,
+    (* proc *)	OpenWindow, CloseWindow, WriteString, WriteLn,
+		ChangeScrollingRegion, SetCursor;
+
+FROM NumericIO IMPORT
+    (* proc *)	WriteCard, WriteRJCard;
+
+(************************************************************************)
+
+VAR
+    (* HaveMouse is TRUE iff a mouse and mouse driver are present.	  *)
+    (* NumberOfButtons is the number of mouse buttons known to the driver.*)
+
+    HaveMouse : BOOLEAN;
+    NumberOfButtons: CARDINAL;
+
+    (* The following counters count the events picked up by our handler.*)
+
+    EventCount: ARRAY [LeftDown..MiddleUp] OF CARDINAL;
+
+    (* Our record of the current mouse position and button status. *)
+
+    MouseState:	RECORD
+		    access: Lock;
+		    Xpos: ColumnRange;
+		    Ypos: RowRange;
+		    LeftPressed, MiddlePressed, RightPressed: BOOLEAN;
+		END (*RECORD*);
+
+    (* Semaphore to signal the fact that a mouse event has happened.	*)
+
+    MouseEvent: Semaphore;
+
+(************************************************************************)
+
+PROCEDURE DisplayPosition;
+
+    (* Runs as a separate task. *)
+
+    VAR X, Y: CARDINAL;  Left, Middle, Right: BOOLEAN;
+	w1, w2: Window;
+	DownUp: ARRAY BOOLEAN OF ARRAY [0..3] OF CHAR;
+
+    BEGIN
+	DownUp[FALSE] := "UP  ";
+	DownUp[TRUE] := "DOWN";
+
+	(* Create a window to display the mouse position. *)
+
+	OpenWindow (w1,black,green,2,6,60,79,simpleframe,doubledivider);
+	WriteString (w1, "  Mouse position");
+	ChangeScrollingRegion (w1, 3, 3);
+	SetCursor (w1, 3, 7);  WriteString (w1, ",");
+
+	(* Create a window to display the button state. *)
+
+	OpenWindow (w2,black,green,8,14,60,79,simpleframe,doubledivider);
+	WriteString (w2, "     Buttons");
+	ChangeScrollingRegion (w2, 3, 7);
+	WriteString (w2, "Left");  WriteLn (w2);
+	WriteString (w2, "Middle");  WriteLn (w2);
+	WriteString (w2, "Right");  WriteLn (w2);
+
+	LOOP	(* forever *)
+	    ShowMouseCursor;
+	    Wait (MouseEvent);
+
+	    (* Pick up the mouse state. *)
+
+	    WITH MouseState DO
+		Obtain (access);
+		X := Xpos;  Y := Ypos;
+		Left := LeftPressed;  Middle := MiddlePressed;
+		Right := RightPressed;
+		Release (access);
+	    END (*WITH*);
+
+	    (* Turn off mouse cursor while writing to the screen. *)
+
+	    HideMouseCursor;
+
+	    (* Display mouse position. *)
+
+	    SetCursor (w1, 3, 3);  WriteRJCard (w1, X, 4);
+	    SetCursor (w1, 3, 9);  WriteRJCard (w1, Y, 4);
+
+	    (* Display button status. *)
+
+	    SetCursor (w2, 3, 9);  WriteString (w2, DownUp[Left]);
+	    IF NumberOfButtons > 1 THEN
+		SetCursor (w2, 5, 9);  WriteString (w2, DownUp[Right]);
+	    END (*IF*);
+	    IF NumberOfButtons > 2 THEN
+		SetCursor (w2, 4, 9);  WriteString (w2, DownUp[Middle]);
+	    END (*IF*);
+	END (*LOOP*);
+
+    END DisplayPosition;
+
+(************************************************************************)
+
+(*# save, call(c_conv => off, same_ds => off, near_call => off) *)
+(*# call(reg_param => (ax,bx,cx,dx,st0,st6,st5,st4,st3)) *)
+
+PROCEDURE Handler (A: EventSet;  B: ButtonSet;  X, Y : CARDINAL);
+
+    (*   +++++ Don't attempt any DOS calls inside one of these ++++++	*)
+    (* This procedure is called by the mouse driver whenever there is	*)
+    (* a mouse event, and that event is in the event set specified at	*)
+    (* the time this handler was activated.				*)
+
+    VAR j: Events;
+
+    BEGIN
+	FOR j := LeftDown TO MiddleUp DO
+	    IF j IN A THEN
+		INC (EventCount[j]);
+	    END (*IF*);
+	END (*FOR*);
+
+	WITH MouseState DO
+	    Obtain (access);
+	    Xpos := X DIV 8;  Ypos := Y DIV 8;
+	    LeftPressed := LeftButton IN B;
+	    MiddlePressed := MiddleButton IN B;
+	    RightPressed := RightButton IN B;
+	    Release (access);
+	END (*WITH*);
+	Signal (MouseEvent);
+
+    END Handler;
+
+(*# restore *)
+
+(************************************************************************)
+
+PROCEDURE RunTheTest;
+
+    (* Starts event handler, starts DisplayPosition task, and lets them	*)
+    (* run until the user hits a keyboard key.  Before exiting, writes	*)
+    (* a summary of the mouse events.					*)
+
+    CONST DetectedEvents = EventSet {LeftDown, LeftUp, MiddleDown, MiddleUp,
+						RightDown, RightUp, Motion};
+
+    VAR w: Window;  ch: CHAR;  B: ButtonSet;
+
+    BEGIN
+	WITH MouseState DO
+	    CreateLock (access);
+	    GetTextMouseStatus (B, Xpos, Ypos);
+	    LeftPressed := LeftButton IN B;
+	    MiddlePressed := MiddleButton IN B;
+	    RightPressed := RightButton IN B;
+	END (*WITH*);
+	Signal (MouseEvent);
+	HideMouseCursor;
+	OpenWindow (w, blue, cyan, 2, 14, 0, 55, simpleframe, nodivider);
+	WriteString(w, 'Mouse detected with ');
+	WriteCard(w, NumberOfButtons); WriteString(w, ' buttons.');
+	WriteLn (w);
+	WriteString(w, 'Move mouse, press buttons, hit any key to finish.');
+	WriteLn (w);
+	ShowMouseCursor;
+
+	InstallEventHandler (DetectedEvents, Handler);
+
+	CreateTask (DisplayPosition, 4, "Position dis");
+
+	(* From now on, all the work is done by Handler and the task	*)
+	(* called Handler.  We stop when the user hits the keyboard.	*)
+
+	ch := InKey();
+
+	(* Write a summary to the screen. *)
+
+	HideMouseCursor;
+	WriteLn(w);
+	WriteCard(w, EventCount[LeftDown]);
+	WriteString(w, ' left presses, ');
+	WriteCard (w, EventCount[LeftUp]);
+	WriteString(w, ' left releases');
+	WriteLn (w);
+	WriteCard (w, EventCount[MiddleDown]);
+	WriteString (w, ' middle presses, ');
+	WriteCard (w, EventCount[MiddleUp]);
+	WriteString (w, ' middle releases');
+	WriteLn (w);
+	WriteCard (w, EventCount[RightDown]);
+	WriteString (w, ' right presses, ');
+	WriteCard (w, EventCount[RightUp]);
+	WriteString (w, ' right releases.');
+	WriteLn (w);
+	WriteLn (w);  WriteString (w, 'Hit any key to finish.');
+	ShowMouseCursor;
+	ch := InKey();
+	CloseWindow (w);
+
+    END RunTheTest;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+VAR j: Events;
+
+BEGIN
+    FOR j := LeftDown TO MiddleUp DO
+	EventCount[j] := 0;
+    END (*FOR*);
+
+    CreateSemaphore (MouseEvent, 0);
+    ResetMouse (HaveMouse, NumberOfButtons);
+
+    IF HaveMouse THEN
+	ShowMouseCursor;  RunTheTest;
+    ELSE
+	Beep;  Beep;  Beep;
+    END (*IF*);
+
+END TestMouse.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/testpara.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/testpara.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/testpara.mod
@@ -0,0 +1,17 @@
+MODULE TestParameterPassing;
+
+FROM ParTest IMPORT TestProc;
+
+VAR a, b: CARDINAL;
+
+BEGIN
+    TestProc (a, b);
+
+    (* Sets a:=1 and b:=2, provided that the parameters are passed so	*)
+    (* that b is deepest on the stack.  We can use the debugger to see	*)
+    (* whether this really happens.					*)
+    (* Result: with TopSpeed 1.17 we get a=2, b=1, which means that	*)
+    (* the parameter-passing mechanism pushes a and then b.		*)
+
+END TestParameterPassing.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/tltest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/tltest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/tltest.mod
@@ -0,0 +1,78 @@
+MODULE TLTest;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of module TextLines		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	23 June 1994			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, PressAnyKey, SetCursor;
+
+FROM TextLines IMPORT
+    (* type *)	LineType,
+    (* proc *)	HLine, VLine, Box;
+
+(************************************************************************)
+
+PROCEDURE Pause (w: Window);
+
+    BEGIN
+	SetCursor (w, 0, 0);
+	PressAnyKey (w);
+    END Pause;
+
+(************************************************************************)
+
+PROCEDURE RunTheTest;
+
+    VAR w: Window;
+
+    BEGIN
+	OpenWindow (w, black, green, 0, 24, 0, 79, noframe, nodivider);
+
+	(* Start with a few sample lines, which intersect. *)
+
+	HLine (w, 10, 20, 50, single);
+	HLine (w, 15, 20, 50, double);
+	VLine (w, 25, 7, 18, single);
+	VLine (w, 40, 7, 18, double);
+
+	(* Draw a box, add a divider bar, then delete divider bar. *)
+
+	Pause(w);
+	Box (w, 12, 30, 15, 10, double);
+	HLine (w, 14, 30, 45, single);
+	Pause (w);
+	HLine (w, 14, 30, 45, none);
+
+	(* Add another box, and fiddle with its divider bar. *)
+
+	Pause(w);
+	Box (w, 5, 35, 15, 8, single);
+	HLine (w, 7, 35, 50, double);
+	Pause (w);
+	HLine (w, 7, 35, 50, single);
+	Pause (w);
+	HLine (w, 7, 35, 50, none);
+
+	(* Delete the first box. *)
+
+	Pause(w);
+	Box (w, 12, 30, 15, 10, none);
+
+	Pause(w);
+	CloseWindow (w);
+    END RunTheTest;
+
+(************************************************************************)
+
+BEGIN
+    RunTheTest;
+END TLTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/trunctst.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/trunctst.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/trunctst.mod
@@ -0,0 +1,137 @@
+MODULE TruncTst;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of suspected bug in TRUNC		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 March 1993			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	The tests confirm that TRUNC rounds rather	*)
+	(*	than truncates.					*)
+	(*							*)
+	(********************************************************)
+
+FROM BugFix IMPORT
+    (* proc *)	Trunc, LongTrunc;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, DividerType, FrameType,
+    (* proc *)	OpenWindow, CloseWindow, WriteString, WriteLn,
+		EraseLine, PressAnyKey;
+
+FROM NumericIO IMPORT
+    (* proc *)	WriteRJCard, WriteRJLongCard, WriteHexByte, WriteHexWord;
+
+FROM RealIO IMPORT
+    (* proc *)	ReadReal, ReadLongReal, WriteReal;
+
+IMPORT Str;
+
+(************************************************************************)
+
+TYPE Word2 = ARRAY[0..1] OF WORD;
+TYPE Word4 = ARRAY[0..3] OF WORD;
+
+(************************************************************************)
+
+PROCEDURE WriteLongReal (w: Window;  number: LONGREAL;  places: CARDINAL);
+
+    (* To bypass possible bug in module Conversions.	*)
+
+    VAR strbuff: ARRAY [0..20] OF CHAR;  OK: BOOLEAN;
+
+    BEGIN
+	Str.RealToStr (number, places, FALSE, strbuff, OK);
+	WriteString (w, strbuff);
+    END WriteLongReal;
+
+(************************************************************************)
+
+PROCEDURE RealTest;
+
+    CONST half = REAL(Word2 (0, 03F00H));
+
+    VAR w: Window;  x: REAL;
+
+    BEGIN
+	OpenWindow (w, cyan, blue, 0, 24, 0, 79, noframe, nodivider);
+	WriteString (w, "       x            CARDINAL(x)      TRUNC(x)     Trunc(x)   VAL(CARDINAL,x-.5)");
+	LOOP
+	    WriteLn (w);  WriteString (w, "x = ? ");
+	    x := ReadReal (w);  EraseLine (w, 0);
+	    IF x < half THEN EXIT(*LOOP*) END(*IF*);
+	    WriteLongReal (w, LONGREAL(x), 15);
+	    WriteRJCard (w, CARDINAL(x), 15);
+	    WriteRJCard (w, TRUNC(x), 15);
+	    WriteRJCard (w, Trunc(x), 15);
+	    WriteRJCard (w, VAL(CARDINAL,x-half), 15);
+	END (*LOOP*);
+	PressAnyKey (w);
+	CloseWindow(w);
+    END RealTest;
+
+(************************************************************************)
+
+PROCEDURE LongTest;
+
+    CONST half = LONGREAL(Word4(0, 0, 0, 3FE0H));
+
+    VAR w: Window;  x: LONGREAL;
+
+    BEGIN
+	OpenWindow (w, cyan, blue, 0, 24, 0, 79, noframe, nodivider);
+	WriteString (w, "       x            LONGCARD(x)      LongTrunc(x)   VAL(LONGCARD,x-0.5)");
+	LOOP
+	    WriteLn (w);  WriteString (w, "x = ? ");
+	    x := ReadLongReal (w);  EraseLine (w, 0);
+	    IF x < half THEN EXIT(*LOOP*) END(*IF*);
+	    WriteLongReal (w, x, 15);
+	    WriteRJLongCard (w, LONGCARD(x), 15);
+	    WriteRJLongCard (w, LongTrunc(x), 15);
+	    WriteRJLongCard (w, VAL(LONGCARD,x-half), 15);
+	END (*LOOP*);
+	PressAnyKey (w);
+	CloseWindow(w);
+    END LongTest;
+
+(************************************************************************)
+
+PROCEDURE HalfTest;
+
+    CONST half1 = Word2 (0FFFFH, 03EFFH);
+	half2 = Word4 (0FFFFH, 0FFFFH, 0FFFFH, 3FDFH);
+	Rhalf = REAL(Word2 (0FFFFH, 03EFFH));
+	Lhalf = LONGREAL(Word4(0FFFFH, 0FFFFH, 0FFFFH, 3FDFH));
+
+    VAR w: Window;  j: CARDINAL;
+
+    BEGIN
+	OpenWindow (w, cyan, blue, 0, 24, 0, 79, noframe, nodivider);
+	FOR j := 1 TO 0 BY -1 DO
+	    WriteHexWord (w, half1[j]);
+	END (*FOR*);
+	WriteString (w, "    ");
+	WriteLongReal (w, LONGREAL(Rhalf), 15);
+
+	WriteLn (w);
+	FOR j := 3 TO 0 BY -1 DO
+	    WriteHexWord (w, half2[j]);
+	END (*FOR*);
+	WriteString (w, "    ");
+	WriteLongReal (w, Lhalf, 15);
+	PressAnyKey (w);
+	CloseWindow(w);
+    END HalfTest;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    HalfTest;
+    RealTest;
+    LongTest;
+END TruncTst.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/ttransfe.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/ttransfe.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/ttransfe.mod
@@ -0,0 +1,55 @@
+MODULE TTransfer;
+
+	(****************************************************************)
+	(*								*)
+	(*		Test of TopSpeed TRANSFER routine		*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	7 October 1992				*)
+	(*  Status:		Just starting				*)
+	(*								*)
+	(****************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	PROCESS,
+    (* proc *)	NEWPROCESS, TRANSFER;
+
+FROM IO IMPORT
+    (* proc *)	WrLn, WrStr;
+
+(************************************************************************)
+(*			    GLOBAL VARIABLES				*)
+(************************************************************************)
+
+VAR Stack2: ARRAY [0..1023] OF SHORTCARD;
+    P1, P2: PROCESS;
+
+(************************************************************************)
+(*			    SUBSIDIARY TASK				*)
+(************************************************************************)
+
+PROCEDURE Task2;
+
+    VAR x: REAL;
+
+    BEGIN
+	WrLn;  WrStr ("Now in Task2");
+	x := 1.0;
+	WrLn;  WrStr ("About to transfer to main task");
+	TRANSFER (P2, P1);
+    END Task2;
+
+(************************************************************************)
+(*			MAIN PROGRAM AND MAIN TASK			*)
+(************************************************************************)
+
+VAR y: REAL;
+
+BEGIN
+    y := 1.0;
+    NEWPROCESS (Task2, FarADR(Stack2), SIZE(Stack2), P2);
+    WrLn;  WrStr ("About to transfer to Task2");
+    TRANSFER (P1, P2);
+    WrLn;  WrStr ("Now back in main task");
+END TTransfer.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/typetest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/typetest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/typetest.mod
@@ -0,0 +1,41 @@
+MODULE TypeTest;
+
+	(********************************************************)
+	(*							*)
+	(*							*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	22 February 1995		*)
+	(*  Status:						*)
+	(*							*)
+	(*	This program produces no output, it's simply	*)
+	(*	something I can look at with the debugger.	*)
+	(*							*)
+	(********************************************************)
+
+FROM Types IMPORT
+    (* type *)	FarPointer, FarWordPointer;
+
+(************************************************************************)
+
+PROCEDURE P;
+
+    BEGIN
+
+    END P;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+VAR fp: FarPointer;  addr: ADDRESS;
+    fwp: FarWordPointer;  wp: POINTER TO WORD;
+
+BEGIN
+    (* fwp := wp; *)	(* ALWAYS ILLEGAL *)
+    (* fp := addr; *)	(* LEGALITY DEPENDS ON MEMORY MODEL *)
+    (* fp := wp; *)	(* LEGALITY DEPENDS ON MEMORY MODEL *)
+    fwp := fp;
+    addr := wp;
+END TypeTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/wc2test.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/wc2test.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/wc2test.mod
@@ -0,0 +1,64 @@
+MODULE WC2Test;
+
+        (********************************************************)
+        (*                                                      *)
+        (*              Test of the WildC2 module               *)
+        (*                                                      *)
+        (*  Programmer:         P. Moylan                       *)
+        (*  Started:            11 May 2003                     *)
+        (*  Last edited:        11 May 2003                     *)
+        (*  Status:             Was working in OS/2, now doing  *)
+        (*              a DOS version so that I can translate   *)
+        (*              it to C.                                *)
+        (*                                                      *)
+        (********************************************************)
+
+FROM IO IMPORT
+    (* proc *)  WrStr, WrLn;
+
+FROM WildC2 IMPORT
+    (* proc *)  WildMatch;
+
+(************************************************************************)
+(*                          TEST CODE                                   *)
+(************************************************************************)
+
+PROCEDURE TestPair (input, template: ARRAY OF CHAR);
+
+    BEGIN
+        WrStr (input);
+        IF WildMatch (input, template) THEN
+            WrStr (" matches ");
+        ELSE
+            WrStr (" doesn't match ");
+        END (*IF*);
+        WrStr ("template ");  WrStr (template);
+        WrLn;
+    END TestPair;
+
+(************************************************************************)
+
+PROCEDURE RunTheTest;
+
+    BEGIN
+        WrStr ("Testing wildcard matches");  WrLn;
+        TestPair ("a", "*a");
+        TestPair ("a", "A");
+        TestPair ("a", "b*");
+        TestPair ("a", "*");
+        TestPair ("ab", "*b*");
+        TestPair ("a", "**");
+        TestPair ("a", "**b");
+        TestPair ("xyabuvdefabcmmdefmmm", "**abc*def*");
+        TestPair ("xyz.uvw.abc.zip", "*.ZIP");
+    END RunTheTest;
+
+(************************************************************************)
+(*                            MAIN PROGRAM                              *)
+(************************************************************************)
+
+BEGIN
+    RunTheTest;
+END WC2Test.
+
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/wildc2.def b/examples/Modula-2_Libraries/PMOS/sources/tests/wildc2.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/wildc2.def
@@ -0,0 +1,29 @@
+DEFINITION MODULE WildC2;
+
+        (********************************************************)
+        (*                                                      *)
+        (*            String matching with wildcards            *)
+        (*                                                      *)
+        (*     A version of module WildCard modified to be      *)
+        (*          compatible with the rules used by           *)
+        (*                 Alessandro Cantatore                 *)
+        (*                                                      *)
+        (*  Programmer:         P. Moylan                       *)
+        (*  Started:            10 May 2003                     *)
+        (*  Last edited:        10 May 2003                     *)
+        (*  Status:             OK                              *)
+        (*                                                      *)
+        (********************************************************)
+
+
+PROCEDURE WildMatch (VAR (*IN*) input, template: ARRAY OF CHAR): BOOLEAN;
+
+    (* Returns TRUE if template and input are equal, with the extra     *)
+    (* rules:                                                           *)
+    (*   1. Character case is not significant.                          *)
+    (*   2. A '?' in template matches any single character except '.'.  *)
+    (*   3. A '*' in template matches any string of zero or more        *)
+    (*      characters.                                                 *)
+
+END WildC2.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/wildc2.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/wildc2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/wildc2.mod
@@ -0,0 +1,266 @@
+IMPLEMENTATION MODULE WildC2;
+
+        (********************************************************)
+        (*                                                      *)
+        (*            String matching with wildcards            *)
+        (*                                                      *)
+        (*     A version of module WildCard modified to be      *)
+        (*          compatible with the rules used by           *)
+        (*                 Alessandro Cantatore                 *)
+        (*                                                      *)
+        (*  Programmer:         P. Moylan                       *)
+        (*  Started:            11 May 2003                     *)
+        (*  Last edited:        11 May 2003                     *)
+        (*  Status:             OS/2 version was working        *)
+        (*          Now producing DOS version so that I can     *)
+        (*          translate it to C.                          *)
+        (*                                                      *)
+        (********************************************************)
+
+
+IMPORT Str;
+
+(************************************************************************)
+(*                         SUBSTRING MATCHING                           *)
+(************************************************************************)
+
+PROCEDURE SubstringMatch (VAR (*IN*) input: ARRAY OF CHAR;
+                           j1, k1: CARDINAL;
+                           VAR (*IN*) template: ARRAY OF CHAR;
+                           j2, k2: CARDINAL): BOOLEAN;           FORWARD;
+
+(************************************************************************)
+
+PROCEDURE HeadMatch (VAR (*IN*) input: ARRAY OF CHAR;
+                          j1, k1: CARDINAL;
+                          VAR (*IN*) template: ARRAY OF CHAR;
+                          j2, k2: CARDINAL): BOOLEAN;
+
+    (* Returns TRUE if input[j1..k] matches template[j2..k2], where     *)
+    (* k1min <= k <= k1max.  If the template is empty (j2 > k2), we     *)
+    (* have a match by definition.                                      *)
+
+    BEGIN
+        LOOP
+            (* From the left, input[j1] and template[j2] are the        *)
+            (* first characters we haven't yet tested for a match.      *)
+
+            IF j2 > k2 THEN
+
+                (* No more template left; match by definition.  *)
+
+                RETURN TRUE;
+
+            ELSIF template[j2] = '*' THEN
+
+                EXIT (*LOOP*);
+
+            ELSIF j1 > k1 THEN
+
+                (* Input exhausted, first unmatched template char *)
+                (* is not wild, so we have a definite mismatch.   *)
+
+                RETURN FALSE;
+
+            ELSIF template[j2] = '?' THEN
+
+                (* Special care needed here, because Alessandro has *)
+                (* modified the rules about matching '.'            *)
+
+                IF input[j1] = '.' THEN
+                    RETURN FALSE;
+                END (*IF*);
+
+            ELSIF CAP(input[j1]) <> CAP(template[j2]) THEN
+
+                RETURN FALSE;
+
+            END (*IF*);
+
+            INC (j1);  INC (j2);
+
+        END (*LOOP*);
+
+        (* If we reach here, template[j2] = '*'. *)
+
+        REPEAT
+            INC (j2);
+        UNTIL (j2 > k2) OR (template[j2] <> '*');
+
+        RETURN SubstringMatch (input, j1, k1, template, j2, k2);
+
+    END HeadMatch;
+
+(************************************************************************)
+
+PROCEDURE SubstringMatch (VAR (*IN*) input: ARRAY OF CHAR;
+                           j1, k1: CARDINAL;
+                           VAR (*IN*) template: ARRAY OF CHAR;
+                           j2, k2: CARDINAL): BOOLEAN;
+
+    (* Returns TRUE if any contiguous substring of input[j1..k1]        *)
+    (* matches template[j2..k2].  If the template is empty (j2 > k2),   *)
+    (* we have a match by definition.                                   *)
+    (* On entry we are guaranteed that j1 <= k1.                        *)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+        j := j1;
+        LOOP
+            IF HeadMatch (input, j, k1, template, j2, k2) THEN
+                RETURN TRUE;
+            ELSIF j >= k1 THEN
+                RETURN FALSE;
+            END (*IF*);
+            INC(j);
+        END (*LOOP*);
+    END SubstringMatch;
+
+(************************************************************************)
+(*                  THE EXTERNALLY CALLABLE PROCEDURES                  *)
+(************************************************************************)
+
+PROCEDURE WildMatch (VAR (*IN*) input, template: ARRAY OF CHAR): BOOLEAN;
+
+    (* Returns TRUE if template and input are equal, with the extra     *)
+    (* rules:                                                           *)
+    (*   1. Character case is not significant.                          *)
+    (*   2. A '?' in template matches any single character except '.'.  *)
+    (*   3. A '*' in template matches any string of zero or more        *)
+    (*      characters.                                                 *)
+
+    VAR j1, k1, j2, k2: CARDINAL;
+
+    BEGIN
+        j1 := 0;  k1 := Str.Length (input);
+        j2 := 0;  k2 := Str.Length (template);
+
+        IF k1 = 0 THEN
+
+            (* Empty input; the only thing that can match is an *)
+            (* empty or all-star template.                      *)
+
+            LOOP
+                IF j2 = k2 THEN RETURN TRUE
+                ELSIF template[j2] = '*' THEN INC(j2)
+                ELSE RETURN FALSE
+                END (*IF*);
+            END (*LOOP*);
+
+        ELSIF k2 = 0 THEN
+
+            (* Empty template, non-empty input. *)
+
+            RETURN FALSE;
+
+        END (*IF*);
+
+        DEC (k1);  DEC(k2);
+
+        (* Having disposed of the "empty" cases, we're now comparing    *)
+        (* input[j1..k1] with template[j2..k2].                         *)
+
+        LOOP
+            (* From the left, input[j1] and template[j2] are the        *)
+            (* first characters we haven't yet tested for a match.      *)
+
+            IF j2 > k2 THEN
+
+                (* No more template left; match iff we've also  *)
+                (* exhausted the input.                         *)
+
+                RETURN j1 > k1;
+
+            ELSIF template[j2] = '*' THEN
+
+                EXIT (*LOOP*);
+
+            ELSIF j1 > k1 THEN
+
+                (* Input exhausted, first unmatched template char *)
+                (* is not '*', so we have a definite mismatch.    *)
+
+                RETURN FALSE;
+
+            ELSIF template[j2] = '?' THEN
+
+                (* Special care needed here, because Alessandro has *)
+                (* modified the rules about matching '.'            *)
+
+                IF input[j1] = '.' THEN
+                    RETURN FALSE;
+                END (*IF*);
+
+            ELSIF CAP(input[j1]) <> CAP(template[j2]) THEN
+
+                RETURN FALSE;
+
+            END (*IF*);
+
+            INC (j1);  INC (j2);
+
+        END (*LOOP*);
+
+        (* If we reach here, template[j2] = '*'. *)
+
+        LOOP
+            (* From the right, input[k1] and template[k2] are the first *)
+            (* characters we haven't yet checked for a match.           *)
+
+            IF template[k2] = '*' THEN
+
+                EXIT (*LOOP*);
+
+            ELSIF k1 < j1 THEN
+
+                (* Input exhausted, last unmatched template char *)
+                (* is not '*', so we have a definite mismatch.   *)
+
+                RETURN FALSE;
+
+            ELSIF template[k2] = '?' THEN
+
+                (* Special care needed here, because Alessandro has *)
+                (* modified the rules about matching '.'            *)
+
+                IF input[k1] = '.' THEN
+                    RETURN FALSE;
+                END (*IF*);
+
+            ELSIF CAP(input[k1]) <> CAP(template[k2]) THEN
+
+                RETURN FALSE;
+
+            END (*IF*);
+
+            (* Special case: if k1=0 then we have to record that we've  *)
+            (* exhausted the input without decrementing k1.  The same   *)
+            (* problem doesn't arise for k2 because at this point we    *)
+            (* know that we'll hit a '*' before exhausting the template.*)
+
+            IF k1 = 0 THEN INC(j1) ELSE DEC (k1) END(*IF*);
+            DEC (k2);
+
+        END (*LOOP*);
+
+        (* If we reach here, k2 >= j2, template[j2] = '*', and          *)
+        (* template[k2] = '*'.  If we have several '*'s in a row, here  *)
+        (* is where we reduce them down.                                *)
+
+        REPEAT
+            INC (j2);
+        UNTIL (j2 > k2) OR (template[j2] <> '*');
+        WHILE (j2 <= k2) AND (template[k2] = '*') DO
+            DEC (k2);
+        END (*WHILE*);
+
+        RETURN SubstringMatch (input, j1, k1, template, j2, k2);
+
+    END WildMatch;
+
+(************************************************************************)
+
+END WildC2.
+
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/wtest.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/wtest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/wtest.mod
@@ -0,0 +1,101 @@
+MODULE WTest;
+
+	(************************************************)
+	(*						*)
+	(*	Test of window operations.		*)
+	(*						*)
+	(*  Programmer:		P. Moylan		*)
+	(*  Last edited:	7 November 1993		*)
+	(*  Status:		Working			*)
+	(*						*)
+	(************************************************)
+
+FROM Trace IMPORT
+    (* proc *)	TraceOff, TraceOn, InTrace, OutTrace, Pause;
+
+FROM Windows IMPORT
+    (* type *)	Window, FrameType, DividerType, Colour,
+    (* proc *)	OpenWindow, CloseWindow, ChangeScrollingRegion,
+		WriteChar, WriteString, WriteLn;
+
+FROM Bounce IMPORT
+    (* proc *)	Bouncing;
+
+(****************************************************************)
+
+PROCEDURE increment (VAR (* inout *) ch: CHAR);
+
+    BEGIN
+	InTrace ("increment");
+	IF ch = CHR(255) THEN
+	    ch := " ";
+	ELSE
+	    INC (ch);
+	END (*IF*);
+	OutTrace ("increment");
+    END increment;
+
+(****************************************************************)
+
+PROCEDURE RunTheTest;
+
+    VAR w1, w2, w3: Window;
+	ch: CHAR;
+	i, j, loopcount: CARDINAL;
+
+    BEGIN
+	InTrace ("RunTheTest");
+	Bouncing (0, 11, 41, 79);
+	Pause;
+	OpenWindow (w1, blue, cyan, 6, 16, 0, 40, simpleframe, nodivider);
+	WriteString (w1, "Test Message, window w1");
+	Pause;
+	OpenWindow (w2, white, magenta, 12, 22, 20, 63, doubleframe, nodivider);
+	WriteString (w2, "Test Message, window w2");
+	OpenWindow (w3, brown, black, 13, 24, 45, 75,
+			simpleframe, doubledivider);
+	WriteString (w3, "This one should have");  WriteLn (w3);
+	WriteString (w3, " a non-scrolling header.");
+	ChangeScrollingRegion (w3, 4, 10);
+	(*Pause*);
+	ch := " ";  loopcount := 0;
+	FOR i := 1 TO 40 DO
+	    FOR j := 1 TO 40 DO
+		WriteChar (w1, ch);  increment (ch);
+	    END (* for *);
+	    FOR j := 1 TO 40 DO
+		WriteChar (w2, ch);  increment (ch);
+	    END (* for *);
+	    INC (loopcount);
+	    IF loopcount = 10 THEN
+		WriteLn (w3);
+		WriteString (w3, " and footer");
+		ChangeScrollingRegion (w3, 4, 8);
+	    ELSIF loopcount = 20 THEN
+		WriteLn (w3);
+		ChangeScrollingRegion (w3, 1, 8);
+	    ELSIF loopcount = 30 THEN
+		WriteLn (w3);
+		ChangeScrollingRegion (w3, 4, 10);
+		loopcount := 0;
+	    END (* if *);
+	    FOR j := 1 TO 40 DO
+		WriteChar (w3, ch);  increment (ch);
+	    END (* for *);
+	    (*Pause*);
+	END (* for *);
+	(*DumpWindow (w2)*);
+	Pause;  CloseWindow (w2);
+	Pause;  CloseWindow (w3);
+	(*Pause*);  CloseWindow (w1);
+	OutTrace ("RunTheTest");
+    END RunTheTest;
+
+(****************************************************************)
+
+BEGIN
+    TraceOn (0, 4, 10, 40, 1);
+    RunTheTest;
+    TraceOff;
+END WTest.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/tests/wtest2.mod b/examples/Modula-2_Libraries/PMOS/sources/tests/wtest2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/tests/wtest2.mod
@@ -0,0 +1,81 @@
+MODULE WTest2;
+
+	(********************************************************)
+	(*							*)
+	(*		Test of window operations.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	17 February 1993		*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	This was an attempt to duplicate the display	*)
+	(*	corruption observed in the test programs	*)
+	(*	DiskPatch and CopyFile.  The problem has now	*)
+	(*	been repaired.					*)
+	(*							*)
+	(********************************************************)
+
+IMPORT Floppy;
+
+IMPORT HardDisk;
+
+FROM Trace IMPORT
+    (* proc *)	TraceOff, TraceOn, InTrace, OutTrace, Pause;
+
+FROM Windows IMPORT
+    (* type *)	Window, FrameType, DividerType, Colour,
+    (* proc *)	OpenWindow, CloseWindow, ChangeScrollingRegion,
+		WriteChar, WriteString, WriteLn, ScrollUp;
+
+(****************************************************************)
+
+PROCEDURE increment (VAR (* inout *) ch: CHAR);
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	InTrace ("increment");
+	IF ch = CHR(255) THEN
+	    ch := " ";
+	ELSE
+	    INC (ch);
+	END (* if *);
+	FOR j := 0 TO 10000 DO (*nothing*) END(*FOR*);
+	OutTrace ("increment");
+    END increment;
+
+(****************************************************************)
+
+PROCEDURE RunTheTest;
+
+    VAR w2: Window;
+	ch: CHAR;
+	i, j, loopcount: CARDINAL;
+
+    BEGIN
+	InTrace ("RunTheTest");
+	OpenWindow (w2, white, magenta, 0, 20, 0, 79, simpleframe, doubledivider);
+	WriteString (w2, "Test Message, window w2");
+	ChangeScrollingRegion (w2, 3, 19);
+	(*Pause*);
+	ch := " ";  loopcount := 0;
+	FOR i := 1 TO 60 DO
+	    FOR j := 1 TO 40 DO
+		WriteChar (w2, ch);  increment (ch);
+	    END (* for *);
+	    INC (loopcount);
+	END (* for *);
+	ScrollUp (w2);  ScrollUp (w2);  ScrollUp (w2);
+	(*DumpWindow (w2)*);
+	Pause;  CloseWindow (w2);
+	OutTrace ("RunTheTest");
+    END RunTheTest;
+
+(****************************************************************)
+
+BEGIN
+    (*TraceOn (0, 4, 10, 40, 1);*)
+    RunTheTest;
+    TraceOff;
+END WTest2.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/unsorted/dummysem.def b/examples/Modula-2_Libraries/PMOS/sources/unsorted/dummysem.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/unsorted/dummysem.def
@@ -0,0 +1,52 @@
+DEFINITION MODULE DummySemaphores;
+
+	(********************************************************)
+	(*							*)
+	(*	Defines the semaphore data type, and the two	*)
+	(*	basic operations on a semaphore.		*)
+	(*							*)
+	(*	Programmer:	P. Moylan			*)
+	(*	Last edited:	14 August 1992			*)
+	(*							*)
+	(*	Status:		OK.				*)
+	(*							*)
+	(********************************************************)
+
+TYPE Semaphore;		(* is private *)
+
+PROCEDURE CreateSemaphore (VAR (*OUT*) s: Semaphore; InitialValue: CARDINAL);
+
+    (* Creates semaphore s, with the given initial value and an empty	*)
+    (* queue.								*)
+
+PROCEDURE DestroySemaphore (VAR (*INOUT*) s: Semaphore);
+
+    (* Reclaims any space used by semaphore s.  Remark:  It is not at	*)
+    (* all obvious what should be done with any tasks which happen to	*)
+    (* be blocked on this semaphore (should they be unblocked, or	*)
+    (* killed?).  At present we take the easy way out and assume that	*)
+    (* there are no pending operations on s at the time that it is	*)
+    (* destroyed.							*)
+
+PROCEDURE Wait (VAR (*INOUT*) s: Semaphore);
+
+    (* Decrements the semaphore value.  If the value goes negative,	*)
+    (* the calling task is blocked and there is a task switch.		*)
+
+PROCEDURE TimedWaitT (VAR (*INOUT*) s: Semaphore;
+			TimeLimit: INTEGER;  VAR (*OUT*) TimedOut: BOOLEAN);
+
+    (* Like procedure Wait, except that it returns with TimedOut TRUE	*)
+    (* if the corresponding Signal does not occur within TimeLimit	*)
+    (* clock ticks.  Note that this procedure is not recommended for	*)
+    (* general use, because "clock ticks" is not a convenient unit of	*)
+    (* time for most callers.  For a more useful version, see procedure	*)
+    (* TimedWait in module Timer.					*)
+
+PROCEDURE Signal (VAR (*INOUT*) s: Semaphore);
+
+    (* Increments the semaphore value.  Unblocks one waiting task,	*)
+    (* if there was one.						*)
+
+END DummySemaphores.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/unsorted/dummysem.mod b/examples/Modula-2_Libraries/PMOS/sources/unsorted/dummysem.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/unsorted/dummysem.mod
@@ -0,0 +1,88 @@
+IMPLEMENTATION MODULE DummySemaphores;
+
+	(********************************************************)
+	(*							*)
+	(*	Defines the semaphore data type, and the two	*)
+	(*	basic operations on a semaphore.		*)
+	(*							*)
+	(*	Programmer:	P. Moylan			*)
+	(*	Last edited:	14 August 1992			*)
+	(*							*)
+	(*	Status:		OK.				*)
+	(*							*)
+	(*	NOTE: This is a dummy version; it does not	*)
+	(*	actually do anything with the "semaphores".	*)
+	(*	It is purely for use in single-task		*)
+	(*	applications.					*)
+	(*							*)
+	(********************************************************)
+
+TYPE Semaphore = POINTER TO CHAR;
+
+VAR Dummy: CHAR;
+
+(************************************************************************)
+
+PROCEDURE CreateSemaphore (VAR (*OUT*) s: Semaphore; InitialValue: CARDINAL);
+
+    (* Creates semaphore s, with the given initial value and an empty	*)
+    (* queue.								*)
+
+    BEGIN
+	s := ADR(Dummy);
+    END CreateSemaphore;
+
+(************************************************************************)
+
+PROCEDURE DestroySemaphore (VAR (*INOUT*) s: Semaphore);
+
+    (* Reclaims any space used by semaphore s.  Remark:  It is not at	*)
+    (* all obvious what should be done with any tasks which happen to	*)
+    (* be blocked on this semaphore (should they be unblocked, or	*)
+    (* killed?).  At present we take the easy way out and assume that	*)
+    (* there are no pending operations on s at the time that it is	*)
+    (* destroyed.							*)
+
+    BEGIN
+	s := NIL;
+    END DestroySemaphore;
+
+(************************************************************************)
+
+PROCEDURE Wait (VAR (*INOUT*) s: Semaphore);
+
+    (* Decrements the semaphore value.  If the value goes negative,	*)
+    (* the calling task is blocked and there is a task switch.		*)
+
+    BEGIN
+    END Wait;
+
+(************************************************************************)
+
+PROCEDURE TimedWaitT (VAR (*INOUT*) s: Semaphore;
+			TimeLimit: INTEGER;  VAR (*OUT*) TimedOut: BOOLEAN);
+
+    (* Like procedure Wait, except that it returns with TimedOut TRUE	*)
+    (* if the corresponding Signal does not occur within TimeLimit	*)
+    (* clock ticks.  Note that this procedure is not recommended for	*)
+    (* general use, because "clock ticks" is not a convenient unit of	*)
+    (* time for most callers.  For a more useful version, see procedure	*)
+    (* TimedWait in module Timer.					*)
+
+    BEGIN
+    END TimedWaitT;
+
+(************************************************************************)
+
+PROCEDURE Signal (VAR (*INOUT*) s: Semaphore);
+
+    (* Increments the semaphore value.  Unblocks one waiting task,	*)
+    (* if there was one.						*)
+
+    BEGIN
+    END Signal;
+
+(************************************************************************)
+
+END DummySemaphores.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/unsorted/minicirc.def b/examples/Modula-2_Libraries/PMOS/sources/unsorted/minicirc.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/unsorted/minicirc.def
@@ -0,0 +1,31 @@
+DEFINITION MODULE MiniCircularBuffers;
+
+	(****************************************************************)
+	(*								*)
+	(*	Circular Buffer for passing character data		*)
+	(*	between a pair of tasks.  (Demonstration version.)	*)
+	(*								*)
+	(*	Author:		P. Moylan				*)
+	(*	Last edited:	16 August 1992				*)
+	(*								*)
+	(*	Status:		OK.					*)
+	(*								*)
+	(****************************************************************)
+
+TYPE CircularBuffer;	(* is private *)
+
+PROCEDURE CreateBuffer (VAR (*OUT*) B: CircularBuffer;  size: CARDINAL);
+
+    (* Allocates space for a circular buffer, and initializes it.  The	*)
+    (* caller specifies how many characters the buffer will hold.	*)
+
+PROCEDURE PutBuffer (B: CircularBuffer; item: CHAR);
+
+    (* Waits for space available, then puts item at the tail of the queue. *)
+
+PROCEDURE GetBuffer (B: CircularBuffer) : CHAR;
+
+    (* Takes one character from the head of the queue, waiting if necessary. *)
+
+END MiniCircularBuffers.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/unsorted/minicirc.mod b/examples/Modula-2_Libraries/PMOS/sources/unsorted/minicirc.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/unsorted/minicirc.mod
@@ -0,0 +1,113 @@
+IMPLEMENTATION MODULE MiniCircularBuffers;
+
+	(********************************************************)
+	(*							*)
+	(*	Circular Buffers for passing character data	*)
+	(*	between a pair of tasks.			*)
+	(*							*)
+	(*	Author:		P. Moylan			*)
+	(*	Last edited:	16 August 1992			*)
+	(*							*)
+	(*	Status:		OK				*)
+	(*							*)
+	(********************************************************)
+
+FROM Storage IMPORT
+    (* proc *)	ALLOCATE;
+
+FROM MiniTrace IMPORT
+    (* proc *)	InTrace, OutTrace;
+
+FROM MiniKernel IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+(************************************************************************)
+
+TYPE
+    BufferTemplate = RECORD
+			SlotAvailable, DataPresent: Semaphore;
+			lastlocation: CARDINAL;
+			GetPlace, PutPlace: CARDINAL;
+			data: ARRAY [0..0] OF CHAR
+		     END;
+
+	(* Remark: we do something slightly nonstandard here, because	*)
+	(* we want circular buffers of various sizes and Modula-2 does	*)
+	(* not support variable-length arrays.  The trick is to define	*)
+	(* an array of one element, but then to extend it by calling	*)
+	(* ALLOCATE to give us the array size we really need.  Of	*)
+	(* course, this works only if we suppress "out of range" error	*)
+	(* checking while compiling this module.  This is, admittedly,	*)
+	(* an example of a programming style which probably should be	*)
+	(* outlawed, but I couldn't think of a legal way to achieve the	*)
+	(* desired result.						*)
+
+    CircularBuffer = POINTER TO BufferTemplate;
+
+(************************************************************************)
+
+PROCEDURE CreateBuffer (VAR (*OUT*) B: CircularBuffer;  size: CARDINAL);
+
+    (* Allocates space for a circular buffer, and initializes it.  The	*)
+    (* caller specifies how many characters the buffer will hold.	*)
+
+    BEGIN
+	InTrace ("CreateBuffer");
+	ALLOCATE (B, SIZE(BufferTemplate) + size - 1);
+	WITH B^ DO
+	    lastlocation := size - 1;
+	    CreateSemaphore (SlotAvailable, size);
+	    CreateSemaphore (DataPresent, 0);
+	    GetPlace := 0;  PutPlace := 0;
+	END (*WITH*);
+	OutTrace ("CreateBuffer");
+    END CreateBuffer;
+
+(************************************************************************)
+
+PROCEDURE PutBuffer (B: CircularBuffer; item: CHAR);
+
+    (* Puts item into the circular buffer, waiting for space available	*)
+    (* if necessary.							*)
+
+    BEGIN
+	InTrace ("PutBuffer");
+	WITH B^ DO
+	    Wait (SlotAvailable);
+	    data[PutPlace] := item;
+	    IF PutPlace = lastlocation THEN PutPlace := 0
+	    ELSE INC (PutPlace);
+	    END (*IF*);
+	    Signal (DataPresent);
+	END (*WITH*);
+	OutTrace ("PutBuffer");
+    END PutBuffer;
+
+(************************************************************************)
+
+PROCEDURE GetBuffer (B: CircularBuffer) : CHAR;
+
+    (* Gets one character from the circular buffer, waiting when	*)
+    (* necessary for a character to become available.			*)
+
+    VAR result: CHAR;
+
+    BEGIN
+	InTrace ("GetBuffer");
+	WITH B^ DO
+	    Wait (DataPresent);
+	    result := data[GetPlace];
+	    IF GetPlace = lastlocation THEN GetPlace := 0
+	    ELSE INC (GetPlace);
+	    END (*IF*);
+	    Signal (SlotAvailable);
+	END (*WITH*);
+	OutTrace ("GetBuffer");
+	RETURN result;
+    END GetBuffer;
+
+(************************************************************************)
+
+END MiniCircularBuffers.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/unsorted/minikern.def b/examples/Modula-2_Libraries/PMOS/sources/unsorted/minikern.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/unsorted/minikern.def
@@ -0,0 +1,61 @@
+DEFINITION MODULE MiniKernel;
+
+	(****************************************************************)
+	(*								*)
+	(*	This is a stripped-down operating system kernel,	*)
+	(*	for demonstration purposes only. It supports		*)
+	(*	multitasking and semaphores, but does not support	*)
+	(*	interrupt handlers or timer operations. Its intended	*)
+	(*	use is to let the user see, through trace messages	*)
+	(*	on the screen, the sequence of procedure calls		*)
+	(*	which occurs during a task switch.			*)
+	(*								*)
+	(*	Programmer:	P. Moylan				*)
+	(*	Last edited:	17 February 1990			*)
+	(*								*)
+	(*	Status:		Working.				*)
+	(*								*)
+	(****************************************************************)
+
+TYPE Semaphore;		(* is private *)
+
+(************************************************************************)
+(*			TASK CREATION AND REMOVAL			*)
+(************************************************************************)
+
+PROCEDURE CreateTask (StartAddress: PROC; taskpriority: CARDINAL);
+
+    (* Must be called to introduce a task to the system. The first	*)
+    (* parameter, which should be the name of a procedure containing	*)
+    (* the task code, gives the starting address.  The second parameter	*)
+    (* is the task priority.  If this task has a higher priority than	*)
+    (* its creator, it will run immediately.  Otherwise, it becomes	*)
+    (* ready.								*)
+
+PROCEDURE TaskExit;
+
+    (* Removes the currently running task from the system, and performs	*)
+    (* a task switch to the next ready task.				*)
+
+(************************************************************************)
+(*				SEMAPHORES				*)
+(************************************************************************)
+
+PROCEDURE CreateSemaphore (VAR (*OUT*) s: Semaphore; InitialValue: INTEGER);
+
+    (* Creates semaphore s, with the given initial value and an empty	*)
+    (* queue.								*)
+
+PROCEDURE Wait (VAR (*INOUT*) s: Semaphore);
+
+    (* Decrements the semaphore value.  If the value goes negative,	*)
+    (* the calling task is blocked and there is a task switch.		*)
+
+PROCEDURE Signal (VAR (*INOUT*) s: Semaphore);
+
+    (* Increments the semaphore value.  Unblocks one waiting task,	*)
+    (* if there was one.						*)
+
+(************************************************************************)
+
+END MiniKernel.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/unsorted/minikern.mod b/examples/Modula-2_Libraries/PMOS/sources/unsorted/minikern.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/unsorted/minikern.mod
@@ -0,0 +1,413 @@
+IMPLEMENTATION MODULE MiniKernel;
+
+	(****************************************************************)
+	(*								*)
+	(*	A stripped-down demonstration version of an operating	*)
+	(*			system kernel.				*)
+	(*								*)
+	(*	Programmer:	P. Moylan				*)
+	(*	Last edited:	16 August 1992				*)
+	(*	Status:		OK					*)
+	(*		Have had to disable kernel tracing, since it	*)
+	(*		causes infinite recursion.  In future must	*)
+	(*		find a new mechanism for handling this.		*)
+	(*								*)
+	(****************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	ADDRESS,
+    (* proc *)	ADR;
+
+FROM SYSTEM IMPORT
+    (* proc *)	NEWPROCESS, TRANSFER;
+
+FROM Storage IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+(*
+FROM GlassTTY IMPORT
+    (* proc *)	WriteString, WriteLn;
+*)
+(*
+FROM Trace IMPORT
+    (* proc *)	InTrace, OutTrace;
+*)
+
+(************************************************************************)
+
+CONST
+    MaxTaskNumber = 31;
+    MaxPriority = 3;
+    StackSize = 1024;
+
+TYPE
+    TaskNumber = [0..MaxTaskNumber];
+    PriorityType = [0..MaxPriority];
+    TaskPointer = POINTER TO TaskDescriptor;
+
+	(****************************************************************)
+	(*								*)
+	(* Each task in the system has a task descriptor.		*)
+	(* The fields in a task descriptor are:				*)
+	(*	next:	pointer to next task descriptor on the queue.	*)
+	(*		(i.e. whatever system queue this task		*)
+	(*		descriptor happens to be on).			*)
+	(*	priority: task priority.				*)
+	(*	selector: a selector for the task state of this task.	*)
+	(*	StackBase: the low address of the memory segment set	*)
+	(*		aside for the stack. This is needed only when	*)
+	(*		we kill a task, and wish to reclaim the memory	*)
+	(*		used by its stack.				*)
+	(*								*)
+	(****************************************************************)
+
+    TaskDescriptor = RECORD
+			next		: TaskPointer;
+			priority	: PriorityType;
+			selector	: ADDRESS;
+			StackBase	: ADDRESS;
+		     END;
+
+	(* The system maintains a number of queues.  Each of these has	*)
+	(* a header which points to the first and last elements on the	*)
+	(* queue.  For an empty queue, both pointers are NIL.		*)
+
+    KernelQueue =   RECORD
+			head, tail: TaskPointer;
+		    END;
+
+    Semaphore = POINTER TO RECORD
+				value	:	INTEGER;
+				blockedlist :	KernelQueue
+			   END;
+
+(************************************************************************)
+
+VAR
+
+    TaskTable: ARRAY TaskNumber OF TaskDescriptor;
+
+	(* TaskTable is an array of task descriptors.  After procedure	*)
+	(* InitialiseTaskControl returns, there will be two tasks in	*)
+	(* the system: the initialisation task, and the null task.  The	*)
+	(* remaining task descriptors will be on the UnusedDescriptors	*)
+	(* list, available for the creation of new tasks.  A task	*)
+	(* descriptor is allocated by procedure CreateTask, and is	*)
+	(* returned to UnusedDescriptors by procedure TaskExit.		*)
+
+    CurrentTaskPointer: TaskPointer;
+
+	(* CurrentTaskPointer points to the running task.  Note: the	*)
+	(* currently running task is not considered to be "ready", and	*)
+	(* its task descriptor is not on any of the kernel queues.	*)
+
+    UnusedDescriptors: KernelQueue;
+
+	(* UnusedDescriptors is a queue of all task descriptors which	*)
+	(* are unused, i.e. which are available for use as descriptors	*)
+	(* of newly created tasks.					*)
+
+    ReadyList: ARRAY PriorityType OF KernelQueue;
+
+	(* ReadyList holds task descriptors for all the ready tasks.	*)
+	(* It is an array of linear lists, one list for each priority	*)
+	(* level.  Priority level 0 is special: only the null task has	*)
+	(* priority zero, and the null task is always ready except when	*)
+	(* it is running.						*)
+
+(************************************************************************)
+(*			    KERNEL LIST OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE CreateQueue (VAR (*OUT*) KQ: KernelQueue);
+
+    (* Creates an initially empty kernel queue.	*)
+
+    BEGIN
+	KQ.head := NIL;  KQ.tail := NIL;
+    END CreateQueue;
+
+(*************************************************************************)
+
+PROCEDURE AddToList (VAR (*INOUT*) Q: KernelQueue; TaskPtr: TaskPointer);
+
+    (* Adds the task descriptor pointed to by TaskPtr to the tail of	*)
+    (* queue Q.								*)
+
+    BEGIN
+	TaskPtr^.next := NIL;
+	IF Q.head = NIL THEN Q.head := TaskPtr
+	ELSE Q.tail^.next := TaskPtr
+	END (*IF*);
+	Q.tail := TaskPtr;
+    END AddToList;
+
+(************************************************************************)
+
+PROCEDURE TakeFromList (VAR (*INOUT*) Q: KernelQueue): TaskPointer;
+
+    (* Removes the first entry, which is a pointer to a task		*)
+    (* descriptor, from queue Q and returns it.  Assumption: the caller	*)
+    (* has already verified that the queue is nonempty.			*)
+
+    VAR result: TaskPointer;
+
+    BEGIN
+	result := Q.head;
+	Q.head := result^.next;
+	IF Q.head = NIL THEN Q.tail := NIL  END (*IF*);
+	RETURN result;
+    END TakeFromList;
+
+(************************************************************************)
+(*				THE NULL TASK				*)
+(************************************************************************)
+
+PROCEDURE NullTask;
+
+    (* The only function of the null task is to soak up processor time	*)
+    (* when no other task is able to run.				*)
+
+    BEGIN
+	(*InTrace ("NullTask");*)
+	LOOP (* Do nothing *) END (*LOOP*);
+    END NullTask;
+
+(************************************************************************)
+(*			    	DISPATCHER				*)
+(************************************************************************)
+
+PROCEDURE TaskSwitch (T: TaskPointer);
+
+    (* Performs a task switch from the current task to task T.  It is	*)
+    (* assumed that the current task has already been moved to the	*)
+    (* appropriate kernel queue.					*)
+
+    VAR OldTaskPointer: TaskPointer;
+
+    BEGIN
+	(*InTrace ("TaskSwitch");*)
+	IF CurrentTaskPointer <> T THEN
+	    OldTaskPointer := CurrentTaskPointer;  CurrentTaskPointer := T;
+	    TRANSFER (OldTaskPointer^.selector, CurrentTaskPointer^.selector);
+	END (*IF*);
+	(*OutTrace ("TaskSwitch");*)
+    END TaskSwitch;
+
+(************************************************************************)
+
+PROCEDURE SelectAnotherTask;
+
+    (* Performs a task switch from the current task to the next ready	*)
+    (* task.  It is assumed that the current task has already been put	*)
+    (* on the appropriate kernel queue.  Notice that there is always at	*)
+    (* least one ready task, namely the null task.  The only time that	*)
+    (* the ready structure can become totally empty is when the null	*)
+    (* task is running.  In that case, this procedure will be called	*)
+    (* only after the null task has been put back on the ready list.	*)
+
+    VAR p: PriorityType;
+
+    BEGIN
+	(*InTrace ("SelectAnotherTask");*)
+	p := MaxPriority;
+	WHILE ReadyList[p].head = NIL DO
+	    DEC (p);
+	END (*WHILE*);
+	TaskSwitch (TakeFromList (ReadyList[p]));
+	(*OutTrace ("SelectAnotherTask");*)
+    END SelectAnotherTask;
+
+(************************************************************************)
+
+PROCEDURE QueueAndSwitchTasks (VAR (*INOUT*) KQ: KernelQueue);
+
+    (* Puts the current task on the tail of list KQ, and gives control	*)
+    (* to the highest-priority ready task.				*)
+
+    BEGIN
+	(*InTrace ("QueueAndSwitchTasks");*)
+	AddToList (KQ, CurrentTaskPointer);
+	SelectAnotherTask;
+	(*OutTrace ("QueueAndSwitchTasks");*)
+    END QueueAndSwitchTasks;
+
+(************************************************************************)
+
+PROCEDURE MarkAsReady (VAR (*INOUT*) FromQ: KernelQueue);
+
+    (* Removes the first task from queue FromQ and makes it ready.  If	*)
+    (* the task has a higher priority than the currently running task,	*)
+    (* then we perform an immediate task switch.  Otherwise, the new	*)
+    (* task descriptor is placed on the ready list.			*)
+
+    VAR thispriority, currentpriority: PriorityType;
+	T: TaskPointer;
+
+    BEGIN
+	(*InTrace ("MarkAsReady");*)
+	currentpriority := CurrentTaskPointer^.priority;
+	T := TakeFromList (FromQ);
+	thispriority := T^.priority;
+	IF (thispriority > currentpriority) THEN
+	    AddToList (ReadyList[currentpriority], CurrentTaskPointer);
+	    TaskSwitch (T);
+	ELSE AddToList (ReadyList[thispriority], T);
+	END (*IF*);
+	(*OutTrace ("MarkAsReady");*)
+    END MarkAsReady;
+
+(************************************************************************)
+(*			    TASK TERMINATION				*)
+(************************************************************************)
+
+PROCEDURE TaskExit;
+
+    (* Removes the currently running task from the system, and performs	*)
+    (* a task switch to the next ready task.				*)
+
+    BEGIN
+	(*InTrace ("TaskExit");*)
+	AddToList (UnusedDescriptors, CurrentTaskPointer);
+
+	(* Note that the current task is now not on any of the active	*)
+	(* kernel queues, and it never will be again.  Therefore, there	*)
+	(* will never be a return from the SelectAnotherTask call below.*)
+
+	DEALLOCATE (CurrentTaskPointer^.StackBase, StackSize);
+	SelectAnotherTask;
+
+	(* We never reach this point.	*)
+
+    END TaskExit;
+
+(************************************************************************)
+(*			    TASK INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE CreateTask (StartAddress: PROC; taskpriority: CARDINAL);
+
+    (* Must be called to introduce a task to the system. The first	*)
+    (* parameter, which should be the name of a procedure containing	*)
+    (* the task code, gives the starting address.  The second parameter	*)
+    (* is the task priority.  If this task has a higher priority than	*)
+    (* its creator, it will run immediately.  Otherwise, it becomes	*)
+    (* ready.								*)
+
+    BEGIN
+	(*InTrace ("CreateTask");*)
+	WITH UnusedDescriptors.head^ DO
+	    priority := taskpriority;
+	    ALLOCATE (StackBase, StackSize);
+	    NEWPROCESS (StartAddress, StackBase, StackSize, selector);
+	END (*WITH*);
+	MarkAsReady (UnusedDescriptors);
+	(*OutTrace ("CreateTask");*)
+    END CreateTask;
+
+(************************************************************************)
+(*				SEMAPHORES				*)
+(************************************************************************)
+
+PROCEDURE CreateSemaphore (VAR (*OUT*) s: Semaphore; InitialValue: INTEGER);
+
+    (* Creates semaphore s, with the given initial value and an empty	*)
+    (* queue.								*)
+
+    BEGIN
+	(*InTrace ("CreateSemaphore");*)
+	NEW(s);
+	s^.value := InitialValue;
+	CreateQueue (s^.blockedlist);
+	(*OutTrace ("CreateSemaphore");*)
+    END CreateSemaphore;
+
+(************************************************************************)
+
+PROCEDURE Wait (VAR (*INOUT*) s: Semaphore);
+
+    (* Decrements the semaphore value.  If the value goes negative,	*)
+    (* the calling task is blocked and there is a task switch.		*)
+
+    BEGIN
+	(*InTrace ("Wait");*)
+	DEC (s^.value);
+	IF s^.value < 0 THEN
+	    QueueAndSwitchTasks (s^.blockedlist)
+	END (*IF*);
+	(*OutTrace ("Wait");*)
+    END Wait;
+
+(************************************************************************)
+
+PROCEDURE Signal (VAR (*INOUT*) s: Semaphore);
+
+    (* Increments the semaphore value.  Unblocks one waiting task,	*)
+    (* if there was one.						*)
+
+    BEGIN
+	(*InTrace ("Signal");*)
+	INC (s^.value);
+	IF s^.value <= 0 THEN
+
+	    (* Note: the test (s^.value <= 0) is equivalent to	*)
+	    (* the test (s^.blockedlist.head <> NIL).		*)
+
+	    MarkAsReady (s^.blockedlist);
+
+	END (*IF*);
+	(*OutTrace ("Signal");*)
+    END Signal;
+
+(************************************************************************)
+(*			    MODULE INITIALISATION			*)
+(************************************************************************)
+
+PROCEDURE InitialiseTaskControl;
+
+    (* Must be called before any tasks are created, to initialise the	*)
+    (* task control data structures.					*)
+
+    VAR p: PriorityType;  j: TaskNumber;
+
+    BEGIN
+	(*InTrace ("InitialiseTaskControl");*)
+
+	(* Collect all the unused task descriptors into a linear list.	*)
+
+	CreateQueue (UnusedDescriptors);
+	FOR j := 0 TO MaxTaskNumber DO
+	    AddToList (UnusedDescriptors, ADR (TaskTable[j]) );
+	END (*FOR*);
+
+	(* The ready list structure is initially empty.  *)
+
+	FOR p := 0 TO MaxPriority DO
+	    CreateQueue (ReadyList[p]);
+	END (*FOR*);
+
+	(* Create a descriptor for the current task, i.e. for the task	*)
+	(* which called this procedure.  We give it a low priority	*)
+	(* because this task is often running the background jobs.	*)
+
+	CurrentTaskPointer := TakeFromList (UnusedDescriptors);
+	CurrentTaskPointer^.priority := 1;
+
+	(* Create the null task.  It will not run immediately, because	*)
+	(* the current (initialisation) task has higher priority.	*)
+
+	CreateTask (NullTask, 0);
+
+	(* We have a working operating system.  It is now safe to	*)
+	(* call CreateTask to introduce more tasks to the system.	*)
+
+	(*OutTrace ("InitialiseTaskControl");*)
+    END InitialiseTaskControl;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+BEGIN
+    InitialiseTaskControl;
+END MiniKernel.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/unsorted/minitrac.def b/examples/Modula-2_Libraries/PMOS/sources/unsorted/minitrac.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/unsorted/minitrac.def
@@ -0,0 +1,56 @@
+DEFINITION MODULE MiniTrace;
+
+	(************************************************)
+	(*						*)
+	(*	    Trace routines for Modula-2		*)
+	(*		program development.		*)
+	(*						*)
+	(*	This is special-purpose version, for	*)
+	(*	use with the MiniKernel demonstration	*)
+	(*	kernel.					*)
+	(*						*)
+	(*  Programmer:		P. Moylan		*)
+	(*  Last edited:	16 August 1992		*)
+	(*  Status:		Working			*)
+	(*						*)
+	(************************************************)
+
+FROM MiniWindows IMPORT
+    (* type *)	RowRange, ColumnRange;
+
+PROCEDURE NYI (name: ARRAY OF CHAR);
+
+	(* Types a "not yet implemented" message.	*)
+
+PROCEDURE Pause;
+
+	(* "Press any key to continue."			*)
+
+PROCEDURE InTrace (name: ARRAY OF CHAR);
+
+	(* Types "Entering 'name'".	*)
+
+PROCEDURE OutTrace (name: ARRAY OF CHAR);
+
+	(* Types "Leaving 'name'".	*)
+
+PROCEDURE TraceOn (firstrow, lastrow: RowRange;
+			firstcol, lastcol: ColumnRange;
+			SlowDownFactor: CARDINAL);
+
+	(* Turns on tracing.  The first four parameters specify the	*)
+	(* size of a screen window to be used for trace messages.  The	*)
+	(* size of the final parameter governs how slowly the program	*)
+	(* will run - it is needed because in many cases the trace	*)
+	(* messages appear on the screen faster than you can read them.	*)
+
+PROCEDURE TraceOff;
+
+	(* Turns off tracing.		*)
+
+PROCEDURE TraceStatus(): BOOLEAN;
+
+	(* Says whether tracing is currently on.	*)
+
+END MiniTrace.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/unsorted/minitrac.mod b/examples/Modula-2_Libraries/PMOS/sources/unsorted/minitrac.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/unsorted/minitrac.mod
@@ -0,0 +1,174 @@
+IMPLEMENTATION MODULE MiniTrace;
+
+	(************************************************)
+	(*						*)
+	(*	    Trace routines for Modula-2		*)
+	(*		program development.		*)
+	(*						*)
+	(*  Programmer:		P. Moylan		*)
+	(*  Last edited:	16 August 1992		*)
+	(*  Status:		OK			*)
+	(*						*)
+	(************************************************)
+
+FROM MyWindows IMPORT
+    (* type *)	Window,
+    (* proc *)	OpenSimpleWindow, CloseWindow, WriteString, WriteLn,
+		ReadChar, EraseLine, CursorUp;
+
+VAR TraceWindowOpen, TraceEnabled: BOOLEAN;
+    nesting: CARDINAL;  PauseLength: CARDINAL;
+    TraceWindow: Window;
+
+(************************************************************************)
+
+PROCEDURE Pause;
+
+    (* Types a "Press any key to continue" message.	*)
+    (* A temporary trace window is opened if necessary.	*)
+
+    VAR dummy: CHAR;
+
+    BEGIN
+	IF NOT TraceWindowOpen THEN
+	    OpenSimpleWindow (TraceWindow, 22, 24, 0, 28);
+	END (*IF*);
+	WriteLn (TraceWindow);
+	WriteString (TraceWindow, "Press any key to continue.");
+	ReadChar (TraceWindow, dummy);
+	IF TraceWindowOpen THEN    (* i.e. not just the temporary window *)
+	    EraseLine (TraceWindow, 0);  CursorUp(TraceWindow);
+	ELSE
+	    CloseWindow (TraceWindow);
+	END (*IF*);
+    END Pause;
+
+(************************************************************************)
+
+PROCEDURE NYI (name: ARRAY OF CHAR);
+
+    (* Types a "not yet implemented" message.  A trace window is opened	*)
+    (* if necessary.							*)
+
+    BEGIN
+	IF NOT TraceWindowOpen THEN
+	    OpenSimpleWindow (TraceWindow, 21, 24, 1, 45);
+	    TraceWindowOpen := TRUE;
+	END (*IF*);
+	WriteLn (TraceWindow);
+	WriteString (TraceWindow, name);
+	WriteString (TraceWindow, " is not yet implemented.");
+    END NYI;
+
+(************************************************************************)
+
+PROCEDURE DeliberatePause;
+
+    (* Inserts a delay in execution, for situations where the trace	*)
+    (* messages would otherwise flash by on the screen too quickly	*)
+    (* to read.								*)
+
+    VAR j,k: CARDINAL;
+
+    BEGIN
+	FOR j := 1 TO PauseLength DO
+	    FOR k := 0 TO 1000 DO
+		(*NOTHING*)
+	    END(*FOR*);
+	END (*FOR*);
+    END DeliberatePause;
+
+(************************************************************************)
+
+PROCEDURE InTrace (name: ARRAY OF CHAR);
+
+    (* To be called when entering a procedure.	*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	IF TraceEnabled THEN
+	    WriteLn (TraceWindow);
+	    FOR j := 1 TO nesting DO
+		WriteString (TraceWindow, "   ");
+	    END (*FOR*);
+	    WriteString (TraceWindow, "Entering ");
+	    WriteString (TraceWindow, name);
+	    DeliberatePause;
+	END (*IF*);
+	INC (nesting);
+    END InTrace;
+
+(************************************************************************)
+
+PROCEDURE OutTrace (name: ARRAY OF CHAR);
+
+    (* To be called when leaving a procedure.	*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	DEC (nesting);
+	IF TraceEnabled THEN
+	    WriteLn (TraceWindow);
+	    FOR j := 1 TO nesting DO
+		WriteString (TraceWindow, "   ");
+	    END (*FOR*);
+	    WriteString (TraceWindow, "Leaving ");
+	    WriteString (TraceWindow, name);
+	    DeliberatePause;
+	END (*IF*);
+    END OutTrace;
+
+(************************************************************************)
+
+PROCEDURE TraceOn (firstrow, lastrow: RowRange;
+			firstcol, lastcol: ColumnRange;
+			SlowDownFactor: CARDINAL);
+
+    (* Turns tracing on.		*)
+
+    BEGIN
+	IF TraceWindowOpen THEN
+
+	    (* Close any previous trace window. *)
+
+	    CloseWindow (TraceWindow);
+
+	END (*IF*);
+	PauseLength := SlowDownFactor;
+	OpenSimpleWindow (TraceWindow, firstrow, lastrow, firstcol, lastcol);
+	TraceWindowOpen := TRUE;  TraceEnabled := TRUE;
+    END TraceOn;
+
+(************************************************************************)
+
+PROCEDURE TraceOff;
+
+    (* Turns tracing off.		*)
+
+    BEGIN
+	IF TraceEnabled THEN
+	    CloseWindow (TraceWindow);  TraceWindowOpen := FALSE;
+	END (*IF*);
+	TraceEnabled := FALSE;
+    END TraceOff;
+
+(************************************************************************)
+
+PROCEDURE TraceStatus (): BOOLEAN;
+
+    (* Says whether tracing is currently on.		*)
+
+    BEGIN
+	RETURN TraceEnabled;
+    END TraceStatus;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+BEGIN
+    TraceEnabled := FALSE;  nesting := 0;  TraceWindowOpen := FALSE;
+END MiniTrace.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/unsorted/miniwind.def b/examples/Modula-2_Libraries/PMOS/sources/unsorted/miniwind.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/unsorted/miniwind.def
@@ -0,0 +1,296 @@
+DEFINITION MODULE MiniWindows;
+
+	(****************************************************************)
+	(*								*)
+	(*	A simple implementation of screen windows.		*)
+	(*								*)
+	(*	This is a special version, using the MiniKernel		*)
+	(*	demonstration kernel.  It is designed solely for	*)
+	(*	demonstrations such as the SemaTest demo.		*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	16 August 1992				*)
+	(*  Status:		SPECIAL VERSION                         *)
+	(*                      This is a version designed for the      *)
+	(*                      SemaTest demo under TopSpeed.		*)
+	(*								*)
+	(****************************************************************)
+
+(************************************************************************)
+(*									*)
+(* REMARK: There are two versions of the basic 'write' procedure.	*)
+(* Procedure WriteChar treats every character as a printable character,	*)
+(* so it can write any character in the standard character set.  This	*)
+(* is the output procedure recommended for general use.  Control	*)
+(* operations are supplied by separate procedures such as WriteLn,	*)
+(* SetCursor, etc., so there is no need to resort to the BASIC		*)
+(* programmers' trick of writing long strings of obscure control codes.	*)
+(* But for people who can't break this bad habit, procedure Write is	*)
+(* supplied; this treats character codes 0..31 as control codes.	*)
+(*									*)
+(* Warning: I have not bothered to look after all the control codes,	*)
+(* just the ones I found a use for.  Most of them print as a		*)
+(* two-character sequence ^<letter>.					*)
+(*									*)
+(************************************************************************)
+
+(************************************************************************)
+(*									*)
+(* NOTE ON CRITICAL SECTIONS: When using this module in a multitasking	*)
+(* environment, there are numerous critical sections because several	*)
+(* tasks may be using the same physical screen.  These sections are	*)
+(* protected by semaphores.  (For the case where we are not using the	*)
+(* multitasking kernel, there is a version of module Semaphores which	*)
+(* contains dummy procedures).  The general philosophy is to assume	*)
+(* that critical section protection is needed for inter-window		*)
+(* conflicts, but that no protection is needed for operations on a	*)
+(* single window because the most common situation is that each window	*)
+(* is used by only one task.  If there happen to be windows which are	*)
+(* shared by two or more tasks, the associated synchronization problems	*)
+(* must be resolved by the caller; they are not resolved in module	*)
+(* Windows, on the grounds that the extra overhead is not justified	*)
+(* just to support a case which rarely happens in practice.		*)
+(*									*)
+(************************************************************************)
+
+CONST
+    MaxRowNumber = 24;
+    MaxColumnNumber = 79;
+
+TYPE
+    Window;	(* is private *)
+    Colour = (black, blue, green, cyan, red, magenta, brown, white,
+		darkgrey, lightblue, lightgreen, lightcyan, lightred,
+		lightmagenta, yellow, intensewhite);
+
+    (* Note: Any of these colours may be used as a foreground colour,	*)
+    (* but in most applications only [black..white] are suitable as	*)
+    (* background colours.  The others may be used, but they can give	*)
+    (* strange effects such as a blinking display.  Use with care!	*)
+
+    RowRange = [0..MaxRowNumber];
+    ColumnRange = [0..MaxColumnNumber];
+    FrameType = (noframe, simpleframe, doubleframe);
+    DividerType = (nodivider, simpledivider, doubledivider);
+
+PROCEDURE OpenWindow (VAR (*OUT*) w: Window;
+			ForegroundColour, BackgroundColour: Colour;
+			firstline, lastline: RowRange;
+			firstcol, lastcol: ColumnRange;
+			FrameDesired: FrameType;
+			DividerDesired: DividerType);
+
+    (* Create a new window.  Note that row and column numbers start	*)
+    (* from 0.  NOTE: If the window has a box drawn around it (the case	*)
+    (* FrameDesired <> noframe), this subtracts from the space		*)
+    (* available for text.						*)
+
+PROCEDURE OpenSimpleWindow (VAR (*OUT*) w: Window;
+			firstline, lastline: RowRange;
+			firstcol, lastcol: ColumnRange);
+
+    (* Identical to OpenWindow, except that you don't get any choice	*)
+    (* about the colours or frame.  The window is white-on-black with	*)
+    (* a simple frame and no dividers for the scrolling region.  This	*)
+    (* version of OpenWindow is useful for those with monochrome	*)
+    (* displays who don't want to be bothered with importing the types	*)
+    (* Colour, FrameType, and DividerType.				*)
+
+PROCEDURE ChangeScrollingRegion (w: Window; firstline, lastline: RowRange);
+
+    (* Changes the scrolling region of window w to the new line		*)
+    (* boundaries given, and sets the cursor of this window to the	*)
+    (* start of the scrolling region.  Row numbers are window-relative;	*)
+    (* that is, line 0 is the top line of the window (which is where	*)
+    (* the border is, unless you have no border).			*)
+
+PROCEDURE NewScrollingRegion (w: Window;  firstline, lastline: RowRange;
+				firstcolumn, lastcolumn: ColumnRange);
+
+    (* Changes the scrolling region of w to be the specified rectangle,	*)
+    (* but unlike ChangeScrollingRegion this procedure does not redraw	*)
+    (* the dividers.  Furthermore the old scrolling region set by	*)
+    (* ChangeScrollingRegion is remembered and may be restored by a	*)
+    (* call to ResetScrollingRegion.					*)
+
+PROCEDURE ResetScrollingRegion (w: Window);
+
+    (* Changes the scrolling region of w back to what it was the last	*)
+    (* time ChangeScrollingRegion was called.  If ChangeScrollingRegion	*)
+    (* was never called, the scrolling region goes back to being the	*)
+    (* entire window minus the frame (if any).				*)
+
+PROCEDURE ShiftWindow (w: Window;  rowchange, columnchange: INTEGER);
+
+    (* Moves w on the screen.  The second and third arguments may be	*)
+    (* negative.  The amount of move may be reduced to prevent a move	*)
+    (* off the edge of the screen.					*)
+
+PROCEDURE CloseWindow (VAR (*INOUT*) w: Window);
+
+    (* Destroys the window. *)
+
+PROCEDURE PutOnTop (w: Window);
+
+    (* Makes sure that window w is fully visible on the screen.  Rarely	*)
+    (* needed, since many window operations automatically put the	*)
+    (* window being used on top.					*)
+
+PROCEDURE RefreshDisplay;
+
+    (* Rewrites every open window.  Should not normally be needed, but	*)
+    (* available for use in cases the display is corrupted by, for	*)
+    (* example, software which bypasses this module and writes directly	*)
+    (* to the screen.							*)
+
+PROCEDURE SetCursor (w: Window; row: RowRange; column: ColumnRange);
+
+    (* Sets the cursor for window w to the given row and column.  The	*)
+    (* coordinates are window-relative; that is, they start at (0,0) at	*)
+    (* the top left of the window.					*)
+
+PROCEDURE SaveCursor (w: Window; VAR (*OUT*) row, column: CARDINAL);
+
+    (* Returns the current cursor position.  The coordinates are	*)
+    (* window-relative; that is, they start at (0,0) at the top left of	*)
+    (* the window.							*)
+
+PROCEDURE CursorLeft (w: Window);
+
+    (* Moves the window cursor one position left.  If it falls off the	*)
+    (* left edge of the window, it moves to the right edge in the same	*)
+    (* row.								*)
+
+PROCEDURE CursorRight (w: Window);
+
+    (* Moves the window cursor one position right.  If it falls off the	*)
+    (* right edge of the window, it moves to the left edge in the same	*)
+    (* row.								*)
+
+PROCEDURE CursorUp (w: Window);
+
+    (* Moves the window cursor one position up.  If it falls off the	*)
+    (* top edge of the window, it moves to the bottom edge in the same	*)
+    (* column.								*)
+
+PROCEDURE CursorDown (w: Window);
+
+    (* Moves the window cursor one position down.  If it falls off the	*)
+    (* bottom edge of the window, it moves to the top edge in the same	*)
+    (* column.								*)
+
+PROCEDURE ScrollUp (w: Window);
+
+    (* Scrolls the scrolling region of window w up by one row, filling	*)
+    (* the vacated row with spaces.					*)
+
+PROCEDURE ScrollDown (w: Window);
+
+    (* Scrolls the scrolling region of window w down by one row,	*)
+    (* filling the vacated row with spaces.				*)
+
+PROCEDURE WriteLn (w: Window);
+
+    (* Go to next line in window, scrolling if necessary.  N.B. The	*)
+    (* window does not scroll if you are not in the scrolling region	*)
+    (* at the time of the WriteLn.					*)
+
+PROCEDURE WriteChar (w: Window; ch: CHAR);
+
+    (* Write one character.  Control characters are not given special	*)
+    (* treatment; they produce something visible just like any other	*)
+    (* character.  Wraps to the next line before writing if the write	*)
+    (* would put us on or beyond the right border of w.			*)
+
+PROCEDURE Write (w: Window; ch: CHAR);
+
+    (* Like WriteChar, but codes in the range 0..31 are treated as	*)
+    (* control characters.  This procedure is not recommended for	*)
+    (* general use, as it leads to obscure programs.  (Instead, do the	*)
+    (* control operations by direct calls to the cursor control		*)
+    (* procedures which are also supplied in this module).  It is	*)
+    (* supplied mainly to help those who are used to the conventions of	*)
+    (* the "standard" Modula-2 I/O modules such as InOut.		*)
+
+PROCEDURE WriteString (w: Window; text: ARRAY OF CHAR);
+
+    (* Write a string of characters, stopping at the first NUL		*)
+    (* character or the end of the array, whichever comes first.	*)
+
+PROCEDURE ReadBack (w: Window;  r: RowRange;  c: ColumnRange): CHAR;
+
+    (* Returns the character which currently occupies relative location	*)
+    (* (r,c) on the display of window w.				*)
+
+PROCEDURE ReadChar (w: Window;  VAR (*OUT*) ch: CHAR);
+
+    (* Read one character, and echo it.	*)
+
+PROCEDURE LookaheadChar (w: Window): CHAR;
+
+    (* Reads a character without consuming it.  That is, the character	*)
+    (* remains available to be read by ReadChar.  This allows the	*)
+    (* caller to check whether the character is really wanted.		*)
+
+PROCEDURE ReadCharWithoutEcho (w: Window;  VAR (*OUT*) ch: CHAR);
+
+    (* Read one character, but don't echo it.  However, a blinking	*)
+    (* cursor is still displayed to prompt for the character.  (If you	*)
+    (* don't want the blinking cursor, use procedure Keyboard.InKey).	*)
+
+PROCEDURE PressAnyKey (w: Window);
+
+    (* Types a "Press any key to continue" message.	*)
+
+PROCEDURE ReadString (w: Window;  VAR (*OUT*) result: ARRAY OF CHAR);
+
+    (* Reads a character string, terminated by carriage return.		*)
+
+PROCEDURE EditString (w: Window;  VAR (*INOUT*) result: ARRAY OF CHAR;
+						fieldsize: CARDINAL);
+
+    (* Reads a character string, where a default result is supplied by	*)
+    (* the caller.  The final result is the state of the string at the	*)
+    (* time where the keyboard user types a carriage return or uses a	*)
+    (* cursor movement key to move out of the displayed field.  If the	*)
+    (* user types Esc at any time, then we return with result[0] = Esc.	*)
+    (* A carriage return or Esc as terminator is not returned to the	*)
+    (* caller, but if the terminator is a cursor control key then it	*)
+    (* it remains available, via Keyboard.Inkey, to the caller.		*)
+    (* At most fieldsize characters of the string can be edited, and	*)
+    (* perhaps fewer if the result array is smaller or if there is	*)
+    (* insufficient space in the window.				*)
+
+PROCEDURE ColourSwap (w: Window; row: RowRange; col: ColumnRange;
+							nchar: CARDINAL);
+
+    (* Sets a field of nchar characters, starting at (row,col), to	*)
+    (* "reverse video" by swapping the foreground and background	*)
+    (* colours.  Notice that the process is reversible: you get back to	*)
+    (* "normal video" by calling this procedure again.  The location is	*)
+    (* given in window-relative coordinates, not absolute screen	*)
+    (* positions.  NOTE: Do not assume that this procedure can wrap	*)
+    (* around to a new line.  It normally cannot.			*)
+
+PROCEDURE Blink (w: Window; r: RowRange; c: ColumnRange; nchar: CARDINAL);
+
+    (* Toggles the blinking status - that is, turns blinking on if it	*)
+    (* was off, and vice versa - for nchar characters, starting at	*)
+    (* relative location (r,c) in window w.				*)
+    (* NOTE: This procedure will not wrap around to a new row.		*)
+
+PROCEDURE EraseLine (w: Window; option: CARDINAL);
+
+    (* Erases some or all of the current line (but never the border).	*)
+    (* The erased characters are replaced by space characters.  The	*)
+    (* window cursor is moved to the location of the first erased	*)
+    (* character.  If w is not the currently active window, the changes	*)
+    (* will not be visible until w is on top again.  The options are:	*)
+    (*		0	the whole of the line, except for the border	*)
+    (*		1	from the current cursor position onwards	*)
+    (*		2	from the start to just before the cursor	*)
+    (* If we are inside a scrolling region, then only that part of the	*)
+    (* line inside the scrolling region is affected.			*)
+
+END MiniWindows.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/unsorted/miniwind.mod b/examples/Modula-2_Libraries/PMOS/sources/unsorted/miniwind.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/unsorted/miniwind.mod
@@ -0,0 +1,1775 @@
+IMPLEMENTATION MODULE MiniWindows;
+
+	(********************************************************)
+	(*							*)
+	(*	A simple implementation of screen windows.	*)
+	(*							*)
+	(*	This version uses the MiniKernel demonstration	*)
+	(*	kernel.						*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	16 August 1992			*)
+	(*  Status:		NEW VERSION                     *)
+	(*                      This is a version specifically  *)
+	(*                      tailored for the SemaTest       *)
+	(*                      demo, under TopSpeed.		*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(*									*)
+(* There are two versions of the basic "write character" operation.	*)
+(* Procedure WriteChar, which is recommended for general use, does not	*)
+(* recognise the concept of a "control character".  Every character	*)
+(* code is considered to represent a character to be displayed on the	*)
+(* screen.  Procedure Write is similar but treats CHR(0) up to CHR(31)	*)
+(* as control codes.  This leads to obscure programs, so you are	*)
+(* advised to avoid Write unless you want your programs to look like	*)
+(* BASIC programs.  Its main intended uses are to echo keyboard input,	*)
+(* and to print a file which contains embedded control characters.	*)
+(*									*)
+(************************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	ADDRESS,
+    (* proc *)	ADR;
+
+FROM MiscPMOS IMPORT
+    (* type *)	RegisterPacket,
+    (* proc *)  Copy, CopyUp, MakePointer, IXOR, InKey, PutBack,
+		BIOS;
+(*
+FROM DummySemaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+*)
+FROM Storage IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM TerminationControl IMPORT
+    (* proc *)	SetTerminationProcedure, ReportTerminationError;
+(*
+FROM LowLevelIO IMPORT
+    (* proc *)	OutByte;
+
+FROM Logic IMPORT
+    (* proc *)	HighByte, LowByte, IXOR;
+
+FROM BIOS IMPORT
+    (* type *)	RegisterPacket,
+    (* proc *)	BIOS;
+
+FROM MemoryModel IMPORT
+    (* proc *)	MakePointer, Virtual, SEGMENT;
+*)
+
+FROM MiniKernel IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+(*
+FROM BlockMove IMPORT
+    (* proc *)	Copy, CopyUp;
+*)
+	(* Remark: We use Copy in preference to CopyUp wherever		*)
+	(* possible, because it is marginally more efficient.  These	*)
+	(* two procedures are equivalent in their final result, except	*)
+	(* for the case (which occurs in scrolling) where the source	*)
+	(* and destination strings overlap in memory.			*)
+(*
+FROM Keyboard IMPORT
+    (* proc *)	InKey, PutBack;
+*)
+(************************************************************************)
+(*	If you want black-and-white operation even though your		*)
+(*	display supports colour (e.g. for the case where the colours	*)
+(*	are not very readable), set ForcedMonochrome to TRUE.		*)
+(*	Otherwise, this module selects colour operation if		*)
+(*	one of the colour modes was active at program startup.		*)
+(************************************************************************)
+
+CONST ForcedMonochrome = FALSE;
+
+(************************************************************************)
+
+CONST
+    VideoInt = 16;			(* interrupt number for BIOS	*)
+    BytesPerChar = 2;			(* # bytes/char in video buffer	*)
+    CharsPerRow = MaxColumnNumber + 1;	(* characters per row		*)
+    BytesPerRow = BytesPerChar*CharsPerRow;
+    buffersize = BytesPerRow * (MaxRowNumber+1);
+					(* size in bytes of video buffer*)
+    DefaultTabs =
+"        T       T       T       T       T       T       T       T       T";
+
+(************************************************************************)
+
+TYPE
+    buffersubscript = [0..buffersize - 1];
+    Rectangle = RECORD
+		    top, bottom: RowRange;
+		    left, right: ColumnRange;
+		END (*RECORD*);
+
+    Window = POINTER TO WindowData;
+
+	(****************************************************************)
+	(*								*)
+	(* WindowData records are linked (by next and previous) as a	*)
+	(* doubly linked list, to implement a stack of windows.		*)
+	(* Variable TopWindow points to the top of this stack.		*)
+	(*								*)
+	(* The row and column values stored in this record are actual	*)
+	(* screen row and column, i.e. they are not window-relative.	*)
+	(*								*)
+	(* The ScreenPosition field is a subscript into the hardware	*)
+	(* video buffer.  It can be computed easily from the "row" and	*)
+	(* "column" fields, but it is more convenient to keep this	*)
+	(* technically redundant variable.				*)
+	(*								*)
+	(* The "obscured" field indicates whether this window is wholly	*)
+	(* or partially obscured by another window on the screen.  By	*)
+	(* keeping track of this, we can avoid some unnecessary screen	*)
+	(* refreshing.							*)
+	(*								*)
+	(* The "blockcursor" field specifies what kind of cursor to	*)
+	(* display: a block cursor if TRUE, an underline cursor if	*)
+	(* FALSE.  Most of the time this is irrelevant, as we display	*)
+	(* a cursor only during input.					*)
+	(*								*)
+	(* The "buffer" array holds a copy of what is supposed to be	*)
+	(* transferred to the video buffer.				*)
+	(* 								*)
+	(****************************************************************)
+
+    WindowData = RECORD
+		    next, previous: Window;
+		    frame: FrameType;  divider: DividerType;
+		    tabstops: ARRAY ColumnRange OF CHAR;
+		    ScrollRegion, DefaultScrollRegion: Rectangle;
+		    FirstRow, LastRow, row: RowRange;
+		    FirstColumn, LastColumn: ColumnRange;
+		    column: [0..MAX(ColumnRange)+1];
+		    ScreenPosition: buffersubscript;
+		    foreground, background: Colour;
+		    CurrentAttributes: CHAR;
+		    obscured, blockcursor: BOOLEAN;
+		    buffer: ARRAY buffersubscript OF CHAR;
+		 END (*RECORD*);
+
+(************************************************************************)
+(*		   NOTE ON CRITICAL SECTION PROTECTION			*)
+(* The potential deadlock problems in this module are surprisingly	*)
+(* subtle, arising from the fact that a procedure incorporating one	*)
+(* form of critical section protection may call other procedures which	*)
+(* themselves contain critical section protection.  To avoid these	*)
+(* problems, we use an ordered resource policy.  Each critical section	*)
+(* protection semaphore is given a "level", which for clarity is shown	*)
+(* as the last character of its name.  A piece of code is said to be	*)
+(* executing at level N if it is inside a critical section protected	*)
+(* by a semaphore whose level is N (and not inside a critical section	*)
+(* protected by any semaphore of any higher level).  The rule which	*)
+(* avoids deadlock is: to lock a semaphore at level N, we must be	*)
+(* executing at a level < N.						*)
+(************************************************************************)
+
+VAR
+
+    (* BlackAndWhite is true if we have a monochrome display.		*)
+
+    BlackAndWhite: BOOLEAN;
+
+    (* BlankRow is set up by the initialisation code as a row of space	*)
+    (* characters.  Note however that the attribute codes need to be	*)
+    (* filled in before each use.					*)
+
+    BlankRow: ARRAY [0..BytesPerRow-1] OF CHAR;
+
+    (* Access to BlankRow is a critical section, so we protect it with	*)
+    (* a semaphore.							*)
+
+    BlankRowAccess1: Semaphore;
+
+    (* StackAccess2 is used to protect access to the shared data	*)
+    (* structure which defines the stack of windows.			*)
+
+    StackAccess2: Semaphore;
+
+    (* TopWindow is the current top of the stack of windows.		*)
+
+    TopWindow: Window;
+
+    (* ScreenAccess3 is used to protect access to memory in segment	*)
+    (* ScreenSeg, i.e. the memory belonging to the physical screen.	*)
+
+    ScreenAccess3: Semaphore;
+
+    (* ScreenSeg is a segment selector for the hardware video buffer,	*)
+    (* and VideoPage is the page number.  (In fact, I don't use		*)
+    (* VideoPage in this version, but it's here to document the way to	*)
+    (* find its value, in case I need it in a future version.)		*)
+    (* CRTCport is the port number to use when addressing the CRT	*)
+    (* controller chip.  It is a variable, because the address depends	*)
+    (* on whether a colour or monochrome interface is installed.	*)
+
+    ScreenSeg: CARDINAL;
+    VideoPage: SHORTCARD;
+    CRTCport: CARDINAL;
+
+    (* PhysicalCursor keeps track of the blinking screen cursor.  The	*)
+    (* CursorWindow field shows which window, if any, currently "owns"	*)
+    (* the physical cursor, and the access4 semaphore ensures that	*)
+    (* there can be at most one such window.  Note: semaphore access4	*)
+    (* is used to protect both variable CursorWindow and the hardware	*)
+    (* operations of turning the cursor on and off.			*)
+
+    PhysicalCursor: RECORD
+			access4: Semaphore;
+			CursorWindow: Window;
+		    END (*RECORD*);
+
+(************************************************************************)
+(*		    MISCELLANEOUS SCREEN OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE SetCursorShape (startline, endline: CARDINAL);
+
+    (* Sets the start and end scan lines for the cursor.  This has to	*)
+    (* be done with a BIOS call, rather than by programming the CRTC	*)
+    (* registers directly, to ensure correct treatment over the variety	*)
+    (* of different video interfaces which could be present.		*)
+    (* Caller must be executing at level 4.				*)
+(*
+    VAR BIOSframe: RegisterPacket;
+*)
+    BEGIN
+(*
+	WITH BIOSframe DO
+	    AH := 1;  CH := startline;  CL := endline;
+	END (*WITH*);
+	BIOS (VideoInt, BIOSframe);
+
+*)
+    END SetCursorShape;
+
+(************************************************************************)
+
+PROCEDURE CursorOff;
+
+    (* Turns the cursor off by putting 01 in bits 5 and 4 of the cursor	*)
+    (* start register of the 6845 CRT controller.  Remark: according to	*)
+    (* the documentation, it should be bits 6 and 5; I do not as yet	*)
+    (* have an explanation of this discrepancy.				*)
+    (* Caller must be executing at level 4.				*)
+
+    BEGIN
+	SetCursorShape (16,0);
+    END CursorOff;
+
+(************************************************************************)
+
+PROCEDURE CursorOn (position: buffersubscript;  blockcursor: BOOLEAN);
+
+    (* Displays a blinking screen cursor at the specified position.	*)
+    (* Note that this procedure actually has to halve the specified	*)
+    (* argument to take account of the fact that attribute bytes take	*)
+    (* space in the character buffer but are not counted by the cursor	*)
+    (* setting hardware.						*)
+    (* Caller must be executing at level 4.				*)
+
+    VAR start, end: CARDINAL;
+
+    BEGIN
+(*
+	position := position DIV BytesPerChar;
+	OutByte (CRTCport, 14);	(* the "cursor position higher" register *)
+	OutByte (CRTCport+1, HighByte(position));
+	OutByte (CRTCport, 15);	(* the "cursor position lower" register *)
+	OutByte (CRTCport+1, LowByte(position));
+	IF BlackAndWhite THEN end := 12 ELSE end := 7 END (*IF*);
+	IF blockcursor THEN start := 1 ELSE start := end-1 END(*IF*);
+	SetCursorShape (start, end);
+*)
+    END CursorOn;
+
+(************************************************************************)
+(*		MANIPULATION OF THE STACK OF WINDOWS			*)
+(************************************************************************)
+
+PROCEDURE UnLink (w: Window);
+
+    (* Removes w^ from the stack, but otherwise leaves it unchanged.	*)
+    (* Caller must have locked StackAccess2.				*)
+
+    BEGIN
+	IF w^.previous <> NIL THEN w^.previous^.next := w^.next END (*IF*);
+	IF w^.next <> NIL THEN w^.next^.previous := w^.previous END (*IF*);
+	IF TopWindow = w THEN TopWindow := w^.next END (*IF*);
+	w^.previous := NIL;  w^.next := NIL;
+    END UnLink;
+
+(************************************************************************)
+(*			   SCREEN REFRESHING				*)
+(************************************************************************)
+
+PROCEDURE PartialRefresh (w: Window;  startrow, endrow: RowRange;
+					startcol, endcol: ColumnRange);
+
+    (* Re-draws the image of window w on the screen, in the area	*)
+    (* bounded by the given absolute screen coordinates.  The ranges	*)
+    (* specified are inclusive limits.					*)
+    (* Caller must be executing at level <3.				*)
+
+    VAR i: RowRange;
+	offset, count: buffersubscript;
+
+    BEGIN
+	WITH w^ DO
+
+	    (* Work out the overlap between the region and the window.	*)
+
+	    IF FirstRow > startrow THEN startrow := FirstRow END (*IF*);
+	    IF LastRow < endrow THEN endrow := LastRow END (*IF*);
+	    IF FirstColumn > startcol THEN startcol := FirstColumn END (*IF*);
+	    IF LastColumn < endcol THEN endcol := LastColumn END (*IF*);
+
+	    (* Refresh that region, if it is nonempty.	*)
+
+	    IF (startrow <= endrow) AND (startcol <= endcol) THEN
+		offset := BytesPerRow*startrow + BytesPerChar*startcol;
+		count := BytesPerChar*(endcol - startcol + 1);
+		Wait (ScreenAccess3);
+		FOR i := startrow TO endrow DO
+		    Copy (ADR(buffer[offset]),
+			MakePointer(ScreenSeg, offset), count);
+		    INC (offset, BytesPerRow);
+		END (*FOR*);
+		Signal (ScreenAccess3);
+	    END (*IF*);
+	END (*WITH*);
+    END PartialRefresh;
+
+(************************************************************************)
+
+PROCEDURE Refresh (w: Window);
+
+    (* Re-draws the image of window w on the screen.	*)
+    (* Caller must be executing at level <3.		*)
+
+    VAR i: RowRange;
+	offset, count: buffersubscript;
+
+    BEGIN
+	WITH w^ DO
+	    offset := BytesPerRow*FirstRow + BytesPerChar*FirstColumn;
+	    count := BytesPerChar*(LastColumn - FirstColumn + 1);
+	    Wait (ScreenAccess3);
+	    FOR i := FirstRow TO LastRow DO
+		Copy (ADR(buffer[offset]),
+			MakePointer(ScreenSeg, offset), count);
+		INC (offset, BytesPerRow);
+	    END (*FOR*);
+	    Signal (ScreenAccess3);
+	    obscured := FALSE;
+	END (*WITH*);
+    END Refresh;
+
+(************************************************************************)
+
+PROCEDURE ComputeCollisions (w: Window);
+
+    (* Updates the "obscured" field of all windows which are below this	*)
+    (* one on the stack, and sets w^.obscured to FALSE.  Turns on the	*)
+    (* blinking screen cursor if it belongs to this window, and turns	*)
+    (* it off if this window obscures it.				*)
+    (* Caller must have locked StackAccess2.				*)
+    (* Caller must be executing at level <4.				*)
+
+    VAR left, right: ColumnRange;
+	top, bottom: RowRange;
+	w2: Window;
+	clear: BOOLEAN;
+
+    BEGIN
+	(* Take note of the screen location of this window. *)
+
+	WITH w^ DO
+	    obscured := FALSE;
+	    left := FirstColumn;  right := LastColumn;
+	    top := FirstRow;  bottom := LastRow;
+	    w2 := next;
+	END (*WITH*);
+
+	(* Decide whether to turn the physical cursor on or off. *)
+
+	WITH PhysicalCursor DO
+	    Wait (access4);
+	    IF CursorWindow = w THEN
+		CursorOn (w^.ScreenPosition, w^.blockcursor);
+	    ELSIF CursorWindow <> NIL THEN
+		WITH CursorWindow^ DO
+		    clear := (row < top) OR (row > bottom)
+				OR (column < left) OR (column > right);
+	        END (*WITH*);
+		IF NOT clear THEN
+		    CursorOff;
+		END (*IF*);
+	    END (*IF*);
+	    Signal (access4);
+	END (*WITH*);
+
+	(* Update the "obscured" information for all windows under	*)
+	(* the current window.  (For those which are already obscured	*)
+	(* by some other window, no further check is needed.)		*)
+
+	WHILE w2 <> NIL DO
+	    WITH w2^ DO
+		IF NOT obscured THEN
+		    clear := (LastColumn < left) OR (FirstColumn > right)
+				OR (LastRow < top) OR (FirstRow > bottom);
+		    obscured := NOT clear;
+		END (*IF*);
+	    END (*WITH*);
+	    w2 := w2^.next;
+	END (*WHILE*);
+    END ComputeCollisions;
+
+(************************************************************************)
+
+PROCEDURE PutOnTopI (w: Window);
+
+    (* Makes w the top of stack, and refreshes its image on the screen.	*)
+    (* This procedure does the same job as PutOnTop (see below), but	*)
+    (* different entry assumptions.					*)
+    (* The caller must have locked StackAccess2.			*)
+    (* The caller must be executing at level 2.				*)
+
+    BEGIN
+	UnLink (w);
+	IF TopWindow <> NIL THEN TopWindow^.previous := w END (*IF*);
+	w^.next := TopWindow;  TopWindow := w;
+	Refresh (w);  ComputeCollisions (w);
+    END PutOnTopI;
+
+(************************************************************************)
+
+PROCEDURE PutOnTop (w: Window);
+
+    (* Makes w the top of stack, and refreshes its image on the screen.	*)
+    (* This is the externally callable version.				*)
+    (* The caller must be executing at a level <2.			*)
+
+    BEGIN
+	Wait (StackAccess2);
+	IF TopWindow <> w THEN
+	    PutOnTopI (w);
+	ELSE
+	    WITH PhysicalCursor DO
+		Wait (access4);
+		IF CursorWindow = w THEN
+		    CursorOn (w^.ScreenPosition, w^.blockcursor);
+		END (*IF*);
+		Signal (access4);
+	    END (*WITH*);
+	END (*IF*);
+	Signal (StackAccess2);
+    END PutOnTop;
+
+(************************************************************************)
+
+PROCEDURE Repaint(startrow, endrow: RowRange; startcol, endcol: ColumnRange);
+
+    (* Repaints the specified (inclusive) rectangular region on the	*)
+    (* screen, and sets the physical screen cursor as necessary.	*)
+    (* The caller must be executing at level 0.				*)
+
+    CONST NormalVideo = CHR(07H);
+
+    VAR i: RowRange;
+	offset, count: buffersubscript;
+	p: Window;
+
+    BEGIN
+	(* First, clear the region.	*)
+
+	Wait (BlankRowAccess1);
+	FOR offset := 1 TO BytesPerRow-1 BY BytesPerChar DO
+	    BlankRow[offset] := NormalVideo;
+	END (*FOR*);
+	offset := BytesPerRow*startrow + BytesPerChar*startcol;
+	count := BytesPerChar*(endcol - startcol + 1);
+	Wait (ScreenAccess3);
+	FOR i := startrow TO endrow DO
+	    Copy (ADR(BlankRow), MakePointer(ScreenSeg, offset), count);
+	    INC (offset, BytesPerRow);
+	END (*FOR*);
+	Signal (ScreenAccess3);
+	Signal (BlankRowAccess1);
+
+	(* Now refresh all open windows (or, more precisely, the parts	*)
+	(* of them which lie in the affected region).			*)
+
+	Wait (StackAccess2);
+	IF TopWindow <> NIL THEN
+	    p := TopWindow;
+	    WHILE p^.next <> NIL DO  p := p^.next  END (*WHILE*);
+	    REPEAT
+		PartialRefresh (p, startrow, endrow, startcol, endcol);
+		ComputeCollisions (p);  p := p^.previous;
+	    UNTIL p = NIL;
+	END (*IF*);
+	Signal (StackAccess2);
+    END Repaint;
+
+(************************************************************************)
+
+PROCEDURE RefreshDisplay;
+
+    (* Rewrites every open window.  Should not normally be needed, but	*)
+    (* available for use in cases the display is corrupted by, for	*)
+    (* example, software which bypasses this module and writes directly	*)
+    (* to the screen.							*)
+    (* The caller must be executing at level 0.				*)
+
+    BEGIN
+	Wait (PhysicalCursor.access4);
+	CursorOff;
+	Signal (PhysicalCursor.access4);
+	Repaint (0, MAX(RowRange), 0, MAX(ColumnRange));
+    END RefreshDisplay;
+
+(************************************************************************)
+(*			SETTING THE SCROLLING REGION			*)
+(************************************************************************)
+
+PROCEDURE InScrollingRegion (w: Window): BOOLEAN;
+
+    (* Returns TRUE iff the current cursor position of window w is	*)
+    (* inside its scrolling region.					*)
+
+    BEGIN
+	WITH w^ DO
+	    WITH ScrollRegion DO
+		RETURN (row >= top) AND (row <= bottom)
+			AND (column >= left) AND (column <= right);
+	    END (*WITH*);
+	END (*WITH*);
+    END InScrollingRegion;
+
+(************************************************************************)
+
+PROCEDURE ChangeScrollingRegion (w: Window;  firstline, lastline: RowRange);
+
+    (* Changes the scrolling region of window w to the new line		*)
+    (* boundaries given, and sets its cursor to the start of the new	*)
+    (* scrolling region.  The line numbers are window-relative.		*)
+
+    VAR horizontal, vertical, leftT, rightT: CHAR;
+	j: ColumnRange;  place: buffersubscript;
+
+    BEGIN
+	(* Although the user specifies window-relative line numbers,	*)
+	(* we use screen-relative numbers internally.  Adjust the	*)
+	(* parameters to take this into account.			*)
+
+	INC (firstline, w^.FirstRow);
+	INC (lastline, w^.FirstRow);
+
+	(* Work out what characters to use for the frame and divider.	*)
+
+	horizontal := '─';  vertical := '│';
+	leftT := '├';  rightT := '┤';
+	WITH w^ DO
+	    IF divider = doubledivider THEN
+		horizontal := '═';
+	    END (*IF*);
+	    IF frame = doubleframe THEN
+		vertical := '║';
+		IF divider = doubledivider THEN
+		    leftT := '╠';  rightT := '╣';
+		ELSE
+		    leftT := '╟';  rightT := '╢';
+		END (*IF*);
+	    ELSIF divider = doubledivider THEN
+		leftT := '╞';  rightT := '╡';
+	    END (*IF*);
+
+	    (* Clean up the frame. *)
+
+	    ScrollRegion := DefaultScrollRegion;
+	    IF frame <> noframe THEN
+
+		(* Remove the left and right T belonging to the	*)
+		(* old divider bars, if necessary.		*)
+
+		IF ScrollRegion.top - 1 > FirstRow THEN
+		    place := BytesPerRow*(ScrollRegion.top - 1)
+					+ BytesPerChar*FirstColumn;
+		    buffer[place] := vertical;
+		    buffer[place + BytesPerChar*(LastColumn - FirstColumn)]
+					:= vertical;
+		END (*IF*);
+
+		IF ScrollRegion.bottom + 1 < LastRow THEN
+		    place := BytesPerRow*(ScrollRegion.bottom+1)
+					+ BytesPerChar*FirstColumn;
+		    buffer[place] := vertical;
+		    buffer[place + BytesPerChar*(LastColumn - FirstColumn)]
+					:= vertical;
+		END (*IF*);
+	    END (*IF*);
+
+	    (* Put in the new divider bars.	*)
+
+	    IF divider <> nodivider THEN
+
+		(* Put in the top horizontal bar.	*)
+
+		IF firstline > FirstRow + 1 THEN
+		    place := BytesPerRow*(firstline-1)
+					+ BytesPerChar*FirstColumn;
+		    IF frame <> noframe THEN
+			buffer[place] := leftT;  INC (place, BytesPerChar);
+		    END (*IF*);
+		    FOR j := ScrollRegion.left TO ScrollRegion.right DO
+			buffer[place] := horizontal;  INC(place, BytesPerChar);
+		    END (*FOR*);
+		    IF frame <> noframe THEN
+			buffer[place] := rightT;
+		    END (*IF*);
+		END (*IF*);
+
+		(* Put in the bottom horizontal bar.	*)
+
+		IF lastline < LastRow - 1 THEN
+		    place := BytesPerRow*(lastline+1)
+					+ BytesPerChar*FirstColumn;
+		    IF frame <> noframe THEN
+			buffer[place] := leftT;  INC (place, BytesPerChar);
+		    END (*IF*);
+		    FOR j := ScrollRegion.left TO ScrollRegion.right DO
+			buffer[place] := horizontal; INC(place, BytesPerChar);
+		    END (*FOR*);
+		    IF frame <> noframe THEN
+			buffer[place] := rightT;
+		    END (*IF*);
+		END (*IF*);
+
+	    END (*IF*);
+
+	    (* Finally, update the scrolling region parameters.	*)
+
+	    WITH ScrollRegion DO
+		top := firstline;  bottom := lastline;
+	    END (*WITH*);
+	    DefaultScrollRegion := ScrollRegion;
+	    SetCursor (w, firstline - FirstRow,
+				ScrollRegion.left - FirstColumn);
+	    Wait (StackAccess2);
+	    IF NOT obscured THEN
+		Refresh (w);
+	    END (*IF*);
+	    Signal (StackAccess2);
+	END (*WITH*);
+    END ChangeScrollingRegion;
+
+(************************************************************************)
+
+PROCEDURE NewScrollingRegion (w: Window;  firstline, lastline: RowRange;
+				firstcolumn, lastcolumn: ColumnRange);
+
+    (* Changes the scrolling region of w to be the specified rectangle,	*)
+    (* but unlike ChangeScrollingRegion this procedure does not redraw	*)
+    (* the dividers.  Furthermore the old scrolling region set by	*)
+    (* ChangeScrollingRegion is remembered and may be restored by a	*)
+    (* call to ResetScrollingRegion.					*)
+
+    BEGIN
+	WITH w^ DO
+	    WITH ScrollRegion DO
+		top := FirstRow+firstline;  bottom := FirstRow+lastline;
+		left := FirstColumn+firstcolumn;
+		right := FirstColumn+lastcolumn;
+	    END (*WITH*);
+	END (*WITH*);
+    END NewScrollingRegion;
+
+(************************************************************************)
+
+PROCEDURE ResetScrollingRegion (w: Window);
+
+    (* Changes the scrolling region of w back to what it was the last	*)
+    (* time ChangeScrollingRegion was called.  If ChangeScrollingRegion	*)
+    (* was never called, the scrolling region goes back to being the	*)
+    (* entire window minus the frame (if any).				*)
+
+    BEGIN
+	w^.ScrollRegion := w^.DefaultScrollRegion;
+    END ResetScrollingRegion;
+
+(************************************************************************)
+(*			    OPENING A WINDOW				*)
+(************************************************************************)
+
+PROCEDURE FillInFrame (w: Window);
+
+    (* Puts the box around the window into the window buffer.	*)
+
+    VAR i: RowRange;  j: ColumnRange;
+	corner: ARRAY [1..4] OF CHAR;
+	horizontal, vertical: CHAR;
+	place, offset: buffersubscript;
+
+    BEGIN
+	IF w^.frame = simpleframe THEN
+	    corner[1] := '┌';  corner[2] := '┐';
+	    corner[3] := '└';  corner[4] := '┘';
+	    horizontal := '─';  vertical := '│';
+	ELSE
+	    corner[1] := '╔';  corner[2] := '╗';
+	    corner[3] := '╚';  corner[4] := '╝';
+	    horizontal := '═';  vertical := '║';
+	END (*IF*);
+
+	WITH w^ DO
+
+	    offset := BytesPerChar*(LastColumn - FirstColumn);
+	    place := BytesPerRow*FirstRow + BytesPerChar*FirstColumn;
+	    buffer[place] := corner[1];
+	    buffer[place+offset] := corner[2];
+	    INC (place, BytesPerRow);
+
+	    FOR i := FirstRow + 1 TO LastRow - 1 DO
+		buffer[place] := vertical;
+		buffer[place+offset] := vertical;
+		INC (place, BytesPerRow);
+	    END (*FOR*);
+
+	    buffer[place] := corner[3];
+	    buffer[place+offset] := corner[4];
+
+	    offset := BytesPerRow*(LastRow - FirstRow);
+	    FOR j := FirstColumn + 1 TO LastColumn - 1 DO
+		INC (place, BytesPerChar);
+		buffer[place-offset] := horizontal;
+		buffer[place] := horizontal;
+	    END (*FOR*);
+
+	END (*WITH*);
+    END FillInFrame;
+
+(************************************************************************)
+
+PROCEDURE MakeMonochrome (VAR (*INOUT*) foreground, background: Colour);
+
+    (* Changes the two given colours to a suitable B/W combination.	*)
+
+    BEGIN
+	IF (foreground = black) OR (foreground = darkgrey) THEN
+	    background := white
+	ELSE
+	    IF foreground > white THEN
+		foreground := intensewhite
+	    ELSE
+		foreground := white;
+	    END (*IF*);
+	    background := black;
+	END (*IF*);
+    END MakeMonochrome;
+
+(************************************************************************)
+
+PROCEDURE OpenWindow (VAR (*OUT*) w: Window;
+			ForegroundColour, BackgroundColour: Colour;
+			firstline, lastline: RowRange;
+			firstcol, lastcol: ColumnRange;
+			FrameDesired: FrameType;
+			DividerDesired: DividerType);
+
+    (* Creates a new window, and makes it the current window, filled	*)
+    (* initially with space characters.					*)
+    (* The caller must be executing at level 0.				*)
+
+    VAR i: RowRange;  j: ColumnRange;  k: buffersubscript;
+
+    BEGIN
+
+	(* Create the new window, and fill in all its fields.	*)
+
+	NEW (w);
+	WITH w^ DO
+	    previous := NIL;  next := NIL;  blockcursor := FALSE;
+	    foreground := ForegroundColour;  background := BackgroundColour;
+	    IF BlackAndWhite OR ForcedMonochrome THEN
+		MakeMonochrome (foreground, background);
+	    END (*IF*);
+	    CurrentAttributes := CHR(16*ORD(background) + ORD(foreground));
+	    frame := FrameDesired;  divider := DividerDesired;
+	    FirstRow := firstline;  LastRow := lastline;
+	    FirstColumn := firstcol;  LastColumn := lastcol;
+	    tabstops := DefaultTabs;
+	    IF frame <> noframe THEN
+		FOR j := MAX(ColumnRange) TO 1 BY -1 DO
+		    tabstops[j] := tabstops[j-1];
+		END (*FOR*);
+		tabstops[0] := " ";
+	    END (*IF*);
+
+	    (* Set the window contents to all space characters.	*)
+
+	    Wait (BlankRowAccess1);
+	    FOR k := 1 TO BytesPerRow-1 BY BytesPerChar DO
+		BlankRow[k] := CurrentAttributes;
+	    END (*FOR*);
+	    FOR i := 0 TO MaxRowNumber DO
+		Copy (ADR(BlankRow), ADR(buffer[i*BytesPerRow]),
+						BytesPerRow);
+	    END (*FOR*);
+	    Signal (BlankRowAccess1);
+
+	    (* Set up a default scrolling region.	*)
+
+	    WITH ScrollRegion DO
+		top := FirstRow;  bottom := LastRow;
+		left := FirstColumn;  right := LastColumn;
+	    END (*WITH*);
+
+	    (* Make the frame.	*)
+
+	    IF frame <> noframe THEN
+		FillInFrame(w);
+		WITH ScrollRegion DO
+		    INC (top);  INC (left);  DEC (bottom);  DEC (right);
+		END (*WITH*);
+	    END (*IF*);
+
+	    DefaultScrollRegion := ScrollRegion;
+	    row := ScrollRegion.top;  column := ScrollRegion.left;
+	    ScreenPosition := BytesPerRow*row + BytesPerChar*column;
+
+	END (*WITH*);
+
+	(* Put the new window on top of the stack of active windows.	*)
+
+	PutOnTop (w);
+
+    END OpenWindow;
+
+(************************************************************************)
+
+PROCEDURE OpenSimpleWindow (VAR (*OUT*) w: Window;
+			firstline, lastline: RowRange;
+			firstcol, lastcol: ColumnRange);
+
+    (* Identical to OpenWindow, except that you don't get any choice	*)
+    (* about the colours or frame.  The window is white-on-black with	*)
+    (* a simple frame and no dividers for the scrolling region.  This	*)
+    (* version of OpenWindow is useful for those with monochrome	*)
+    (* displays who don't want to be bothered with importing the types	*)
+    (* Colour, FrameType, and DividerType.				*)
+
+    BEGIN
+	OpenWindow (w, white, black, firstline, lastline,
+			firstcol, lastcol, simpleframe, nodivider);
+    END OpenSimpleWindow;
+
+(************************************************************************)
+(*		   CHANGING THE POSITION OF A WINDOW			*)
+(************************************************************************)
+
+PROCEDURE ShiftWindow (w: Window;  rowchange, columnchange: INTEGER);
+
+    (* Moves w on the screen.  The second and third arguments may be	*)
+    (* negative.  The amount of move may be reduced to prevent a move	*)
+    (* off the edge of the screen.					*)
+    (* The caller must be executing at level 0.				*)
+
+    VAR byteshift: INTEGER;
+
+    BEGIN
+(*
+	PutOnTop (w);
+	WITH w^ DO
+
+	    (* First check that the shift is a sensible one.	*)
+
+	    IF FirstRow+rowchange < 0 THEN rowchange := -FirstRow
+	    ELSIF LastRow+rowchange > MaxRowNumber THEN
+		rowchange := MaxRowNumber - LastRow
+	    END (*IF*);
+
+	    IF FirstColumn+columnchange < 0 THEN columnchange := -FirstColumn
+	    ELSIF LastColumn+columnchange > MaxColumnNumber THEN
+		columnchange := MaxColumnNumber - LastColumn
+	    END (*IF*);
+
+	    byteshift := BytesPerRow*rowchange + BytesPerChar*columnchange;
+
+	    (* Shift the buffer contents.	*)
+
+	    IF byteshift < 0 THEN
+		Copy (ADR(buffer[-byteshift]), ADR(buffer[0]),
+						buffersize+byteshift)
+	    ELSE
+		CopyUp (ADR(buffer[0]), ADR(buffer[byteshift]),
+						buffersize-byteshift)
+	    END (*IF*);
+
+	    (* Adjust the affected window parameters.	*)
+
+	    WITH ScrollRegion DO
+		INC (top, rowchange);  INC (bottom, rowchange);
+		INC (left, columnchange);  INC (right, columnchange);
+	    END (*WITH*);
+	    WITH DefaultScrollRegion DO
+		INC (top, rowchange);  INC (bottom, rowchange);
+		INC (left, columnchange);  INC (right, columnchange);
+	    END (*WITH*);
+	    INC (FirstRow, rowchange);  INC (LastRow, rowchange);
+	    INC (row, rowchange);
+	    INC (FirstColumn, columnchange);  INC (LastColumn, columnchange);
+	    INC (column, columnchange);
+	    INC (ScreenPosition, byteshift);
+
+	    (* Refresh the two affected areas of the screen.	*)
+
+	    Repaint (FirstRow-rowchange, LastRow-rowchange,
+			FirstColumn-columnchange, LastColumn-columnchange);
+	    Repaint (FirstRow, LastRow, FirstColumn, LastColumn);
+
+	END (*WITH*);
+*)
+    END ShiftWindow;
+
+(************************************************************************)
+(*			    CLOSING A WINDOW				*)
+(************************************************************************)
+
+PROCEDURE CloseWindow (VAR (*INOUT*) w: Window);
+
+    (* Reclaims the buffer space used for this window, and puts the	*)
+    (* next window on top of the stack.					*)
+    (* The caller must be executing at level 0.				*)
+
+    VAR p: Window;
+
+    BEGIN
+	Wait (StackAccess2);
+	UnLink (w);
+	Signal (StackAccess2);
+
+	(* Repaint the part of the screen which this window occupied.	*)
+
+	WITH w^ DO
+	    Repaint (FirstRow, LastRow, FirstColumn, LastColumn);
+	END (*WITH*);
+
+	DISPOSE (w);
+
+    END CloseWindow;
+
+(************************************************************************)
+(*	     	OPERATIONS ON CHARACTER ATTRIBUTES			*)
+(************************************************************************)
+
+PROCEDURE ColourSwap (w: Window; r: RowRange; c: ColumnRange;
+							nchar: CARDINAL);
+
+    (* Switches the foreground and background colours for nchar		*)
+    (* characters, starting at location (r,c).  The row and column	*)
+    (* numbers are window-relative, not absolute screen coordinates.	*)
+    (* This is our colour equivalent of the "reverse video" operation.	*)
+    (* NOTE: This procedure will not wrap around to a new row.		*)
+    (* The caller must be executing at level <3.			*)
+
+    VAR k, start: buffersubscript;  oldattribute: CARDINAL;
+
+    BEGIN
+	WITH w^ DO
+	    start := BytesPerRow*(r+FirstRow)
+			+ BytesPerChar*(c+FirstColumn) + 1;
+	    FOR k := start TO start+BytesPerChar*(nchar-1) BY BytesPerChar DO
+		oldattribute := ORD(buffer[k]);
+		buffer[k] := CHR (16*(oldattribute MOD 16)
+					+ (oldattribute DIV 16));
+	    END (*FOR*);
+	    Wait (StackAccess2);
+	    IF obscured THEN PutOnTopI(w)
+	    ELSE
+		Wait (ScreenAccess3);
+		Copy (ADR(buffer[start]), MakePointer(ScreenSeg, start),
+				BytesPerChar*nchar);
+		Signal (ScreenAccess3);
+	    END (*IF*);
+	    Signal (StackAccess2);
+	END (*WITH*);
+    END ColourSwap;
+
+(************************************************************************)
+
+PROCEDURE Blink (w: Window; r: RowRange; c: ColumnRange; nchar: CARDINAL);
+
+    (* Toggles the blinking status - that is, turns blinking on if it	*)
+    (* was off, and vice versa - for nchar characters, starting at	*)
+    (* relative location (r,c) in window w.				*)
+    (* NOTE: This procedure will not wrap around to a new row.		*)
+    (* The caller must be executing at level <3.			*)
+
+    VAR k, start: buffersubscript;
+
+    BEGIN
+	WITH w^ DO
+	    start := BytesPerRow*(r+FirstRow)
+			+ BytesPerChar*(c+FirstColumn) + 1;
+	    FOR k := start TO start+BytesPerChar*(nchar-1) BY BytesPerChar DO
+		buffer[k] := CHR (IXOR(ORD(buffer[k]), 80H));
+	    END (*FOR*);
+	    Wait (StackAccess2);
+	    IF obscured THEN PutOnTopI(w)
+	    ELSE
+		Wait (ScreenAccess3);
+		Copy (ADR(buffer[start]), MakePointer(ScreenSeg, start),
+				BytesPerChar*nchar);
+		Signal (ScreenAccess3);
+	    END (*IF*);
+	    Signal (StackAccess2);
+	END (*WITH*);
+    END Blink;
+
+(************************************************************************)
+(*			    CURSOR OPERATIONS				*)
+(************************************************************************)
+
+PROCEDURE SetCursor (w: Window; r: RowRange; c: ColumnRange);
+
+    (* Sets the cursor for window w to relative row r, column c.	*)
+
+    BEGIN
+	WITH w^ DO
+	    row := r + FirstRow;  column := c + FirstColumn;
+	    ScreenPosition := BytesPerRow*row + BytesPerChar*column;
+	END (*WITH*);
+    END SetCursor;
+
+(************************************************************************)
+
+PROCEDURE SaveCursor (w: Window; VAR (*OUT*) r, c: CARDINAL);
+
+    (* Returns the current cursor position of window w.		*)
+
+    BEGIN
+	WITH w^ DO
+	    r := row - FirstRow;  c := column - FirstColumn;
+	END (*WITH*);
+    END SaveCursor;
+
+(************************************************************************)
+
+PROCEDURE CursorLeft (w: Window);
+
+    (* Moves the window cursor one position left.  If it falls off the	*)
+    (* left edge of the window, move to the right edge in the same row.	*)
+
+    BEGIN
+	WITH w^ DO
+	    IF column = FirstColumn THEN
+		column := LastColumn;
+		ScreenPosition := BytesPerRow*row + BytesPerChar*column;
+	    ELSE
+		DEC (column);  DEC (ScreenPosition, BytesPerChar);
+	    END (*IF*);
+	END (*WITH*);
+    END CursorLeft;
+
+(************************************************************************)
+
+PROCEDURE CursorRight (w: Window);
+
+    (* Moves the window cursor one position right.  If it falls off the	*)
+    (* right edge of the window, move to the left edge in the same row.	*)
+
+    BEGIN
+	WITH w^ DO
+	    IF column = LastColumn THEN
+		column := FirstColumn;
+		ScreenPosition := BytesPerRow*row + BytesPerChar*column;
+	    ELSE
+		INC (column);  INC (ScreenPosition, BytesPerChar);
+	    END (*IF*);
+	END (*WITH*);
+    END CursorRight;
+
+(************************************************************************)
+
+PROCEDURE CursorUp (w: Window);
+
+    (* Moves the window cursor one position up.  If it falls off the	*)
+    (* top edge of the window, it moves to the bottom edge in the same	*)
+    (* column.								*)
+
+    BEGIN
+	WITH w^ DO
+	    IF row = FirstRow THEN
+		row := LastRow;
+		ScreenPosition := BytesPerRow*row + BytesPerChar*column;
+	    ELSE
+		DEC (row);  DEC (ScreenPosition, BytesPerRow);
+	    END (*IF*);
+	END (*WITH*);
+    END CursorUp;
+
+(************************************************************************)
+
+PROCEDURE CursorDown (w: Window);
+
+    (* Moves the window cursor one position down.  If it falls off the	*)
+    (* bottom edge of the window, it moves to the top edge in the same	*)
+    (* column.								*)
+
+    BEGIN
+	WITH w^ DO
+	    IF row = LastRow THEN
+		row := FirstRow;
+		ScreenPosition := BytesPerRow*row + BytesPerChar*column;
+	    ELSE
+		INC (row);  INC (ScreenPosition, BytesPerRow);
+	    END (*IF*);
+	END (*WITH*);
+    END CursorDown;
+
+(************************************************************************)
+
+PROCEDURE ScrollUp (w: Window);
+
+    (* Scrolls window w up by one line, both on the screen and in its	*)
+    (* buffer.  The last row is filled with spaces.			*)
+    (* The caller must be executing at level <3.			*)
+
+    VAR k: buffersubscript;
+
+    BEGIN
+	WITH w^ DO
+	    Wait (BlankRowAccess1);
+	    FOR k := 1 TO BytesPerRow-1 BY BytesPerChar DO
+		BlankRow[k] := CurrentAttributes;
+	    END (*FOR*);
+	    WITH ScrollRegion DO
+		k := BytesPerRow * top;
+		Copy (ADR(buffer[k+BytesPerRow]), ADR(buffer[k]),
+			BytesPerRow*(bottom-top));
+		Copy (ADR(BlankRow),
+			ADR(buffer[BytesPerRow*bottom+BytesPerChar*left]),
+				BytesPerChar*(right-left+1));
+	    END (*WITH*);
+	    Signal (BlankRowAccess1);
+	    Wait (StackAccess2);
+	    IF obscured THEN PutOnTopI(w) ELSE Refresh (w);
+	    END (*IF*);
+	    Signal (StackAccess2);
+	END (*WITH*);
+    END ScrollUp;
+
+(************************************************************************)
+
+PROCEDURE ScrollDown (w: Window);
+
+    (* Scrolls window w down by one line, both on the screen and in its	*)
+    (* buffer.  The first row is filled with spaces.			*)
+    (* The caller must be executing at level <3.			*)
+
+    VAR k: buffersubscript;
+
+    BEGIN
+	WITH w^ DO
+	    Wait (BlankRowAccess1);
+	    FOR k := 1 TO BytesPerRow-1 BY BytesPerChar DO
+		BlankRow[k] := CurrentAttributes;
+	    END (*FOR*);
+	    WITH ScrollRegion DO
+		k := BytesPerRow * top;
+		CopyUp (ADR(buffer[k]), ADR(buffer[k+BytesPerRow]),
+			BytesPerRow*(bottom-top));
+		Copy (ADR(BlankRow), ADR(buffer[k+BytesPerChar*left]),
+			BytesPerChar*(right-left+1));
+	    END (*WITH*);
+	    Signal (BlankRowAccess1);
+	    Wait (StackAccess2);
+	    IF obscured THEN PutOnTopI(w) ELSE Refresh (w);
+	    END (*IF*);
+	    Signal (StackAccess2);
+	END (*WITH*);
+    END ScrollDown;
+
+(************************************************************************)
+(*			    MAIN OUTPUT ROUTINES			*)
+(************************************************************************)
+
+PROCEDURE WriteChar (w: Window; ch: CHAR);
+
+    (* Writes one character to window w, and updates the cursor for	*)
+    (* this window.  As a side-effect, this window becomes the		*)
+    (* currently active window if it was obscured.  Wraps around to the	*)
+    (* next line if we are about to run off the end of the current	*)
+    (* line.  This procedure does not recognise the concept of a	*)
+    (* control character.  Every possible value of ch produces		*)
+    (* something readable on the screen.				*)
+    (* The caller must be executing at level <3.			*)
+
+    VAR screenloc: POINTER TO CHAR;
+
+    BEGIN
+	WITH w^ DO
+	    (* Wrap to a new line if we about to leave the scrolling	*)
+	    (* region or if we are outside the legal writing region.	*)
+
+	    IF (column = ScrollRegion.right + 1)
+			OR (column > DefaultScrollRegion.right) THEN
+		DEC (column);  WriteLn (w);
+	    END (*IF*);
+
+	    buffer[ScreenPosition] := ch;
+	    buffer[ScreenPosition + 1] := CurrentAttributes;
+
+	    Wait (StackAccess2);
+	    IF obscured THEN PutOnTopI(w) END (*IF*);
+	    Wait (ScreenAccess3);
+	    screenloc := MakePointer (ScreenSeg, ScreenPosition);
+	    screenloc^ := ch;
+	    screenloc := MakePointer (ScreenSeg, ScreenPosition+1);
+	    screenloc^ := CurrentAttributes;
+	    Signal (ScreenAccess3);
+	    Signal (StackAccess2);
+
+	    (* Note that the following statement may cause column to	*)
+	    (* go beyond the edge of the window; but this will be	*)
+	    (* picked up on the next call to WriteChar.  We prefer not	*)
+	    (* to do a WriteLn just yet, because that could cause an	*)
+	    (* unintended scroll operation when writing to the bottom	*)
+	    (* right of the window.					*)
+
+	    INC (column);  INC (ScreenPosition, BytesPerChar);
+	END (*WITH*);
+    END WriteChar;
+
+(************************************************************************)
+
+PROCEDURE WriteLn (w: Window);
+
+    (* Moves the cursor of window w to the start of the next row.  If	*)
+    (* we are already at the last row, the window scrolls up.		*)
+
+    BEGIN
+	WITH w^ DO
+	    IF InScrollingRegion (w) THEN
+		column := ScrollRegion.left;
+		IF row = ScrollRegion.bottom THEN ScrollUp (w)
+		ELSE INC (row);
+		END (*IF*);
+	    ELSE
+		column := DefaultScrollRegion.left;
+		IF row >= LastRow THEN row := LastRow
+		ELSE INC (row);
+		END (*IF*);
+	    END (*IF*);
+	    ScreenPosition := BytesPerRow*row + BytesPerChar*column;
+	END (*WITH*);
+    END WriteLn;
+
+(************************************************************************)
+
+PROCEDURE WriteString (w: Window; text: ARRAY OF CHAR);
+
+    (* Writes a sequence of characters, terminated either by NUL or by	*)
+    (* the end of the array.						*)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	j := 0;
+	LOOP
+	    IF ORD (text[j]) = 0 THEN EXIT (*LOOP*)  END (*IF*);
+	    WriteChar (w, text[j]);  INC (j);
+	    IF j > HIGH (text) THEN EXIT (*LOOP*)  END (*IF*);
+	END (*LOOP*);
+    END WriteString;
+
+(************************************************************************)
+
+PROCEDURE Write (w: Window; ch: CHAR);
+
+    (* A version of procedure WriteChar which looks after some of the	*)
+    (* control characters.						*)
+
+    BEGIN
+	IF ch >= " " THEN WriteChar (w, ch)
+	ELSIF ORD(ch) = 8 THEN		(* backspace *)
+	    CursorLeft(w)
+	ELSIF ORD(ch) = 9 THEN		(* tab *)
+	    WITH w^ DO
+		REPEAT
+		    WriteChar (w, " ");
+		UNTIL (column=MAX(ColumnRange)) OR (tabstops[column]="T");
+	    END (*WITH*);
+	ELSIF ORD(ch) = 10 THEN		(* line feed - ignore *)
+	ELSIF ORD(ch) = 13 THEN		(* carriage return *)
+	    WriteLn(w)
+	ELSE				(* other control character *)
+	    WriteChar (w, "^");  WriteChar (w, CHR(ORD(ch)+64))
+	END (*IF*);
+    END Write;
+
+(************************************************************************)
+(*				INPUT					*)
+(************************************************************************)
+
+PROCEDURE ReadBack (w: Window;  r: RowRange;  c: ColumnRange): CHAR;
+
+    (* Returns the character which currently occupies relative location	*)
+    (* (r,c) on the display of window w.				*)
+
+    BEGIN
+	WITH w^ DO
+	    RETURN buffer[BytesPerRow*(r+FirstRow)
+				+ BytesPerChar*(c+FirstColumn)];
+	END (*WITH*);
+    END ReadBack;
+
+(************************************************************************)
+
+PROCEDURE ReadCharWithoutEcho (w: Window;  VAR (*OUT*) ch: CHAR);
+
+    (* Read one character.  Window w is forced to be the top window,	*)
+    (* in order that the cursor be visible.  The critical section	*)
+    (* protection provided by PhysicalCursor.access ensures that only	*)
+    (* one window at a time is involved in keyboard input.  Procedure	*)
+    (* PutOnTop will turn on the physical cursor when it discovers that	*)
+    (* w = CursorWindow.  The cursor might subsequently disappear if a	*)
+    (* task switch leads to another window obscuring it, but at least	*)
+    (* we ensure that the physical cursor cannot turn up in some other	*)
+    (* window until the current task has left its critical section.	*)
+    (* The caller must be executing at a level <2.			*)
+
+    BEGIN
+	WITH PhysicalCursor DO
+	    Wait (access4);  CursorWindow := w;  Signal (access4);
+	    PutOnTop(w);  ch := InKey();
+
+	    (* By now, another window might be on top as the result of	*)
+	    (* a task switch.  We put the current window back on top to	*)
+	    (* give some feedback to the user, and turn off the		*)
+	    (* blinking cursor.						*)
+
+	    Wait(access4); CursorWindow := NIL; CursorOff; Signal(access4);
+	    PutOnTop(w);
+
+	END (*WITH*);
+    END ReadCharWithoutEcho;
+
+(************************************************************************)
+
+PROCEDURE ReadChar (w: Window;  VAR (*OUT*) ch: CHAR);
+
+    (* Like ReadCharWithoutEcho, but the input character is echoed.	*)
+
+    BEGIN
+	ReadCharWithoutEcho (w, ch);  Write (w, ch);
+    END ReadChar;
+
+(************************************************************************)
+
+PROCEDURE LookaheadChar (w: Window): CHAR;
+
+    (* Reads a character without consuming it.  That is, the character	*)
+    (* remains available to be read by ReadChar.  This allows the	*)
+    (* caller to check whether the character is really wanted.		*)
+
+    VAR ch: CHAR;
+
+    BEGIN
+	ReadCharWithoutEcho (w, ch);  PutBack (ch);
+	RETURN ch;
+    END LookaheadChar;
+
+(************************************************************************)
+
+PROCEDURE PressAnyKey (w: Window);
+
+    (* Types a "Press any key to continue" message.	*)
+
+    VAR dummy: CHAR;
+
+    BEGIN
+	WriteLn (w);
+	WriteString (w, "Press any key to continue.");
+	ReadChar (w, dummy);
+	EraseLine (w, 0);  CursorUp(w);
+    END PressAnyKey;
+
+(************************************************************************)
+
+PROCEDURE ReadString (w: Window;  VAR (*OUT*) result: ARRAY OF CHAR);
+
+    (* Reads a character string, terminated by carriage return.		*)
+
+    VAR j: CARDINAL;  ch: CHAR;
+
+    BEGIN
+	FOR j := 0 TO HIGH(result) DO
+	    result[j] := " ";
+	END (*FOR*);
+	j := 0;
+	LOOP
+	    ReadChar (w, ch);
+	    IF ORD(ch) = 13 THEN
+		result[j] := CHR(0);  EXIT(*LOOP*)
+	    ELSIF ORD(ch) = 8 THEN	(* backspace *)
+		IF j > 0 THEN
+		    CursorLeft(w);  WriteChar(w, " ");  CursorLeft(w);
+		    DEC (j);
+		END (*IF*);
+	    ELSE
+		result[j] := ch;
+		IF j = HIGH(result) THEN EXIT(*LOOP*) END(*IF*);
+		INC (j);
+	    END(*IF*);
+	END (*LOOP*);
+    END ReadString;
+
+(************************************************************************)
+
+PROCEDURE EditString (w: Window;  VAR (*INOUT*) result: ARRAY OF CHAR;
+						fieldsize: CARDINAL);
+
+    (* Reads a character string, where a default result is supplied by	*)
+    (* the caller.  The final result is the state of the string at the	*)
+    (* time where the keyboard user types a carriage return or uses a	*)
+    (* cursor movement key to move out of the displayed field.  If the	*)
+    (* user types Esc at any time, then we return with result[0] = Esc.	*)
+    (* A carriage return or Esc as terminator is not returned to the	*)
+    (* caller, but if the terminator is a cursor control key then it	*)
+    (* it remains available, via Keyboard.Inkey, to the caller.		*)
+    (* At most fieldsize characters of the string can be edited, and	*)
+    (* perhaps fewer if the result array is smaller or if there is	*)
+    (* insufficient space in the window.				*)
+
+    CONST Esc = CHR(01BH);  Space = " ";
+
+    VAR place, k: CARDINAL;  ch: CHAR;  limit: ColumnRange;
+	SavedAttributes: CHAR;
+	startrow, startcolumn: CARDINAL;
+	InsertMode, SavedCursorType: BOOLEAN;
+
+    (********************************************************************)
+
+    PROCEDURE RewriteString ();
+
+	BEGIN
+	    SetCursor (w, startrow, startcolumn);
+	    WriteString (w, result);
+	    SetCursor (w, startrow, startcolumn+place);
+	END RewriteString;
+
+    (********************************************************************)
+
+    PROCEDURE GoToEnd;
+
+	(* Puts the cursor just after the last non-blank character.	*)
+
+	BEGIN
+	    place := limit+1;
+	    WHILE (place > 0) AND (result[place-1] = Space) DO
+		DEC (place);
+	    END (*WHILE*);
+	    SetCursor (w, startrow, startcolumn+place);
+	END GoToEnd;
+
+    (********************************************************************)
+
+    PROCEDURE HandleControlChar(): BOOLEAN;
+
+	(* Called after detecting the CHR(0) which means that a control	*)
+	(* character has been typed.  Performs the appropriate actions,	*)
+	(* returns TRUE iff editing is finished.			*)
+
+	BEGIN
+	    ReadCharWithoutEcho (w, ch);
+	    IF ch = "K" THEN				(* cursor left *)
+		IF place = 0 THEN
+		    PutBack(ch);  PutBack(CHR(0));
+		    RETURN TRUE;
+		END (*IF*);
+		CursorLeft(w);  DEC (place);
+	    ELSIF ch = "M" THEN				(* cursor right *)
+		IF place > limit THEN
+		    PutBack(ch);  PutBack(CHR(0));
+		    RETURN TRUE;
+		END (*IF*);
+		CursorRight(w);  INC (place);
+	    ELSIF (ch = "H") OR (ch = "P") THEN		(* cursor up/down *)
+		PutBack(ch);  PutBack(CHR(0));
+		RETURN TRUE;
+	    ELSIF ch = "G" THEN				(* home *)
+		place := 0;
+		SetCursor (w, startrow, startcolumn);
+	    ELSIF ch = "O" THEN				(* end *)
+		GoToEnd;
+	    ELSIF ch = "R" THEN				(* insert *)
+		w^.blockcursor := InsertMode;
+		InsertMode := NOT InsertMode;
+	    ELSIF ch = "S" THEN				(* delete right *)
+		IF place <= limit THEN
+		    FOR k := place TO limit-1 DO
+			result[k] := result[k+1];
+		    END (*FOR*);
+		    result[limit] := Space;
+		    RewriteString ();
+		END (*IF*);
+	    END (*IF*);
+	    RETURN FALSE;
+	END HandleControlChar;
+
+    (********************************************************************)
+
+    BEGIN	(* Body of EditString *)
+
+	SaveCursor (w, startrow, startcolumn);
+	SavedCursorType := w^.blockcursor;
+	InsertMode := TRUE;  w^.blockcursor := FALSE;
+
+	(* Compute a limit which stops us from running off the window.	*)
+
+	WITH w^ DO
+	    IF InScrollingRegion(w) THEN
+		limit := ScrollRegion.right;
+	    ELSE
+		limit := DefaultScrollRegion.right;
+	    END (*IF*);
+	    DEC (limit, FirstColumn + startcolumn);
+	    SavedAttributes := CurrentAttributes;
+	END (*WITH*);
+	IF HIGH(result) < limit THEN
+	    limit := HIGH(result);
+	END (*IF*);
+	IF fieldsize <= limit THEN
+	    limit := fieldsize - 1;
+	END (*IF*);
+
+	(* Preprocessing: for a Nul-terminated string, remove the Nul	*)
+	(* and pad out the string with spaces at the right.  Otherwise	*)
+	(* we get problems if, for example, the Nul is deleted.		*)
+
+	place := 0;
+	LOOP
+	    IF result[place] = CHR(0) THEN
+		FOR k := place TO limit DO
+		    result[k] := Space;
+		END (*FOR*);
+		EXIT (*LOOP*);
+	    END (*IF*);
+	    IF place = limit THEN EXIT(*LOOP*) END(*IF*);
+	    INC (place);
+	END (*LOOP*);
+	FOR k := limit+1 TO HIGH(result) DO
+	    result[k] := CHR(0);
+	END (*FOR*);
+
+	(* Write the string, using reverse video.	*)
+
+	WriteString (w, result);
+	ColourSwap (w, startrow, startcolumn, limit+1);
+	WITH w^ DO
+	    CurrentAttributes := CHR(16*ORD(foreground) + ORD(background));
+	END (*WITH*);
+	place := 0;
+	SetCursor (w, startrow, startcolumn);
+	PutOnTop(w);
+
+	(* Now the main editing loop.	*)
+
+	LOOP
+	    ReadCharWithoutEcho (w, ch);
+	    IF ORD(ch) = 0 THEN				(* control char *)
+		IF HandleControlChar() THEN
+		    EXIT (*LOOP*);
+		END (*IF*);
+	    ELSIF ch = Esc THEN				(* Esc *)
+		result[0] := Esc;  EXIT(*LOOP*);
+	    ELSIF ORD(ch) = 13 THEN			(* carriage return *)
+		EXIT(*LOOP*)
+	    ELSIF ORD(ch) = 8 THEN			(* delete left *)
+		IF place > 0 THEN
+		    DEC (place);
+		    FOR k := place TO limit-1 DO
+			result[k] := result[k+1];
+		    END (*FOR*);
+		    result[limit] := Space;
+		    RewriteString ();
+		END (*IF*);
+	    ELSIF place <= limit THEN			(* any other char *)
+		IF InsertMode THEN
+		    FOR k := limit TO place+1 BY -1 DO
+			result[k] := result[k-1];
+		    END (*FOR*);
+		    RewriteString ();
+		END (*IF*);
+		result[place] := ch;  WriteChar (w, ch);
+		INC (place);
+	    END(*IF*);
+	END (*LOOP*);
+	ColourSwap (w, startrow, startcolumn, limit+1);
+	w^.blockcursor := SavedCursorType;
+	w^.CurrentAttributes := SavedAttributes;
+    END EditString;
+
+(************************************************************************)
+(*		    MISCELLANEOUS CONTROL OPERATIONS			*)
+(************************************************************************)
+
+PROCEDURE EraseLine (w: Window;  option: CARDINAL);
+
+    (* Replaces some or all of the current line, except for the border,	*)
+    (* with space characters.  The window cursor is moved to the	*)
+    (* location of the first erased character.  The options are:	*)
+    (*		0	the whole of the line, except for the border	*)
+    (*		1	from the current cursor position onwards	*)
+    (*		2	from the start to just before the cursor	*)
+    (* If we are inside a scrolling region, then only that part of the	*)
+    (* line inside the scrolling region is affected.			*)
+
+    VAR first, last: ColumnRange;
+	k, firstk, lastk: buffersubscript;
+
+    BEGIN
+	WITH w^ DO
+	    IF InScrollingRegion(w) THEN
+		first := ScrollRegion.left;  last := ScrollRegion.right;
+	    ELSE
+		first := DefaultScrollRegion.left;
+		last := DefaultScrollRegion.right;
+	    END (*IF*);
+	    IF option = 1 THEN first := column
+	    ELSIF option = 2 THEN last := column - 1
+	    END (*IF*);
+	    firstk := BytesPerRow*row + BytesPerChar*first;
+	    lastk := BytesPerRow*row + BytesPerChar*last;
+	    FOR k := firstk TO lastk BY BytesPerChar DO
+		buffer[k] := " ";  buffer[k+1] := CurrentAttributes;
+	    END (*FOR*);
+	    Wait (ScreenAccess3);
+	    IF NOT obscured THEN
+		Copy (ADR(buffer[firstk]), MakePointer(ScreenSeg,firstk),
+					lastk - firstk + 2);
+	    END (*IF*);
+	    Signal (ScreenAccess3);
+	    column := first;  ScreenPosition := firstk;
+	END (*WITH*);
+    END EraseLine;
+
+(************************************************************************)
+(*			     TERMINATION				*)
+(************************************************************************)
+
+PROCEDURE CleanUp;
+
+    (* Called at program termination.  If termination was caused by an	*)
+    (* error, displays the error and waits for the user to press any	*)
+    (* key.  Then closes all open windows, and turns on the blinking	*)
+    (* screen cursor.							*)
+
+    VAR w: Window;  dummy: CHAR;
+
+    BEGIN
+	(* For abnormal termination, put an error diagnostic on the	*)
+	(* screen.  We lock ScreenAccess3 while doing this in order to	*)
+	(* prevent corruption of our error message by another task,	*)
+	(* and in particular to prevent screen scrolling.		*)
+(*
+	Wait (ScreenAccess3);
+	IF ReportTerminationError() THEN
+	    dummy := InKey();
+	END (*IF*);
+	Signal (ScreenAccess3);
+*)
+	(* Close all open windows.	*)
+
+	LOOP
+	    Wait (StackAccess2);
+	    w := TopWindow;
+	    Signal (StackAccess2);
+	    IF w = NIL THEN EXIT(*LOOP*) END(*IF*);
+	    CloseWindow (w);
+	END (*LOOP*);
+
+	(* Restore the usual screen cursor shape.	*)
+
+	Wait (PhysicalCursor.access4);
+	CursorOn (0, FALSE);
+	Signal (PhysicalCursor.access4);
+
+    END CleanUp;
+
+(************************************************************************)
+(*			    INITIALISATION				*)
+(************************************************************************)
+
+VAR j: buffersubscript;
+    Registers: RegisterPacket;
+
+BEGIN
+    FOR j := 0 TO HIGH(BlankRow) DO
+	BlankRow[j] := " ";
+    END (*FOR*);
+    CreateSemaphore (BlankRowAccess1, 1);
+
+    TopWindow := NIL;
+    CreateSemaphore (StackAccess2, 1);
+
+    (* The BIOS video call 0FH returns the current video state.  From	*)
+    (* this we can work out whether to use colour or mono.		*)
+(*
+    ScreenSeg := SEGMENT(Virtual(0B0000H));    (* assume mono initially *)
+*)
+    ScreenSeg := 0B000H;
+    BlackAndWhite := TRUE;
+
+    WITH Registers DO
+	AH := 0FH;  BIOS (VideoInt, Registers);
+	VideoPage := BH;
+	IF AL <> 7 THEN		(* must be colour *)
+
+	    (* ScreenSeg := SEGMENT(Virtual(0B8000H)); *)
+	    ScreenSeg := 0B800H;
+	    BlackAndWhite := FALSE;
+
+	    (* Set the screen to 25*80 colour.	*)
+
+	    AH := 0;  AL := 3;  BIOS (VideoInt, Registers);
+
+	END (*IF*);
+    END (*WITH*);
+
+    IF BlackAndWhite THEN
+	CRTCport := 03B4H;
+    ELSE
+	CRTCport := 03D4H;
+    END (*IF*);
+
+    CreateSemaphore (ScreenAccess3, 1);
+
+    (* Initialise the screen cursor information. *)
+
+    CursorOff;
+    WITH PhysicalCursor DO
+	CreateSemaphore (access4, 1);
+	CursorWindow := NIL;
+    END (*WITH*);
+
+    SetTerminationProcedure (CleanUp);
+
+    (* Blank the screen, to erase otherwise annoying background stuff	*)
+    (* left by other programs.						*)
+
+    Repaint (0,MaxRowNumber,0,MaxColumnNumber);
+
+END MiniWindows.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/util/asciitst.mod b/examples/Modula-2_Libraries/PMOS/sources/util/asciitst.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/util/asciitst.mod
@@ -0,0 +1,45 @@
+MODULE AsciiTst;
+
+	(********************************************************)
+	(*							*)
+	(*	For discovering the ASCII codes returned by	*)
+	(*		various special keys.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	10 October 1992			*)
+	(*  Status:		Working.			*)
+	(*							*)
+	(********************************************************)
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey;
+
+FROM GlassTTY IMPORT
+    (* proc *)	WriteChar, WriteString, WriteLn, WriteCard;
+
+(************************************************************************)
+
+PROCEDURE RunTheTest;
+
+    CONST ControlZ = CHR(26);
+
+    VAR char: CHAR;
+
+    BEGIN
+	WriteString ("Type ^Z to exit");  WriteLn;
+	REPEAT
+	    char := InKey ();
+	    WriteString ("Character is ");  WriteChar (char);
+	    WriteString ("  Code is ");  WriteCard (ORD(char));
+	    WriteLn;
+	UNTIL char = ControlZ;
+    END RunTheTest;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    RunTheTest;
+END AsciiTst.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/util/colourte.mod b/examples/Modula-2_Libraries/PMOS/sources/util/colourte.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/util/colourte.mod
@@ -0,0 +1,75 @@
+MODULE ColourTest;
+
+	(****************************************************************)
+	(*								*)
+	(*	To check out how various colours look on a		*)
+	(*	monochrome display.					*)
+	(*								*)
+	(*	Conclusions so far:					*)
+	(*	1.	The following combinations are OK:		*)
+	(*								*)
+	(*	2.	The following combinations are not OK:		*)
+	(*								*)
+	(*	3.	Anything else - not yet tested.			*)
+	(*								*)
+	(****************************************************************)
+
+FROM Windows IMPORT
+    (* type *)	Colour, Window, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, WriteString, SetCursor;
+
+FROM Trace IMPORT
+    (* proc *)	NYI, Pause;
+
+(************************************************************************)
+
+PROCEDURE WriteColour (w: Window; col: Colour);
+
+    BEGIN
+	CASE col OF
+	    black:	WriteString (w, "black     ");
+	|   blue:	WriteString (w, "blue      ");
+	|   green:	WriteString (w, "green     ");
+	|   cyan:	WriteString (w, "cyan      ");
+	|   red:	WriteString (w, "red       ");
+	|   magenta:	WriteString (w, "magenta   ");
+	|   brown:	WriteString (w, "brown     ");
+	|   white:	WriteString (w, "white     ");
+	    ELSE	WriteString (w, "unknown   ");
+	END (*CASE*);
+    END WriteColour;
+
+(************************************************************************)
+
+PROCEDURE DoTheTest;
+
+    VAR test, monitor: Window;
+	foreground, background: Colour;
+
+    BEGIN
+	OpenWindow (monitor, white, black, 5, 10, 10, 70,
+			simpleframe, nodivider);
+	FOR background := black TO white DO
+	    SetCursor (monitor, 1, 1);
+	    WriteString (monitor, "Background code is ");
+	    WriteColour (monitor, background);
+	    FOR foreground := black TO white DO
+		SetCursor (monitor, 2, 1);
+		WriteString (monitor, "Foreground code is ");
+		WriteColour (monitor, foreground);
+		OpenWindow (test, foreground, background, 15, 20, 10, 70,
+						simpleframe, nodivider);
+		WriteString (test, "Test message");
+		Pause;
+		CloseWindow (test);
+	    END (*FOR*);
+	END (*FOR*);
+    END DoTheTest;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+BEGIN
+    DoTheTest;
+END ColourTest.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/util/cursoron.mod b/examples/Modula-2_Libraries/PMOS/sources/util/cursoron.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/util/cursoron.mod
@@ -0,0 +1,67 @@
+MODULE CursorOn;
+
+	(****************************************************************)
+	(*								*)
+	(* Turns the screen cursor on; used for recovery when a program	*)
+	(*		has accidentally left it off.			*)
+	(*								*)
+	(*	Programmer:	P. Moylan				*)
+	(*	Last edited:	20 January 1993				*)
+	(*								*)
+	(****************************************************************)
+
+FROM MiscPMOS IMPORT
+    (* type *)	RegisterPacket,
+    (* proc *)	BIOS;
+
+(************************************************************************)
+
+CONST VideoInt = 16;
+
+VAR BIOSframe: RegisterPacket;
+    BlackAndWhite: BOOLEAN;
+
+(************************************************************************)
+
+PROCEDURE TurnCursorOn;
+
+    (* Turns on the physical screen cursor.  This has to be done with a	*)
+    (* BIOS call, rather than by programming the CRTC registers		*)
+    (* directly, to ensure correct treatment over the variety of	*)
+    (* different video interfaces which could be present.		*)
+
+    VAR startline: SHORTCARD;
+
+    BEGIN
+	IF BlackAndWhite THEN
+	    startline := 11;
+	ELSE
+	    startline := 6;
+	END (*IF*);
+	WITH BIOSframe DO
+	    AH := 1;  CH := startline;  CL := startline+1;
+	END (*WITH*);
+	BIOS (VideoInt, BIOSframe);
+    END TurnCursorOn;
+
+(************************************************************************)
+
+BEGIN
+    BlackAndWhite := TRUE;
+    WITH BIOSframe DO
+	AH := 0FH;  BIOS (VideoInt, BIOSframe);
+	IF AL <> 7 THEN		(* must be colour *)
+
+	    BlackAndWhite := FALSE;
+
+	    (* Set the screen to 25*80 colour.	*)
+
+	    AH := 0;  AL := 3;  BIOS (VideoInt, BIOSframe);
+
+	END (*IF*);
+    END (*WITH*);
+
+    TurnCursorOn;
+
+END CursorOn.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/util/playmake.mod b/examples/Modula-2_Libraries/PMOS/sources/util/playmake.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/util/playmake.mod
@@ -0,0 +1,201 @@
+MODULE PlayMake;
+
+	(********************************************************)
+	(*							*)
+	(*	Program to make some tables needed for		*)
+	(*	playing music.  The data file produced		*)
+	(*	by this program can be incorporated into	*)
+	(*	an assembly language source file.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	15 March 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+FROM FileSys IMPORT
+    (* type *)	File,
+    (* proc *)	OpenFile, CloseFile, WriteRecord;
+
+FROM IOErrorCodes IMPORT
+    (* type *)	ErrorCode,
+    (* proc *)	TranslateErrorCode;
+
+FROM Conversions IMPORT
+    (* proc *)	ShortCardToString, CardinalToString;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, WriteString, WriteLn,
+		ReadChar, PressAnyKey;
+
+FROM MATHLIB IMPORT
+    (* proc *)	Exp, Log, Sin;
+
+(************************************************************************)
+
+TYPE Note = SHORTCARD [0..63];
+
+VAR
+    log: Window;
+    linecount: CARDINAL;
+    CRLF: ARRAY [0..1] OF CHAR;
+
+(************************************************************************)
+
+PROCEDURE SendByteToFile (f: File;  value: SHORTCARD);
+
+    (* Writes one value to the file, with a new line every eight values.*)
+
+    VAR buffer: ARRAY [0..31] OF CHAR;
+	status: ErrorCode;
+
+    BEGIN
+	status := OK;
+	IF linecount = 8 THEN
+	    buffer := "   db ";
+	    buffer[0] := CHR(13);  buffer[1] := CHR(10);
+	    buffer[2] := CHR(9);  buffer[5] := CHR(9);
+	    status := WriteRecord (f, ADR(buffer), 6);
+	    linecount := 0;
+	ELSE
+	    buffer := ",";
+	    status := WriteRecord (f, ADR(buffer), 1);
+	END (*IF*);
+	IF status = OK THEN
+	    ShortCardToString (value, buffer, 4);
+	    status := WriteRecord (f, ADR(buffer), 4);
+	END (*IF*);
+	INC (linecount);
+	IF status <> OK THEN
+	    TranslateErrorCode (status, buffer);
+	    WriteString (log, buffer);
+	END (*IF*);
+    END SendByteToFile;
+
+(************************************************************************)
+
+PROCEDURE SendWordToFile (f: File;  value: CARDINAL);
+
+    (* Writes one value to the file, with a new line every eight values.*)
+
+
+    VAR buffer: ARRAY [0..31] OF CHAR;
+	status: ErrorCode;
+
+    BEGIN
+	status := OK;
+	IF linecount = 8 THEN
+	    buffer := "   dw ";
+	    buffer[0] := CHR(13);  buffer[1] := CHR(10);
+	    buffer[2] := CHR(9);  buffer[5] := CHR(9);
+	    status := WriteRecord (f, ADR(buffer), 6);
+	    linecount := 0;
+	ELSE
+	    buffer := ",";
+	    status := WriteRecord (f, ADR(buffer), 1);
+	END (*IF*);
+	IF status = OK THEN
+	    CardinalToString (value, buffer, 6);
+	    status := WriteRecord (f, ADR(buffer), 6);
+	END (*IF*);
+	INC (linecount);
+	IF status <> OK THEN
+	    TranslateErrorCode (status, buffer);
+	    WriteString (log, buffer);
+	END (*IF*);
+    END SendWordToFile;
+
+(************************************************************************)
+
+PROCEDURE MakeDataFile;
+
+    (* Initialises the global data. *)
+
+    CONST PI =  3.141592653589793240;
+
+    VAR step, scale: LONGREAL;
+	j, value: SHORTCARD;  note: Note;
+	ch: CHAR;
+	f: File;  status: ErrorCode;
+	buffer: ARRAY [0..31] OF CHAR;
+
+    BEGIN
+	(* Open the data file. *)
+
+	status := OpenFile (f, "PLAYDATA.TXT", TRUE);
+	IF status = DuplicateFileName THEN
+	    WriteString (log, "PLAYDATA.TXT already exists.  Overwrite? ");
+	    ReadChar (log, ch);
+	    WriteLn (log);
+	    IF CAP(ch) = 'Y' THEN
+		status := OpenFile (f, "PLAYDATA.TXT", FALSE);
+	    END (*IF*);
+	END (*IF*);
+	IF status <> OK THEN
+	    TranslateErrorCode (status, buffer);
+	    WriteString (log, buffer);
+	    PressAnyKey (log);
+	    RETURN;
+	END (*IF*);
+
+	(* Create the note-to-interval map. *)
+
+	buffer := "    StepTable:";
+	status := WriteRecord (f, ADR(buffer), 14);
+	IF status <> OK THEN
+	    TranslateErrorCode (status, buffer);
+	    WriteString (log, buffer);
+	    PressAnyKey (log);
+	    RETURN;
+	END (*IF*);
+
+	linecount := 8;
+
+	scale := Exp(Log(2.0)/12.0);
+	step := 110.0;
+	SendWordToFile (f, 0);
+	FOR note := 1 TO MAX(Note) DO
+	    SendWordToFile (f, VAL(CARDINAL, step));
+	    step := step*scale;
+	END (*FOR*);
+
+	(* Create the waveform array. *)
+
+	status := WriteRecord (f, ADR(CRLF), 2);
+	IF status = OK THEN
+	    status := WriteRecord (f, ADR(CRLF), 2);
+	END (*IF*);
+	IF status = OK THEN
+	    buffer := "    Wave:";
+	    status := WriteRecord (f, ADR(buffer), 9);
+	END (*IF*);
+	IF status <> OK THEN
+	    TranslateErrorCode (status, buffer);
+	    WriteString (log, buffer);
+	    PressAnyKey (log);
+	    RETURN;
+	END (*IF*);
+
+	linecount := 8;
+
+	FOR j := 0 TO 255 DO
+	    value := VAL(SHORTCARD,
+			42.0*(1.0 + Sin(VAL(LONGREAL,j)*PI/128.0)));
+	    SendByteToFile (f, value);
+	END (*FOR*);
+	status := WriteRecord (f, ADR(CRLF), 2);
+
+	CloseFile (f);
+
+    END MakeDataFile;
+
+(************************************************************************)
+
+BEGIN
+    CRLF[0] := CHR(13);  CRLF[1] := CHR(10);
+    OpenWindow (log, blue, cyan, 2,22, 2,77, simpleframe, nodivider);
+    MakeDataFile;
+    CloseWindow (log);
+END PlayMake.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/util/plink.mod b/examples/Modula-2_Libraries/PMOS/sources/util/plink.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/util/plink.mod
@@ -0,0 +1,545 @@
+MODULE Plink;
+
+	(********************************************************)
+	(*							*)
+	(*	  Allows the user to test the effect of		*)
+	(*	adjustable music parameters on the sound,	*)
+	(*	  by trial and error from the keyboard.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	21 March 1995			*)
+	(*  Status:		Working				*)
+	(*	The "model 1" approach needs major improvements	*)
+	(*							*)
+	(********************************************************)
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, SetCursor, WriteLn, WriteString, ColourSwap;
+
+FROM NumericIO IMPORT
+    (* proc *)	WriteRJCard, EditCardinal;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey, PutBack;
+
+FROM Play3 IMPORT
+    (* const*)	CycleCount,
+    (* type *)	WaveNumber, GainType, WaveGroup, EnvelopeArrayIndex,
+    (* proc *)	DefineWaveform, DefineEnvelope, Play;
+
+FROM MATHLIB IMPORT
+    (* proc *)	Sin, Cos, Exp;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE;
+
+(************************************************************************)
+
+TYPE
+    VarRange = [0..6];
+
+VAR
+    (* Waveform table pointers. *)
+
+    Wave: ARRAY WaveNumber OF WaveGroup;
+
+    (* Array to define the attack/decay envelope. *)
+
+    Envelope: ARRAY EnvelopeArrayIndex OF GainType;
+
+    (* Where the music is stored.  We also use part of the MainVoice	*)
+    (* array for temporary storage of data.				*)
+
+    MainVoice: ARRAY [0..7] OF CARDINAL;
+    NullVoice: ARRAY [0..0] OF CARDINAL;
+
+    (* Some variables whose values will be adjusted from the keyboard.	*)
+
+    attack, decay, sustain: CARDINAL;
+
+    (* Envelope generation model. *)
+
+    Model: [0..1];
+
+    (* Map that tells us how to access the variables that can be	*)
+    (* changed from the keyboard.					*)
+
+    VarMap: ARRAY VarRange OF
+		RECORD
+		    address: POINTER TO CARDINAL;
+		    max: CARDINAL;
+		END (*RECORD*);
+
+(************************************************************************)
+(*			ENVELOPE CALCULATIONS				*)
+(************************************************************************)
+
+PROCEDURE EnvelopeModel0 (Attack, Decay, Sustain: LONGREAL);
+
+    (* Calculates the envelope array using an attack/decay/sustain model.*)
+
+    CONST scaletogain = LONGREAL(MAX(GainType));
+
+    VAR level: LONGREAL;
+	phase: [0..1];  j: EnvelopeArrayIndex;
+
+    BEGIN
+	Decay := 1.0 - Decay;
+	phase := 0;  level := 0.0;
+	FOR j := 0 TO MAX(EnvelopeArrayIndex) DO
+	    IF phase = 0 THEN
+
+		(* Attack phase: ramp up linearly to maximum. *)
+
+		level := level + Attack;
+		IF level > 1.0 THEN
+		    level := 1.0;  INC(phase);
+		END(*IF*);
+
+	    ELSE
+
+		(* Decay phase: we're using an exponential decay. *)
+
+		level := Sustain + Decay*(level - Sustain);
+
+	    END (*IF*);
+
+	    Envelope[j] := VAL(GainType, scaletogain*level);
+
+	END (*FOR*);
+
+    END EnvelopeModel0;
+
+(************************************************************************)
+
+PROCEDURE OldEnvelopeModel1 (alpha, beta, steady: LONGREAL);
+
+    (* Calculates the envelope array using a second order dynamic model.*)
+    (* This model is not yet working well, apparently because I'm not	*)
+    (* working with a useful range of parameters.			*)
+
+    CONST small = 1.0E-20;
+
+    VAR state: ARRAY [0..1] OF LONGREAL;
+	nextstate: LONGREAL;  j: EnvelopeArrayIndex;
+	Result: ARRAY EnvelopeArrayIndex OF LONGREAL;
+	min, max, scale: LONGREAL;
+
+    BEGIN
+	min := 0.0;  max := 0.0;
+
+	(* Map alpha and beta to the stable range: alpha from -2.0 to	*)
+	(* +2.0, and beta from -1.0 to 1.0-ABS(alpha).			*)
+
+	alpha := 4.0*alpha - 2.0;
+	beta := (2.0 - ABS(alpha))*beta - 1.0;
+
+	state[0] := -steady;  state[1] := -steady;
+	FOR j := 0 TO MAX(EnvelopeArrayIndex) DO
+	    Result[j] := state[1] + steady;
+	    IF Result[j] < min THEN min := Result[j]
+	    ELSIF Result[j] > max THEN max := Result[j]
+	    END (*IF*);
+	    nextstate := alpha*state[1] + beta*state[0];
+	    state[0] := state[1];
+	    state[1] := nextstate;
+	END (*FOR*);
+
+	(* Now scale the results to fit into the desired range. *)
+
+	IF ABS(max-min) < small THEN
+	    Envelope[0] := 0;
+	    FOR j := 1 TO MAX(EnvelopeArrayIndex) DO
+		Envelope[j] := MAX (GainType);
+	    END (*FOR*);
+	ELSE
+	    scale := LONGREAL(MAX(GainType))/(max - min);
+	    FOR j := 0 TO MAX(EnvelopeArrayIndex) DO
+		Envelope[j] := VAL (GainType, scale*(Result[j] - min));
+	    END (*FOR*);
+	END (*IF*);
+
+    END OldEnvelopeModel1;
+
+(************************************************************************)
+
+PROCEDURE EnvelopeModel1 (A, D, steady: LONGREAL);
+
+    (* Calculates the envelope array using a second order dynamic model.*)
+    (* This model is not yet working well, apparently because I'm not	*)
+    (* working with a useful range of parameters.			*)
+
+    CONST small = 1.0E-20;
+	scaleA = 10.0;  scaleD = 0.5;
+
+    VAR j: EnvelopeArrayIndex;
+	Result: ARRAY EnvelopeArrayIndex OF LONGREAL;
+	min, max, scale: LONGREAL;
+	t, deltat: LONGREAL;
+	K1, K2, K3, alpha: LONGREAL;
+
+    BEGIN
+	min := 0.0;  max := 0.0;
+	K1 := steady;  K2 := -K1;
+	deltat := 0.2;
+	alpha := scaleD*D;
+	K3 := scaleA*A + alpha*K2;
+	t := 0.0;
+
+	FOR j := 0 TO MAX(EnvelopeArrayIndex) DO
+	    Result[j] := K1 + Exp(-alpha*t)*(K2*Cos(t) + K3*Sin(t));
+	    IF Result[j] < min THEN min := Result[j]
+	    ELSIF Result[j] > max THEN max := Result[j]
+	    END (*IF*);
+	    t := t + deltat;
+	END (*FOR*);
+
+	(* Now scale the results to fit into the desired range. *)
+
+	scale := LONGREAL(MAX(GainType))/(max-min);
+	FOR j := 0 TO MAX(EnvelopeArrayIndex) DO
+	    Envelope[j] := VAL (GainType, scale*(Result[j]-min));
+	END (*FOR*);
+
+    END EnvelopeModel1;
+
+(************************************************************************)
+
+PROCEDURE UpdateEnvelope;
+
+    (* Turns the current envelope parameters into an envelope array.	*)
+
+    CONST scaletoreal = 1.0/LONGREAL(MAX(CARDINAL));
+
+    VAR Attack, Decay, Sustain: LONGREAL;
+
+    BEGIN
+	Attack := scaletoreal*LONGREAL(attack);
+	Decay := scaletoreal*LONGREAL(decay);
+	Sustain := scaletoreal*LONGREAL(sustain);
+
+	IF Model = 0 THEN EnvelopeModel0 (Attack, Decay, Sustain);
+	ELSE EnvelopeModel1 (Attack, Decay, Sustain);
+	END (*IF*);
+
+    END UpdateEnvelope;
+
+(************************************************************************)
+
+PROCEDURE ShowEnvelope (w: Window);
+
+    (* Displays the current envelope. *)
+
+    VAR j: EnvelopeArrayIndex;
+
+    BEGIN
+	SetCursor (w, 2, 1);
+	FOR j := 0 TO MAX(EnvelopeArrayIndex) DO
+	    WriteRJCard (w, Envelope[j], 6);
+	END (*FOR*);
+    END ShowEnvelope;
+
+(************************************************************************)
+(*			   SCREEN EDITING				*)
+(************************************************************************)
+
+PROCEDURE EditValue (w: Window;  N: VarRange;  fieldsize: CARDINAL);
+
+    (* Allows direct entry of the value of variable number N from the	*)
+    (* keyboard.							*)
+
+    VAR value: CARDINAL;
+
+    BEGIN
+	WITH VarMap[N] DO
+	    value := address^;
+	    EditCardinal (w, value, fieldsize);
+	    IF value > max THEN value := max END(*IF*);
+	    address^ := value;
+	END (*WITH*);
+    END EditValue;
+
+(************************************************************************)
+
+PROCEDURE AdjustValue (N: VarRange;  amount: INTEGER);
+
+    (* Changes the value of variable number N by the given amount, with	*)
+    (* wraparound.  We clip "amount" in the case where the value	*)
+    (* specified is inappropriately large relative to the maximum	*)
+    (* allowed value of variable number N.				*)
+
+    VAR value, max, absamount: CARDINAL;  halfmax: INTEGER;
+
+    BEGIN
+	max := VarMap[N].max;
+	IF max < MAX(CARDINAL) THEN
+	    IF max = 1 THEN halfmax := 1
+	    ELSE halfmax := max DIV 2;
+	    END (*IF*);
+	    IF amount > halfmax THEN amount := halfmax
+	    ELSIF amount < -halfmax THEN amount := -halfmax
+	    END (*IF*);
+	END (*IF*);
+	value := VarMap[N].address^;
+	IF amount > 0 THEN
+	    absamount := amount;
+	    IF value <= max - absamount THEN
+		value := value + absamount;
+	    ELSE
+		value := value - (max - absamount + 1);
+	    END (*IF*);
+	ELSE
+	    absamount := -amount;
+	    IF value >= absamount THEN
+		value := value - absamount;
+	    ELSE
+		value := value + (max - absamount + 1);
+	    END (*IF*);
+	END (*IF*);
+	VarMap[N].address^ := value;
+    END AdjustValue;
+
+(************************************************************************)
+
+PROCEDURE DoTheTests;
+
+    TYPE CharSet = SET OF CHAR;
+
+    CONST
+	Esc = CHR(27);  Digits = CharSet {'0'..'9'};
+	userrow = 6;  colbase = 10;  fieldwidth = 5;  gap = 4;
+
+    VAR w, EW: Window;  ch: CHAR;
+	N: VarRange;  value: CARDINAL;
+
+    (********************************************************************)
+
+    PROCEDURE Highlight;
+
+	(* Swaps the screen colour for field N. *)
+
+	BEGIN
+	    ColourSwap (w, userrow, colbase + (fieldwidth+gap)*N, fieldwidth);
+	END Highlight;
+
+    (********************************************************************)
+
+    PROCEDURE PositionCursor (N: VarRange);
+
+	(* Sets the screen cursor to the position of variable N.	*)
+
+	BEGIN
+	    SetCursor (w, userrow, colbase + (fieldwidth+gap)*N);
+	END PositionCursor;
+
+    (********************************************************************)
+
+    PROCEDURE WriteValue (N: VarRange);
+
+	(* Writes the value for field N to the screen. *)
+
+	BEGIN
+	    PositionCursor (N);
+	    WriteRJCard (w, VarMap[N].address^, fieldwidth);
+	END WriteValue;
+
+    (********************************************************************)
+
+    BEGIN
+	OpenWindow (EW, black, white, 17, 24, 0, 79, simpleframe, nodivider);
+	WriteString (EW, "Envelope:");
+	OpenWindow (w, black, green, 8, 16, 0, 79, noframe, nodivider);
+	WriteLn (w);
+	WriteString (w, "        Cursor right/left to select variable,");
+	WriteString (w, " up/down to change value,");
+	WriteLn (w);
+	WriteString (w, "       PgUp/PgDown for coarse changes, Space to");
+	WriteString (w, " play note, Esc to exit");
+	SetCursor (w, userrow-2, colbase-1);
+	WriteString (w, "Duration Frequency Waveform Attack   Decay");
+	WriteString (w, "   Sustain    Model");
+	SetCursor (w, userrow, colbase);
+	FOR N := 0 TO 6 DO
+	    WriteValue (N);
+	END (*FOR*);
+	N := 0;
+	LOOP
+	    UpdateEnvelope;  ShowEnvelope (EW);
+	    Highlight;
+	    ch := InKey();
+	    Highlight;
+	    IF ch = Esc THEN
+		EXIT (*LOOP*);
+	    ELSIF ch = " " THEN
+		Play (MainVoice, NullVoice, NullVoice);
+	    ELSIF ch IN Digits THEN
+		PositionCursor (N);
+		PutBack (ch);
+		EditValue (w, N, fieldwidth);
+		WriteValue (N);
+	    ELSIF ch = CHR(0) THEN
+		ch := InKey();
+		IF ch = "H" THEN		(* cursor up *)
+		    AdjustValue (N, 1);
+		    WriteValue (N);
+		ELSIF ch = "P" THEN		(* cursor down *)
+		    AdjustValue (N, -1);
+		    WriteValue (N);
+		ELSIF ch = "I" THEN		(* page up *)
+		    AdjustValue (N, 250);
+		    WriteValue (N);
+		ELSIF ch = "Q" THEN		(* page down *)
+		    AdjustValue (N, -250);
+		    WriteValue (N);
+		ELSIF ch = "M" THEN		(* cursor right *)
+		    IF N = MAX(VarRange) THEN N := 0
+		    ELSE INC(N);
+		    END (*IF*);
+		ELSIF ch = "K" THEN		(* cursor left *)
+		    IF N = 0 THEN N := MAX(VarRange)
+		    ELSE DEC(N);
+		    END (*IF*);
+		END (*IF*);
+
+	    END (*IF*);
+
+	END (*LOOP*);
+
+    END DoTheTests;
+
+(************************************************************************)
+(*			MODULE INITIALISATION				*)
+(************************************************************************)
+
+PROCEDURE Initialise;
+
+    CONST
+	PI = 3.141592653589793240;
+	offset = LONGREAL(128*CycleCount-1) / 3.0;
+	bound = 2.0*offset;		(* limit on peak-to-peak value	*)
+
+    VAR scale: LONGREAL;
+	j, break: SHORTCARD;
+	w: WaveNumber;
+	v: VarRange;
+	g: GainType;
+	Gain: ARRAY GainType OF LONGREAL;
+
+    (********************************************************************)
+
+    PROCEDURE WaveValue (w: WaveNumber;  pos: BYTE;  val: LONGREAL);
+
+	(* Is passed the value for maximum sound, fills in the tables	*)
+	(* with all the scaled values.					*)
+
+	VAR g: GainType;
+
+	BEGIN
+	    FOR g := 0 TO MAX(GainType) DO
+		Wave[w][g]^[pos] := VAL(INTEGER, val*Gain[g]);
+	    END;
+	END WaveValue;
+
+    (********************************************************************)
+
+    BEGIN
+	(* Create the waveform arrays. *)
+
+	FOR g := 0 TO MAX(GainType) DO
+	    Gain[g] := LONGREAL(g)/LONGREAL(MAX(GainType));
+	    FOR w := 0 TO HIGH(Wave) DO
+		NEW (Wave[w][g]);
+	    END (*FOR*);
+	END (*FOR*);
+
+	(* Waveform #0: sine wave. *)
+	(* Waveform #1: sine wave + 3rd harmonic. *)
+
+	FOR j := 0 TO 255 DO
+	    WaveValue (0, j, 0.5*bound*Sin(VAL(LONGREAL,j)*PI/128.0));
+	    WaveValue (1, j, 0.56*bound*(Sin(VAL(LONGREAL,j)*PI/128.0)
+				+ 0.18*Sin(3.0*VAL(LONGREAL,j)*PI/128.0)));
+	END (*FOR*);
+
+	(* Waveforms #2, 3, 4: rectangular waves.	*)
+
+	FOR w := 2 TO 4 DO
+	    break := 56*SHORTCARD(w) + 16;
+	    FOR j := 0 TO break-1 DO
+		WaveValue (w, j, offset);
+	    END (*FOR*);
+	    FOR j := break TO 255 DO
+		WaveValue (w, j, -offset);
+	    END (*FOR*);
+	END (*FOR*);
+
+	(* Waveforms #5, 6, 7: triangular waves.	*)
+
+	FOR w := 5 TO 6 DO
+	    break := VAL(SHORTCARD, 64*w - 192);
+	    scale := bound/LONGREAL(break);
+	    FOR j := 0 TO break-1 DO
+		WaveValue (w,j, scale*LONGREAL(j)-offset);
+	    END (*FOR*);
+	    scale := bound/LONGREAL(256-CARDINAL(break));
+	    FOR j := break TO 255 DO
+		WaveValue (w, j, scale*LONGREAL(256-CARDINAL(j))-offset);
+	    END (*FOR*);
+	END (*FOR*);
+	FOR j := 0 TO 255 DO
+	    WaveValue (7, j, bound*LONGREAL(j)/256.0-offset);
+	END (*FOR*);
+
+	(* Pass the waveforms and envelope address to the subsidiary	*)
+	(* module.							*)
+
+	FOR w := 0 TO 7 DO
+	    DefineWaveform (w, Wave[w]);
+	END (*FOR*);
+	DefineEnvelope (0, ADR(Envelope));
+
+	(* Put some code in the Voice arrays.	*)
+
+	MainVoice[0] := 65534;
+	MainVoice[1] := 300;		(* Duration *)
+	MainVoice[2] := 65532;
+	MainVoice[3] := 2;		(* Waveform number *)
+	MainVoice[4] := 65531;
+	MainVoice[5] := 0;		(* Envelope number *)
+	MainVoice[6] := 2750;		(* note code *)
+	MainVoice[7] := 65535;
+	NullVoice[0] := 65535;
+
+	(* Set up the VarMap array. *)
+
+	FOR v := 0 TO MAX(VarRange) DO
+	    VarMap[v].max := MAX(CARDINAL);
+	END (*FOR*);
+	VarMap[2].max := MAX(WaveNumber);
+	VarMap[6].max := 1;
+
+	VarMap[0].address := ADR(MainVoice[1]);		(* Duration *)
+	VarMap[1].address := ADR(MainVoice[6]);		(* Note code *)
+	VarMap[2].address := ADR(MainVoice[3]);		(* Waveform number *)
+	VarMap[3].address := ADR(attack);		(* attack *)
+	VarMap[4].address := ADR(decay);		(* decay *)
+	VarMap[5].address := ADR(sustain);		(* sustain *)
+	VarMap[6].address := ADR(Model);		(* model *)
+
+	(* Give initial values to some other global variables. *)
+
+	Model := 1;
+	attack := 65535;
+	decay := 2000;
+	sustain := 32768;
+
+    END Initialise;
+
+(************************************************************************)
+
+BEGIN
+    Initialise;
+    DoTheTests;
+END Plink.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/util/pp.mod b/examples/Modula-2_Libraries/PMOS/sources/util/pp.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/util/pp.mod
@@ -0,0 +1,836 @@
+MODULE PP;
+
+	(********************************************************)
+	(*							*)
+	(*		Version extraction program		*)
+	(*							*)
+	(*	Originally derived from a program given to	*)
+	(*	me by Deane Blackman of Monash University,	*)
+	(*	using a source syntax similar to that used	*)
+	(*	by a utility in Rowley Modula-2.		*)
+	(*							*)
+	(*  Compilers currently supported:			*)
+	(*	FST, Rowley, TopSpeed 1.17, TopSpeed 3.10	*)
+	(*	The Rowley version is untested and may have	*)
+	(*	errors.						*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	24 February 1995		*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*  Minor shortcoming: with the "S" command-line	*)
+	(*	option, we can get blank lines in the output	*)
+	(*	file resulting from the fact that we've		*)
+	(*	deleted everything except some space and tab	*)
+	(*	characters.  Fixing this would require a	*)
+	(*	change in strategy - we'd need to avoid		*)
+	(*	writing a partial line, saving it instead	*)
+	(*	so that we can look at the whole line before	*)
+	(*	deciding whether it consists entirely of	*)
+	(*	white space.  For now I don't consider this	*)
+	(*	important enough to justify the effort of	*)
+	(*	redesigning for that case.			*)
+	(*							*)
+	(*  Remark: in case you're wondering why all the File	*)
+	(*	parameters in procedures are VAR parameters:	*)
+	(*	we have to do it this way because some		*)
+	(*	compilers (e.g. FST) implement a File variable	*)
+	(*	as a record, rather than as some sort of	*)
+	(*	handle which points to the file descriptor.	*)
+	(*	If we used value parameters then we'd have	*)
+	(*	multiple copies of file descriptors in various	*)
+	(*	procedures, and they wouldn't be consistent	*)
+	(*	with one another in terms of things like the	*)
+	(*	end-of-file flag.				*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(*									*)
+(* Selection by (*<xxx where  xxx  is a selecting string.  The		*)
+(* terminator for this region is >*).  The text between the (*< and	*)
+(* >*) will be activated iff the  xxx  evaluates to TRUE using the	*)
+(* assignments in the PP.CFG file.					*)
+(*									*)
+(* If the S (for suppress) option is specified, all inactive text and	*)
+(* all selection delimiters are deleted.  If the S option is absent	*)
+(* then all original text is retained but the part that is supposed to	*)
+(* be inactive is commented out.					*)
+(*									*)
+(************************************************************************)
+
+FROM PPExpr IMPORT
+    (* proc *)	DefineSymbol, Id, Expr, StringExpr, DumpSymbolTable;
+
+FROM PPMisc IMPORT
+    (* type *)	File,
+    (* proc *)	Length, CopyString, Pos,
+		OpenFile, CloseFile, WriteToFile, TerminateLine,
+		ReadLine, EndOfFile, DeleteFile, RenameFile,
+		Message, EndOfMessage, CommandLine;
+
+(************************************************************************)
+(*			   GLOBAL VARIABLES				*)
+(************************************************************************)
+
+TYPE
+    BufferSubscript = [0..255];
+    FileNumber = [1..255];
+    SpecialSymbol = (EofSymbol, StartVersion, EndVersion, CommentedEndVersion);
+    CharSet = SET OF CHAR;
+
+CONST
+    AlphaNumerics = CharSet {"A".."Z", "a".."z", "0".."9"};
+
+VAR
+    (* Buffer holds the current source line being processed.  We make	*)
+    (* it global since it is accessed by a number of procedures.	*)
+    (* LinePlace is the location in Buffer that holds the next		*)
+    (* character to be looked at.					*)
+
+    Buffer: ARRAY BufferSubscript OF CHAR;
+    LinePlace: CARDINAL;
+
+    (* The following flag is set if we have read an empty line from	*)
+    (* the input file.  We use it to distinguish between lines that	*)
+    (* were empty originally, and those we have made empty by deletions.*)
+    (* This allows us to avoid generating excess blank lines in the	*)
+    (* output, while still retaining those blank lines that the author	*)
+    (* intended to keep.						*)
+
+    TerminateEmptyLine: BOOLEAN;
+
+    (* The next flag says whether there is anything in Buffer.  This	*)
+    (* is a guard against reading rubbish or writing the same line	*)
+    (* twice.  (There's probably a better way to achieve this, but so	*)
+    (* far I haven't worked out a simpler way to handle the end-of-file	*)
+    (* condition.)							*)
+
+    BufferLoaded: BOOLEAN;
+
+    (* SourceLength is either MAX(CARDINAL) or the length of the string	*)
+    (* in Buffer.  Most of the time we leave it equal to MAX(CARDINAL)	*)
+    (* and recompute only as needed.					*)
+
+    SourceLength: CARDINAL;
+
+    (* FileName is a list of files that have to be processed. *)
+
+    FileName: ARRAY FileNumber OF ARRAY [0..127] OF CHAR;
+
+    (* There are LastFileNumber+1 files in total. *)
+
+    LastFileNumber: [0..MAX(FileNumber)];
+
+(************************************************************************)
+(*		INSERTIONS AND DELETIONS IN THE LINE BUFFER		*)
+(************************************************************************)
+
+PROCEDURE InsertString (offset: INTEGER;  str: ARRAY OF CHAR);
+
+    (* Inserts str at Buffer[LinePlace+offset].  If offset is zero or	*)
+    (* negative then LinePlace is adjusted.				*)
+
+    VAR j, amount, base: CARDINAL;
+
+    BEGIN
+	IF SourceLength > HIGH(Buffer) THEN
+	    SourceLength := Length(Buffer);
+	END (*IF*);
+	amount := Length(str);
+	base := INTEGER(LinePlace) + offset;
+	FOR j := SourceLength+amount-1 TO base+amount BY -1 DO
+	    Buffer[j] := Buffer[j-amount];
+	END (*FOR*);
+	FOR j := 0 TO amount-1 DO
+	    Buffer[base+j] := str[j];
+	END (*FOR*);
+	IF offset <= 0 THEN
+	    LinePlace := LinePlace + amount;
+	END (*IF*);
+	INC (SourceLength, amount);
+	IF SourceLength <= HIGH(Buffer) THEN
+	    Buffer[SourceLength] := CHR(0);
+	END (*IF*);
+    END InsertString;
+
+(************************************************************************)
+
+PROCEDURE DeleteString (offset: INTEGER;  length: CARDINAL);
+
+    (* Deletes the substring of length "length" starting at		*)
+    (* Buffer[LinePlace+offset].  If offset is negative then LinePlace	*)
+    (* is adjusted.							*)
+
+    VAR j, base: CARDINAL;
+
+    BEGIN
+	IF SourceLength > HIGH(Buffer) THEN
+	    SourceLength := Length(Buffer);
+	END (*IF*);
+	base := INTEGER(LinePlace) + offset;
+	FOR j := base TO SourceLength-length DO
+	    Buffer[j] := Buffer[j+length];
+	END (*FOR*);
+	Buffer[SourceLength-length+1] := CHR(0);
+	IF offset < 0 THEN
+	    IF INTEGER(length) + offset > 0 THEN LinePlace := base;
+	    ELSE DEC(LinePlace, length);
+	    END (*IF*);
+	END (*IF*);
+	DEC (SourceLength, length);
+    END DeleteString;
+
+(************************************************************************)
+
+PROCEDURE WritePartialLine (VAR (*INOUT*) f: File;  pos: CARDINAL);
+
+    (* Writes Buffer[0..pos-1] to file f, and then deletes the written	*)
+    (* data from Buffer.						*)
+
+    VAR ch: CHAR;
+
+    BEGIN
+	ch := Buffer[pos];  Buffer[pos] := CHR(0);
+	WriteToFile (f, Buffer);
+	Buffer[pos] := ch;
+	DeleteString (-INTEGER(pos), pos);
+
+	(* This next assignment is to ensure that the output line	*)
+	(* will be terminated even if the rest of it is deleted.	*)
+
+	TerminateEmptyLine := TRUE;
+
+    END WritePartialLine;
+
+(************************************************************************)
+(*			COPYING "ORDINARY" TEXT				*)
+(************************************************************************)
+
+PROCEDURE EndOfLine(): BOOLEAN;
+
+    (* Returns TRUE iff we are at the end of the line buffer. *)
+
+    BEGIN
+	RETURN (LinePlace > HIGH(Buffer)) OR (Buffer[LinePlace] = CHR(0));
+    END EndOfLine;
+
+(************************************************************************)
+
+PROCEDURE WriteCurrentLine (VAR (*INOUT*) f: File);
+
+    (* Writes out the current buffer contents. *)
+
+    BEGIN
+	(* Blank line suppression test. *)
+	IF Buffer[0] = CHR(0) THEN
+	    IF TerminateEmptyLine THEN
+		TerminateLine (f);
+	    END (*IF*);
+	ELSE
+	    WriteToFile (f, Buffer);
+	    TerminateLine (f);
+	END (*IF*);
+	BufferLoaded := FALSE;  TerminateEmptyLine := FALSE;
+    END WriteCurrentLine;
+
+(************************************************************************)
+
+PROCEDURE GetNextLine (VAR (*INOUT*) fin, fout: File;  SendToOutput: BOOLEAN);
+
+    (* Writes out the current line to fout if SendToOutput is TRUE,	*)
+    (* and then re-fills the line buffer from fin.			*)
+
+    BEGIN
+	IF SendToOutput AND BufferLoaded THEN
+	    WriteCurrentLine (fout);
+	END (*IF*);
+	IF NOT EndOfFile(fin) THEN
+	    ReadLine (fin, Buffer);  LinePlace := 0;
+	    TerminateEmptyLine := Buffer[0] = CHR(0);
+	    SourceLength := MAX(CARDINAL);
+
+	    (* The next test is to guard against the possibility that  *)
+	    (* all we have read is the terminating end-of-file char.   *)
+
+	    BufferLoaded := NOT (TerminateEmptyLine AND EndOfFile(fin));
+
+	END (*IF*);
+
+    END GetNextLine;
+
+(************************************************************************)
+
+PROCEDURE EndCommentMarkerPresent(): BOOLEAN;
+
+    (* If an "end comment" delimiter is found in the source then we	*)
+    (* move past it and return TRUE.  Otherwise the result is FALSE.	*)
+
+    BEGIN
+	IF (Buffer[LinePlace] = "*") AND (Buffer[LinePlace+1] = ")") THEN
+	    INC (LinePlace, 2);
+	    RETURN TRUE;
+	END (*IF*);
+	RETURN FALSE;
+    END EndCommentMarkerPresent;
+
+(************************************************************************)
+
+PROCEDURE SkipComment (VAR (*INOUT*) fin, fout: File;  SendToOutput: BOOLEAN);
+
+    (* On entry we have just passed a "start comment" delimiter in the	*)
+    (* source.  We copy this over, taking nested comments into account,	*)
+    (* and return with Buffer[LinePlace] hold the character just beyond	*)
+    (* the corresponding "end comment" delimiter.			*)
+
+    BEGIN
+	LOOP
+	    IF EndOfLine() THEN
+		IF EndOfFile (fin) THEN
+		    RETURN;
+		END (*IF*);
+		GetNextLine (fin, fout, SendToOutput);
+		IF NOT BufferLoaded THEN
+		    RETURN;
+		END (*IF*);
+	    ELSIF EndCommentMarkerPresent() THEN
+		RETURN;
+	    ELSIF (Buffer[LinePlace] = "(") AND (Buffer[LinePlace+1] = "*") THEN
+		INC (LinePlace, 2);
+		SkipComment (fin, fout, SendToOutput);
+	    ELSE
+		INC (LinePlace);
+	    END (*IF*);
+	END (*LOOP*);
+    END SkipComment;
+
+(************************************************************************)
+
+PROCEDURE CopyOver (VAR (*INOUT*) fin, fout: File;
+				SendToOutput: BOOLEAN): SpecialSymbol;
+
+    (* This procedure simply reads the input file fin, copying it to	*)
+    (* fout if SendToOutput is TRUE, and returns on end of file or	*)
+    (* when an opening or closing version delimiter is detected.  Note	*)
+    (* that version delimiters inside comments, or outside comments but	*)
+    (* inside string delimiters, are treated as ordinary text.		*)
+    (* The function result is the symbol that caused this procedure to	*)
+    (* return.  On return we have already read past that symbol.	*)
+
+    (* Note: on return there might still be some unprocessed text in	*)
+    (* Buffer.  This is indicated by the global variable BufferLoaded.	*)
+
+    VAR ch: CHAR;
+
+    BEGIN
+	LOOP
+	    WHILE EndOfLine() DO
+		IF EndOfFile (fin) THEN
+		    IF SendToOutput AND BufferLoaded THEN
+			WriteCurrentLine (fout);
+		    END (*IF*);
+		    RETURN EofSymbol;
+		END (*IF*);
+		GetNextLine (fin, fout, SendToOutput);
+	    END (*WHILE*);
+
+	    (* Pick up next source character. *)
+
+	    ch := Buffer[LinePlace];  INC(LinePlace);
+
+	    IF (ch = "'") OR (ch = '"') THEN
+
+		(* Special case: character string. *)
+
+		WHILE NOT EndOfLine() AND (Buffer[LinePlace] <> ch) DO
+		    INC(LinePlace);
+		END (*WHILE*);
+		IF EndOfLine() THEN
+		    EndOfMessage;
+		    Message ("Error: Unterminated character string");
+		    EndOfMessage;
+		    Message (Buffer);
+		ELSE
+		    INC(LinePlace);
+		END (*IF*);
+
+	    ELSIF (ch = "(") AND (Buffer[LinePlace] = "*") THEN
+
+		(* Special case: start of comment.  This could be an	*)
+		(* ordinary comment, a "start version" delimiter, or a	*)
+		(* commented-out "end version" delimiter.		*)
+
+		INC (LinePlace);
+		IF Buffer[LinePlace] = "<" THEN
+		    INC (LinePlace);
+		    RETURN StartVersion;
+		ELSIF Buffer[LinePlace] = ">" THEN
+		    INC (LinePlace);
+		    IF EndCommentMarkerPresent() THEN
+			RETURN CommentedEndVersion;
+		    END (*IF*);
+		ELSE
+		    SkipComment (fin, fout, SendToOutput);
+		END (*IF*);
+
+	    ELSIF ch = ">" THEN
+
+		(* This could be an "end version" delimiter - look in	*)
+		(* more detail.						*)
+
+		IF EndCommentMarkerPresent() THEN
+		    RETURN EndVersion;
+		END (*IF*);
+
+	    END (*IF*);
+
+	END (*LOOP*);
+
+    END CopyOver;
+
+(************************************************************************)
+(*			THE MAIN CONVERSION ROUTINES			*)
+(************************************************************************)
+
+PROCEDURE Filter (VAR (*INOUT*) fin, fout: File;
+			KeepText, Active: BOOLEAN;
+			VAR (*INOUT*) ChangeMade: BOOLEAN): SpecialSymbol;
+
+    (* Copies from fin to fout, altering the version delimiters as	*)
+    (* appropriate to comment and uncomment text.  This procedure	*)
+    (* returns after reaching the end of fin, or finding the		*)
+    (* first unmatched "close version" delimiter, whichever comes	*)
+    (* first.  The reason for defining the return condition in this	*)
+    (* way is that we use recursive calls to handle nested conditions.	*)
+
+    (* KeepText specifies whether the unselected versions should be	*)
+    (* copied over (commented out); if KeepText is false then the	*)
+    (* unselected code is omitted from the output file.  The "Active"	*)
+    (* parameter specifies whether we are currently in a section that	*)
+    (* should be retained without being commented out - it should be	*)
+    (* TRUE on the first call, but may be false on recursive calls.	*)
+    (* The function result indicates which special symbol terminated	*)
+    (* the processing.							*)
+
+    VAR code: SpecialSymbol;  include, endcomment: BOOLEAN;
+	markerstart, length: CARDINAL;
+
+    BEGIN
+	LOOP
+	    code := CopyOver (fin, fout, KeepText OR Active);
+	    IF NOT KeepText AND NOT Active THEN
+		ChangeMade := TRUE;
+	    END (*IF*);
+
+	    (* The result of CopyOver can be one of:			*)
+	    (*	EofSymbol:	means processing is complete		*)
+	    (*	StartVersion:	means that we have to conditionally	*)
+	    (*			copy a version				*)
+	    (*	EndVersion, CommentedEndVersion: these terminate a	*)
+	    (*			recursive call				*)
+
+	    IF code <> StartVersion THEN EXIT(*LOOP*) END(*IF*);
+
+	    (* We have reached a "start version" delimiter; so we have	*)
+	    (* to decide whether to retain or remove the following	*)
+	    (* section of source.					*)
+
+	    markerstart := LinePlace - 3;
+	    include := Expr(Buffer, LinePlace) AND Active;
+	    endcomment := EndCommentMarkerPresent();
+
+	    IF include THEN
+
+		(* The code in this section should be included.  If	*)
+		(* KeepText is TRUE we should put an "end comment"	*)
+		(* delimiter after this "start version" marker, unless	*)
+		(* it's already there.  If KeepText is FALSE then we	*)
+		(* should delete the entire version selector, including	*)
+		(* the "end comment" delimiter if present.		*)
+
+		IF KeepText THEN
+		    IF NOT endcomment THEN
+			InsertString (0, "*)");  ChangeMade := TRUE;
+		    END (*IF*);
+		ELSE
+		    length := LinePlace - markerstart;
+		    DeleteString (-INTEGER(length), length);
+		    ChangeMade := TRUE;
+		END (*IF*);
+		code := Filter (fin, fout, KeepText, TRUE, ChangeMade);
+		IF code = EndVersion THEN
+
+		    (* Delete the "end version" delimiter, or comment	*)
+		    (* it out, depending on the value of KeepText.	*)
+
+		    IF KeepText THEN
+			InsertString (-3, "(*");
+		    ELSE
+			DeleteString (-3, 3);
+		    END (*IF*);
+		    ChangeMade := TRUE;
+
+		ELSIF (code = CommentedEndVersion) AND NOT KeepText THEN
+		    (* Delete a commented "end version" delimiter if	*)
+		    (* KeepText is FALSE.				*)
+		    DeleteString (-5, 5);
+		    ChangeMade := TRUE;
+		END (*IF*);
+
+	    ELSE
+
+		(* The code in this section should be suppressed.  If	*)
+		(* KeepText is FALSE we may need to write out the part	*)
+		(* of the input line before the suppressed text.  If	*)
+		(* KeepText is TRUE we merely remove any "end comment"	*)
+		(* delimiter after this "start version" marker.		*)
+
+		IF KeepText THEN
+		    IF endcomment THEN
+			DeleteString (-2, 2);
+			IF Buffer[LinePlace] IN AlphaNumerics THEN
+			    InsertString (0, " ");
+			END (*IF*);
+			ChangeMade := TRUE;
+		    END (*IF*);
+		ELSIF Active THEN
+		    WritePartialLine (fout, markerstart);
+		END (*IF*);
+		code := Filter (fin, fout, KeepText, FALSE, ChangeMade);
+		IF KeepText THEN
+		    IF code = CommentedEndVersion THEN
+			(* Change the CommentedEndVersion to an EndVersion. *)
+			DeleteString (-5, 2);
+			ChangeMade := TRUE;
+		    END (*IF*);
+		ELSE
+		    (* Delete that part of the line already processed. *)
+		    DeleteString (-INTEGER(LinePlace), LinePlace);
+		    ChangeMade := TRUE;
+		END (*IF*);
+
+	    END (*IF include*);
+
+	    (* In all cases, the special symbol just read should have	*)
+	    (* been some variety of "end version" marker.		*)
+
+	    IF code = EofSymbol THEN
+		EndOfMessage;
+		Message ("Error: section not terminated before end of file.");
+		EXIT (*LOOP*);
+	    END (*IF*);
+
+	END (*LOOP*);
+
+	RETURN code;
+
+    END Filter;
+
+(************************************************************************)
+
+PROCEDURE ConvertFile (VAR (*INOUT*) fin, fout: File;
+		KeepText: BOOLEAN;  VAR (*OUT*) changed: BOOLEAN): BOOLEAN;
+
+    (* Copies fin to fout, converting as directed by the embedded	*)
+    (* version control delimiters.  Returns FALSE if the operation	*)
+    (* stopped before end-of-file.					*)
+
+    BEGIN
+	ReadLine (fin, Buffer);  LinePlace := 0;
+	changed := FALSE;
+	TerminateEmptyLine := Buffer[0] = CHR(0);
+	SourceLength := MAX(CARDINAL);
+	BufferLoaded := TRUE;
+	IF Filter (fin, fout, KeepText, TRUE, changed) <> EofSymbol THEN
+	    EndOfMessage;
+	    Message ("Error: unmatched delimiter, entire file not read.");
+	    EndOfMessage;
+	    RETURN FALSE;
+	END (*IF*);
+	RETURN TRUE;
+    END ConvertFile;
+
+(************************************************************************)
+
+PROCEDURE ConvertAllFiles (KeepText: BOOLEAN);
+
+    (* Converts all files named in array FileName.  The original copies	*)
+    (* are renamed with a .BAK extension.				*)
+
+    VAR j: FileNumber;  success, changed: BOOLEAN;
+	tmpname, BAKname: ARRAY [0..127] OF CHAR;
+	dotplace: CARDINAL;
+	fin, fout: File;
+
+    BEGIN
+	IF LastFileNumber = 0 THEN RETURN END(*IF*);
+
+	FOR j := 1 TO LastFileNumber DO
+
+	    Message (FileName[j]);
+	    Message (": ");
+
+	    (* From the file name, obtain two derived names. *)
+
+	    CopyString (FileName[j], BAKname);
+	    dotplace := Pos (".", BAKname);
+	    IF dotplace > Length(BAKname) THEN
+		dotplace := Length(BAKname);
+		BAKname[dotplace] := ".";
+	    END (*IF*);
+	    BAKname[dotplace+1] := "B";
+	    BAKname[dotplace+2] := "A";
+	    BAKname[dotplace+3] := "K";
+	    BAKname[dotplace+4] := CHR(0);
+	    CopyString (BAKname, tmpname);
+	    tmpname[dotplace+1] := "$";
+	    tmpname[dotplace+2] := "$";
+	    tmpname[dotplace+3] := "$";
+
+	    (* Open the source file, and open a temporary file for	*)
+	    (* output.							*)
+
+	    success := TRUE;
+	    IF OpenFile (fin, FileName[j], FALSE) THEN
+		IF NOT OpenFile (fout, tmpname, TRUE) THEN
+		    Message ("can't create output file.");
+		    CloseFile (fin);
+		    success := FALSE;
+		END (*IF*);
+	    ELSE
+		Message ("missing input file ");
+		Message (FileName[j]);
+		success := FALSE;
+	    END (*IF*);
+
+	    IF success THEN
+
+		(* Perform the conversion. *)
+
+		success := ConvertFile (fin, fout, KeepText, changed);
+		CloseFile (fin);  CloseFile (fout);
+
+		IF success THEN
+
+		    IF changed THEN
+
+			(* Delete any existing .BAK file, and rename	*)
+			(* the input and output files.			*)
+
+			DeleteFile (BAKname);
+			RenameFile (FileName[j], BAKname);
+			RenameFile (tmpname, FileName[j]);
+			Message ("done");
+
+		    ELSE
+
+			(* File has not changed, so throw away the	*)
+			(* output file.					*)
+
+			DeleteFile (tmpname);
+			Message ("unchanged");
+
+		    END (*IF*);
+
+		END (*IF*);
+
+	    END (*IF*);
+	    EndOfMessage;
+
+	END (*FOR*);
+
+    END ConvertAllFiles;
+
+(************************************************************************)
+(*			LOADING THE SYMBOL TABLE			*)
+(************************************************************************)
+
+PROCEDURE SkipBlanks;
+
+    (* Moves LinePlace past any space or tab characters in Buffer. *)
+
+    CONST space = " ";  tab = CHR(9);
+
+    BEGIN
+	WHILE (LinePlace < HIGH(Buffer)) AND
+		((Buffer[LinePlace] = space) OR (Buffer[LinePlace] = tab)) DO
+	    INC (LinePlace);
+	END (*WHILE*);
+    END SkipBlanks;
+
+(************************************************************************)
+
+PROCEDURE ProcessAssignment;
+
+    (* Handles an assignment in the line buffer.  The assignment can be	*)
+    (* a single symbol (in which it is given the value "TRUE"), or it	*)
+    (* can be of the form    <symbol> := <expression>			*)
+
+    VAR symbol, result: ARRAY [0..31] OF CHAR;
+
+    BEGIN
+	Id (Buffer, LinePlace, symbol);
+	SkipBlanks;
+	IF (Buffer[LinePlace] = ":") AND (Buffer[LinePlace+1] = "=") THEN
+	    INC (LinePlace, 2);
+	    SkipBlanks;
+	    StringExpr (Buffer, LinePlace, result);
+	ELSE
+	    CopyString ("TRUE", result);
+	END (*IF*);
+	DefineSymbol (symbol, result);
+    END ProcessAssignment;
+
+(************************************************************************)
+
+PROCEDURE ProcessConfigurationFile(): BOOLEAN;
+
+    (* Processes the assignments in the configuration file PP.CFG, and	*)
+    (* loads the results into the symbol table.  Returns TRUE to	*)
+    (* indicate success.						*)
+
+    VAR f: File;
+
+    BEGIN
+	IF NOT OpenFile (f, "PP.CFG", FALSE) THEN
+	    Message ("Error: Can't find file PP.CFG");
+	    EndOfMessage;
+	    RETURN FALSE;
+	END (*IF*);
+
+	(* We process one line of input on each pass through this loop.	*)
+
+	LOOP
+	    IF EndOfFile (f) THEN
+		CloseFile (f);  RETURN TRUE;
+	    END (*IF*);
+	    ReadLine (f, Buffer);  LinePlace := 0;
+
+	    (* Leading white space is legal. *)
+
+	    SkipBlanks;
+
+	    (* A legal assignment should start with an alphanumeric. *)
+
+	    IF Buffer[LinePlace] IN AlphaNumerics THEN
+		ProcessAssignment;
+	    END (*IF*);
+
+	    (* Trailing white space is also legal. *)
+
+	    SkipBlanks;
+
+	    (* The only other thing that should be on the line is an	*)
+	    (* optional comment.  Comments start with "--".		*)
+
+	    IF NOT EndOfLine() AND ((Buffer[LinePlace] <> "-")
+					OR (Buffer[LinePlace+1] <> "-")) THEN
+		Message ("Error: illegal expression in PP.CFG");
+		EndOfMessage;
+		Message (Buffer);
+		EndOfMessage;
+		CloseFile (f);
+		RETURN FALSE;
+	    END (*IF*);
+
+	END (*LOOP*);
+
+    END ProcessConfigurationFile;
+
+(************************************************************************)
+(*		     LOADING THE LIST OF FILE NAMES			*)
+(************************************************************************)
+
+PROCEDURE GetFileNames(): BOOLEAN;
+
+    (* Reads a list of file names from the file PP.FIL.  Returns FALSE	*)
+    (* if the operation failed.						*)
+
+    VAR f: File;
+
+    BEGIN
+	IF NOT OpenFile (f, "PP.FIL", FALSE) THEN
+	    Message ("Error: Can't find file PP.FIL");
+	    EndOfMessage;
+	    RETURN FALSE;
+	END (*IF*);
+	LastFileNumber := 0;
+	
+	(* We process one line of input on each pass through this loop.	*)
+
+	LOOP
+	    IF EndOfFile (f) THEN
+		CloseFile (f);
+		IF LastFileNumber = 0 THEN
+		    Message ("Warning: no files to process.");
+		    EndOfMessage;
+		    RETURN FALSE;
+		ELSE
+		    RETURN TRUE;
+		END (*IF*);
+	    END (*IF*);
+
+	    INC (LastFileNumber);
+	    ReadLine (f, FileName[LastFileNumber]);
+
+	    (* Watch out for blank lines and comment lines. *)
+
+	    IF (FileName[LastFileNumber][0] = CHR(0))
+			OR ((FileName[LastFileNumber][0] = "-")
+			    AND (FileName[LastFileNumber][1] = "-")) THEN
+		DEC (LastFileNumber);
+	    END (*IF*);
+
+	END (*LOOP*);
+
+    END GetFileNames;
+
+(************************************************************************)
+(*			PARSING THE COMMAND LINE			*)
+(************************************************************************)
+
+PROCEDURE ParseCommandLine (VAR (*OUT*) KeepText: BOOLEAN): BOOLEAN;
+
+    (* Reads the command line and checks for the "suppress unused	*)
+    (* versions" flag.  Returns FALSE if there is something wrong with	*)
+    (* the command line.						*)
+
+    VAR str: ARRAY [0..31] OF CHAR;
+	arglen: CARDINAL;
+
+    BEGIN
+	CommandLine (1, str, arglen);
+	IF arglen = 0 THEN
+	    KeepText := TRUE;  RETURN TRUE;
+	END (*IF*);
+
+	(* An argument was present.  Only "S" or "s" are legal. *)
+
+	KeepText := (arglen <> 1) OR (CAP(str[0]) <> "S");
+
+	(* Check for two or more arguments. *)
+
+	CommandLine (2, str, arglen);
+	IF (arglen > 0) OR KeepText THEN
+	    Message ("Usage: PP [S]");
+	    EndOfMessage;
+	    RETURN FALSE;
+	END (*IF*);
+	RETURN TRUE;
+
+    END ParseCommandLine;
+
+(************************************************************************)
+(*			    MAIN PROGRAM				*)
+(************************************************************************)
+
+VAR KeepText: BOOLEAN;
+
+BEGIN
+    IF ParseCommandLine (KeepText) AND GetFileNames()
+		AND ProcessConfigurationFile() THEN
+	DumpSymbolTable;
+	ConvertAllFiles (KeepText);
+    END (*IF*);
+END PP.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/util/ppexpr.def b/examples/Modula-2_Libraries/PMOS/sources/util/ppexpr.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/util/ppexpr.def
@@ -0,0 +1,70 @@
+DEFINITION MODULE PPExpr;
+
+	(********************************************************)
+	(*							*)
+	(*	   Expression handler for preprocessor		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	2 August 1994			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+(************************************************************************)
+(* This module evaluates expressions consisting of alphanumeric symbols	*)
+(* connected by the operators:						*)
+(*	|   logical OR		&   logical AND		~   logical NOT	*)
+(*	=   string equality	<>  string inequality	()  parentheses	*)
+(* An expression consisting of one operand and no operators is		*)
+(* string-valued.  Any other expression has a Boolean result.  When a	*)
+(* string operand is used with any of the logical operators (including	*)
+(* parentheses) the string "T" is evaluated as TRUE, and anything else	*)
+(* is evaluated as FALSE.  When a Boolean is stored as a string, TRUE	*)
+(* is stored as "T" and FALSE is stored as "F".				*)
+(*									*)
+(* A string operand can consist of up to 32 characters, each of which	*)
+(* is a letter or digit.  Leading digits are legal.  The case of a	*)
+(* letter is significant.  When a value is assigned to a string operand	*)
+(* via procedure DefineSymbol, that operand becomes a variable, and	*)
+(* subsequent references to it will return the assigned value.  Any	*)
+(* other alphanumeric string will be considered to be a string literal.	*)
+(*									*)
+(* An expression may not contain embedded spaces.  (This restriction	*)
+(* is imposed because this module is used in an application where the	*)
+(* space character is needed as an expression terminator.)		*)
+(************************************************************************)
+
+PROCEDURE DefineSymbol (VAR (*IN*) symbol: ARRAY OF CHAR;
+					value: ARRAY OF CHAR);
+
+    (* Stores "value" as the value of variable "symbol".  The variable	*)
+    (* might or might not already exist in the symbol table.		*)
+
+PROCEDURE DumpSymbolTable;
+
+    (* Writes the current contents of the symbol table to the screen. *)
+
+(************************************************************************)
+(* In each of the following procedures, Place is updated on exit so	*)
+(* that Line[Place] is the first non-alphanumeric character found.	*)
+(************************************************************************)
+
+PROCEDURE Id (VAR (*IN*) Buffer: ARRAY OF CHAR;
+		VAR (*INOUT*) Place: CARDINAL;
+		VAR (*OUT*) result: ARRAY OF CHAR);
+
+    (* Picks up an alphanumeric string starting at Buffer[Place]. *)
+
+PROCEDURE Expr (VAR (*IN*) Buffer: ARRAY OF CHAR;
+		VAR (*INOUT*) Place: CARDINAL): BOOLEAN;
+
+    (* Evaluates a Boolean expression starting at Buffer[Place]. *)
+
+PROCEDURE StringExpr (VAR (*IN*) Buffer: ARRAY OF CHAR;
+		VAR (*INOUT*) Place: CARDINAL;
+		VAR (*OUT*) result: ARRAY OF CHAR);
+
+    (* Evaluates a string-valued expression starting at Buffer[Place]. *)
+
+END PPExpr.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/util/ppexpr.mod b/examples/Modula-2_Libraries/PMOS/sources/util/ppexpr.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/util/ppexpr.mod
@@ -0,0 +1,363 @@
+IMPLEMENTATION MODULE PPExpr;
+
+	(********************************************************)
+	(*							*)
+	(*	   Expression handler for preprocessor		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	9 February 1995			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	Could possibly be improved in terms of code	*)
+	(*	compactness and clarity; the present version	*)
+	(*	duplicates many code sections because of the	*)
+	(*	fact that we don't know in advance whether	*)
+	(*	we're dealing with a Boolean-valued result.	*)
+	(*							*)
+	(********************************************************)
+
+FROM PPMisc IMPORT
+    (* proc *)	StringMatch, CopyString, Message, EndOfMessage;
+
+(************************************************************************)
+
+TYPE
+    SymbolTableIndex = [0..50];
+    String = ARRAY [0..31] OF CHAR;
+    CharSet = SET OF CHAR;
+
+CONST
+    AlphaNumerics = CharSet {"A".."Z", "a".."z", "0".."9"};
+
+VAR
+    (* The symbol table is a table of string-valued variables.  In this	*)
+    (* application the table is likely always to be quite small, so we	*)
+    (* can get away with an unsorted table and a crude linear search.	*)
+    (* NextEntry is the location of the first unused entry.		*)
+
+    SymTable: ARRAY SymbolTableIndex OF
+		    RECORD
+			sym, val: String;
+		    END (*RECORD*);
+
+    NextEntry: SymbolTableIndex;
+
+(************************************************************************)
+(*			  SYMBOL TABLE HANDLING				*)
+(************************************************************************)
+
+PROCEDURE LocateSymbol (VAR (*IN*) symbol: ARRAY OF CHAR;
+			VAR (*OUT*) location: SymbolTableIndex): BOOLEAN;
+
+    BEGIN
+	location := 0;
+	LOOP
+	    IF location = NextEntry THEN
+	        RETURN FALSE;
+	    END (*IF*);
+	    IF StringMatch (symbol, SymTable[location].sym) THEN
+	        RETURN TRUE;
+	    END (*IF*);
+	    INC (location);
+	END (*LOOP*);
+    END LocateSymbol;
+
+(************************************************************************)
+
+PROCEDURE Lookup (VAR (*IN*) symbol: ARRAY OF CHAR;
+				VAR (*OUT*) value: ARRAY OF CHAR);
+
+    (* Gets the value of "symbol" from the symbol table.  If the symbol	*)
+    (* is not there, the result is the string value of "symbol" itself.	*)
+
+    VAR found: BOOLEAN;  place: SymbolTableIndex;
+
+    BEGIN
+	IF LocateSymbol (symbol, place) THEN
+	    CopyString (SymTable[place].val, value);
+	ELSE
+	    CopyString (symbol, value);
+	END (*IF*);
+    END Lookup;
+
+(************************************************************************)
+
+PROCEDURE DefineSymbol (VAR (*IN*) symbol: ARRAY OF CHAR;
+					value: ARRAY OF CHAR);
+
+    (* Stores "value" as the value of variable "symbol".  The variable	*)
+    (* might or might not already exist in the symbol table.		*)
+
+    VAR found: BOOLEAN;  place: SymbolTableIndex;
+
+    BEGIN
+	found := LocateSymbol (symbol, place);
+	IF NOT found THEN
+	    place := NextEntry;  INC(NextEntry);
+	    CopyString (symbol, SymTable[place].sym);
+	END (*IF*);
+	CopyString (value, SymTable[place].val);
+    END DefineSymbol;
+
+(************************************************************************)
+
+PROCEDURE DumpSymbolTable;
+
+    (* Writes the current contents of the symbol table to the screen. *)
+
+    VAR j: SymbolTableIndex;
+
+    BEGIN
+	IF NextEntry = 0 THEN
+	    Message ("Warning: No symbols currently defined");
+	ELSE
+	    Message ("LIST OF SYMBOLS CURRENTLY DEFINED");
+	    EndOfMessage;  EndOfMessage;
+	    FOR j := 0 TO NextEntry-1 DO
+		Message ("      ");
+		WITH SymTable[j] DO
+		    Message (sym);  Message (" = ");
+		    Message (val);
+		END (*WITH*);
+		EndOfMessage;
+	    END (*FOR*);
+	END (*IF*);
+	EndOfMessage;
+    END DumpSymbolTable;
+
+(************************************************************************)
+(*			  EXPRESSION EVALUATION				*)
+(*									*)
+(* In each of the following procedures, the source string starts at	*)
+(* Buffer[Place], Place is updated so that on exit Buffer[Place] is the	*)
+(* first non-alphanumeric character found.				*)
+(* Note: short-circuit evaluation is NOT used, since in all cases we	*)
+(* want to scan to the end of the input string.				*)
+(*									*)
+(************************************************************************)
+
+PROCEDURE Id (VAR (*IN*) Buffer: ARRAY OF CHAR;
+		VAR (*INOUT*) Place: CARDINAL;
+		VAR (*OUT*) result: ARRAY OF CHAR);
+
+    (* Picks up an alphanumeric string starting at Buffer[Place]. *)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	j := 0;
+	WHILE Buffer[Place] IN AlphaNumerics DO
+	    result[j] := Buffer[Place];
+	    INC (Place);  INC(j);
+	END (*WHILE*);
+	IF j <= HIGH(result) THEN
+	    result[j] := CHR(0);
+	END (*IF*);
+    END Id;
+
+(************************************************************************)
+
+PROCEDURE EvalId (VAR (*IN*) Buffer: ARRAY OF CHAR;
+		VAR (*INOUT*) Place: CARDINAL;
+		VAR (*OUT*) result: ARRAY OF CHAR);
+
+    (* Picks up and evaluates an alphanumeric string starting at	*)
+    (* Buffer[Place].  The difference between this procedure and Id is	*)
+    (* that Id returns the symbol literally, whereas this procedure	*)
+    (* returns the result of evaluating the string.			*)
+
+    VAR symbol: String;
+
+    BEGIN
+	Id (Buffer, Place, symbol);
+	Lookup (symbol, result);
+    END EvalId;
+
+(************************************************************************)
+
+PROCEDURE Factor (VAR (*IN*) Buffer: ARRAY OF CHAR;
+		VAR (*INOUT*) Place: CARDINAL): BOOLEAN;
+
+    (* Evaluates a Boolean expression consisting of a single identifier	*)
+    (* or an expression in parentheses.					*)
+
+    VAR NOTcount: CARDINAL;  value, value2: String;  result: BOOLEAN;
+
+    BEGIN
+	(* To evaluate "NOT" conditions, I can avoid recursion by	*)
+	(* simply waltzing my ~ until there are no more.		*)
+
+	NOTcount := 0;
+	WHILE Buffer[Place] = "~" DO
+	    INC (NOTcount);  INC(Place);
+	END (*WHILE*);
+
+	(* The remaining cases we have to handle are parenthesised	*)
+	(* expressions, comparisons, and simple identifiers.		*)
+
+	IF Buffer[Place] = "(" THEN
+	    INC (Place);
+	    result := Expr (Buffer, Place);
+	    IF Buffer[Place] = ")" THEN
+		INC (Place);
+	    ELSE
+		Message ("Error: Mismatched () in expression.");
+		EndOfMessage;
+	    END (*IF*);
+	ELSE
+	    EvalId (Buffer, Place, value);
+	    IF Buffer[Place] = "=" THEN
+		INC (Place);
+		EvalId (Buffer, Place, value2);
+	    ELSIF (Buffer[Place] = "<") AND (Buffer[Place+1] = ">") THEN
+		INC (Place, 2);
+		EvalId (Buffer, Place, value2);
+		INC (NOTcount);
+	    ELSE
+		CopyString ("TRUE", value2);
+	    END (*IF*);
+	    result := StringMatch (value, value2);
+	END (*IF*);
+
+	IF ODD (NOTcount) THEN result := NOT result END (*IF*);
+	RETURN result;
+
+    END Factor;
+
+(************************************************************************)
+
+PROCEDURE StringFactor (VAR (*IN*) Buffer: ARRAY OF CHAR;
+		VAR (*INOUT*) Place: CARDINAL;
+		VAR (*OUT*) result: ARRAY OF CHAR);
+
+    (* Evaluates a string-valued factor starting at Buffer[Place]. *)
+
+    VAR value2: String;
+
+    BEGIN
+	IF Buffer[Place] IN AlphaNumerics THEN
+
+	    (* We have a simple Id, or a comparison. *)
+
+	    EvalId (Buffer, Place, result);
+	    IF Buffer[Place] = "=" THEN
+		INC (Place);
+		EvalId (Buffer, Place, value2);
+		IF StringMatch (result, value2) THEN
+		    CopyString ("TRUE", result);
+		ELSE
+		    CopyString ("FALSE", result);
+		END (*IF*);
+	    ELSIF (Buffer[Place] = "<") AND (Buffer[Place+1] = ">") THEN
+		INC (Place, 2);
+		EvalId (Buffer, Place, value2);
+		IF StringMatch (result, value2) THEN
+		    CopyString ("FALSE", result);
+		ELSE
+		    CopyString ("TRUE", result);
+		END (*IF*);
+	    END (*IF*);
+
+	ELSE
+
+	    (* It's definitely a Boolean factor. *)
+
+	    IF Factor(Buffer,Place) THEN
+		CopyString ("TRUE", result);
+	    ELSE
+		CopyString ("FALSE", result);
+	    END (*IF*);
+
+	END (*IF*);
+
+    END StringFactor;
+
+(************************************************************************)
+
+PROCEDURE Term (VAR (*IN*) Buffer: ARRAY OF CHAR;
+		VAR (*INOUT*) Place: CARDINAL): BOOLEAN;
+
+    (* Evaluates a Boolean expression consisting of one or more factors	*)
+    (* connected by logical AND operations (indicated by "&").		*)
+
+    VAR result: BOOLEAN;
+
+    BEGIN
+	result := Factor (Buffer, Place);
+	WHILE Buffer[Place] = "&" DO
+	    INC (Place);
+	    result := Factor(Buffer,Place) AND result;
+	END (*WHILE*);
+	RETURN result;
+    END Term;
+
+(************************************************************************)
+
+PROCEDURE StringTerm (VAR (*IN*) Buffer: ARRAY OF CHAR;
+		VAR (*INOUT*) Place: CARDINAL;
+		VAR (*OUT*) result: ARRAY OF CHAR);
+
+    (* Evaluates a string-valued term starting at Buffer[Place]. *)
+
+    BEGIN
+	StringFactor (Buffer, Place, result);
+	IF Buffer[Place] = "&" THEN
+	    INC (Place);
+	    IF Expr(Buffer,Place) AND StringMatch(result,"TRUE") THEN
+		CopyString ("TRUE", result);
+	    ELSE
+		CopyString ("FALSE", result);
+	    END (*IF*);
+	END (*IF*);
+    END StringTerm;
+
+(************************************************************************)
+
+PROCEDURE Expr (VAR (*IN*) Buffer: ARRAY OF CHAR;
+		VAR (*INOUT*) Place: CARDINAL): BOOLEAN;
+
+    (* Evaluates a Boolean expression starting at Buffer[Place].	*)
+    (* On exit Place is updated so that Line[Place] is the first	*)
+    (* non-alphanumeric character found.				*)
+
+    VAR result: BOOLEAN;
+
+    BEGIN
+	result := Term (Buffer, Place);
+	WHILE Buffer[Place] = "|" DO
+	    INC (Place);
+	    result := Term(Buffer,Place) OR result;
+	END (*WHILE*);
+	RETURN result;
+    END Expr;
+
+(************************************************************************)
+
+PROCEDURE StringExpr (VAR (*IN*) Buffer: ARRAY OF CHAR;
+		VAR (*INOUT*) Place: CARDINAL;
+		VAR (*OUT*) result: ARRAY OF CHAR);
+
+    (* Evaluates a string-valued expression starting at Buffer[Place]. *)
+
+    BEGIN
+	StringTerm (Buffer, Place, result);
+	IF Buffer[Place] = "|" THEN
+	    INC (Place);
+	    IF Expr(Buffer,Place) OR StringMatch(result,"TRUE") THEN
+		CopyString ("TRUE", result);
+	    ELSE
+		CopyString ("FALSE", result);
+	    END (*IF*);
+	END (*IF*);
+    END StringExpr;
+
+(************************************************************************)
+
+VAR s: CHAR;
+
+BEGIN
+    NextEntry := 0;
+    s := "T";  DefineSymbol (s, "TRUE");
+    s := "F";  DefineSymbol (s, "FALSE");
+END PPExpr.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/util/ppmisc.def b/examples/Modula-2_Libraries/PMOS/sources/util/ppmisc.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/util/ppmisc.def
@@ -0,0 +1,115 @@
+DEFINITION MODULE PPMisc;
+
+	(********************************************************)
+	(*							*)
+	(*	Miscellaneous procedures for preprocessor.	*)
+	(*							*)
+	(*	The purpose of this module is to collect	*)
+	(*	together the compiler-dependent of the		*)
+	(*	preprocessor.  The module consists mostly	*)
+	(*	of file and string operations.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	4 August 1994			*)
+	(*  Status:		Working with FST, TopSpeed 1.17	*)
+	(*			   and TopSpeed 3.10		*)
+	(*							*)
+	(*  Rowley version is untested and probably wrong.	*)
+	(*							*)
+	(********************************************************)
+
+(*<FST|Rowley
+IMPORT FileSystem;
+>*)
+
+(*<TopSpeed*)
+IMPORT FIO;
+(*>*)
+
+TYPE File = (*<TopSpeed*) FIO.File; (*>*)
+	    (*<FST|Rowley FileSystem.File; >*)
+
+(************************************************************************)
+(*			   STRING OPERATIONS				*)
+(************************************************************************)
+
+PROCEDURE Length (s: ARRAY OF CHAR): CARDINAL;
+
+    (* Returns the length of string s. *)
+
+PROCEDURE StringMatch (s1, s2: ARRAY OF CHAR): BOOLEAN;
+
+    (* Returns TRUE iff the two strings are equal. *)
+
+PROCEDURE CopyString (src: ARRAY OF CHAR;  VAR (*OUT*) dst: ARRAY OF CHAR);
+
+    (* Copies src to dst. *)
+
+PROCEDURE Pos (pattern, string: ARRAY OF CHAR): CARDINAL;
+
+    (* If pattern is a substring of string, returns the index in	*)
+    (* string of the start of the first occurrence of pattern.  If	*)
+    (* no match then the value returned is beyond the end of string.	*)
+
+(************************************************************************)
+(*				TERMINAL I/O				*)
+(************************************************************************)
+
+PROCEDURE Message (mess: ARRAY OF CHAR);
+
+    (* Writes a string to the screen. *)
+
+PROCEDURE EndOfMessage;
+
+    (* Goes to the next line on the screen. *)
+
+PROCEDURE CommandLine (argNr: CARDINAL;  VAR (*OUT*) strg : ARRAY OF CHAR;
+					VAR (*OUT*) arglen : CARDINAL);
+
+    (* Picks up argument number argNr from the command line. *)
+
+(************************************************************************)
+(*			     FILE OPERATIONS				*)
+(************************************************************************)
+
+PROCEDURE OpenFile (VAR (*OUT*) f: File;  filename: ARRAY OF CHAR;
+						create: BOOLEAN): BOOLEAN;
+
+    (* Opens the file specified as "filename".  We open it for input if	*)
+    (* create=FALSE, or create a new file for output if create=TRUE.	*)
+    (* The function result indicates success.				*)
+
+    (* Warning: the code used for TopSpeed allocates file buffers on	*)
+    (* the assumption that we never have more than one input file and	*)
+    (* one output file open at any one time.				*)
+
+PROCEDURE CloseFile (VAR (*INOUT*) f: File);
+
+    (* Closes file f. *)
+
+PROCEDURE EndOfFile (VAR (*INOUT*) f: File): BOOLEAN;
+
+    (* Returns TRUE iff the end of file f has been reached. *)
+
+PROCEDURE WriteToFile (VAR (*INOUT*) f: File;
+				VAR (*IN*) str: ARRAY OF CHAR);
+
+    (* Writes a text string to file f. *)
+
+PROCEDURE TerminateLine (VAR (*INOUT*) f: File);
+
+    (* Writes an end-of-line to file f. *)
+
+PROCEDURE ReadLine (VAR (*INOUT*) f: File;  VAR (*OUT*) strg: ARRAY OF CHAR);
+
+    (* Reads a line of text from file f. *)
+
+PROCEDURE DeleteFile (name: ARRAY OF CHAR);
+
+    (* Deletes a file, if it exists.  The file must not be open. *)
+
+PROCEDURE RenameFile (originalname, newname: ARRAY OF CHAR);
+
+    (* Renames an existing file.  The file should not be open. *)
+
+END PPMisc.
diff --git a/examples/Modula-2_Libraries/PMOS/sources/util/ppmisc.mod b/examples/Modula-2_Libraries/PMOS/sources/util/ppmisc.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/util/ppmisc.mod
@@ -0,0 +1,283 @@
+IMPLEMENTATION MODULE PPMisc;
+
+	(********************************************************)
+	(*							*)
+	(*	Miscellaneous procedures for preprocessor.	*)
+	(*							*)
+	(*	The purpose of this module is to collect	*)
+	(*	together the compiler-dependent of the		*)
+	(*	preprocessor.  The module consists mostly	*)
+	(*	of file and string operations.			*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	15 March 1994			*)
+	(*  Status:		Working with FST, TopSpeed 1.17	*)
+	(*			   and TopSpeed 3.10		*)
+	(*							*)
+	(*  Rowley version is untested and probably wrong.	*)
+	(*							*)
+	(********************************************************)
+
+(*<FST
+IMPORT System, InOut, FileSystem, Directories, PPTextIO, Strings;
+>*)
+
+(*<Rowley
+IMPORT Environment, InOut, FileSystem, Directories, TextIO, Strings;
+>*)
+
+(*<TopSpeed*)
+IMPORT SYSTEM, FIO, IO, Lib, Str;
+(*>*)
+
+(************************************************************************)
+
+(*<TopSpeed*)
+
+(* Warning: the code used for TopSpeed allocates file buffers on the	*)
+(* assumption that we never have more than one input file and one	*)
+(* output file open at any one time.					*)
+
+VAR InFileBuffer, OutFileBuffer: ARRAY [1..2048+FIO.BufferOverhead] OF BYTE;
+(*>*)
+
+(************************************************************************)
+(*			   STRING OPERATIONS				*)
+(************************************************************************)
+
+PROCEDURE Length (s: ARRAY OF CHAR): CARDINAL;
+
+    (* Returns the length of string s. *)
+
+    BEGIN
+	RETURN (*<TopSpeed*) Str.Length(s); (*>*)
+	       (*<FST|Rowley Strings.Length(s); >*)
+    END Length;
+
+(************************************************************************)
+
+PROCEDURE StringMatch (s1, s2: ARRAY OF CHAR): BOOLEAN;
+
+    (* Returns TRUE iff the two strings are equal. *)
+
+    BEGIN
+	(*<FST RETURN (Strings.CompareStr (s1, s2) = 0); >*)
+	(*<TopSpeed*) RETURN (Str.Compare (s1, s2) = 0); (*>*)
+	(*<Rowley RETURN (Strings.Compare (s1, s2) = 0); >*)
+    END StringMatch;
+
+(************************************************************************)
+
+PROCEDURE CopyString (src: ARRAY OF CHAR; VAR (*OUT*) dst: ARRAY OF CHAR);
+
+    (* Copies src to dst. *)
+
+    BEGIN
+	(*<FST|Rowley Strings.Assign (src, dst); >*)
+	(*<TopSpeed*) Str.Copy (dst, src); (*>*)
+    END CopyString;
+
+(************************************************************************)
+
+PROCEDURE Pos (pattern, string: ARRAY OF CHAR): CARDINAL;
+
+    (* If pattern is a substring of string, returns the index in	*)
+    (* string of the start of the first occurrence of pattern.  If	*)
+    (* no match then the value returned is beyond the end of string.	*)
+
+    BEGIN
+	(*<FST|Rowley RETURN Strings.Pos (pattern, string); >*)
+	(*<TopSpeed*)
+	(* A trap for the unwary: note the order of the parameters. *)
+	RETURN Str.Pos (string, pattern);
+	(*>*)
+    END Pos;
+
+(************************************************************************)
+(*				TERMINAL I/O				*)
+(************************************************************************)
+
+PROCEDURE Message (mess: ARRAY OF CHAR);
+
+    (* Writes a string to the screen. *)
+
+    BEGIN
+	(*<FST|Rowley InOut.WriteString (mess); >*)
+	(*<TopSpeed*) IO.WrStr (mess); (*>*)
+    END Message;
+
+(************************************************************************)
+
+PROCEDURE EndOfMessage;
+
+    (* Goes to the next line on the screen. *)
+
+    BEGIN
+	(*<FST|Rowley InOut.WriteLn; >*)
+	(*<TopSpeed*) IO.WrLn; (*>*)
+    END EndOfMessage;
+
+(************************************************************************)
+
+PROCEDURE CommandLine (argNr: CARDINAL;  VAR (*OUT*) strg : ARRAY OF CHAR;
+					VAR (*OUT*) arglen : CARDINAL);
+
+    (* Picks up argument number argNr from the command line. *)
+
+(*<FST
+    BEGIN
+	System.GetArg (strg, arglen);
+    END CommandLine;
+>*)
+
+(*<TopSpeed*)
+    BEGIN
+	Lib.ParamStr (strg, argNr);
+	arglen := Str.Length (strg);
+    END CommandLine;
+(*>*)
+
+(*<Rowley
+    VAR OK : BOOLEAN;
+    BEGIN
+	Environment.GetArg (argNr, strg, OK);
+	IF NOT OK THEN
+	    arglen := 0;
+	ELSE
+	    arglen := Strings.Length (strg);
+	END;
+    END CommandLine;
+>*)
+
+(************************************************************************)
+(*			     FILE OPERATIONS				*)
+(************************************************************************)
+
+PROCEDURE OpenFile (VAR (*OUT*) f: File;  filename: ARRAY OF CHAR;
+						create: BOOLEAN): BOOLEAN;
+
+    (* Opens the file specified as "filename".  We open it for input if	*)
+    (* create=FALSE, or create a new file for output if create=TRUE.	*)
+    (* The function result indicates success.				*)
+
+    (*<TopSpeed*) VAR temp: BOOLEAN; (*>*)
+
+    BEGIN
+(*<TopSpeed*)
+	temp := FIO.IOcheck;  FIO.IOcheck := FALSE;
+	IF create THEN
+	    f := FIO.Create (filename);
+	ELSE
+	    f := FIO.Open (filename);
+	END (*IF*);
+	FIO.IOcheck := temp;
+	IF f < MAX(CARDINAL) THEN
+	    IF create THEN
+		FIO.AssignBuffer (f, OutFileBuffer);
+	    ELSE
+		FIO.AssignBuffer (f, InFileBuffer);
+	    END (*IF*);
+	    RETURN TRUE;
+	ELSE
+	    RETURN FALSE;
+	END (*IF*);
+(*>*)
+(*<FST|Rowley
+	FileSystem.Lookup (f, filename, create);
+	RETURN (f.res = FileSystem.done);
+>*)
+    END OpenFile;
+
+(************************************************************************)
+
+PROCEDURE CloseFile (VAR (*INOUT*) f: File);
+
+    (* Closes file f. *)
+
+    BEGIN
+	(*<FST|Rowley FileSystem.Close(f); >*)
+	(*<TopSpeed*) FIO.Close(f); (*>*)
+    END CloseFile;
+
+(************************************************************************)
+
+PROCEDURE EndOfFile (VAR (*INOUT*) f: File): BOOLEAN;
+
+    (* Returns TRUE iff the end of file f has been reached.		*)
+    (* Remark: in the TopSpeed case the library procedure FIO.EOF is	*)
+    (* inadequate for this purpose, because (a) it is only updated	*)
+    (* after a read, and (b) there is no feedback about WHICH file has	*)
+    (* reached its end.							*)
+
+    BEGIN
+	(*<FST|Rowley RETURN f.eof; >*)
+	(*<TopSpeed*) RETURN FIO.GetPos(f) >= FIO.Size(f); (*>*)
+    END EndOfFile;
+
+(************************************************************************)
+
+PROCEDURE WriteToFile (VAR (*INOUT*) f: File;
+				VAR (*IN*) str: ARRAY OF CHAR);
+
+    (* Writes a text string to file f. *)
+
+    BEGIN
+	(*<FST PPTextIO.WriteString (f, str); >*)
+	(*<Rowley TextIO.WriteString (f, str); >*)
+	(*<TopSpeed*) FIO.WrStr (f, str); (*>*)
+    END WriteToFile;
+
+(************************************************************************)
+
+PROCEDURE TerminateLine (VAR (*INOUT*) f: File);
+
+    (* Writes an end-of-line to file f. *)
+
+    BEGIN
+	(*<FST PPTextIO.WriteLn (f); >*)
+	(*<Rowley TextIO.WriteLn (f); >*)
+	(*<TopSpeed*) FIO.WrLn (f); (*>*)
+    END TerminateLine;
+
+(************************************************************************)
+
+PROCEDURE ReadLine (VAR (*INOUT*) f: File;  VAR (*OUT*) strg: ARRAY OF CHAR);
+
+    (* Reads a line of text from file f. *)
+
+    BEGIN
+	(*<FST PPTextIO.ReadString (f,strg); >*)
+	(*<Rowley TextIO.ReadString (f,strg);  TextIO.ReadLn (f); >*)
+	(*<TopSpeed*) FIO.RdStr (f,strg); (*>*)
+    END ReadLine;
+
+(************************************************************************)
+
+PROCEDURE DeleteFile (name: ARRAY OF CHAR);
+
+    (* Deletes a file, if it exists.  The file must not be open. *)
+
+    BEGIN
+	(*<FST|Rowley
+	Directories.Delete(name);
+	>*)
+	(*<TopSpeed*)
+	IF FIO.Exists(name) THEN FIO.Erase(name); END (*IF*);
+	(*>*)
+    END DeleteFile;
+
+(************************************************************************)
+
+PROCEDURE RenameFile (originalname, newname: ARRAY OF CHAR);
+
+    (* Renames an existing file.  The file should not be open. *)
+
+    BEGIN
+	(*<FST|Rowley Directories.Rename(originalname, newname); >*)
+	(*<TopSpeed*) FIO.Rename(originalname, newname); (*>*)
+    END RenameFile;
+
+(************************************************************************)
+
+END PPMisc.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/util/pptextio.def b/examples/Modula-2_Libraries/PMOS/sources/util/pptextio.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/util/pptextio.def
@@ -0,0 +1,39 @@
+DEFINITION MODULE PPTextIO;
+
+	(********************************************************)
+	(*							*)
+	(*	Extra file operations for preprocessor.		*)
+	(*	This module is needed only when using the	*)
+	(*	FST compiler - it adds some procedures which	*)
+	(*	are missing from the FST library.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	16 August 1994			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(*	N.B.  This is not in any sense a general-	*)
+	(*	purpose library module.  It merely implements	*)
+	(*	a small set of procedures for use by PP.	*)
+	(*							*)
+	(********************************************************)
+
+IMPORT FileSystem;
+
+TYPE File = FileSystem.File;
+
+PROCEDURE WriteString (VAR (*INOUT*) f: File;  str: ARRAY OF CHAR);
+
+    (* Sends the string to file f. *)
+
+PROCEDURE WriteLn (VAR (*INOUT*) f: File);
+
+    (* Writes an end-of-line marker to file f. *)
+
+PROCEDURE ReadString (VAR (*INOUT*) f: File;
+				VAR (*OUT*) str: ARRAY OF CHAR);
+
+    (* Reads from file f until end-of-line.  The line-terminating	*)
+    (* characters are not stored, we simply skip over them.		*)
+
+END PPTextIO.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/util/pptextio.mod b/examples/Modula-2_Libraries/PMOS/sources/util/pptextio.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/util/pptextio.mod
@@ -0,0 +1,73 @@
+IMPLEMENTATION MODULE PPTextIO;
+
+	(********************************************************)
+	(*							*)
+	(*	Extra file operations for preprocessor.		*)
+	(*	This module is needed only when using the	*)
+	(*	FST compiler - it adds some procedures which	*)
+	(*	are missing from the FST library.		*)
+	(*							*)
+	(*  Programmer:		P. Moylan			*)
+	(*  Last edited:	16 August 1994			*)
+	(*  Status:		Working				*)
+	(*							*)
+	(********************************************************)
+
+IMPORT FileSystem, ASCII;
+
+(************************************************************************)
+
+PROCEDURE WriteString (VAR (*INOUT*) f: File;  str: ARRAY OF CHAR);
+
+    (* Sends the string to file f. *)
+
+    VAR j: CARDINAL;
+
+    BEGIN
+	j := 0;
+	WHILE (j <= HIGH(str)) AND (str[j] <> CHR(0)) DO
+	    FileSystem.WriteChar (f, str[j]);
+	    INC (j);
+	END (*WHILE*);
+    END WriteString;
+
+(************************************************************************)
+
+PROCEDURE WriteLn (VAR (*INOUT*) f: File);
+
+    (* Writes an end-of-line marker to file f. *)
+
+    BEGIN
+	FileSystem.WriteChar (f, ASCII.EOL);
+    END WriteLn;
+
+(************************************************************************)
+
+PROCEDURE ReadString (VAR (*INOUT*) f: File;
+				VAR (*OUT*) str: ARRAY OF CHAR);
+
+    (* Reads from file f until end-of-line.  The line-terminating	*)
+    (* characters are not stored, we simply skip over them.  If the	*)
+    (* whole line won't fit in str, we read only what will fit.		*)
+
+    VAR j: CARDINAL;  ch: CHAR;
+
+    BEGIN
+	j := 0;
+	LOOP
+            IF f.eof OR (j > HIGH(str)) THEN EXIT(*LOOP*) END(*IF*);
+	    FileSystem.ReadChar(f, ch);
+	    IF (ch = ASCII.CtrlZ) OR (ch = ASCII.EOL) THEN
+		EXIT(*LOOP*)
+	    END(*IF*);
+	    str[j] := ch;  INC(j);
+	END (*LOOP*);
+	IF j <= HIGH(str) THEN
+	    str[j] := CHR(0);
+	END (*IF*);
+    END ReadString;
+
+(************************************************************************)
+
+END PPTextIO.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/util/settime.mod b/examples/Modula-2_Libraries/PMOS/sources/util/settime.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/util/settime.mod
@@ -0,0 +1,438 @@
+MODULE SetTime;
+
+	(****************************************************************)
+	(*								*)
+	(*		  Setting the real-time clock			*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	18 March 1995				*)
+	(*  Status:		Working					*)
+	(*	Note: no provision at present for setting the century;	*)
+	(*	this version of the program always sets the century	*)
+	(*	to 19.							*)
+	(*								*)
+	(****************************************************************)
+
+FROM SYSTEM IMPORT
+    (* type *)	BYTE;
+
+FROM TimeOfDay IMPORT
+    (* type *)	TimeRecord,
+    (* proc *)	ReadClock, SetClock, SetBinaryMode;
+
+FROM MiscPMOS IMPORT
+    (* proc *)	WriteCMOS;
+
+FROM Windows IMPORT
+    (* type *)	Window, Colour, FrameType, DividerType,
+    (* proc *)	OpenWindow, CloseWindow, WriteString, WriteChar,
+		SetCursor, EraseLine, Blink, ColourSwap;
+
+FROM NumericIO IMPORT
+    (* proc *)	WriteHexByte;
+
+FROM Lib IMPORT
+    (* proc *)	Dos;
+
+FROM Keyboard IMPORT
+    (* proc *)	InKey;
+
+FROM Timer IMPORT
+    (* proc *)	Sleep;
+
+FROM Semaphores IMPORT
+    (* type *)	Semaphore,
+    (* proc *)	CreateSemaphore, Wait, Signal;
+
+FROM TaskControl IMPORT
+    (* proc *)	CreateTask;
+
+FROM LowLevel IMPORT
+    (* proc *)	IANDB, IORB;
+
+FROM MiscPMOS IMPORT
+    (* type *)	RegisterPacket,
+    (* proc *)	EnterCriticalSection, LeaveCriticalSection;
+
+(************************************************************************)
+
+TYPE CharSet = SET OF CHAR;
+
+CONST
+    Nul = CHR(0);  Esc = CHR(27);
+    Digits = CharSet {'0'..'9'};
+
+TYPE
+    subscript = [0..8];
+    subset = SET OF subscript;
+
+VAR
+    (* LocalTime is the local copy of the time record, as we edit it.	*)
+    (* It is periodically updated from the "true" time supplied by	*)
+    (* module CMOS.  LTprotect gives critical section protection.	*)
+
+    LocalTime: TimeRecord;
+    LTprotect: Semaphore;
+
+    (* Many of the procedures in this module work as if LocalTime were	*)
+    (* an array of 9 bytes.  Variable 'protected' gives the array	*)
+    (* subscript of the entry which must not be automatically updated	*)
+    (* since it is being edited, and 'blinking' is the array subscript	*)
+    (* of the entry which should display as a blinking field.		*)
+
+    protected, blinking: subscript;
+
+    (* Window editwindow is shared among the display and editing	*)
+    (* procedures.  Semaphore ScreenAccess protects access to it.	*)
+
+    editwindow: Window;
+    ScreenAccess: Semaphore;
+
+(************************************************************************)
+(*			    SCREEN OPERATIONS				*)
+(************************************************************************)
+
+PROCEDURE LocateCursor (j: subscript;  VAR (*OUT*) row, column: CARDINAL);
+
+    (* Returns the screen coordinates of the place where LocalTime[j]	*)
+    (* is displayed.							*)
+
+    BEGIN
+	CASE j OF
+	    0:	row := 2;  column := 12;	(* ticks (not shown) *)
+	  |
+	    1:	row := 4;  column := 9;		(* seconds *)
+	  |
+	    2:	row := 4;  column := 6;		(* minutes *)
+	  |
+	    3:	row := 4;  column := 3;		(* hours *)
+	  |
+	    4:	row := 2;  column := 1;		(* day of week *)
+	  |
+	    5:	row := 3;  column := 3;		(* day of month *)
+	  |
+	    6:	row := 3;  column := 6;		(* month *)
+	  |
+	    7:	row := 3;  column := 9;		(* year *)
+	END (*CASE*);
+    END LocateCursor;
+
+(************************************************************************)
+
+PROCEDURE InitialDisplay;
+
+    BEGIN
+	SetCursor (editwindow, 2, 3);  WriteChar (editwindow, '=');
+	SetCursor (editwindow, 3, 5);  WriteString (editwindow, "/  /");
+	SetCursor (editwindow, 4, 5);  WriteString (editwindow, ":  :");
+    END InitialDisplay;
+
+(************************************************************************)
+(*	     PROCEDURES TO WORK ON A TIME RECORD AS AN ARRAY		*)
+(************************************************************************)
+
+PROCEDURE Get (VAR (*IN*) array: ARRAY OF BYTE;  j: subscript): BYTE;
+
+    (* Returns the j'th entry of array.	*)
+
+    BEGIN
+	RETURN array[j];
+    END Get;
+
+(************************************************************************)
+
+PROCEDURE Put (value: BYTE;  VAR (*OUT*) array: ARRAY OF BYTE;  j: subscript);
+
+    (* Stores value in array[j].	*)
+
+    BEGIN
+	array[j] := value;
+    END Put;
+
+(************************************************************************)
+(*		    TASK TO DISPLAY THE DATE AND TIME			*)
+(************************************************************************)
+
+PROCEDURE WriteDay (w: Window; dayinweek: BYTE);
+
+    (* Writes the name of the day *)
+
+    BEGIN
+	CASE ORD(dayinweek) OF
+	    1:	WriteString (w, "Mon");
+	  |
+	    2:	WriteString (w, "Tues");
+	  |
+	    3:	WriteString (w, "Wednes");
+	  |
+	    4:	WriteString (w, "Thurs");
+	  |
+	    5:	WriteString (w, "Fri");
+	  |
+	    6:	WriteString (w, "Satur");
+	  |
+	    7:	WriteString (w, "Sun");
+	  |
+	    ELSE
+		WriteHexByte (w, dayinweek);
+	END (*CASE*);
+	WriteString (w, "day");
+    END WriteDay;
+
+(************************************************************************)
+
+PROCEDURE ShowTime;
+
+    (* Continuously displays the time and date on the screen.	*)
+
+    VAR w: Window;  row, column: CARDINAL;
+	j: subscript;  value: BYTE;
+	copyoftime: TimeRecord;
+
+    BEGIN
+	LOOP
+	    Sleep (500);
+	    Wait (LTprotect);
+	    ReadClock (copyoftime);
+	    FOR j := 1 TO 7 DO
+		IF j <> protected THEN
+		    value := Get (copyoftime, j);
+		    Put (value, LocalTime, j);
+		    Wait (ScreenAccess);
+		    LocateCursor (j, row, column);
+		    SetCursor (editwindow, row, column);
+		    WriteHexByte (editwindow, value);
+		    IF j = blinking THEN
+			Blink (editwindow, row, column, 2);
+		    END (*IF*);
+		    IF j = 4 THEN
+			SetCursor (editwindow, row, column+3);
+			WriteDay (editwindow, value);
+			EraseLine (editwindow, 1);
+		    END (*IF*);
+		    Signal (ScreenAccess);
+		END (*IF*);
+	    END (*FOR*);
+	    Signal (LTprotect);
+	END (*LOOP*);
+    END ShowTime;
+
+(************************************************************************)
+(*			 EDITING THE DATE AND TIME			*)
+(************************************************************************)
+
+PROCEDURE CursorMovement (VAR (*INOUT*) j: subscript);
+
+    (* On entry, a Nul has already been read from the keyboard, so we	*)
+    (* presume that that was the start of an arrow-key code.  Adjusts	*)
+    (* the field number j appropriately.  Any keyboard code which makes	*)
+    (* no sense as a cursor movement is treated as a no-operation.	*)
+    (* To understand the cursor movements, note that the fields on the	*)
+    (* screen display are laid out in the form:				*)
+    (*		4		Looks strange, I know, but that's	*)
+    (*		5  6  7		a compromise between what CMOS returns	*)
+    (*		3  2  1		and the preferred human-readable form	*)
+
+    VAR ch: CHAR;
+
+    BEGIN
+	ch := InKey();
+	IF ch = "H" THEN				(* cursor up *)
+	    IF j IN subset {5,6,7} THEN j := 4
+	    ELSIF j<>4 THEN j := 8-j
+	    END (*IF*);
+	ELSIF ch = "P" THEN				(* cursor down *)
+	    IF j = 4 THEN INC(j)
+	    ELSIF j IN subset {5,6,7} THEN j := 8-j
+	    END (*IF*);
+	ELSIF ch = "M" THEN				(* cursor right *)
+	    IF j IN subset {5,6} THEN INC(j)
+	    ELSIF j IN subset {2,3} THEN DEC(j)
+	    END (*IF*);
+	ELSIF ch = "K" THEN				(* cursor left *)
+	    IF j IN subset {1,2} THEN INC(j)
+	    ELSIF j IN subset {6,7} THEN DEC(j)
+	    END (*IF*);
+	END (*IF*);
+    END CursorMovement;
+
+(************************************************************************)
+
+PROCEDURE WriteHighlighted (j: subscript;  value: BYTE);
+
+    (* Writes value on the screen, in reverse video, in the location	*)
+    (* reserved for field j.						*)
+
+    VAR row, column: CARDINAL;
+
+    BEGIN
+	LocateCursor (j, row, column);
+	Wait (ScreenAccess);
+	SetCursor (editwindow, row, column);
+	WriteHexByte (editwindow, value);
+	ColourSwap (editwindow, row, column, 2);
+	Signal (ScreenAccess);
+    END WriteHighlighted;
+
+(************************************************************************)
+(*			   EDITING PROCEDURES				*)
+(************************************************************************)
+
+PROCEDURE EditField (j: subscript;  ch: CHAR);
+
+    (* Edits field j, where the user has already typed character ch.	*)
+
+    VAR	value: BYTE;
+
+    BEGIN
+	protected := j;
+
+	(* Use ch to update the first digit of the current value. *)
+
+	value := IORB (IANDB (Get (LocalTime, j), 0FH),
+				BYTE (16*(ORD(ch)-ORD('0'))));
+	WriteHighlighted (j, value);
+
+	(* Now pick up and use the second digit. *)
+
+	ch := InKey();
+	IF ch IN Digits THEN
+	    value := IORB (IANDB (value, 0F0H), BYTE (ORD(ch)-ORD('0')));
+	    WriteHighlighted (j, value);
+	END (*IF*);
+
+	(* Update the master record of the time.  *)
+
+	Wait (LTprotect);
+	Put (value, LocalTime, j);
+	Put (0, LocalTime, 0);
+	SetClock (LocalTime);
+	Signal (LTprotect);
+
+	protected := 0;
+    END EditField;
+
+(************************************************************************)
+
+PROCEDURE Edit;
+
+    (* The master editing routine.  Allows the keyboard user to adjust	*)
+    (* the displayed date and time fields.				*)
+
+    VAR j: subscript;
+	row, col: CARDINAL;
+	ch: CHAR;
+
+    BEGIN
+	j := 4;
+	LOOP
+	    blinking := j;
+	    ch := InKey ();
+	    blinking := 0;
+	    IF ch = Esc THEN EXIT(*LOOP*)
+	    ELSIF ch IN Digits THEN EditField(j, ch)
+	    ELSIF ch = Nul THEN CursorMovement (j)
+	    END(*IF*);
+ 	END (*LOOP*);
+    END Edit;
+
+(************************************************************************)
+(*			SETTING THE MS-DOS DATE/TIME			*)
+(************************************************************************)
+
+PROCEDURE binary (BCDvalue: BYTE): CARDINAL;
+
+    (* Converts a BCD value to binary.	*)
+
+    VAR val: CARDINAL;
+
+    BEGIN
+	val := CARDINAL (BCDvalue);
+	RETURN 10*(val DIV 16) + val MOD 16;
+    END binary;
+
+(************************************************************************)
+
+PROCEDURE SetDosTime;
+
+    (* Sets the date and time kept by MS-DOS to agree with the values	*)
+    (* held by CMOS.  Note the important critical section problem: the	*)
+    (* operations of setting the date and setting the time are separate	*)
+    (* DOS functions, but of course we must do the setting in one	*)
+    (* indivisible operation to avoid a problem which can occur at	*)
+    (* midnight.							*)
+
+    VAR copyoftime: TimeRecord;
+	args: RegisterPacket;
+	savedPSW: CARDINAL;
+
+    BEGIN
+	ReadClock (copyoftime);
+	savedPSW := EnterCriticalSection();
+	WITH copyoftime DO
+	    WITH args DO
+		DH := BYTE(binary (month));
+		DL := BYTE(binary (dayofmonth));
+		CX := 100*binary(century) + binary(year);
+		AH := 43;	(* Set Date *)
+		AL := 0;
+	    END (*WITH*);
+	    Dos (args);
+	    WITH args DO
+		CH := BYTE(binary (hours));
+		CL := BYTE(binary (minutes));
+		DH := BYTE(binary (seconds));
+		DL := BYTE((25*binary(ticks) + 2) DIV 4);
+		AH := 45;	(* Set Time *)
+	    END (*WITH*);
+	    Dos (args);
+	END (*WITH*);
+	LeaveCriticalSection (savedPSW);
+    END SetDosTime;
+
+(************************************************************************)
+(*			     MAIN PROCEDURE				*)
+(************************************************************************)
+
+PROCEDURE SetTheClock;
+
+    VAR message: Window;
+
+    BEGIN
+	OpenWindow (message, blue, white, 5, 17, 14, 65, simpleframe,nodivider);
+	SetCursor (message, 1, 9);
+	WriteString (message, "Setting the CMOS real-time clock");
+	SetCursor (message, 2, 4);
+	WriteString (message,
+			"This version also sets the MS-DOS date/time");
+	SetCursor (message, 10, 13);
+	WriteString (message, "Use the Esc key to exit");
+
+	(* Temporary arrangement - the century field is constant.	*)
+
+	WriteCMOS (032H, 019H);
+	Put (019H, LocalTime, 8);
+
+	(* Now let the user do any modifications.	*)
+	
+	Edit;
+
+	CloseWindow (message);
+    END SetTheClock;
+
+(************************************************************************)
+(*			    INITIALIZATION				*)
+(************************************************************************)
+
+BEGIN
+    CreateSemaphore (ScreenAccess, 1);
+    CreateSemaphore (LTprotect, 1);
+    OpenWindow (editwindow, red, white, 9,14, 33,46, doubleframe, nodivider);
+    SetBinaryMode (FALSE);
+    protected := 0;  blinking := 0;
+    InitialDisplay;
+    CreateTask (ShowTime, 2, "Show time");
+    SetTheClock;
+    SetDosTime;
+END SetTime.
+
diff --git a/examples/Modula-2_Libraries/PMOS/sources/util/vidchk.mod b/examples/Modula-2_Libraries/PMOS/sources/util/vidchk.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/PMOS/sources/util/vidchk.mod
@@ -0,0 +1,483 @@
+MODULE VidChk;
+
+	(****************************************************************)
+	(*								*)
+	(*		    Test of PMOS graphics.			*)
+	(*								*)
+	(*	The purpose of this program is to list the graphics	*)
+	(*	modes which we believe are supported by PMOS on		*)
+	(*	the video adaptor in use when the program is run.	*)
+	(*								*)
+	(*  Programmer:		P. Moylan				*)
+	(*  Last edited:	18 March 1995				*)
+	(*  Status:		OK, still some room for improvement	*)
+	(*								*)
+	(****************************************************************)
+
+FROM Types IMPORT
+    (* proc *)	FarPointer, FarBytePointer;
+
+FROM Storage1 IMPORT
+    (* proc *)	ALLOCATE, DEALLOCATE;
+
+FROM LowLevel IMPORT
+    (* proc *)	OFFSET, SEGMENT, FarAddOffset;
+
+FROM MiscPMOS IMPORT
+    (* type *)	RegisterPacket,
+    (* proc *)	BIOS;
+
+FROM Screen IMPORT
+    (* const*)	HercGraphics,
+    (* type *)	VideoAdaptorType, ModeInfoType,
+    (* proc *)	VideoKind, Supported, VESAdriverPresent, GetModeInfo;
+
+FROM Graphics IMPORT
+    (* type *)	ColourType,
+    (* proc *)	SetMode, GraphicsOff, PlotLine,
+		ClippedString,	(* for testing it *)
+		PlotString, GetScreenShape, Fill;
+
+FROM Conversions IMPORT
+    (* proc *)	CardinalToString;
+
+FROM IO IMPORT
+    (* proc *)	RdKey;
+
+FROM GlassTTY IMPORT
+    (* proc *)	WriteChar, WriteString, WriteLn;
+
+(************************************************************************)
+
+CONST VideoInt = 16;
+
+TYPE
+    Mode = [0..511];
+    ModeSet = SET OF Mode;
+
+VAR
+    (* The kind of display adaptor which is installed. *)
+
+    AdaptorType: VideoAdaptorType;
+
+    (* Maximum X and Y, and maximum colour. *)
+
+    Xmax, Ymax: CARDINAL;
+    MaxColour: ColourType;
+
+(************************************************************************)
+
+PROCEDURE Abort(): BOOLEAN;
+
+    (* Waits until a key is struck on the keyboard, returns TRUE if	*)
+    (* the key was the Escape key.					*)
+
+    CONST Esc = CHR(01BH);
+
+    BEGIN
+	RETURN RdKey() = Esc;
+    END Abort;
+
+(************************************************************************)
+
+PROCEDURE YesNo(): BOOLEAN;
+
+    (* Waits for Y or N from keyboard; returns TRUE for Y, FALSE for N.	*)
+
+    VAR ch: CHAR;
+
+    BEGIN
+	LOOP
+	    ch := RdKey();
+	    IF CAP(ch) = 'Y' THEN
+		WriteChar ("Y");  RETURN TRUE;
+	    ELSIF CAP(ch) = 'N' THEN
+		WriteChar ("N");  RETURN FALSE;
+	    END (*IF*);
+	END (*LOOP*);
+    END YesNo;
+
+(************************************************************************)
+
+PROCEDURE ColourStrip (x0, y0, width, height: CARDINAL;  c0, c1: ColourType);
+
+    (* Displays a band, whose lower left is (x0,y0) and whose height	*)
+    (* is "height", of the colour range c0..c1.  Each coloured block is	*)
+    (* "width" pixels wide.						*)
+
+    VAR c: ColourType;
+
+    BEGIN
+	FOR c := c0 TO c1 DO
+	    Fill (x0, y0, x0+width-1, y0+height, c);
+	    INC (x0, width);
+	END (*FOR*);
+    END ColourStrip;
+
+(************************************************************************)
+
+PROCEDURE AssembleTitle (mode: Mode;  VAR (*OUT*) Title: ARRAY OF CHAR)
+								: CARDINAL;
+
+    (* Creates a title string for the given mode.  The function result	*)
+    (* is equal to the number of characters assembled.			*)
+
+    VAR StringBuffer: ARRAY [0..4] OF CHAR;
+	k: [0..4];  count: CARDINAL;
+
+    BEGIN
+	StringBuffer := "MODE ";
+	FOR k := 0 TO 4 DO
+	    Title[k] := StringBuffer[k];
+	END (*FOR*);
+	count := 5;
+	CardinalToString (mode, StringBuffer, 3);
+	FOR k := 0 TO 2 DO
+	    IF StringBuffer[k] <> " " THEN
+		Title[count] := StringBuffer[k];  INC (count);
+	    END (*IF*);
+	END (*FOR*);
+	Title[count] := " ";  INC (count);
+	Title[count] := " ";  INC (count);
+	CardinalToString (Xmax+1, StringBuffer, 4);
+	FOR k := 0 TO 3 DO
+	    IF StringBuffer[k] <> " " THEN
+		Title[count] := StringBuffer[k];  INC (count);
+	    END (*IF*);
+	END (*FOR*);
+	Title[count] := "x";  INC (count);
+	CardinalToString (Ymax+1, StringBuffer, 4);
+	FOR k := 0 TO 3 DO
+	    IF StringBuffer[k] <> " " THEN
+		Title[count] := StringBuffer[k];  INC (count);
+	    END (*IF*);
+	END (*FOR*);
+	Title[count] := "x";  INC (count);
+	IF MaxColour = MAX(CARDINAL) THEN
+	    StringBuffer := "65536";
+	ELSE
+	    CardinalToString (MaxColour+1, StringBuffer, 5);
+	END (*IF*);
+	FOR k := 0 TO 4 DO
+	    IF StringBuffer[k] <> " " THEN
+		Title[count] := StringBuffer[k];  INC (count);
+	    END (*IF*);
+	END (*FOR*);
+	RETURN count;
+    END AssembleTitle;
+
+(************************************************************************)
+
+PROCEDURE TestMode (m: Mode): BOOLEAN;
+
+    (* Displays a test pattern for mode m, waiting for the user to	*)
+    (* press a key before returning.  Returns TRUE if the key was the	*)
+    (* Esc key.								*)
+
+    VAR count: CARDINAL;  textcolour, c: ColourType;
+	Title: ARRAY [0..25] OF CHAR;
+	x0, x1, y0, y1, xgap, ygap, width, height, CharHeight: CARDINAL;
+
+	left, right, ymin, ymax: CARDINAL;	(* for testing ClippedString *)
+
+    BEGIN
+	(* Set the mode, and pick a display colour. *)
+
+	SetMode (m, TRUE);
+	GetScreenShape (Xmax, Ymax, MaxColour, CharHeight);
+	IF MaxColour >= 255 THEN textcolour := 3;
+	ELSE textcolour := MaxColour;
+	END (*IF*);
+
+	(* Put together a descriptive caption. *)
+
+	count := AssembleTitle (m, Title);
+
+	(* Put a band of colours across part of the screen. *)
+
+	IF MaxColour < Xmax THEN
+	    x0 := (Xmax+1) MOD (MaxColour+1) DIV 2;
+	    y0 := 3*Ymax DIV 4;
+	    width := (Xmax+1) DIV (MaxColour+1);
+	    height := Ymax DIV 8;
+	    ColourStrip (x0, y0, width, height, 0, MaxColour);
+	    IF width > 5 THEN
+		(* Put a frame around the black section. *)
+		PlotLine (x0,y0,x0+width-1,y0,1);
+		PlotLine (x0,y0+height,x0+width-1,y0+height,1);
+		PlotLine (x0,y0,x0,y0+height,1);
+	    END (*IF*);
+
+	END (*IF*);
+
+	(* Write the caption in the centre of the screen. *)
+
+	x0 := (Xmax - 8*count) DIV 2;
+	y0 := (Ymax - CharHeight) DIV 2;
+	PlotString (Title, x0, y0, count, textcolour);
+
+	(* If testing ClippedString: write the caption again, clipped. *)
+
+(*
+	INC (y0, 15);
+	left := x0;
+	right := x0 + 8*count - 3;
+	ymin := y0;
+	ymax := y0 + CharHeight - 1;
+	ClippedString (Title, x0, y0, count, textcolour,
+				left, right, ymin, ymax);
+*)
+	RETURN Abort();
+
+    END TestMode;
+
+(************************************************************************)
+
+PROCEDURE TestPatterns (S: ModeSet);
+
+    (* Displays a test pattern for every mode in S, waiting for the	*)
+    (* user to press a key in between tests.				*)
+
+    VAR j: Mode;
+
+    BEGIN
+	WriteString ("Press any key to start each test.");
+	IF NOT Abort() THEN
+	    j := 0;
+	    LOOP
+		IF j IN S THEN
+		    IF TestMode (j) THEN EXIT(*LOOP*) END(*IF*);
+		END (*IF*);
+		IF j = MAX(Mode) THEN EXIT(*LOOP*) END(*IF*);
+		INC (j);
+	    END (*LOOP*);
+	END (*IF*);
+    END TestPatterns;
+
+(************************************************************************)
+
+PROCEDURE ShowExtraModes;
+
+    (* Tells which SVGA modes are supported, and optionally displays a	*)
+    (* test pattern for each of them.					*)
+
+    VAR mode: Mode;  count: CARDINAL;  TextMode: BOOLEAN;
+	Title: ARRAY [0..26] OF CHAR;
+	ExtraModes: ModeSet;
+	info: ModeInfoType;
+
+    BEGIN
+	WriteString ("Your hardware appears to support the following ");
+	WriteString ("SVGA modes.");
+	WriteLn;
+	WriteString ("Of these, PMOS will support the graphics modes ");
+	WriteString ("with up to 65536 colours.");
+	WriteLn;  WriteLn;
+	ExtraModes := ModeSet {};
+	FOR mode := 20 TO MAX(Mode) DO
+	    IF Supported (mode) THEN
+		GetModeInfo (mode, info);
+		Xmax := info.MaxX;
+		Ymax := info.MaxY;
+		MaxColour := info.MaxColour;
+		TextMode := info.TextMode;
+
+		IF NOT TextMode THEN
+		    ExtraModes := ExtraModes + ModeSet {mode};
+		END (*IF*);
+		count := AssembleTitle (mode, Title);
+		Title[count] := CHR(0);
+		WriteString ("        ");  WriteString (Title);
+		IF TextMode THEN
+		    WriteString ("  text");
+		END (*IF*);
+		WriteLn;
+	    END (*IF*);
+	END (*FOR*);
+	IF ExtraModes = ModeSet {} THEN
+	    WriteString ("(No extra modes found)");
+	    WriteLn;
+	ELSE
+	    WriteLn;
+	    WriteString ("Do you want to display test patterns for these modes?");
+	    WriteString (" [Y/N] ");
+	    IF YesNo() THEN
+		WriteLn;
+		TestPatterns (ExtraModes);
+	    END (*IF*);
+	    GraphicsOff (TRUE);
+	END (*IF*);
+	WriteLn;
+    END ShowExtraModes;
+
+(************************************************************************)
+
+PROCEDURE ShowStandardModes;
+
+    (* Tells which standard (up to VGA) modes are supported, and	*)
+    (* optionally displays a test pattern for each of them.		*)
+
+    VAR StandardModes: ModeSet;
+
+    BEGIN
+	WriteString ("Under PMOS you should have the following ");
+	WriteString ("standard graphics modes available.");
+	WriteLn;  WriteLn;
+	StandardModes := ModeSet {};
+	IF AdaptorType = MDA THEN
+	    WriteString ("No graphics modes are supported.  Sorry.");
+	    WriteLn;
+	ELSIF AdaptorType = Hercules THEN
+	    WriteString ("   720 x 348 monochrome");  WriteLn;
+	    StandardModes := ModeSet {HercGraphics};
+	ELSE
+	    IF AdaptorType >= CGA THEN
+		WriteString ("      4     320 x 200 x   4");  WriteLn;
+		WriteString ("      5     320 x 200 monochrome");  WriteLn;
+		WriteString ("      6     640 x 200 monochrome");  WriteLn;
+		StandardModes := StandardModes + ModeSet {4..6};
+	    END (*IF*);
+	    IF AdaptorType >= EGA THEN
+		WriteString ("     13     320 x 200 x  16");  WriteLn;
+		WriteString ("     14     640 x 200 x  16");  WriteLn;
+		WriteString ("     15     640 x 350 monochrome");  WriteLn;
+		WriteString ("     16     640 x 350 x  16");  WriteLn;
+		StandardModes := StandardModes + ModeSet {13..16};
+	    END (*IF*);
+	    IF AdaptorType >= VGA THEN
+		WriteString ("     17     640 x 480 monochrome");  WriteLn;
+		WriteString ("     18     640 x 480 x  16");  WriteLn;
+		WriteString ("     19     320 x 200 x 256");  WriteLn;
+		StandardModes := StandardModes + ModeSet {17..19};
+	    END (*IF*);
+	    IF AdaptorType > VGA THEN
+		WriteLn;
+		WriteString ("(This does not include the SVGA modes, ");
+		WriteString ("which will be listed later.)");
+		WriteLn;
+	    END (*IF*);
+	END (*IF*);
+	WriteLn;
+	WriteString ("Do you want to display test patterns for these modes?");
+	WriteString (" [Y/N] ");
+	IF YesNo() THEN
+	    WriteLn;
+	    TestPatterns (StandardModes);
+	END (*IF*);
+	GraphicsOff (TRUE);
+	WriteLn;
+    END ShowStandardModes;
+
+(************************************************************************)
+
+PROCEDURE ReportOEMString;
+
+    (* Writes the OEM string from the VESA driver.	*)
+
+    TYPE CharPtr = FarBytePointer;
+
+    VAR Registers: RegisterPacket;
+	SysInfoPtr: POINTER TO
+			    RECORD
+				VesaSignature: ARRAY [0..3] OF CHAR;
+				VesaVersion: WORD;
+				OEM_OffsetString: CharPtr;
+				capabilities: LONGWORD;
+				ModeListPointer: FarPointer;
+				NumberOf64KBlocks: CARDINAL;
+				reserved: ARRAY [20..255] OF BYTE;
+			    END (*RECORD*);
+	pch: CharPtr;
+
+    (********************************************************************)
+
+    BEGIN
+	(* Call the VESA BIOS subfunction 0, which is supposed to	*)
+	(* return system information.					*)
+
+	NEW(SysInfoPtr);
+	WITH Registers DO
+	    AX := 4F00H;
+	    DI := OFFSET(SysInfoPtr);
+	    ES := SEGMENT(SysInfoPtr);
+	    BIOS(VideoInt,Registers);
+	END (*WITH*);
+
+	WriteLn;
+	WriteString ("The manufacturer identification from the");
+	WriteString (" VESA driver is:");
+	WriteLn;
+	pch := SysInfoPtr^.OEM_OffsetString;
+	WHILE pch^ <> BYTE(0) DO
+	    WriteChar (pch^);
+	    pch := FarAddOffset (pch, 1);
+	END (*WHILE*);
+	WriteLn;
+	DISPOSE (SysInfoPtr);
+
+    END ReportOEMString;
+
+(************************************************************************)
+
+PROCEDURE OpeningMessage;
+
+    (* Explains the purpose of the program, reports display adaptor	*)
+    (* type, and writes the OEM string from the VESA driver if present.	*)
+
+    BEGIN
+	GraphicsOff (TRUE);
+	WriteString ("This program shows which graphics modes ");
+	WriteString ("PMOS supports on your display adaptor.");
+	WriteLn;
+	WriteString ("PMOS classifies your adaptor as being of type: ");
+	CASE AdaptorType OF
+		MDA:	WriteString ("MDA");
+	  |
+		Hercules: WriteString ("Hercules");
+	  |
+		CGA:	WriteString ("CGA");
+	  |
+		EGA:	WriteString ("EGA");
+	  |
+		VGA:	WriteString ("VGA");
+	  |
+		SVGA:	WriteString ("SVGA");
+	  |
+		ATI:	WriteString ("ATI");
+	  |
+		S3:	WriteString ("S3");
+	  |
+		Trident: WriteString ("Trident");
+	END (*CASE*);
+	WriteLn;
+	IF VESAdriverPresent() THEN
+	    ReportOEMString;
+	ELSE
+	    WriteLn;
+	    WriteString ("No VESA driver was detected.");
+	    WriteLn;
+	END (*IF*);
+	WriteLn;
+    END OpeningMessage;
+
+(************************************************************************)
+(*				MAIN PROGRAM				*)
+(************************************************************************)
+
+VAR dummy: BOOLEAN;
+
+BEGIN
+    AdaptorType := VideoKind ();
+    OpeningMessage;
+    ShowStandardModes;
+    IF AdaptorType > VGA THEN
+	ShowExtraModes;
+    END (*IF*);
+    WriteString ("End of tests.");
+    WriteLn;
+    WriteString ("Press any key to exit.");
+    WriteLn;
+    dummy := Abort();
+    GraphicsOff (TRUE);
+END VidChk.
+
diff --git a/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/keytest/keytest.mod b/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/keytest/keytest.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/keytest/keytest.mod
@@ -0,0 +1,270 @@
+MODULE KeyTest;
+
+(*
+* This program will show which VT200 key is pressed
+* till the user types the sequence "quit" or "exit"
+*
+* The intended use of this program is to help in the setup of
+* PC emulation packages.
+* Users can use this to test which keys on the PC map to which VT200 keys.
+*)
+
+(* John Andrea, Jun.16/1991 *)
+
+FROM GetCharacter IMPORT Get, GetNoWait,
+                         SetPassallCharacterMode, UnSetPassallCharacterMode;
+
+FROM InOut IMPORT WriteString, WriteLn, WriteCard;
+
+VAR
+  c                :CHAR;
+  v                :CARDINAL;
+  quit, qui, qu, q :BOOLEAN;
+  exit, exi, ex, e :BOOLEAN;
+
+  esc, esc_openp,
+  esc_openp_ABCD,
+  esc_openp_16, esc_openp_16_tilde,
+  esc_openp_16_09, esc_openp_16_09_tilde,
+  esc_O, esc_O_LY                         :BOOLEAN;
+
+  digit_1, digit_2 :CHAR;
+
+  ctrl_names :ARRAY [0..31] OF ARRAY [0..3] OF CHAR;
+
+  (* ------------------------------------------------------------- *)
+  PROCEDURE SetupControls;
+  (* setup names for the control-characters *)
+  BEGIN
+      ctrl_names[00] := 'NUL'; (* null, control @ *)
+      ctrl_names[01] := 'SOH'; (* control A *)
+      ctrl_names[02] := 'STX'; (* control B *)
+      ctrl_names[03] := 'ETX'; (* control C *)
+      ctrl_names[04] := 'EOT'; (* control D *)
+      ctrl_names[05] := 'ENQ'; (* control E *)
+      ctrl_names[06] := 'ACK'; (* control F *)
+      ctrl_names[07] := 'BEL'; (* bell, control G *)
+      ctrl_names[08] := 'BS '; (* backspace, control H *)
+      ctrl_names[09] := 'HT '; (* tab, control I *)
+      ctrl_names[10] := 'LF '; (* line feed, control J *)
+      ctrl_names[11] := 'VT '; (* control K *)
+      ctrl_names[12] := 'FF '; (* form feed, control L *)
+      ctrl_names[13] := 'CR '; (* carriage return, control M *)
+      ctrl_names[14] := 'SO '; (* control N *)
+      ctrl_names[15] := 'SI '; (* control O *)
+      ctrl_names[16] := 'DLE'; (* control P *)
+      ctrl_names[17] := 'DC1'; (* control Q *)
+      ctrl_names[18] := 'DC2'; (* control R *)
+      ctrl_names[19] := 'DC3'; (* control S *)
+      ctrl_names[20] := 'DC4'; (* control T *)
+      ctrl_names[21] := 'NAK'; (* control U *)
+      ctrl_names[22] := 'SYN'; (* control V *)
+      ctrl_names[23] := 'ETB'; (* control W *)
+      ctrl_names[24] := 'CAN'; (* control X *)
+      ctrl_names[25] := 'EM '; (* control Y *)
+      ctrl_names[26] := 'SUB'; (* control Z *)
+      ctrl_names[27] := 'ESC'; (* escape, control [ *)
+      ctrl_names[28] := 'FS '; (* control \ *)
+      ctrl_names[29] := 'GS '; (* control ] *)
+      ctrl_names[30] := 'RS '; (* control ^ *)
+      ctrl_names[31] := 'US '; (* control _ *)
+  END SetupControls;
+
+  (* ------------------------------------------------------------- *)
+  PROCEDURE ShowSeq( string :ARRAY OF CHAR );
+  BEGIN
+     WriteString( 'that sequence corresponded to the ' );
+     WriteString( string );
+     WriteLn;
+  END ShowSeq;
+
+BEGIN (* KeyTest *)
+
+SetupControls;
+
+WriteLn;
+WriteString( 'KEYTEST begin, start hitting keys' ); WriteLn;
+WriteString( 'the program stops with the sequence' ); WriteLn;
+WriteString( 'quit OR exit' ); WriteLn;
+WriteLn;
+
+SetPassallCharacterMode;
+
+WHILE NOT ( quit OR exit ) DO
+
+   Get(c);     v := ORD( c );
+
+   WriteString( 'value:' ); WriteCard( v, 4 ); WriteString( ', ' );
+
+   IF ( c > ' ' ) & ( c <= '~' ) THEN
+     WriteString( 'the standard character: ' );
+     WriteString( c );
+   ELSIF c = ' 'THEN
+     WriteString( 'the SPACE character' );
+   ELSIF v = 127 THEN
+     WriteString( 'the DEL character' );
+   ELSIF ( v >= 0 ) & ( v <= 31 ) THEN
+     WriteString( 'the control character named: ');
+     WriteString( ctrl_names[v] );
+     WriteString( ' which is Control-' );
+     WriteString( CHR(v+64) );
+   ELSIF ( v >= 161 ) & ( v <= 253 ) THEN
+     WriteString( 'the compose character: ' );
+     WriteString( c );
+   ELSE
+     WriteString( 'unknown character' );
+   END;
+
+   WriteLn;
+
+   (* 5 chars *)
+   esc_openp_16_09_tilde := esc_openp_16_09 & ( c = '~' );
+
+   (* 4 chars *)
+   esc_openp_16_09       := esc_openp_16 & ( ( c >= '0' ) & ( c <= '9' ) );
+   esc_openp_16_tilde    := esc_openp_16 & ( c = '~' );
+
+   (* 3 chars *)
+   esc_openp_16          := esc_openp & ( ( c >= '1' ) & ( c <= '6' ) );
+   esc_openp_ABCD        := esc_openp & ( ( c >= 'A' ) & ( c <= 'D' ) );
+   esc_O_LY              := esc_O     & (( CAP(c) >= 'L' ) & ( CAP(c) <= 'Y' ));
+
+   (* 2 chars *)
+   esc_O                 := esc & ( c = 'O' );  (* thats an "oh" *)
+   esc_openp             := esc & ( c = '[' );
+
+   (* 1 char *)
+   esc                   := v = 27;
+
+   IF esc_openp_16 THEN
+     digit_1 := c;
+   END;
+
+   IF esc_openp_16_09 THEN
+     digit_2 := c;
+   END;
+
+   IF esc_O_LY THEN
+     IF    c = 'p' THEN
+       ShowSeq( 'KEYPAD 0' );
+     ELSIF c = 'q' THEN
+       ShowSeq( 'KEYPAD 1' );
+     ELSIF c = 'r' THEN
+       ShowSeq( 'KEYPAD 2' );
+     ELSIF c = 's' THEN
+       ShowSeq( 'KEYPAD 3' );
+     ELSIF c = 't' THEN
+       ShowSeq( 'KEYPAD 4' );
+     ELSIF c = 'u' THEN
+       ShowSeq( 'KEYPAD 5' );
+     ELSIF c = 'v' THEN
+       ShowSeq( 'KEYPAD 6' );
+     ELSIF c = 'w' THEN
+       ShowSeq( 'KEYPAD 7' );
+     ELSIF c = 'x' THEN
+       ShowSeq( 'KEYPAD 8' );
+     ELSIF c = 'y' THEN
+       ShowSeq( 'KEYPAD 9' );
+     ELSIF c = 'm' THEN
+       ShowSeq( 'KEYPAD MINUS' );
+     ELSIF c = 'l' THEN
+       ShowSeq( 'KEYPAD COMMA');
+     ELSIF c = 'n' THEN
+       ShowSeq( 'KEYPAD PERIOD' );
+     ELSIF c = 'M' THEN
+       ShowSeq( 'KEYPAD ENTER' );
+     ELSIF c = 'P' THEN
+       ShowSeq( 'PF1' );
+     ELSIF c = 'Q' THEN
+       ShowSeq( 'PF2' );
+     ELSIF c = 'R' THEN
+       ShowSeq( 'PF3' );
+     ELSIF c = 'S' THEN
+       ShowSeq( 'PF4' );
+     END;
+   END;
+
+   IF esc_openp_16_09_tilde THEN
+     IF    digit_1 = '1' THEN
+       IF    digit_2 = '7' THEN
+         ShowSeq( 'F6 key' );
+       ELSIF digit_2 = '8' THEN
+         ShowSeq( 'F7 key' );
+       ELSIF digit_2 = '9' THEN
+         ShowSeq( 'F8 key' );
+       END;
+     ELSIF digit_1 = '2' THEN
+       IF    digit_2 = '0' THEN
+         ShowSeq( 'F9 key' );
+       ELSIF digit_2 = '1' THEN
+         ShowSeq( 'F10 key' );
+       ELSIF digit_2 = '3' THEN
+         ShowSeq( 'F11 key' );
+       ELSIF digit_2 = '4' THEN
+         ShowSeq( 'F12 key' );
+       ELSIF digit_2 = '5' THEN
+         ShowSeq( 'F13 key' );
+       ELSIF digit_2 = '6' THEN
+         ShowSeq( 'F14 key' );
+       ELSIF digit_2 = '8' THEN
+         ShowSeq( 'HELP key' );
+       ELSIF digit_2 = '9' THEN
+         ShowSeq( 'DO key' );
+       END;
+     ELSIF digit_1 = '3' THEN
+       IF    digit_2 = '1' THEN
+         ShowSeq( 'F17 key' );
+       ELSIF digit_2 = '2' THEN
+         ShowSeq( 'F18 key' );
+       ELSIF digit_2 = '3' THEN
+         ShowSeq( 'F19 key' );
+       ELSIF digit_2 = '4' THEN
+         ShowSeq( 'F20 key' );
+       END;
+     END;
+   END;
+
+   IF esc_openp_16_tilde THEN
+     IF    digit_1 = '1' THEN
+        ShowSeq( 'FIND key' );
+     ELSIF digit_1 = '2' THEN
+        ShowSeq( 'INSERT HERE key' );
+     ELSIF digit_1 = '3' THEN
+        ShowSeq( 'REMOVE key' );
+     ELSIF digit_1 = '4' THEN
+        ShowSeq( 'SELECT key' );
+     ELSIF digit_1 = '5' THEN
+        ShowSeq( 'PREV SCREEN key' );
+     ELSIF digit_1 = '6' THEN
+        ShowSeq( 'NEXT SCREEN key' );
+     END;
+   END;
+
+   IF esc_openp_ABCD THEN
+     IF    c = 'A' THEN
+        ShowSeq( 'UP ARROW' );
+     ELSIF c = 'B' THEN
+        ShowSeq( 'DOWN ARROW' );
+     ELSIF c = 'C' THEN
+        ShowSeq( 'RIGHT ARROW' );
+     ELSIF c = 'D' THEN
+        ShowSeq( 'LEFT ARROW' );
+     END;
+   END;
+
+   c    := CAP( c );
+   quit := qui & ( c = 'T' );
+   qui  := qu  & ( c = 'I' );
+   qu   := q   & ( c = 'U' );
+   q    :=       ( c = 'Q' );
+   exit := exi & ( c = 'T' );
+   exi  := ex  & ( c = 'I' );
+   ex   := e   & ( c = 'X' );
+   e    :=       ( c = 'E' );
+END; (* while *)
+
+UnSetPassallCharacterMode;
+
+WriteLn; WriteString( 'KEYTEST finished' ); WriteLn;
+
+END KeyTest.
diff --git a/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/life/life.mod b/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/life/life.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/life/life.mod
@@ -0,0 +1,45 @@
+MODULE Life;
+
+(*
+  The program gets input from a file that contains
+  a first line of a file description ( any characters )
+  and a list of coordinates ( row , column ) for the first generation
+  of LIVE cells.
+*)
+(*
+  see: Computer Recreations Dept. in Oct.83 and March.84 Scientific American
+       and the original paper by Martin Gardner in
+            Mathematical Games, Scientific American, Oct. 1970
+*)
+(* The Game of Life, John Andrea, Oct.25/ 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+
+FROM InOut      IMPORT WriteString, WriteLn, OpenInput, CloseInput;
+FROM FileSystem IMPORT Done;
+FROM LifeModule IMPORT Genesis, PlayGod;
+
+
+BEGIN (* Life *)
+
+  WriteLn;
+  WriteString('What is the name of the coordinate file ? ');
+  OpenInput('.DAT');
+
+  IF Done() THEN
+
+     Genesis;
+
+     CloseInput;
+
+     PlayGod;
+
+  ELSE
+
+    WriteLn;
+    WriteString('No such file available !');
+    WriteLn;
+
+  END; (* if *)
+
+END Life.
diff --git a/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/life/lifemodul.def b/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/life/lifemodul.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/life/lifemodul.def
@@ -0,0 +1,93 @@
+DEFINITION MODULE LifeModule;
+
+(* objects needed by Life and life Editor programs *)
+(* J. Andrea, 1984 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+
+EXPORT QUALIFIED 
+    (* CONSTs *)
+    screen_row_min, screen_row_max, screen_col_min, screen_col_max,
+    title_row,      title_col,;
+    label_1_row,    label_1_col,  label_2_row, label_2_col,
+    menu_row,       menu_col,
+    q_row,          q_col,
+
+   (* TYPEs *)
+    LifeFunction, Generation,
+
+    (* VARs *)
+    ekg, all_dead,
+
+    (* PROCEDUREs *);
+    Genesis, Genesis2, PlayGod, ShowBirths, ShowGeneration;
+
+
+
+CONST
+G
+    screen_row_min = 2;      (* the coordinates of the playing field *)
+    screen_row_max = 23;
+    screen_col_min = 2;
+    screen_col_max = 50;
+
+    title_row = 4;
+    title_col = 55;
+
+
+    label_1_row =  8;        (* generation number *)
+    label_1_col = 55;
+    label_2_row = 10;        (* population size *)
+    label_2_col = 55;
+
+
+    menu_row = 17;           (* menu of options *)
+    menu_col = 55;
+
+    q_row = 21;              (* position for NEXT GENERATION question *)
+    q_col = 55;
+
+
+TYPE
+   LifeFunction = (dead,alive);
+   Generation = ARRAY [screen_row_min-1..screen_row_max+1] OF
+                ARRAY [screen_col_min-1..screen_col_max+1] OF LifeFunction;
+
+
+VAR
+   ekg       :ARRAY [dead..alive] OF CHAR;
+   all_dead  :Generation;
+
+
+
+
+    PROCEDURE Genesis;
+    (* read a set of coordinates (row,col) of positions that are to
+       be set to ALIVE positions *)
+
+
+
+
+    PROCEDURE Genesis2( VAR new :Generation; VAR population :CARDINAL );
+    (* read a set of coordinates (row,col) of positions that are to
+       be set to ALIVE positions *)
+    (* for MAKELIFE, no error reporting *)
+
+
+
+    PROCEDURE PlayGod;
+    (* play the game *)
+
+
+
+
+    PROCEDURE ShowBirths( new , old :Generation; VAR changes :CARDINAL);
+    (* show the difference between the two generations *)
+
+
+
+    PROCEDURE ShowGeneration( new :Generation );
+    (* put up a boundary and show the generation *)
+
+
+END LifeModule.
diff --git a/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/life/lifemodul.mod b/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/life/lifemodul.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/life/lifemodul.mod
@@ -0,0 +1,536 @@
+IMPLEMENTATION MODULE LifeModule;
+
+(* objects needed by Life and life Editor programs *)
+(* John Andrea, Nov.16/ 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM GetCharacter IMPORT Get, GetNoWait, StartGet, StopGet;
+
+FROM Conversions  IMPORT CardToString;
+
+FROM VeryScreen IMPORT Home, EraseScreen, EraseLine,
+                       PutCursor, CursorOn, PutString;
+
+FROM InOut IMPORT WriteString, WriteLn, WriteCard,
+                  ReadString,  ReadLn,  ReadCard, Read,
+                  OpenInput,   CloseInput, in;
+
+FROM FileSystem IMPORT Eof, File, Done, EOL;
+
+TYPE
+  GameType    = (conway,con_mod,fredkin,fred_mod,other);
+  Description = ARRAY [0..80] OF CHAR;
+
+VAR
+  row, col, population :CARDINAL;
+  c                    :CHAR;
+  game                 :GameType;
+  name                 :Description;
+  new, old             :Generation;
+
+    (* ---------------------------------------------------- *)
+    PROCEDURE Genesis;
+
+    (* read a set of coordinates (row,col) of positions that are to
+       be set to ALIVE positions *)
+
+    VAR
+      input_line                         :CARDINAL;
+      row_min, row_max, col_min, col_max :CARDINAL;
+
+    BEGIN (* Genesis *)
+
+      row_min := 1; row_max := screen_row_max - screen_row_min + 1;
+      col_min := 1; col_max := screen_col_max - screen_col_min + 1;
+
+      population := 0;
+
+      new := all_dead;
+
+      (* read off the file description at line # 1 *)
+      Read(c);
+      col := 0;
+      WHILE (c # EOL) & (col < 80) DO
+        name[col] := c;
+        col := col + 1;
+        Read(c);
+      END; (* while *)
+      name[col] := 0C;
+      ReadLn;
+
+      input_line := 2;
+
+      (* read in the coordinates *)
+      ReadCard(row);
+      WHILE NOT Eof(in) DO
+
+         ReadCard(col); ReadLn;
+
+         IF (row >= row_min) & (row <= row_max) THEN
+            row := row + screen_row_min - 1;
+         ELSE
+            WriteString('row out of range, input line #');
+            WriteCard(input_line,4); WriteLn;
+            WriteString('min row = '); WriteCard(row_min,3);
+            WriteString('max row = '); WriteCard(row_max,3); WriteLn;
+            row := screen_row_min;
+         END; (* if *)
+
+         IF (col >= col_min) & (col <= col_max) THEN
+            col := col + screen_col_min - 1;
+         ELSE
+            WriteString('col out of range, input line #');
+            WriteCard(input_line,4); WriteLn;
+            WriteString('min col = '); WriteCard(col_min,3);
+            WriteString('max col = '); WriteCard(col_max,3); WriteLn;
+            col := screen_col_min;
+         END; (* if *)
+
+         population   := population + 1;
+         new[row,col] := alive;
+
+         input_line := input_line + 1;
+         ReadCard(row);
+      END; (* while *)
+
+    END Genesis;
+
+    (* ---------------------------------------------------- *)
+    PROCEDURE Genesis2( VAR new :Generation; VAR population :CARDINAL);
+
+    (* read a set of coordinates (row,col) of positions that are to
+       be set to ALIVE positions *)
+    (* for MAKELIFE only, no error reporting *)
+
+    VAR
+      input_line                         :CARDINAL;
+      row_min, row_max, col_min, col_max :CARDINAL;
+
+    BEGIN (* Genesis *)
+
+      row_min := 1; row_max := screen_row_max - screen_row_min + 1;
+      col_min := 1; col_max := screen_col_max - screen_col_min + 1;
+
+      population := 0;
+
+      new := all_dead;
+
+      (* read off the file description at line # 1 *)
+      Read(c);
+      col := 0;
+      WHILE (c # EOL) & (col < 80) DO
+        name[col] := c;
+        col := col + 1;
+        Read(c);
+      END; (* while *)
+      name[col] := 0C;
+      ReadLn;
+
+      input_line := 2;
+      (* read in the coordinates *)
+      ReadCard(row);
+      WHILE NOT Eof(in) DO
+
+         ReadCard(col); ReadLn;
+
+         IF (row >= row_min) & (row <= row_max) THEN
+            row := row + screen_row_min - 1;
+         END; (* if *)
+
+         IF (col >= col_min) & (col <= col_max) THEN
+            col := col + screen_col_min - 1;
+         END; (* if *)
+
+         population   := population + 1;
+         new[row,col] := alive;
+
+         input_line   := input_line + 1;
+         ReadCard(row);
+
+      END; (* while *)
+
+    END Genesis2;
+
+
+    (* ----------------------------------------------------- *)
+    PROCEDURE ShowBirths( new, old :Generation; VAR changes :CARDINAL);
+
+    (* show the difference between the two generations *)
+
+    BEGIN (* ShowBirths *)
+
+       changes := 0;
+
+       (* run through the whole field *)
+
+       FOR row := screen_row_min TO screen_row_max DO
+          FOR col := screen_col_min TO screen_col_max DO
+
+              (* optimize screen updating, only change a position *)
+              (* if it needs changing                             *)
+
+              IF new[row,col] # old[row,col] THEN
+
+                 changes := changes + 1;
+                 PutString( ekg[new[row,col]], row, col );
+
+              END; (* if *)
+
+          END; (* for *) (* col *)
+       END; (* for *) (* row *)
+
+   END ShowBirths;
+
+    (* -------------------------------------------------- *)
+   PROCEDURE StartShow(name : Description);
+
+   (* put up the box and name *)
+
+   BEGIN (* StartShow *)
+
+      (* draw up a box around the playing field *)
+
+      FOR col := screen_col_min -1 TO screen_col_max +1 DO
+         PutString( '-', screen_row_min-1, col );
+         PutString( '-', screen_row_max+1, col );
+      END; (* for *)
+
+      FOR row := screen_row_min -1 TO screen_row_max +1 DO
+         PutString( '|', row, screen_col_min-1 );
+         PutString( '|', row, screen_col_max+1 );
+      END; (* for *)
+
+      (* put up the name *)
+      PutString( name, 1, 1 );
+
+   END StartShow;
+
+    (* ----------------------------------------------------- *)
+    PROCEDURE ShowGeneration( new :Generation );
+
+    (* put up a boundary and show the generation *)
+
+    VAR
+       screen_changes :CARDINAL;
+
+    BEGIN (* ShowGeneration *)
+
+      StartShow(name);
+
+      ShowBirths( new , all_dead , screen_changes );
+
+    END ShowGeneration;
+
+
+    (* ---------------------------------------------------- *)
+    PROCEDURE PlayGod;
+
+    (* keep generating new generations *)
+
+    TYPE
+       ContinueModes = ( step , go );
+
+    VAR
+      row, col     :CARDINAL;
+      god_function :ARRAY [0..17] OF LifeFunction; 
+                                               (* what to do with neighbours *)
+      diagnosis    :ARRAY [dead..alive] OF CARDINAL; (* convert it to cardinal *)
+
+      c              :CHAR;
+      generation     :CARDINAL;
+      number         :ARRAY [0..20] OF CHAR;
+      screen_changes :CARDINAL;
+
+      finished       :BOOLEAN;
+      mode           :ContinueModes;
+
+       (* --------------------------------------------------- *)
+       PROCEDURE GiveBirth;
+
+       (* make the next generation using the god_function *)
+
+       VAR
+         neighbours, naybor_row, naybor_col :CARDINAL;
+         new_population                     :CARDINAL;
+
+       BEGIN (* GiveBirth *)
+
+         new_population := 0;
+
+         (* run through the whole generation *)
+
+         FOR row := screen_row_min TO screen_row_max DO
+            FOR col := screen_col_min TO screen_col_max DO
+
+               neighbours := 0;
+
+               IF game = conway THEN
+
+                  FOR naybor_row := row-1 TO row+1 DO
+                     FOR naybor_col := col-1 TO col+1 DO
+                         IF old[naybor_row,naybor_col] = alive THEN
+                            neighbours := neighbours + 1;
+                         END; (* if *)
+                     END; (* for *) (* col *)
+                  END; (* for *) (* row *)
+
+                  IF old[row,col] = alive THEN
+                     (* remove itself if necessary *)
+                     neighbours := neighbours - 1;
+                  END; (* if *)
+                  neighbours := neighbours + diagnosis[old[row,col]]*9;
+
+                ELSIF game = con_mod THEN
+
+                  FOR naybor_row := row-1 TO row+1 DO
+                     FOR naybor_col := col-1 TO col+1 DO
+                         IF old[naybor_row,naybor_col] = alive THEN
+                            neighbours := neighbours + 1;
+                         END; (* if *)
+                     END; (* for *) (* col *)
+                  END; (* for *) (* row *)
+
+                  IF old[row,col] = alive THEN
+                     (* remove itself if necessary *)
+                     neighbours := neighbours - 1;
+                  END; (* if *)
+
+                ELSIF game = fredkin THEN
+
+                  IF old[row-1,col] = alive THEN
+                     neighbours := neighbours + 1;
+                  END; (* if *)
+
+                  IF old[row+1,col] = alive THEN
+                     neighbours := neighbours + 1;
+                  END; (* if *)
+
+                  IF old[row,col-1] = alive THEN
+                     neighbours := neighbours + 1;
+                  END; (* if *)
+
+                  IF old[row,col+1] = alive THEN
+                     neighbours := neighbours + 1;
+                  END; (* if *)
+
+                ELSE (* modified fredkin *)
+
+                  IF old[row-1,col-1] = alive THEN
+                     neighbours := neighbours + 1;
+                  END; (* if *)
+
+                  IF old[row+1,col-1] = alive THEN
+                     neighbours := neighbours + 1;
+                  END; (* if *)
+
+                  IF old[row-1,col+1] = alive THEN
+                     neighbours := neighbours + 1;
+                  END; (* if *)
+
+                  IF old[row+1,col+1] = alive THEN
+                     neighbours := neighbours + 1;
+                  END; (* if *)
+
+               END; (* if *)
+
+               IF god_function[neighbours] = alive THEN
+                  new[row,col]   := alive;
+                  new_population := new_population + 1;
+               ELSE
+                  new[row,col] := dead;
+               END; (* if *)
+
+            END; (* for *) (* col *)
+         END; (* for *) (* row *)
+
+         population := new_population;
+
+       END GiveBirth;
+
+       (* ----------------------------------------------- *)
+       PROCEDURE DrawScreen;
+       BEGIN (* DrawScreen *)
+
+          (* initialize the screen *)
+          Home; EraseScreen;
+
+          IF game = conway THEN
+             PutString('Conways Game Of Life',title_row,title_col);
+          ELSIF game = con_mod THEN
+             PutString('Modified Conways',title_row,title_col);
+          ELSIF game = fredkin THEN
+             PutString('Fredkins Game Of Life',title_row,title_col);
+          ELSE
+             PutString('Modified Fredkins',title_row,title_col);
+          END; (* if *)
+
+          StartShow(name);
+
+          PutString('generation:',label_1_row,label_1_col);
+          PutString('population:',label_2_row,label_2_col);
+
+          (* option for menu's *)
+          PutString('give <CR> for next',menu_row,menu_col);
+          PutString('Q to quit',menu_row+1,menu_col);
+          PutString('G to not ask again',menu_row+2,menu_col);
+
+       END DrawScreen;
+
+
+    BEGIN (* PlayGod *)
+
+      WriteLn;
+      WriteString('Which type of Life, Conway or Fredkin'); WriteLn;
+      WriteString('   or Modified Conway or Modified Fredkin'); WriteLn;
+      WriteString('( C or F or D or G ) ? ');
+      (* WriteString(' C or F ? '); *)
+      ReadString(c); ReadLn; c := CAP(c);
+      WHILE (c # 'C') & (c # 'F') & (c # 'D') & (c # 'G') DO
+         WriteLn;
+         WriteString('( C or F or D or G ) ? ');
+         ReadString(c); ReadLn; c := CAP(c);
+      END; (* while *)
+      WriteLn;
+
+      (* convert dead,alive to a CARDINAL for function arithmetic *)
+      diagnosis[dead]  := 0;
+      diagnosis[alive] := 1;
+
+      (* define the function to give life or death according to
+         the number of neighbours *)
+      FOR row := 0 TO 17 DO
+         god_function[row] := dead;
+      END; (* for *)
+
+      IF c = 'C' THEN
+         game             := conway;
+         god_function[3]  := alive;
+         god_function[11] := alive;
+         god_function[12] := alive;
+      ELSIF c = 'F' THEN
+         game             := fredkin;
+         god_function[1]  := alive;
+         god_function[3]  := alive;
+      ELSIF c = 'G' THEN
+         (* modified fredkin rules are the same as fredkin,
+            except that it uses the 4 diagonal elements    *)
+         game             := fred_mod;
+         god_function[1]  := alive;
+         god_function[3]  := alive;
+      ELSE
+         (* modified conway rules are the same as conway
+            except that it uses the odd/even rules *)
+         game             := con_mod;
+         god_function[1]  := alive;
+         god_function[3]  := alive;
+         god_function[5]  := alive;
+         god_function[7]  := alive;
+         god_function[9]  := alive;
+         god_function[11] := alive;
+         god_function[13] := alive;
+         god_function[17] := alive;
+      END; (* if *)
+
+      DrawScreen;
+
+      CursorOn( FALSE );
+
+      StartGet;
+
+      c              := ' ';
+      screen_changes := population;
+      generation     := 1;
+
+      (* run the game, until zero-population or user says Quit *)
+      mode := step;    finished := FALSE;
+
+      WHILE NOT finished DO
+
+          ShowBirths( new, old, screen_changes );
+
+          finished := ( population = 0 ) OR ( screen_changes = 0 );
+
+          (* generation number *)
+          CardToString( generation, 5, number );
+          PutString( number, label_1_row, label_1_col+12 );
+
+          (* population number *)
+          CardToString( population, 5, number );
+          PutString( number, label_2_row, label_2_col+12 );
+
+          IF NOT finished THEN
+             old := new;             (* flip generations *)
+
+             GiveBirth;
+             generation := generation + 1;
+
+             IF mode = step THEN
+               Get(c);
+               IF ( c = 'Q' ) OR ( c = 'q' ) THEN
+                  finished := TRUE;
+               ELSE
+                  IF ( c = 'G' ) OR ( c = 'g' ) THEN
+                     (* enter GO mode *)
+                     (* no more options for menu's *)
+                     PutCursor( menu_row,   menu_col ); EraseLine;
+                     PutCursor( menu_row+1, menu_col ); EraseLine;
+                     PutCursor( menu_row+2, menu_col ); EraseLine;
+                     mode := go;
+                     PutCursor( q_row, q_col ); EraseLine;
+                     PutString( 'press a character to stop', q_row, q_col);
+                  END; (* if *)
+               END; (* if *)
+
+             ELSE (* already in GO mode *)
+
+               GetNoWait(c);
+               IF c # 0C THEN
+                  (* return to step mode, and put back the option list *)
+                  mode := step;
+                  PutString('give <CR> for next',menu_row,menu_col);
+                  PutString('Q to quit',menu_row+1,menu_col);
+                  PutString('G to not ask again',menu_row+2,menu_col);
+                  PutCursor( q_row, q_col ); EraseLine;
+               END; (* if *)
+             END; (* if *)
+          END; (* if *)
+      END; (* while *)
+
+      StopGet;
+
+      (* finish up *)
+      PutCursor( menu_row,   menu_col );  EraseLine;
+      PutCursor( menu_row+1, menu_col );  EraseLine;
+      PutCursor( menu_row+2, menu_col );  EraseLine;
+
+      PutCursor( q_row, q_col );  EraseLine;
+
+      IF screen_changes = 0 THEN
+         PutString( 'population STABLE', menu_row, menu_col );
+      ELSE
+         IF population = 0 THEN
+            PutString( 'population EXTINCT', menu_row, menu_col );
+         ELSE
+            PutString( 'QUIT', menu_row, menu_col );
+         END; (* if *)
+      END; (* if *)
+
+      PutCursor( screen_row_max, 1 );  CursorOn( TRUE );
+
+    END PlayGod;
+
+
+BEGIN (* LifeModule *)
+
+(* make all of the old one DEAD *)
+FOR row := screen_row_min-1 TO screen_row_max+1 DO
+   FOR col := screen_col_min-1 TO screen_col_max+1 DO
+      all_dead[row,col] := dead;
+   END; (* for *) (* col *)
+END; (* for *) (* row *)
+
+(* what the dead and alive elements look like *)
+ekg[dead]  := ' ';
+ekg[alive] := '*';
+
+END LifeModule.
diff --git a/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/life/makelife.mod b/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/life/makelife.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/life/makelife.mod
@@ -0,0 +1,517 @@
+MODULE MakeLife;
+
+(* this is a coordinate editor for Life files *)
+(* editor idea from Jerry MacGillivray *)
+
+(* John Andrea, Nov.16/1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM VeryScreen IMPORT Home, PutCursor, PutString,
+                       EraseScreen,  EraseLine, CursorOn;
+
+FROM InOut IMPORT WriteString, WriteLn,
+                  ReadString,  ReadLn,  ReadCard, Read,
+                  OpenInput,   CloseInput, in ,out;
+
+FROM FileSystem IMPORT Eof, File, Done, EOL;
+
+FROM Conversions IMPORT CardToString;
+
+FROM GetCharacter IMPORT Get, SetNoPassallCharacterMode,
+                             UnSetNoPassallCharacterMode;
+
+FROM TextIO IMPORT Write, OpenOutput, Close, WriteCard;
+
+FROM LifeModule IMPORT screen_row_min, screen_row_max,
+                       screen_col_min, screen_col_max,
+                       title_row,      title_col,
+                       label_1_row,    label_1_col,
+                       label_2_row,    label_2_col,
+                       menu_row,       menu_col,
+                       q_row,          q_col, 
+                       LifeFunction,   Generation,
+                       ekg,            all_dead,
+                       Genesis2,       ShowGeneration, ShowBirths;
+
+TYPE
+   SelectOption = (quit,exit,continue);
+   MotionStatus = (ok,stopped,none);
+
+VAR
+  births                 :Generation;
+  population             :CARDINAL;
+  row, col               :CARDINAL;
+  last_row, last_col     :CARDINAL;
+  actual_row, actual_col :CARDINAL;
+  temp_row,   temp_col   :CARDINAL;
+  save_file              :File;
+  option                 :SelectOption;
+  c, last_dir            :CHAR;
+  row_center, col_center :CARDINAL;
+  move_status            :MotionStatus;
+  changes                :CARDINAL;
+   
+   (* -------------------------------------------- *)
+   PROCEDURE Bell;
+
+   CONST 
+      bell = 7C;
+
+   BEGIN (* Bell *)
+
+      Write(out,bell); WriteLn;
+
+   END Bell;
+
+
+    (* ----------------------------------------------- *)
+    PROCEDURE DrawScreen;
+
+    BEGIN (* DrawScreen *)
+
+      Home; EraseScreen;
+
+      ShowGeneration(births);
+
+      (* title *)
+      PutString( 'Life Editor',             title_row, title_col );
+      PutString( 'use keypad numbers as directions', title_row+2, title_col+1 );
+      PutString( '5 ="flip value of cell"', title_row+3, title_col+1 );
+      PutString( '0 =move to last pos',     title_row+4, title_col+1 );
+      PutString( '. + dir move to border',  title_row+5, title_col+1 );
+
+      (* option for menu's *)
+      PutString( 'E to exit',         menu_row,   menu_col );
+      PutString( 'Q to quit',         menu_row+1, menu_col );
+      PutString( 'W to redraw',       menu_row+2, menu_col );
+      PutString( 'L + dir for line',  menu_row+3, menu_col );
+      PutString( 'A + dir for alive', menu_row+4, menu_col );
+      PutString( 'S + dir to shift',  menu_row+5, menu_col );
+
+    END DrawScreen;
+
+    (* ----------------------------------------------- *)
+    PROCEDURE Shift( row_move, col_move :INTEGER );
+
+    VAR
+      temp_1, temp_2 :Generation; (* hold the current one *)
+      move           :CARDINAL;
+      row, col       :CARDINAL;
+
+    BEGIN (* Shift *)
+
+      move := CARDINAL(ABS(row_move));
+      IF row_move > 0 THEN
+
+         temp_1 := all_dead;
+
+         (* don't move the columns *)
+         FOR col := screen_col_min TO screen_col_max DO
+            (* move down *)
+            FOR row := screen_row_min TO screen_row_max-move DO
+                temp_1[row+move,col] := births[row,col];
+            END; (* for *)
+         END; (* for *)
+
+      ELSIF row_move < 0 THEN
+
+         temp_1 := all_dead;
+
+         (* don't move the columns *)
+         FOR col := screen_col_min TO screen_col_max DO
+            (* move up *)
+            FOR row := screen_row_min+move TO screen_row_max DO
+                temp_1[row-move,col] := births[row,col];
+            END; (* for *)
+         END; (* for *)
+
+      ELSE
+         temp_1 := births;
+      END; (* if *)
+
+      move := CARDINAL(ABS(col_move));
+
+      IF col_move > 0 THEN
+
+         temp_2 := all_dead;
+
+         (* don't move the rows *)
+         FOR row := screen_row_min TO screen_row_max DO
+            (* move right *)
+            FOR col := screen_col_min TO screen_col_max-move DO
+               temp_2[row,col+move] := temp_1[row,col];
+            END; (* for *) (* col *)
+         END; (* for *) (* row *)
+
+      ELSIF col_move < 0 THEN
+
+         temp_2 := all_dead;
+
+         (* don't move the rows *)
+         FOR row := screen_row_min TO screen_row_max DO
+            (* move left *)
+            FOR col := screen_col_min+move TO screen_col_max DO
+               temp_2[row,col-move] := temp_1[row,col];
+            END; (* for *) (* col *)
+         END; (* for *) (* row *)
+
+      ELSE
+         temp_2 := temp_1;
+      END; (* if *)
+
+      ShowBirths( temp_2, births, changes );
+
+      births := temp_2;
+
+    END Shift;
+
+    (* ---------------------------------------- *)
+    PROCEDURE Center;
+
+    VAR
+      row, col                         :CARDINAL;
+      min_row, min_col                 :CARDINAL;
+      max_row, max_col                 :CARDINAL;
+      temp_row_center, temp_col_center :CARDINAL;
+      row_diff, col_diff               :INTEGER;
+
+    BEGIN (* Center *)
+
+      min_col := screen_col_max;
+      max_col := screen_col_min;
+      FOR row := screen_row_min TO screen_row_max DO
+
+         col := screen_col_min;
+         WHILE (col < screen_col_max) & (births[row,col] = dead) DO
+           col := col + 1;
+         END; (* while *)
+         IF col < min_col THEN
+            min_col := col;
+         END; (* if *)
+
+         col := screen_col_max;
+         WHILE (col > screen_col_min) & (births[row,col] = dead) DO
+           col := col - 1;
+         END; (* while *)
+         IF col > max_col THEN
+            max_col := col;
+         END; (* if *)
+
+      END; (* for *) (* row *)
+
+      min_row := screen_row_max;
+      max_row := screen_row_min;
+      FOR col := screen_col_min TO screen_col_max DO
+
+         row := screen_row_min;
+         WHILE (row < screen_row_max) & (births[row,col] = dead) DO
+           row := row + 1;
+         END; (* while *)
+         IF row < min_row THEN
+            min_row := row;
+         END; (* if *)
+
+         row := screen_row_max;
+         WHILE (row > screen_row_min) & (births[row,col] = dead) DO
+           row := row - 1;
+         END; (* while *)
+         IF row > max_row THEN
+            max_row := row;
+         END; (* if *)
+
+      END; (* for *) (* col *)
+
+      temp_row_center := ((max_row - min_row) DIV 2) + min_row;
+      temp_col_center := ((max_col - min_col) DIV 2) + min_col;
+
+      row_diff := INTEGER(temp_row_center) - INTEGER(row_center);
+      col_diff := INTEGER(temp_col_center) - INTEGER(col_center);
+
+      Shift( -row_diff, -col_diff );
+
+    END Center;
+
+    (* ----------------------------------------------------- *)
+    PROCEDURE Motion( direction :CHAR );
+    BEGIN (* Motion *)
+
+       move_status := ok;
+
+       CASE direction OF
+     '1' :
+         IF (row >= screen_row_max) OR (col <= screen_col_min) THEN
+           Bell;
+           move_status := stopped;
+         ELSE
+           row := row + 1;
+           col := col - 1;
+         END;
+    |'2' :
+         IF row >= screen_row_max THEN
+            Bell;
+            move_status := stopped;
+         ELSE
+            row := row + 1;
+         END;
+    |'3' :
+         IF (row >= screen_row_max) OR (col >= screen_col_max) THEN
+           Bell;
+           move_status := stopped;
+         ELSE
+           row := row + 1;
+           col := col + 1;
+         END;
+    |'4' :
+         IF col <= screen_col_min THEN
+           Bell;
+           move_status := stopped;
+         ELSE
+           col := col - 1;
+         END;
+    |'6' :
+         IF col >= screen_col_max THEN
+           Bell;
+           move_status := stopped;
+         ELSE
+           col := col + 1;
+         END;
+    |'7' :
+         IF (row <= screen_row_min) OR (col <= screen_col_min) THEN
+           Bell;
+           move_status := stopped;
+         ELSE
+           row := row - 1;
+           col := col - 1;
+         END;
+    |'8' :
+         IF row <= screen_row_min THEN
+           Bell;
+           move_status := stopped;
+         ELSE
+           row := row - 1;
+         END;
+    |'9' :
+         IF (row <= screen_row_min) OR (col >= screen_col_max) THEN
+           Bell;
+           move_status := stopped;
+         ELSE
+           row := row - 1;
+           col := col + 1;
+         END;
+     ELSE
+         Bell;
+         move_status := none;
+     END; (* case *)
+
+    END Motion;
+
+    (* ------------------------------------------------ *)
+    PROCEDURE Flip;
+
+    (* flip the value of the current cell *)
+
+    BEGIN (* Flip *)
+
+       IF births[row,col] = alive THEN
+          PutString( ekg[dead], row, col );
+          births[row,col] := dead;
+          population := population - 1;
+       ELSE
+          PutString( ekg[alive], row, col );
+          births[row,col] := alive;
+          population := population + 1;
+       END;
+
+    END Flip;
+
+
+    (* ------------------------------------------------ *)
+    PROCEDURE NoFlip;
+
+    (* make the current cell alive *)
+
+    BEGIN (* NoFlip *)
+
+       IF births[row,col] = dead THEN
+          PutString( ekg[alive], row, col );
+          births[row,col] := alive;
+          population := population + 1;
+       END;
+
+    END NoFlip;
+
+
+BEGIN (* MakeLife *)
+
+(* center of the screen *)
+row_center := ((screen_row_max - screen_row_min) DIV 2) + screen_row_min;
+col_center := ((screen_col_max - screen_col_min) DIV 2) + screen_col_min;
+
+WriteLn;
+WriteString('Do you want to edit an existing coordinate file ? ');
+Read(c); ReadLn;
+IF CAP(c) = 'Y' THEN
+  WriteLn;
+  WriteString('What is the name of the coordinate file ? ');
+  OpenInput('.DAT');
+  Genesis2( births, population );
+  CloseInput;
+END; (* if *)
+
+DrawScreen;
+
+row      := row_center;  col      := col_center;
+last_row := row;         last_col := col;
+last_dir := ' ';
+
+PutCursor( row, col);
+
+SetNoPassallCharacterMode;
+
+option := continue;
+
+WHILE option = continue DO
+
+  Get(c);
+
+  CASE c OF
+'.' :  (* goto border, using next direction *)
+     Get(c);
+
+     CASE c OF
+     '1' :
+          row := screen_row_max;
+          col := screen_col_min;
+    |'2' :
+          row := screen_row_max;
+    |'3' :
+          row := screen_row_max;
+          col := screen_col_max;
+    |'4' :
+          col := screen_col_min;
+    |'5' :
+          row := row_center;
+          col := col_center;
+    |'6' :
+          col := screen_col_max;
+    |'7' :
+          row := screen_row_min;
+          col := screen_col_min;
+    |'8' :
+          row := screen_row_min;
+    |'9' :
+          row := screen_row_min;
+          col := screen_col_max;
+     ELSE
+       Bell;
+     END; (* case *)
+
+|'0' : (* goto last position *)
+     temp_row := row;         temp_col := col;
+     row := last_row;         col := last_col;
+     last_row := temp_row;    last_col := temp_col;
+
+|'1'..'4','6'..'9' :
+     last_row := row;         last_col := col;
+     last_dir := c;
+     Motion(c);
+
+|'5' :
+     Flip;
+     (* Motion(last_dir); *)
+
+| 'E','e' :     (* exit *)
+     option := exit;
+
+| 'Q','q' :     (* quit *)
+     option := quit;
+
+| 'W','w' : (* redraw *)
+     DrawScreen;
+
+| 'L','l' : (* draw a line *)
+     Get(c);
+     WHILE move_status = ok DO
+       Flip;
+       Motion(c);
+     END; (* while *)
+
+| 'A','a' : (* draw a line , always alive *)
+     Get(c);
+     WHILE move_status = ok DO
+       NoFlip;
+       Motion(c);
+     END; (* while *)
+
+| 'S','s' : (* move the whole thing *)
+     Get(c);
+     CASE c OF
+     '1' :
+          Shift(1,-1)
+    |'2' :
+          Shift(1,0)
+    |'3' :
+          Shift(1,1)
+    |'4' :
+          Shift(0,-1)
+    |'5' : (* center it *)
+          Center;
+    |'6' :
+          Shift(0,1)
+    |'7' :
+          Shift(-1,-1)
+    |'8' :
+          Shift(-1,0)
+    |'9' :
+          Shift(-1,1)
+     ELSE
+       Bell;
+     END; (* case *) (* shift *)
+
+  ELSE (* case *)
+     Bell;
+     PutCursor( row, col );
+  END; (* case *)
+
+  PutCursor( row, col );
+  move_status := ok;
+
+END; (* while *)
+
+UnSetNoPassallCharacterMode;
+
+PutCursor( 23, 1 ); WriteLn;
+
+IF option = exit THEN
+   WriteLn;
+   WriteString('What will be the name of the coordinate file ? ');
+   OpenOutput(save_file,'.DAT');
+
+   (* read off the file description at line # 1 *)
+   WriteLn; WriteString('input a description'); WriteLn;
+   Read(c);
+   col := 0;
+   WHILE (c # EOL) & (col < 80) DO
+      Write(save_file,c);
+      col := col + 1;
+      Read(c);
+   END; (* while *)
+   Write(save_file,EOL);
+   ReadLn;
+
+   (* put the screen coordinates into the file *)
+   FOR row := screen_row_min TO screen_row_max DO
+      actual_row := row - screen_row_min + 1;
+      FOR col := screen_col_min TO screen_col_max DO
+         actual_col := col - screen_col_min + 1;
+         IF births[row,col] = alive THEN
+            WriteCard(save_file,actual_row,3);
+            Write(save_file,' ');
+            WriteCard(save_file,actual_col,3);
+            Write(save_file,EOL);
+         END; (* if *)
+      END; (* for *) (* col *)
+   END; (* for *) (* row *)
+END;
+
+END MakeLife.
diff --git a/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/text-tools/countwords.mod b/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/text-tools/countwords.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/text-tools/countwords.mod
@@ -0,0 +1,319 @@
+MODULE CountWords;
+
+(* 
+ * input a file of characters and break the file into a single list
+ * of sorted words to be output to another file
+ *
+ * and keep track of the number of times that each one occurs
+ *
+ * words have no punctuation, and case is ignored
+ *
+ * questions ? should words be broken at underscores
+ *           ? should punctuation become separate words
+ *
+*)
+
+(* V1.0, J.Andrea, June 1985 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM InOut      IMPORT OpenInput, OpenOutput, CloseInput, CloseOutput,
+                       Read, ReadString, ReadLn, ReadCard,
+                       Write, WriteString, WriteLn, WriteCard,
+                       EOL, Done, in, out;
+
+FROM FileSystem IMPORT Eof;
+
+FROM Storage    IMPORT ALLOCATE, DEALLOCATE;
+
+CONST
+   null = 0C;
+
+TYPE
+   String  = ARRAY [0..132] OF CHAR;
+
+   TriePtr = POINTER TO Trie;
+   Trie    = RECORD
+               key         : CHAR;
+               first_child : TriePtr;
+               sibling     : TriePtr;
+               CASE bottom : BOOLEAN OF
+                  TRUE : word_count : CARDINAL;
+               END; (* case *)
+             END; (* record *)
+
+VAR
+   input_word_count, output_word_count : CARDINAL;
+   alpha                               : TriePtr; (* the very top of the tree*)
+
+   max_count, min_count : CARDINAL;
+
+   (* ----------------------------------------------------------- *)
+   PROCEDURE Initialize;
+   BEGIN (* Initalize *)
+
+     input_word_count  := 0;
+     output_word_count := 0;
+
+     NEW(alpha); (* define the very top of the tree *)
+     alpha^.key         := '@';  (* it has no value *)
+     alpha^.first_child := NIL;   (* no children YET *)
+     alpha^.sibling     := NIL;   (* and cannot have any sisters *)
+
+   END Initialize;
+
+   (* ----------------------------------------------------------- *)
+   PROCEDURE InputWords;
+   (*
+    * use ReadString to input each word (separated by blanks) and put
+    * each word into a trie-tree character by char
+   *)
+
+   VAR
+      word : String;
+      len  : CARDINAL;
+
+      (* -------------------------------------------------------- *)
+      PROCEDURE AddWordToTree;
+      (* put this word into the tree *)
+
+      VAR
+        p, parent, save : TriePtr;
+        i               : CARDINAL;
+        c               : CHAR;
+        new_word        : BOOLEAN;
+
+      BEGIN (* AddWordToTree *)
+
+        p := alpha;    new_word := FALSE;
+
+        FOR i := 0 TO LEN(word) DO
+
+           c := word[i];
+           (* make the words case-independent. uppercase them *)
+           IF ( c >= 'a' ) & ( c <= 'z' ) THEN c := CAP(c); END;
+
+           parent := p;   p := parent^.first_child;
+
+           (* does this parent have any children *)
+           IF p = NIL THEN
+
+              (* no children, this is the first child, so add it *)
+              new_word := TRUE;
+              NEW(p);
+              parent^.first_child := p;
+              p^.key         := c;
+              p^.first_child := NIL;
+              p^.sibling     := NIL;
+
+           ELSE
+
+              (* check all the children for this character *)
+
+              (* keep it sorted *)
+              save := p;
+              WHILE ( p # NIL ) & ( p^.key < c ) DO
+                save := p;
+                p := p^.sibling;
+              END; (* while *)
+
+              (* was it found *)
+              IF p = NIL THEN
+                 (* no, add the new char at the end of the list *)
+                 new_word := TRUE;
+                 NEW(p);
+                 save^.sibling  := p;
+                 p^.key         := c;
+                 p^.first_child := NIL;
+                 p^.sibling     := NIL;
+              ELSE
+                 IF p^.key # c THEN
+                    (* no, insert the char between two existing ones *)
+                    IF p = parent^.first_child THEN
+                       (* the current char must go before the first *)
+                       new_word := TRUE;
+                       NEW(p);
+                       p^.sibling          := parent^.first_child;
+                       parent^.first_child := p;
+                       p^.key              := c;
+                       p^.first_child      := NIL;
+                    ELSE
+                       new_word := TRUE;
+                       NEW(p);
+                       p^.sibling     := save^.sibling;  (* switch points *)
+                       save^.sibling  := p;
+                       p^.key         := c;
+                       p^.first_child := NIL;
+                    END; (* if *)
+                 ELSE
+                 END; (* if *)
+              END; (* if *)
+
+           END; (* if *)
+
+        END; (* for *)
+
+        (* at bottom of list *)
+        IF new_word THEN
+           p^.bottom     := TRUE;
+           p^.word_count := 1;
+        ELSE
+           p^.word_count := p^.word_count + 1;
+        END; (* if *)
+           
+      END AddWordToTree;
+
+      (* ------------------------------------------------------- *)
+      PROCEDURE ReadProperWord;
+      (*
+       * words are delemited by control-chars, spaces and punctuation
+      *)
+
+      VAR
+         c : CHAR;
+         i : CARDINAL;
+
+         (* ------------------------------------------------------- *)
+         PROCEDURE AlphaNumeric( c : CHAR ) : BOOLEAN;
+         VAR cap : CHAR;
+         BEGIN (* AlphaNumeric *)
+           cap := CAP(c);
+           RETURN ( ( cap >= 'A' ) & ( cap <= 'Z' ) )
+               OR ( ( c   >= '0' ) & ( c   <= '9' ) )
+         END AlphaNumeric;
+
+      BEGIN (* ReadProperWord *)
+
+         (* skip special chars *)
+         Read(c);
+         WHILE ( NOT Eof(in) ) & ( NOT AlphaNumeric(c) ) DO
+            Read(c);
+         END; (* while *)
+
+         i := 0;
+         WHILE ( NOT Eof(in) ) & ( AlphaNumeric(c) ) DO
+            word[i] := c;
+            i := i + 1;  Read(c);
+         END; (* while *)
+         word[i] := null;
+
+      END ReadProperWord;
+
+   BEGIN (* InputWords *)
+
+       ReadProperWord;
+       WHILE NOT Eof(in) DO
+           input_word_count := input_word_count + 1;
+           len := LEN(word);
+           IF len > 0 THEN
+              AddWordToTree;
+           END; (* if *)
+           ReadProperWord;
+       END; (* while *)
+
+   END InputWords;
+
+   (* ----------------------------------------------------------- *)
+   PROCEDURE OutputWords;
+
+   (*
+    * do char by char output of the tree into a new file to show
+    * each unique word
+   *)
+
+    VAR
+       output_word : String;
+       i           : CARDINAL;
+       save        : TriePtr;
+
+      (* ------------------------------------------------------- *)
+      PROCEDURE PrintTree( parent : TriePtr ; level : CARDINAL );
+      (* output the contents of the tree *)
+
+      BEGIN (* PrintTree *)
+
+         (* is there a character at this node *)
+         IF parent = NIL THEN
+
+            IF ( save^.word_count >= min_count ) &
+               ( save^.word_count <= max_count ) THEN
+
+               (* this must be the bottom of a word *)
+
+               output_word[level] := null;
+               output_word_count  := output_word_count + 1;
+
+               WriteCard( save^.word_count, 6 ); 
+               WriteString( ' ' );
+               WriteString( output_word );
+               WriteLn;
+
+            END; (* if *)
+
+         ELSE
+
+            (* do all the children at this same level *)
+            WHILE parent # NIL DO
+
+               output_word[level] := parent^.key;
+
+               save := parent;
+               (* go down another level *)
+               PrintTree( parent^.first_child , level+1 );
+
+               (* back at this same level *)
+               parent := parent^.sibling;
+  
+            END; (* while *)
+
+         END; (* if *)
+
+      END PrintTree;
+
+   BEGIN (* OutputWords *)
+
+       PrintTree(alpha^.first_child,0);
+
+   END OutputWords;
+
+BEGIN (* CountWords *)
+
+   Initialize;
+
+   WriteLn;
+   WriteString('For the text of words');
+   OpenInput('.TXT');
+
+   InputWords;
+
+   CloseInput;   
+
+   WriteLn;
+   WriteString('     There are '); WriteCard(input_word_count,6);
+   WriteString(' words in the input file.'); WriteLn;
+
+   max_count := 0;   min_count := 0;
+
+   WriteLn;
+   WriteString('What is the minimum limit for word count ? ');
+   ReadCard(min_count); ReadLn;
+   WriteLn;
+   WriteString('What is the maximum limit for word count ? ');
+   ReadCard(max_count); ReadLn;
+
+   IF max_count = 0 THEN max_count := 65000 END;
+
+   WriteLn;
+   WriteString('For the single list of words');
+   OpenOutput('.OUT');
+
+   OutputWords;
+
+   CloseOutput;
+
+   WriteLn;
+   WriteString('     And '); WriteCard(output_word_count,6);
+   WriteString(' unique words in the output file.');
+
+   WriteLn;   WriteLn;
+
+END CountWords.
diff --git a/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/text-tools/kwic.mod b/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/text-tools/kwic.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/text-tools/kwic.mod
@@ -0,0 +1,450 @@
+MODULE Kwic;
+
+(* A keyword-in-context program *)
+
+(* V1.0, J.Andrea, July 85 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+(* 
+*  find the input string in a text file and show the line on which
+*  it occured in the output file, with the line number --- many times too
+*
+*  the line consists of a number of characters before and after the string
+*    -- this size is input by the user
+*
+*  the line buffer is implemented with the use of a circular linked list
+*   with a pointer to the start, and a pointer to the position at which
+*   the string search is being performed
+*
+*  the input string is converted to uppercase and the search is performed
+*   on uppercase only
+*
+*)
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+
+FROM InOut   IMPORT OpenInput, OpenOutput, CloseInput, CloseOutput,
+                    Read, ReadLn, ReadCard,
+                    WriteString, WriteLn, WriteCard,
+                    in, out, EOL;
+
+FROM FileSystem IMPORT Eof, Name;
+
+
+CONST
+    null  = 0C;
+    blank = ' ';
+
+    abs_max_string_size = 132 DIV 2;
+    abs_max_buffer      = 132 - 2;
+
+TYPE
+    String = ARRAY [0..abs_max_string_size] OF CHAR;
+
+VAR
+    input_line_number : CARDINAL;
+    match_count       : CARDINAL;
+
+    string            : String;
+    string_size       : CARDINAL;
+
+    buffer_size       : CARDINAL;
+
+    input_file_name   : String;
+
+    i                 : CARDINAL;
+
+   (* --------------------------------------------------------- *)
+   PROCEDURE UpperCase( c : CHAR ) : CHAR;
+   BEGIN (* *)
+     IF ( c >= 'a' ) & ( c <= 'z' ) THEN
+        RETURN CAP(c);
+     ELSE
+        RETURN c;
+     END; (* if *)
+   END UpperCase;
+
+   (* --------------------------------------------------------- *)
+   PROCEDURE InputString;
+   (* 
+   *  get the string to be search for and make sure that its not too big 
+   *)
+
+   VAR
+      c       : CHAR;
+      p       : CARDINAL;
+      too_big : BOOLEAN;
+
+   BEGIN (* InputString *)
+
+      WriteString('Input the string to find ? ');
+
+      too_big := FALSE;
+      p := 0;   Read(c);
+      WHILE ( c # EOL ) & ( NOT too_big ) DO
+         IF p = abs_max_string_size THEN
+            too_big := TRUE;
+         ELSE
+            string[p] := UpperCase(c);
+            Read(c);        p := p + 1;
+         END; (* if *)
+      END; (* while *)
+      ReadLn;
+
+      IF too_big THEN
+         WriteLn;
+         WriteString('The program will only handle strings to a size of');
+         WriteCard(abs_max_string_size,10); WriteLn;
+         WriteString('so your string was truncated.'); WriteLn;
+      END; (* if *)
+
+      string[p]   := null;
+      string_size := p;
+
+   END InputString;
+
+   (* --------------------------------------------------------- *)
+   PROCEDURE InputBufferSize;
+   (*
+   *  get the number of characters to be output before and after the
+   *  string once it is found 
+   *)
+
+   BEGIN (* InputBufferSize *)
+
+      WriteString('What is the number of characters to be buffered');
+      WriteLn;
+      WriteString(' before and after the search string'); WriteLn;
+
+      (* 
+      * make this suggestion about the size if its going on a terminal
+      *   or a printer page 
+      *)
+      WriteString('The suggested sizes are:'); WriteLn;
+      IF 80 > string_size THEN
+         WriteCard( (80-string_size) DIV 2, 10);
+         WriteString(' to fill up an 80 character line.'); WriteLn;
+      END; (* if *)
+      WriteCard( (132-string_size) DIV 2, 10);
+      WriteString(' to fill up a 132 character line.'); WriteLn;
+
+      WriteString(' 1 to'); WriteCard(abs_max_buffer,5);
+      WriteString(' ? ');
+      ReadCard(buffer_size); ReadLn;
+
+      WHILE ( buffer_size < 1 ) OR ( buffer_size > abs_max_buffer ) DO
+
+         WriteLn;
+         WriteString(' -- invalid number, try again --');
+         WriteLn;
+
+         WriteString('What is the number of characters to be buffered');
+         WriteLn;
+         WriteString(' before and after the search string');
+         WriteString(' 1 to'); WriteCard(abs_max_buffer,5);
+         WriteString(' ? ');
+         ReadCard(buffer_size);  ReadLn;
+
+      END; (* while *)
+      
+   END InputBufferSize;
+
+   (* --------------------------------------------------------- *)
+   PROCEDURE ScanText;
+   (*
+   * search through the input text looking for the input search string 
+   *   the search is done a character at a time every time a new character
+   *     is input
+   *   the beginning of the search position is always kept as a pointer to
+   *     the position 'string_position'
+   *  the top of the text is the pointer 'first', which moves one position
+   *     forward in the ring every time a new character is input
+   *  and characters are always input at the end position 'last'
+   *
+   *  So the ring actually moves backward through the text, with characters
+   *    being dropped off at the head 'first', but upon output the head
+   *    of the ring is the first character on the line.
+   *)
+
+   TYPE
+      RingPtr     = POINTER TO RingElement;
+      RingElement = RECORD
+                      value : CHAR;
+                      next  : RingPtr;
+                    END; (* record *)
+
+
+   VAR
+      first, last, string_position : RingPtr;
+      real_buffer_size             : CARDINAL;
+
+       (* --------------------------------------------------------- *)
+       PROCEDURE InitalizeRing;
+       (*
+       *  build the ring with the given number of characters on each side
+       *    of the string using a linked list
+       *)
+
+       VAR
+          i       : CARDINAL;
+          fiddle_dum, fiddle_de : RingPtr;
+
+       BEGIN (* InitalizeRing *)
+
+          (* the the actual size of the linked ring is   *)
+          real_buffer_size := 2 * buffer_size + string_size;
+
+          (* build each element in the ring *)
+          (* each one points to the next element in the list *)
+
+          (* create the top of the list *)
+          NEW(first);
+          first^.value := null;
+
+          (* first is the part before the string *)
+          NEW(fiddle_dum);
+          first^.next := fiddle_dum;
+
+          FOR i := 1 TO buffer_size - 2 DO
+             NEW(fiddle_de);
+             fiddle_dum^.next := fiddle_de;
+             fiddle_dum^.value:= null;
+             fiddle_dum       := fiddle_de;
+          END; (* for *)
+
+          (* then the string part *)
+          NEW(fiddle_de);
+          (* make the string point to this place *)
+          string_position := fiddle_dum;
+          (* and continue *)
+          fiddle_dum^.next := fiddle_de;
+          fiddle_dum^.value:= null;
+          fiddle_dum       := fiddle_de;
+
+          FOR i := 1 TO string_size - 1 DO
+             NEW(fiddle_de);
+             fiddle_dum^.next := fiddle_de;
+             fiddle_dum^.value:= null;
+             fiddle_dum       := fiddle_de;
+          END; (* for *)
+
+          (* and last is the part after the string *)
+          FOR i := 1 TO buffer_size DO
+             NEW(fiddle_de);
+             fiddle_dum^.next := fiddle_de;
+             fiddle_dum^.value:= null;
+             fiddle_dum       := fiddle_de;
+          END; (* for *)
+
+          (* finally, burn the candle at both ends *)
+          fiddle_dum^.next := first;
+          fiddle_dum^.value:= null;
+          last             := fiddle_dum;
+
+          (* now fill up the ring with the first charcters in the file *)
+          i := 0;
+          WHILE ( NOT Eof(in) ) & ( i < real_buffer_size ) DO
+             ReadNextChar;   UpdateRingPointers;
+             i := i + 1;
+          END; (* while *)
+
+       END InitalizeRing;
+
+       (* --------------------------------------------------------- *)
+       PROCEDURE ReadNextChar;
+       (*
+       * get the next character in the file, control characters are blanked
+       *)
+
+       VAR
+          c : CHAR;
+
+       BEGIN (* ReadNextChar *)
+
+          IF NOT Eof(in) THEN
+
+             Read(c);
+             IF c = EOL THEN
+                (* replace the end of line with a blank *)
+                c := blank;
+                input_line_number := input_line_number + 1;
+             ELSIF c < ' ' THEN
+                (* skip control chars *)
+                c := blank;
+             END; (* if *)
+
+             last := last^.next;
+             last^.value := c;
+
+          ELSE
+             c := null;
+          END; (* if *)
+          
+       END ReadNextChar;
+
+       (* --------------------------------------------------------- *)
+       PROCEDURE UpdateStringPointer;
+       (* move the position of the string ahead in the ring *)
+
+       BEGIN (* UpdateStringPointer *)
+
+          string_position := string_position^.next;
+
+       END UpdateStringPointer;
+
+       (* --------------------------------------------------------- *)
+       PROCEDURE UpdateRingPointers;
+       (* move the position of the first of the ring to the next character *)
+
+       BEGIN (* UpdateRingPointers *)
+
+          first := first^.next;
+
+          UpdateStringPointer;
+
+       END UpdateRingPointers;
+
+       (* --------------------------------------------------------- *)
+       PROCEDURE SearchForStringInFirstRing;
+       (* look for the string in the first 'buffer' characters' *)
+
+       VAR
+          save_position : RingPtr;
+
+       BEGIN (* SearchForStringInFirstRing *)
+
+          (* save the old position *)
+          save_position := string_position;
+
+          (* look for the string at the very beginning *)
+          string_position := first;
+
+          (*
+          * search until we come to the position of the real string pointer
+          *  in the normal ring
+          *)
+          WHILE string_position # save_position DO
+             SearchForString;
+             UpdateStringPointer;
+          END; (* while *)
+
+          (*
+          *  reset the old string place, to its normal position
+          *  where it will stay for the rest of the program
+          *)
+          string_position := save_position;
+
+       END SearchForStringInFirstRing;
+
+       (* --------------------------------------------------------- *)
+       PROCEDURE SearchForString;
+       (* 
+       * look for the search string at the current position
+       *  if each successive character matches then move the search location
+       *  along to the next character in the ring and test again ...
+       *)
+
+       VAR
+          i            : CARDINAL;
+          search_value : RingPtr;
+          c            : CHAR;
+          char_match   : BOOLEAN;
+
+       BEGIN (* SearchForString *)
+
+          search_value := string_position;
+
+          i := 0;  char_match := TRUE;
+
+          WHILE ( char_match ) & ( i < string_size ) DO
+              c            := UpperCase(search_value^.value);
+              char_match   := c = string[i];
+              i            := i + 1;
+              search_value := search_value^.next;
+          END; (* while *)
+
+          IF char_match THEN
+             (* wow, it must have found the string *)
+             match_count := match_count + 1;
+
+             (* output the line number *)
+             WriteString('< line');
+             WriteCard(input_line_number,10);
+             WriteString(' >');WriteLn;
+
+             search_value := first;
+
+             (* output this line *)
+
+             (* do the first character in the ring *)
+             WriteString(search_value^.value);
+             search_value := search_value^.next;
+
+             (* then continue until we come back to the first again *)
+             WHILE search_value # first DO
+                WriteString(search_value^.value);
+                search_value := search_value^.next;
+             END; (* while *)
+             WriteLn;  WriteLn;
+
+          END; (* if *)
+
+       END SearchForString;
+
+   BEGIN (* ScanText *)
+
+     match_count := 0;    input_line_number := 1;
+
+     InitalizeRing;
+
+     SearchForStringInFirstRing;
+
+     WHILE NOT Eof(in) DO
+        SearchForString;
+        ReadNextChar;
+        UpdateRingPointers;
+     END; (* while *)
+
+     (* keep searching till the end of the current and last ring *)
+     FOR i := 1 TO buffer_size + string_size - 1 DO
+         UpdateStringPointer;
+         SearchForString;
+     END; (* for *)
+
+   END ScanText;
+
+
+BEGIN (* Kwic *)
+
+  WriteLn;
+  InputString;
+
+  IF string_size > 0 THEN
+
+     WriteLn;
+     InputBufferSize;
+
+     WriteLn;  OpenInput('.TXT');   WriteLn; OpenOutput('.OUT');
+
+     Name(in,input_file_name);
+     WriteString('KWIC searching for "'); WriteString(string);
+     WriteString('" in '); WriteString(input_file_name);
+     WriteLn;
+     WriteString('using a'); WriteCard(buffer_size,10);
+     WriteString(' character buffer on each side of the string.');
+     WriteLn;  WriteLn;
+
+     ScanText;
+
+     CloseInput;  CloseOutput;
+
+     WriteLn;
+     WriteCard(match_count,10);       WriteString(' matches found in ');
+     WriteCard(input_line_number-1,10); WriteString(' input lines');
+     WriteLn;
+
+  ELSE
+    WriteString('null string is no good'); WriteLn;
+  END; (* if *)
+
+END Kwic.
diff --git a/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/text-tools/words.mod b/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/text-tools/words.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/text-tools/words.mod
@@ -0,0 +1,276 @@
+MODULE Words;
+
+(* 
+ * input a file of characters and break the file into a single list
+ * of sorted words to be output to another file
+ *
+ * words have no punctuation, and case is ignored
+ *
+ * questions ? should words be broken at underscores
+ *           ? should punctuation become separate words
+ *
+*)
+
+(* V1.0, J.Andrea, June 1985 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM InOut      IMPORT OpenInput, OpenOutput, CloseInput, CloseOutput,
+                       Read, ReadString, ReadLn,
+                       Write, WriteString, WriteLn, WriteCard,
+                       EOL, Done, in, out;
+
+FROM FileSystem IMPORT Eof;
+
+FROM Storage    IMPORT ALLOCATE, DEALLOCATE;
+
+CONST
+   null = 0C;
+
+TYPE
+   String  = ARRAY [0..132] OF CHAR;
+
+   TriePtr = POINTER TO Trie;
+   Trie    = RECORD
+               key         : CHAR;
+               first_child : TriePtr;
+               sibling     : TriePtr;
+             END; (* record *)
+
+VAR
+   input_word_count, output_word_count : CARDINAL;
+   alpha                               : TriePtr; (* the very top of the tree*)
+
+
+   (* ----------------------------------------------------------- *)
+   PROCEDURE Initialize;
+   BEGIN (* Initalize *)
+
+     input_word_count  := 0;
+     output_word_count := 0;
+
+     NEW(alpha); (* define the very top of the tree *)
+     alpha^.key         := '@';  (* it has no value *)
+     alpha^.first_child := NIL;   (* no children YET *)
+     alpha^.sibling     := NIL;   (* and cannot have any sisters *)
+
+   END Initialize;
+
+   (* ----------------------------------------------------------- *)
+   PROCEDURE InputWords;
+   (*
+    * use ReadString to input each word (separated by blanks) and put
+    * each word into a trie-tree character by char
+   *)
+
+   VAR
+      word : String;
+      len  : CARDINAL;
+
+      (* -------------------------------------------------------- *)
+      PROCEDURE AddWordToTree;
+      (* put this word into the tree *)
+
+      VAR
+        p, parent, save : TriePtr;
+        i               : CARDINAL;
+        c               : CHAR;
+
+      BEGIN (* AddWordToTree *)
+
+        p := alpha;
+
+        FOR i := 0 TO LEN(word) DO
+
+           c := word[i];
+           (* make the words case-independent. uppercase them *)
+           IF ( c >= 'a' ) & ( c <= 'z' ) THEN c := CAP(c); END;
+
+           parent := p;   p := parent^.first_child;
+
+           (* does this parent have any children *)
+           IF p = NIL THEN
+
+              (* no children, this is the first child, so add it *)
+              NEW(p);
+              parent^.first_child := p;
+              p^.key         := c;
+              p^.first_child := NIL;
+              p^.sibling     := NIL;
+
+           ELSE
+
+              (* check all the children for this character *)
+
+              (* keep it sorted *)
+              save := p;
+              WHILE ( p # NIL ) & ( p^.key < c ) DO
+                save := p;
+                p := p^.sibling;
+              END; (* while *)
+
+              (* was it found *)
+              IF p = NIL THEN
+                 (* no, add the new char at the end of the list *)
+                 NEW(p);
+                 save^.sibling  := p;
+                 p^.key         := c;
+                 p^.first_child := NIL;
+                 p^.sibling     := NIL;
+              ELSE
+                 IF p^.key # c THEN
+                    (* no, insert the char between two existing ones *)
+                    IF p = parent^.first_child THEN
+                       (* the current char must go before the first *)
+                       NEW(p);
+                       p^.sibling          := parent^.first_child;
+                       parent^.first_child := p;
+                       p^.key              := c;
+                       p^.first_child      := NIL;
+                    ELSE
+                       NEW(p);
+                       p^.sibling     := save^.sibling;  (* switch points *)
+                       save^.sibling  := p;
+                       p^.key         := c;
+                       p^.first_child := NIL;
+                    END; (* if *)
+                 ELSE
+                 END; (* if *)
+              END; (* if *)
+
+           END; (* if *)
+
+        END; (* for *)
+
+      END AddWordToTree;
+
+      (* ------------------------------------------------------- *)
+      PROCEDURE ReadProperWord;
+      (*
+       * words are delemited by control-chars, spaces and punctuation
+      *)
+
+      VAR
+         c : CHAR;
+         i : CARDINAL;
+
+         (* ------------------------------------------------------- *)
+         PROCEDURE AlphaNumeric( c : CHAR ) : BOOLEAN;
+         VAR cap : CHAR;
+         BEGIN (* AlphaNumeric *)
+           cap := CAP(c);
+           RETURN ( ( cap >= 'A' ) & ( cap <= 'Z' ) )
+               OR ( ( c   >= '0' ) & ( c   <= '9' ) )
+         END AlphaNumeric;
+
+      BEGIN (* ReadProperWord *)
+
+         (* skip special chars *)
+         Read(c);
+         WHILE ( NOT Eof(in) ) & ( NOT AlphaNumeric(c) ) DO
+            Read(c);
+         END; (* while *)
+
+         i := 0;
+         WHILE ( NOT Eof(in) ) & ( AlphaNumeric(c) ) DO
+            word[i] := c;
+            i := i + 1;  Read(c);
+         END; (* while *)
+         word[i] := null;
+
+      END ReadProperWord;
+
+   BEGIN (* InputWords *)
+
+       ReadProperWord;
+       WHILE NOT Eof(in) DO
+           input_word_count := input_word_count + 1;
+           len := LEN(word);
+           IF len > 0 THEN
+              AddWordToTree;
+           END; (* if *)
+           ReadProperWord;
+       END; (* while *)
+
+   END InputWords;
+
+   (* ----------------------------------------------------------- *)
+   PROCEDURE OutputWords;
+
+   (*
+    * do char by char output of the tree into a new file to show
+    * each unique word
+   *)
+
+    VAR
+       output_word : String;
+
+      (* ------------------------------------------------------- *)
+      PROCEDURE PrintTree( parent : TriePtr ; level : CARDINAL );
+      (* output the contents of the tree *)
+
+      BEGIN (* PrintTree *)
+
+         (* is there a character at this node *)
+         IF parent = NIL THEN
+
+            (* no, this must be the bottom of a word *)
+            output_word[level] := null;
+            WriteString(output_word); WriteLn;
+            output_word_count := output_word_count + 1;
+
+         ELSE
+
+            (* do all the children at this same level *)
+            WHILE parent # NIL DO
+
+               output_word[level] := parent^.key;
+
+               (* go down another level *)
+               PrintTree( parent^.first_child , level+1 );
+
+               (* back at this same level *)
+               parent := parent^.sibling;
+  
+            END; (* while *)
+
+         END; (* if *)
+
+      END PrintTree;
+
+   BEGIN (* OutputWords *)
+
+       PrintTree(alpha^.first_child,0);
+
+   END OutputWords;
+
+BEGIN (* Words *)
+
+   Initialize;
+
+   WriteLn;
+   WriteString('For the text of words');
+   OpenInput('.TXT');
+
+   InputWords;
+
+   CloseInput;   
+
+   WriteLn;
+   WriteString('     There are '); WriteCard(input_word_count,6);
+   WriteString(' words in the input file.'); WriteLn;
+
+   WriteLn;
+   WriteString('For the single list of words');
+   OpenOutput('.OUT');
+
+   OutputWords;
+
+   CloseOutput;
+
+   WriteLn;
+   WriteString('     And '); WriteCard(output_word_count,6);
+   WriteString(' unique words in the output file.');
+
+   WriteLn;   WriteLn;
+
+END Words.
diff --git a/examples/Modula-2_Libraries/andrea-m2/applications/fst/search/search.mod b/examples/Modula-2_Libraries/andrea-m2/applications/fst/search/search.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/applications/fst/search/search.mod
@@ -0,0 +1,167 @@
+MODULE Search;
+
+(*
+ Search the file given by argument 1
+ for any line which contains all of the strings defined by arguments 2,3,...
+*)
+(* John Andrea, June.27/92 *)
+(* This code may be freely distributed, it may not be sold *)
+
+FROM Break IMPORT EnableBreak;
+FROM System IMPORT GetArg;
+FROM InOut IMPORT Write, WriteString, WriteLn, RedirectInput, Read, WriteCard, Done;
+FROM ASCII IMPORT EOL, EOF;
+
+CONST
+  max_size = 30;
+  max_args = 11;
+  max_line = 133;
+
+VAR
+  i       :CARDINAL;
+
+  n_args  :CARDINAL;
+  arg     :ARRAY [1..max_args] OF ARRAY [1..max_size] OF CHAR;
+  size    :ARRAY [1..max_args] OF CARDINAL;
+
+  line    :ARRAY [1..max_line] OF CHAR;
+  len     :CARDINAL;
+
+  eof     :BOOLEAN;
+
+  (* ------------------------------------------ *)
+  PROCEDURE ReadLine;
+  VAR
+    c :CHAR;
+  BEGIN
+
+    Read( c );
+
+    IF c = EOF THEN
+      eof := TRUE;
+    ELSE
+
+      len := 1;
+
+      WHILE ( len < max_line ) & ( c # EOL ) & ( c # EOF ) DO
+        line[len] := c;
+        Read( c );
+        len := len + 1;
+      END;
+
+      IF len <= max_line THEN
+       line[len] := 0C;
+      ELSE
+       (* finish reading this line, beacuse its too big to fit into the buffer *)
+       Read( c );
+       WHILE c # EOL DO
+         Read( c );
+       END;
+      END;
+
+      len := len - 1;
+
+    END;
+
+  END ReadLine;
+
+    (* -------------------------------------------------------- *)
+    PROCEDURE Contains( pattern :ARRAY OF CHAR; len_p :CARDINAL ) :BOOLEAN;
+    VAR
+       s, p :CARDINAL;
+       done, found :BOOLEAN;
+    BEGIN
+
+       IF ( len_p = 0 ) OR ( len_p > len ) THEN
+         RETURN FALSE;
+       ELSE
+
+         found := FALSE;
+         done  := FALSE;
+
+         s := 1;
+
+         WHILE ( NOT done ) & ( NOT found ) DO
+
+           (* find the next occurance of the first char of the pattern *)
+           WHILE ( s <= len ) & ( CAP(line[s]) # CAP(pattern[0]) ) DO
+              s := s + 1;
+           END;
+
+           IF s > len THEN
+             (* didn't find another first character match *)
+             done := TRUE;
+           ELSE
+
+             (* try to determine if the pattern fits here *)
+
+             IF len - s + 1 < len_p THEN
+               (* the pattern won't fit in the remainder if the source *)
+               done := TRUE;
+             ELSE
+
+               (* ok, try to make a match *)
+
+               p := 0;
+               WHILE ( p < len_p ) & ( CAP(line[s+p]) = CAP(pattern[p]) ) DO
+                  p := p + 1;
+               END;
+
+               found := p = len_p;
+
+             END;
+
+           END;
+
+           s := s + 1;
+
+         END; (* while *)
+
+         RETURN found;
+
+       END;
+
+    END Contains;
+
+BEGIN EnableBreak;
+
+  n_args := 0;
+  REPEAT
+    n_args := n_args + 1;
+    GetArg( arg[n_args], size[n_args] );
+  UNTIL ( n_args = max_args ) OR ( size[n_args] = 0 );
+
+  n_args := n_args - 1;
+  IF n_args > 1 THEN
+
+    eof := FALSE;
+
+    RedirectInput( arg[1] );
+    IF Done THEN
+
+      ReadLine;
+      WHILE NOT eof DO
+
+        (* only try to search though the line if is isn't all blank *)
+        IF len > 0 THEN
+
+          (* stop searching if one of the arg strings isn't in this line *)
+          i := 2;
+          WHILE ( i <= n_args ) & Contains( arg[i], size[i] ) DO
+            i := i + 1;
+          END;
+
+          IF i > n_args THEN
+            WriteString( line ); WriteLn;
+          END;
+
+        END;
+        ReadLine;
+      END;
+
+    ELSE
+      WriteString( 'cant open input file ' ); WriteString( arg[1] ); WriteLn;
+    END;
+
+  END;
+END Search.
diff --git a/examples/Modula-2_Libraries/andrea-m2/applications/generic/misc/feigenbaum_plot.mod b/examples/Modula-2_Libraries/andrea-m2/applications/generic/misc/feigenbaum_plot.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/applications/generic/misc/feigenbaum_plot.mod
@@ -0,0 +1,106 @@
+MODULE FeigenbaumPlot;
+
+(*
+ This program will make a plot of a Feigenbaum Chaos diagram
+ for output on a PostScript printer.
+ The output file produced is always called CHAOS.PS
+
+ Users input the dimensions of the plot, recommended values are displayed.
+
+ Compile this program with no run time checks for best speed.
+*)
+(* J. Andrea, Nov.11/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT ReadLn, ReadReal, ReadCard, Read,
+                  WriteLn, WriteString, WriteReal, WriteCard;
+FROM PSDots IMPORT BeginPS, EndPS, Dot, GetDimensions, Title;
+FROM Conversions IMPORT CardToString;
+FROM RealInOut IMPORT ToFString;
+FROM StringOperations IMPORT Append;
+
+VAR
+  range, i :CARDINAL;
+  population, feedback :REAL;
+  max_row, max_col :CARDINAL;
+  real_max_row, real_max_col :REAL;
+  right, left, top, bottom, xrange, yrange, xscale, yscale :REAL;
+  visible, invisible :CARDINAL;
+  
+  title, string  :ARRAY [0..100] OF CHAR;
+
+  (* ----------------------------------------------------------- *)
+  PROCEDURE NewPop;
+  VAR
+    delta :REAL;
+  BEGIN
+      population := feedback * population * ( 1.0 - population );
+
+      IF population > 1.0 THEN
+        population := population - FLOAT( TRUNC( population ) );
+      END;
+
+  END NewPop;
+
+BEGIN
+
+WriteLn;
+WriteString( 'recommended values are:' ); WriteLn;
+WriteString( 'left=2.7 right=4 bottom=0 top=1 invisible=300 visible=150' ); WriteLn;
+
+WriteLn;
+WriteString( 'left ? ' ); ReadReal( left );
+WriteString( 'right ? ' ); ReadReal( right );
+WriteString( 'bottom ? ' ); ReadReal( bottom );
+WriteString( 'top ? ' ); ReadReal( top );
+WriteLn;
+
+WriteString( 'invisible ? ' ); ReadCard( invisible );
+WriteString( 'visible ? ' ); ReadCard( visible );
+
+xrange := right - left;
+yrange := top   - bottom;
+
+GetDimensions( max_col, max_row );
+
+xscale := FLOAT( max_col ) / xrange;
+yscale := FLOAT( max_row ) / yrange;
+
+WriteString( 'the output file will be CHAOS.PS' ); WriteLn;
+
+BeginPS( 'chaos.ps' );
+
+title := ' ';
+Append( 'left=', title );
+     ToFString( left, 3, 1, string );  Append( string, title );
+Append( ' right=', title );
+     ToFString( right, 3, 1, string ); Append( string, title );
+Append( ' bottom=', title );
+     ToFString( bottom, 3, 1, string ); Append( string, title );
+Append( ' top=', title );
+     ToFString( top, 3, 1, string );   Append( string, title );
+Append( ' invisible=', title );
+     CardToString( invisible, 0, string ); Append( string, title );
+Append( ' visible=', title );
+     CardToString( visible, 0, string ); Append( string, title );
+Title( title );
+
+FOR range := 0 TO max_col DO
+   feedback   := left + FLOAT( range ) / xscale;
+   population := 0.3;
+
+   FOR i := 0 TO invisible DO
+      NewPop;
+   END;
+
+   FOR i := 0 TO visible DO
+      Dot( TRUNC( ( feedback   - left )   * xscale ),
+           TRUNC( ( population - bottom ) * yscale ) );
+      NewPop;
+   END;
+
+END;
+
+EndPS;
+
+END FeigenbaumPlot.
diff --git a/examples/Modula-2_Libraries/andrea-m2/applications/generic/misc/number_puzzle.mod b/examples/Modula-2_Libraries/andrea-m2/applications/generic/misc/number_puzzle.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/applications/generic/misc/number_puzzle.mod
@@ -0,0 +1,80 @@
+MODULE NumberPuzzle;
+
+(*
+ Find a 9 digit number containing the digits 1 to 9 once and only once
+ such that the first 1 digit is a multiple of 1, the first 2 digits form a
+ number that is a multiple of 2, the first 3 digits form a number that is
+ a multiple of 3, etc...
+*)
+(* John Andrea, Dec.11/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteString, WriteCard, WriteLn;
+
+VAR
+  digit_taken            :ARRAY [1..9] OF BOOLEAN;
+  attempts, solutions, i :CARDINAL;
+
+  (* -------------------------------------------------- *)
+  PROCEDURE TrySolve( value, level :CARDINAL );
+  VAR i :CARDINAL;
+  BEGIN
+
+    attempts := attempts + 1;
+
+    (* does the value so far satisfy the conditions *)
+
+    IF value MOD level = 0 THEN
+      (* ok, it works so far *)
+
+      IF level = 9 THEN
+        (* all digits taken, this must be a solution *)
+
+        solutions := solutions + 1;
+        WriteCard( value, 0 ); WriteLn;
+
+      ELSE
+        (* try all the  available digits *)
+
+        FOR i := 1 TO 9 DO
+           IF NOT digit_taken[i] THEN
+             digit_taken[i] := TRUE;
+
+             TrySolve( value * 10 + i, level + 1 );
+
+             digit_taken[i] := FALSE;
+           END;
+        END;
+      END;
+    END;
+
+  END TrySolve;
+
+BEGIN
+
+   attempts := 0;  solutions := 0;
+
+   FOR i := 1 TO 9 DO  digit_taken[i] := FALSE;  END;
+
+   WriteString( 'Starting to solve the puzzle...' ); WriteLn;
+
+   WriteLn;
+   FOR i := 1 TO 9 DO
+      digit_taken[i] := TRUE;
+
+      TrySolve( i, 1 );
+
+      digit_taken[i] := FALSE;
+   END;
+   WriteLn;
+
+   IF solutions = 0 THEN
+     WriteString( 'impossible' );
+   ELSE
+     WriteCard( solutions, 0 ); WriteString( ' solutions' );
+   END;
+   WriteLn;
+   
+   WriteString( 'after ' ); WriteCard( attempts, 0 ); WriteString( ' attempts' );  WriteLn;
+
+END NumberPuzzle.
diff --git a/examples/Modula-2_Libraries/andrea-m2/applications/generic/misc/un_stream.mod b/examples/Modula-2_Libraries/andrea-m2/applications/generic/misc/un_stream.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/applications/generic/misc/un_stream.mod
@@ -0,0 +1,135 @@
+MODULE UnStream;
+
+(* Convert a file from Stream_LF format to standard text,
+   and break long lines as well *)
+(* J. Andrea, Jun.17/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM ForeignCommand IMPORT ReadCommand, GetOption;
+IMPORT BlockIO;
+IMPORT TextIO;
+
+CONST
+  out_max = 132;
+
+VAR
+  in_f        :BlockIO.BlockFile;
+  out_f       :TextIO.File;
+  filename    :ARRAY [0..80] OF CHAR;
+  block_data       :ARRAY [1..512] OF CHAR;
+  block_count, block_size :CARDINAL;
+
+  out_line, save_line :ARRAY [1..out_max+1] OF CHAR;
+  out_len,  saved     :CARDINAL;
+
+  (* ----------------------------------------------------------- *)
+  PROCEDURE DoDump;
+  VAR
+     p, i, j :CARDINAL;
+
+        (* ----------------------------------------------------------- *)
+        PROCEDURE Output( length :CARDINAL );
+        BEGIN
+           IF length > 0 THEN
+             out_line[length+1] := 0C;
+             TextIO.WriteString( out_f, out_line );
+           END;
+           TextIO.WriteLn( out_f );
+        END Output;
+
+        (* ----------------------------------------------------------- *)
+        PROCEDURE NewLine( c :CHAR ) :BOOLEAN;
+        CONST
+           lf  = 12C;
+           cr  = 15C;
+        BEGIN
+           RETURN ( c = lf ) OR ( c = cr );
+        END NewLine;
+
+   BEGIN
+
+     FOR p := 1 TO block_size DO
+ 
+       IF NewLine( block_data[p] ) THEN
+         Output( out_len );
+         out_len := 0;
+       ELSE
+
+         IF out_len < out_max THEN
+           out_len := out_len + 1;
+           out_line[out_len] := block_data[p];
+         ELSE
+
+           (* its going to be too big to fit into the output record,
+              so break the line at the beginning of this word *)
+
+           (* go backwards to the the last blank *)
+           i := out_len;
+           WHILE ( i > 0 ) & ( out_line[i] > ' ' ) DO
+             i := i - 1;
+           END;
+
+           IF i = 0 THEN
+             (* couldn't find a place to break, force out all we've got *)
+             Output( out_len );
+             out_len := 0;
+           ELSE
+
+             (* save the end part of the line *)
+             saved := 0;
+             FOR j := i+1 TO out_len DO
+                saved := saved + 1;
+                save_line[saved] := out_line[j];
+             END;
+
+             Output( i );
+
+             out_line := save_line;
+             out_len  := saved;
+           END;
+
+           (* and add in the current character *)
+           out_len := out_len + 1;
+           out_line[out_len] := block_data[p];
+
+         END;
+       END;
+
+     END;
+
+  END DoDump;
+
+BEGIN
+
+ReadCommand( 'input filename ? ' );
+GetOption( 1, filename, block_size );
+
+BlockIO.OpenIn( in_f, filename );
+IF BlockIO.Done() THEN
+
+  TextIO.OpenOut( out_f, 'out.unstream' );
+  IF TextIO.Done THEN
+
+    out_len := 0;
+
+    block_count := 1;
+    BlockIO.Read( in_f, block_count, block_data, block_size );
+
+    WHILE BlockIO.Done() DO
+
+      DoDump;
+
+      block_count := block_count + 1;
+      BlockIO.Read( in_f, block_count, block_data, block_size );
+    END;
+
+    BlockIO.Close( in_f );
+
+  ELSE
+    TextIO.WriteString( TextIO.tty, 'output file not opened' ); TextIO.WriteLn( TextIO.tty );
+  END;
+ELSE
+  TextIO.WriteString( TextIO.tty, 'file not opened' ); TextIO.WriteLn( TextIO.tty );
+END;
+
+END UnStream.
diff --git a/examples/Modula-2_Libraries/andrea-m2/applications/multiscope/defect/defect-x.mod b/examples/Modula-2_Libraries/andrea-m2/applications/multiscope/defect/defect-x.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/applications/multiscope/defect/defect-x.mod
@@ -0,0 +1,169 @@
+MODULE Defect;
+
+(* Cellular Automata Defects *)
+(* See A.K. Dewdney, Scientific American, Aug.89 "Computer Recreations *)
+
+(* V4.0, jaa, Jun.22/93 -dynamic matricies *)
+(* V3.2, jaa, Jun.13/93 -only 4 neighbours *)
+(* V3.0, jaa, May.2/92 - eat neighbours *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM Break IMPORT EnableBreak;
+FROM Graphics IMPORT gph16CHiRes, ScreenMode, GetScreenMode, Circle;
+FROM Terminal IMPORT Read, KeyPressed;
+FROM Random IMPORT RandomCard;
+FROM InOut IMPORT WriteString, WriteInt, ReadInt, WriteLn;
+FROM PackMatrix IMPORT Matrix, Build, Get, Put, Duplicate, Destroy;
+
+CONST
+  size  = 220;
+  min_states = 8; max_states = 15;  (* number useful that is, 0-15 is range *)
+  
+  radius   = 1;
+  offset   = 40;
+  diameter = 2 * radius;
+    
+  old = 1;
+  new = 2;
+  
+TYPE
+  StateType = CARDINAL;
+  StateRange = [0..max_states];
+
+VAR
+  space     :ARRAY [old..new] OF Matrix;
+  neighbour :ARRAY [1..4] OF RECORD
+                                 row, col :INTEGER;
+                              END;
+
+  state_wrap  :ARRAY StateRange OF StateType;
+  s, s_to_eat :StateType;
+  
+  n_states   :INTEGER;
+  
+  i, j, k, l, m :INTEGER;
+  
+  screen_mode :INTEGER;
+  c           :CHAR;
+  row, col    :INTEGER;
+  changes     :BOOLEAN;
+  
+BEGIN  EnableBreak;
+
+  WriteString( 'how many states (' );
+  WriteInt( min_states, 0 ); WriteString( ' to ' );
+  WriteInt( max_states, 0 ); WriteString( ') ? ' );
+  ReadInt( n_states );
+  WriteLn;
+  
+  IF n_states < min_states THEN n_states := min_states END;
+  IF n_states > max_states THEN n_states := max_states END;
+   
+  WriteInt( n_states, 0 ); WriteString( ' states,' ); WriteLn;
+  WriteString( 'in a space of ' ); WriteInt( size, 0 );
+  WriteString( ' by ' ); WriteInt( size, 0 ); WriteLn;
+  
+  (* build the matricies *)
+  Build( space[old], 0, max_states, size, size );
+ 
+  (* define the offsets of the neighbours *);
+  (* N *)  neighbour[1].row := -1;  neighbour[1].col := +0;
+  (* E *)  neighbour[2].row := +0;  neighbour[2].col := +1;
+  (* S *)  neighbour[3].row := +1;  neighbour[3].col := +0;
+  (* W *)  neighbour[4].row := +0;  neighbour[4].col := -1;
+  
+  (* and define the wrap of states from one end to another *)
+  FOR i := 1 TO n_states DO
+     state_wrap[i] := i - 1;
+  END;
+  state_wrap[0]        := n_states;
+  state_wrap[n_states] := 0;
+   
+  (* randomize the first space *)
+  FOR i := 1 TO size DO
+    FOR j := 1 TO size DO
+      Put( space[old], i, j, RandomCard( n_states ) );
+    END;
+  END;
+  Duplicate( space[old], space[new] );
+  
+  WriteLn;
+  WriteString( 'hit any key to start, then any key to quit' );
+  WriteLn;
+  Read( c );
+  
+  GetScreenMode( screen_mode );
+  ScreenMode( gph16CHiRes );
+  
+  (* draw the initial state *)
+  row := radius + offset;
+  FOR i := 1 TO size DO
+    col := radius;
+    FOR j := 1 TO size DO      
+       Circle( row, col, row, col+radius, Get( space[old], i, j ), TRUE );       
+       col := col + diameter;
+    END;
+    row := row + diameter;
+  END;
+   
+  (* now run the rest *)
+  
+  WHILE NOT KeyPressed() DO
+  
+    FOR i := 1 TO size DO
+      FOR j := 1 TO size DO
+         s_to_eat := state_wrap[ Get( space[old], i, j ) ];
+         m := 1;
+         WHILE m <= 4 DO            
+            k := i + neighbour[m].row;
+            l := j + neighbour[m].col;
+             
+            IF k = 0 THEN k := size ELSE IF k > size THEN k := 1 END; END;
+            IF l = 0 THEN l := size ELSE IF l > size THEN l := 1 END; END; 
+ 
+            IF Get( space[old], k, l ) = s_to_eat THEN
+              Put( space[new], i, j, s_to_eat );
+              m := 5; (* exit loop *)
+            ELSE
+              m := m + 1;
+            END;
+            
+         END;         
+      END;
+    END;
+    
+    (* display the new cells *)
+    
+    changes := FALSE;
+    
+    row := radius + offset;
+    FOR i := 1 TO size DO
+      col := radius;
+      FOR j := 1 TO size DO
+   
+         s := Get( space[new], i, j );
+         IF s # Get( space[old], i, j ) THEN
+           (* there has been a change, so show it, and save it *)
+           Circle( row, col, row, col+radius, s, TRUE );
+           Put( space[old], i, j, s );
+           changes := TRUE;
+         END;
+         
+         col := col + diameter;         
+      END;
+      row := row + diameter;
+    END;
+ 
+    (* put up a marker to say 'no changes' *)
+    IF NOT changes THEN
+      Circle( 10, 200, 10, 200+10, 15, TRUE );
+    END;
+    
+  END;
+
+  Destroy( space[old] ); Destroy( space[new] );
+  
+  Read( c );
+  ScreenMode( screen_mode );
+ 
+END Defect.
diff --git a/examples/Modula-2_Libraries/andrea-m2/applications/multiscope/defect/defect.mod b/examples/Modula-2_Libraries/andrea-m2/applications/multiscope/defect/defect.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/applications/multiscope/defect/defect.mod
@@ -0,0 +1,181 @@
+MODULE Defect;
+
+(* Cellular Automata Defects *)
+(* See A.K. Dewdney, Scientific American, Aug.89 "Computer Recreations" *)
+
+(* V4.0, J.Andrea, Jun.22/93 -general fixups *)
+(* V3.2, jaa, Jun.13/93 -only 4 neighbours *)
+(* V3.0, jaa, May.2/92 - eat neighbours *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM Break IMPORT EnableBreak;
+FROM Graphics IMPORT gph16CHiRes, ScreenMode, GetScreenMode, Circle;
+FROM Terminal IMPORT Read, KeyPressed;
+FROM Random IMPORT RandomInt;
+FROM InOut IMPORT WriteString, WriteInt, ReadInt, WriteLn;
+
+CONST
+  size  = 100;
+  min_states = 8; max_states = 15;  (* number useful that is, 0-15 is range *)
+  
+  first_state    = 'a';
+  abs_last_state = 'o';    (* 15 - 1 past 'a' *)
+
+  radius   = 2;
+  offset   = 40;
+  diameter = 2 * radius;
+    
+  old = 1;
+  new = 2;
+  
+TYPE
+  StateType = CHAR;
+  StateRange = [first_state..abs_last_state];  
+  Space = ARRAY [1..size] OF ARRAY [1..size] OF StateType;
+  
+VAR
+  space     :ARRAY [old..new] OF Space;
+  neighbour :ARRAY [1..4] OF RECORD
+                                 row, col :INTEGER;
+                              END;
+
+  state_map   :ARRAY StateRange OF INTEGER;  (* clut *)
+  state_wrap  :ARRAY StateRange OF StateType;
+  s, s_to_eat :StateType;
+  
+  n_states   :INTEGER;
+  last_state :StateType;
+  
+  i, j, k, l, m :INTEGER;
+  
+  screen_mode :INTEGER;
+  c           :CHAR;
+  row, col    :INTEGER;
+  changes     :BOOLEAN;
+  
+BEGIN  EnableBreak;
+
+  WriteString( 'how many states (' );
+  WriteInt( min_states, 0 ); WriteString( ' to ' );
+  WriteInt( max_states, 0 ); WriteString( ') ? ' );
+  ReadInt( n_states );
+  WriteLn;
+  
+  IF n_states < min_states THEN n_states := min_states END;
+  IF n_states > max_states THEN n_states := max_states END;
+  
+  last_state := CHR( ORD( first_state ) + CARDINAL(n_states) - 1 );
+  
+  WriteInt( n_states, 0 ); WriteString( ' states,' ); WriteLn;
+  WriteString( 'in a space of ' ); WriteInt( size, 0 );
+  WriteString( ' by ' ); WriteInt( size, 0 ); WriteLn;
+  
+  (* define the offsets of the neighbours *);
+  (* N *)  neighbour[1].row := -1;  neighbour[1].col := +0;
+  (* E *)  neighbour[2].row := +0;  neighbour[2].col := +1;
+  (* S *)  neighbour[3].row := +1;  neighbour[3].col := +0;
+  (* W *)  neighbour[4].row := +0;  neighbour[4].col := -1;
+  
+  (* initialize the states as the first colours *)
+  i := 1;
+  FOR c := first_state TO last_state DO
+    state_map[c] := i;
+    i := i + 1;
+  END;
+  
+  (* and define the wrap of states from one end to another *)
+  FOR c := first_state TO last_state DO
+     state_wrap[c] := CHR( ORD(c) - 1 );
+  END;
+  state_wrap[first_state] := last_state;
+   
+  (* randomize the first space *)
+  FOR i := 1 TO size DO
+    FOR j := 1 TO size DO
+       k := INTEGER( ORD( first_state ) ) + RandomInt( n_states );
+       space[old][i,j] := CHR(k);
+    END;
+  END;
+  space[new] := space[old];
+  
+  WriteLn;
+  WriteString( 'hit any key to start, then any key to quit' );
+  WriteLn;
+  Read( c );
+  
+  GetScreenMode( screen_mode );
+  ScreenMode( gph16CHiRes );
+  
+  (* draw the initial state *)
+  row := radius + offset;
+  FOR i := 1 TO size DO
+    col := radius;
+    FOR j := 1 TO size DO
+      
+       s := space[old][i,j];
+       Circle( row, col, row, col+radius, state_map[s], TRUE );
+       
+       col := col + diameter;
+    END;
+    row := row + diameter;
+  END;
+   
+  (* now run the rest *)
+  
+  WHILE NOT KeyPressed() DO
+  
+    FOR i := 1 TO size DO
+      FOR j := 1 TO size DO
+         s_to_eat := state_wrap[ space[old][i,j] ];
+         m := 1;
+         WHILE m <= 4 DO            
+            k := i + neighbour[m].row;
+            l := j + neighbour[m].col;
+             
+            IF k = 0 THEN k := size ELSE IF k > size THEN k := 1 END; END;
+            IF l = 0 THEN l := size ELSE IF l > size THEN l := 1 END; END; 
+ 
+            IF space[old][k,l] = s_to_eat THEN
+              space[new][i,j] := s_to_eat;
+              m := 5;
+            ELSE
+              m := m + 1;
+            END;
+            
+         END;         
+      END;
+    END;
+    
+    (* display the new cells *)
+    
+    changes := FALSE;
+    
+    row := radius + offset;
+    FOR i := 1 TO size DO
+      col := radius;
+      FOR j := 1 TO size DO
+   
+         s := space[new][i,j];
+         IF s # space[old][i,j] THEN
+           (* there has been a change, so show it, and save it *)
+           Circle( row, col, row, col+radius, state_map[s], TRUE );
+           space[old][i,j] := s;
+           changes := TRUE;
+         END;
+         
+         col := col + diameter;         
+      END;
+      row := row + diameter;
+    END;
+ 
+    (* put up a marker to say 'no changes' *)
+    IF NOT changes THEN
+      Circle( 10, 200, 10, 200+10, 15, TRUE );
+    END;
+    
+  END;
+
+  Read( c );
+  ScreenMode( screen_mode );
+ 
+END Defect.
diff --git a/examples/Modula-2_Libraries/andrea-m2/applications/multiscope/golygon/golygon.mod b/examples/Modula-2_Libraries/andrea-m2/applications/multiscope/golygon/golygon.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/applications/multiscope/golygon/golygon.mod
@@ -0,0 +1,242 @@
+MODULE Golygon;
+
+(* 
+ Find all the golygons of a given length,
+ see Mathematical Recreations, by. A.K. Dewdney in
+     Scientific American, July 1990
+ and Serial Isogons of 90 Degrees
+     by Lee Sallows and Martin Gardner, Richard Guy and Donald Knuth
+     Mathematics Magazine (in press).
+
+ A golygon is a polygon with n sides, each side being one unit longer
+ then the previous side, and every two sides are attached at a right angle.
+
+ This program uses a backtracking algorithm to compute all possible golygons
+ of a given number of sides, running in 2^(n-1) time. To find all the 
+ golygons of length 32 will take approximately 21 hours on a 2 mip computer,
+ after trying more than 2 billion configurations.
+
+ This program will generate solutions which are mirror images, i consider
+ these to be unique, which is not considered in Dewdney's article.
+
+ 4 sides = 0 solutions, 8 sides = 2 solutions,
+ 16 sides = 16 solutions, 24 sides = 4216 solutions,
+ 64 sides = 2 * 127,674,038,970,623 solutions (from Knuth)
+
+ Golygons only exist with the number of sides as a multiple of 8.
+
+ This program display's the solutions as a list of directions North, South,
+ East, West. The first side is if length 1.
+*)
+(* John Andrea, Nov.24/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM VGAGraphics IMPORT BeginVGA, EndVGA, Move, Line, EraseScreen,
+			GetDimensions, TextColor;
+FROM NumberConversion IMPORT CardToString;
+FROM MoreMath IMPORT MinCard, MaxCard;
+FROM Break IMPORT EnableBreak;
+(* FROM Keyboard IMPORT KeyPressed; *)
+
+CONST
+  max = 32;
+
+TYPE
+  Directions = (north,south,east,west);
+
+VAR
+  i     :CARDINAL;
+  list  :ARRAY [1..max] OF Directions;
+  number_solutions, tries, start, stop :CARDINAL;
+  initial_dir :Directions;
+  max_row, max_col :CARDINAL;
+  continue :BOOLEAN;
+   
+  (* ------------------------------------------------- *)
+  PROCEDURE KeyPressed():BOOLEAN;
+  BEGIN
+    RETURN FALSE;
+  END KeyPressed;
+
+  (* ------------------------------------------------- *)
+  PROCEDURE DrawIt( len :CARDINAL );
+
+  VAR 
+    i           :CARDINAL;
+    x, y, min_x, max_x, min_y, max_y, s :INTEGER;
+    range_x, range_y :CARDINAL;
+    screen_x, screen_y :CARDINAL;
+    factor           :CARDINAL;
+
+        (* ------------------------------------------------- *)
+        PROCEDURE Vector( length, angle :CARDINAL );
+        BEGIN
+           IF angle = 0 THEN
+             screen_x := screen_x + length;
+           ELSIF angle = 90 THEN
+             screen_y := screen_y + length;
+           ELSIF angle = 180 THEN
+             screen_x := screen_x - length;
+           ELSIF angle = 270 THEN
+             screen_y := screen_y - length;
+           END;
+           Line( screen_x, screen_y );
+        END Vector;
+
+        (* ------------------------------------------------- *)
+        PROCEDURE Title;
+        VAR string :ARRAY [1..10] OF CHAR;
+        BEGIN
+           Move( 20, 500 );
+           CardToString( len, string, 0 );
+           TextColor( string, 3 );
+           
+           Move( 200, 500 );
+           CardToString( number_solutions, string, 0 );
+           TextColor( string, 3 );
+        END Title;
+
+        (* ------------------------------------------------- *)
+        PROCEDURE FindOffset( min, max :INTEGER ) :INTEGER;
+        VAR range, center :INTEGER;
+        BEGIN
+           range  := max - min;
+           center := min + range DIV 2;
+           RETURN - center;
+        END FindOffset;
+
+        (* ------------------------------------------------- *)
+        PROCEDURE ScreenCenter( max :CARDINAL; offset :INTEGER ) :CARDINAL;
+        VAR center, diff :CARDINAL;
+        BEGIN
+
+          center := max DIV 2;
+
+          diff := factor * CARDINAL( ABS( offset ) );
+
+          IF offset < 0 THEN
+            center := center - diff;
+          ELSE
+            center := center + diff;
+          END;
+
+          RETURN center;
+        END ScreenCenter;
+
+  BEGIN
+
+    (* compute the bounding box of the golygon *)
+    x := 0; y := 0;    min_x := 0; max_x := 0;    min_y := 0; max_y := 0;
+      
+    FOR i := 1 TO len DO
+       s := INTEGER( i );
+      
+       IF list[i] = north THEN
+         y := y + s;
+       ELSIF list[i] = south THEN
+         y := y - s;
+       ELSIF list[i] = east THEN
+         x := x + s;
+       ELSE
+         x := x - s;
+       END;
+      
+       IF x < min_x THEN min_x := x END;
+       IF x > max_x THEN max_x := x END;
+       IF y < min_y THEN min_y := y END;
+       IF y > max_y THEN max_y := y END;
+      
+     END;
+             
+     range_x := CARDINAL( max_x - min_x + 1 );
+     range_y := CARDINAL( max_y - min_y + 1 );
+      
+     (* the screen is much bigger than any golygon side *)
+     (* so find a scale factor *)
+     factor := MinCard( max_row, max_col ) DIV MaxCard( range_x, range_y );
+      
+     (* so the actual location of 0,0 is the same relative offset from *)
+     (* the center of the screen *)
+     screen_x := ScreenCenter( max_col, FindOffset( min_x, max_x ) );
+     screen_y := ScreenCenter( max_row, FindOffset( min_y, max_y ) );
+      
+     EraseScreen;   Title;
+      
+     (* move to the center of the screen *)
+      
+     Move( screen_x, screen_y );
+      
+     FOR i := 1 TO len DO
+        IF list[i] = north THEN
+          Vector( i*factor, 90 );
+        ELSIF list[i] = south THEN
+          Vector( i*factor, 270 );
+        ELSIF list[i] = east THEN
+          Vector( i*factor, 0 );
+        ELSE
+          Vector( i*factor, 180 );
+        END;
+     END;
+
+   END DrawIt;
+
+    (* ---------------------------------------------------- *)
+    PROCEDURE TrySolve( nsides :CARDINAL; prev_dir :Directions;
+                        sides :CARDINAL; x, y :INTEGER );
+    VAR
+        s :INTEGER;
+    BEGIN
+
+       IF KeyPressed() THEN
+         continue := FALSE;
+       ELSE
+       IF sides > nsides THEN
+         tries := tries + 1;
+         (* have we returned to the origin too *)
+         IF ( x = 0 ) & ( y = 0 ) & ( prev_dir # initial_dir ) THEN
+           number_solutions := number_solutions + 1;
+           DrawIt( nsides );
+         END;
+       ELSE
+
+         s := INTEGER( sides );
+
+         (* make another side, trying each of the directions *)
+
+         IF ( prev_dir = east ) OR ( prev_dir = west ) THEN
+           list[sides] := north;  TrySolve( nsides, north, sides+1, x, y+s );
+           list[sides] := south;  TrySolve( nsides, south, sides+1, x, y-s );
+         ELSE
+           list[sides] := east;  TrySolve( nsides, east, sides+1, x+s, y );
+           list[sides] := west;  TrySolve( nsides, west, sides+1, x-s, y );
+         END;
+
+       END;
+       END;
+    END TrySolve;
+
+BEGIN EnableBreak;
+  start := 4;  stop := 32;
+  
+  GetDimensions( max_col, max_row );
+
+  initial_dir := north;
+
+  (* always head north, first *)
+  list[1] := initial_dir;
+
+  BeginVGA;
+
+  continue := TRUE;
+  i := start;
+  WHILE continue & ( i <= stop ) DO  
+
+    number_solutions := 0;
+    TrySolve( i, initial_dir, 2, 0, 1 );
+
+    i := i + 4;
+  END;
+
+  EndVGA;
+  
+END Golygon.
diff --git a/examples/Modula-2_Libraries/andrea-m2/applications/multiscope/symmetry/symm3.mod b/examples/Modula-2_Libraries/andrea-m2/applications/multiscope/symmetry/symm3.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/applications/multiscope/symmetry/symm3.mod
@@ -0,0 +1,124 @@
+MODULE Symmetry;
+
+(* Symmetric Chaos: three fold *)
+(* See "Mathematical Recreations", Scientific American, December 1992 *)
+
+(* J. Andrea, Dec.1992 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM Randomly IMPORT RandomReal;
+FROM VGAGraphics IMPORT BeginVGA, EndVGA, EraseScreen, Move, Dot, Text;
+FROM Terminal IMPORT Read, ReadString, WriteString, WriteLn;
+FROM RealConversions IMPORT StringToReal;
+FROM RealInOut IMPORT WriteReal;
+FROM Break IMPORT EnableBreak;
+
+CONST
+  max_iter = 32000;    (* maximum size for DOS *)
+  max_loop = 2;        (* so do it again *)
+  
+  nx = 640; ny = 480;
+  
+VAR
+  a, b, c, d :REAL;
+  x, x2, x3, y, y2, y3 :REAL;
+  u, v, f :REAL;
+  x_min, x_max, y_min, y_max, x_offset, y_offset, x_scale, y_scale :REAL;
+  i, j, k, iter, loop :CARDINAL;
+  ch :CHAR;
+  
+  PROCEDURE Function;
+  BEGIN
+    x2 := x * x;  x3 := x2 * x;
+    y2 := y * y;  y3 := y2 * y;
+    f := a + b * (x2 + y2);
+    u := f * x + c * (x3 - 3.0 * x * y2) + d * (x2 - y2);
+    v := f * y + c * (3.0 * x2 * y - y3) - d * 2.0 * x * y;
+    x := u;
+    y := v;
+  END Function;
+  
+  PROCEDURE GetValue( name, default :ARRAY OF CHAR; VAR out :REAL );
+  VAR
+    value :ARRAY [0..20] OF CHAR;
+    ok    :BOOLEAN;
+    longout :LONGREAL;
+  BEGIN
+    WriteString( name ); WriteString( ' (default = ' );
+    WriteString( default ); WriteString( ') ? ' );
+    ReadString( value ); WriteLn;
+    IF value[0] = 0C THEN
+      StringToReal( default, longout, ok );
+    ELSE
+      StringToReal( value, longout, ok );
+    END;
+    IF ok THEN
+      out := longout;
+    ELSE
+      out := 0.0;
+    END;
+  END GetValue;
+  
+BEGIN EnableBreak;
+
+  GetValue( 'a', '2.5', a );
+  GetValue( 'b', '-2.5', b );
+  GetValue( 'c', '0.0', c );
+  GetValue( 'd', '-0.55', d );
+  
+  WriteReal( a, 10 ); WriteString( '  ' ); WriteReal( b, 10 ); WriteString( ' ' );
+  WriteReal( c, 10 ); WriteString( '  ' ); WriteReal( d, 10 ); WriteLn;
+
+  WriteString( 'wait...' ); WriteLn;
+
+  x := RandomReal( 0.0, 1.0 );
+  y := RandomReal( 0.0, 1.0 );
+
+  x_min := x; x_max := x;
+  y_min := y; y_max := y;
+  FOR i := 1 TO 5000 DO
+    Function;
+    IF x < x_min THEN
+      x_min := x;
+    ELSIF x > x_max THEN
+      x_max := x;
+    END;
+    IF y < y_min THEN
+      y_min := y;
+    ELSIF y > y_max THEN
+      y_max := y;
+    END;
+  END;
+  
+  (* change 10% *)
+  x_min := x_min - x_min / 10.0;
+  x_max := x_max + x_max / 10.0;
+  y_min := y_min - y_min / 10.0;
+  y_max := y_max + y_max / 10.0;
+  
+  x_offset := x_min;
+  y_offset := y_min;
+  
+  x_scale := FLOAT( nx ) / ( x_max - x_min );
+  y_scale := FLOAT( ny ) / ( y_max - y_min );
+
+  BeginVGA; EraseScreen;
+  
+  FOR loop := 1 TO max_loop DO
+  FOR iter := 1 TO max_iter DO
+    Function;
+
+    i := TRUNC( ( x - x_offset ) * x_scale );
+    j := TRUNC( ( y - y_offset ) * y_scale );
+
+    IF ( i > 0 ) & ( i <= nx ) & ( j > 0 ) & ( j <= ny ) THEN
+      Move( i, j ); Dot;
+    END;
+
+  END; END;
+
+  Move( 600, 10 ); Text( 'done' );
+  Read( ch );
+  EndVGA;
+  
+END Symmetry.
diff --git a/examples/Modula-2_Libraries/andrea-m2/applications/multiscope/symmetry/symm4.mod b/examples/Modula-2_Libraries/andrea-m2/applications/multiscope/symmetry/symm4.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/applications/multiscope/symmetry/symm4.mod
@@ -0,0 +1,124 @@
+MODULE Symmetry;
+
+(* Symmetric Chaos: four fold *)
+(* See "Mathematical Recreations", Scientific American, December 1992 *)
+
+(* J. Andrea, Dec.1992 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM Randomly IMPORT RandomReal;
+FROM VGAGraphics IMPORT BeginVGA, EndVGA, EraseScreen, Move, Dot, Text;
+FROM Terminal IMPORT Read, ReadString, WriteString, WriteLn;
+FROM RealConversions IMPORT StringToReal;
+FROM RealInOut IMPORT WriteReal;
+FROM Break IMPORT EnableBreak;
+
+CONST
+  max_iter = 32000;    (* maximum size for DOS *)
+  max_loop = 1;        (* so do it again *)
+  
+  nx = 640; ny = 480;
+  
+VAR
+  a, b, c, d :REAL;
+  x, x2, x3, x4, y, y2, y3, y4 :REAL;
+  u, v, f :REAL;
+  x_min, x_max, y_min, y_max, x_offset, y_offset, x_scale, y_scale :REAL;
+  i, j, k, iter, loop :CARDINAL;
+  ch :CHAR;
+  
+  PROCEDURE Function;
+  BEGIN
+    x2 := x * x;  x3 := x2 * x;  x4 := x3 * x;
+    y2 := y * y;  y3 := y2 * y;  y4 := y3 * y;
+    f := a + b * (x2 + y2);
+    u := f * x + c * (x4 - 6.0 * x2 * y2 + y4) + d * (x3 - 3.0 * x * y2);
+    v := f * y + c * (4.0 * x3 * y - 4.0 * x * y3) + d * ( y3 - 3.0 * x2 * y);
+    x := u;
+    y := v;
+  END Function;
+  
+  PROCEDURE GetValue( name, default :ARRAY OF CHAR; VAR out :REAL );
+  VAR
+    value :ARRAY [0..20] OF CHAR;
+    ok    :BOOLEAN;
+    longout :LONGREAL;
+  BEGIN
+    WriteString( name ); WriteString( ' (default = ' );
+    WriteString( default ); WriteString( ') ? ' );
+    ReadString( value ); WriteLn;
+    IF value[0] = 0C THEN
+      StringToReal( default, longout, ok );
+    ELSE
+      StringToReal( value, longout, ok );
+    END;
+    IF ok THEN
+      out := longout;
+    ELSE
+      out := 0.0;
+    END;
+  END GetValue;
+  
+BEGIN EnableBreak;
+
+  GetValue( 'a', '2.5', a );
+  GetValue( 'b', '-2.5', b );
+  GetValue( 'c', '0.0', c );
+  GetValue( 'd', '-0.55', d );
+  
+  WriteReal( a, 10 ); WriteString( '  ' ); WriteReal( b, 10 ); WriteString( ' ' );
+  WriteReal( c, 10 ); WriteString( '  ' ); WriteReal( d, 10 ); WriteLn;
+
+  WriteString( 'wait...' ); WriteLn;
+
+  x := RandomReal( 0.0, 1.0 );
+  y := RandomReal( 0.0, 1.0 );
+
+  x_min := x; x_max := x;
+  y_min := y; y_max := y;
+  FOR i := 1 TO 5000 DO
+    Function;
+    IF x < x_min THEN
+      x_min := x;
+    ELSIF x > x_max THEN
+      x_max := x;
+    END;
+    IF y < y_min THEN
+      y_min := y;
+    ELSIF y > y_max THEN
+      y_max := y;
+    END;
+  END;
+  
+  (* change 5% *)
+  x_min := x_min - x_min / 20.0;
+  x_max := x_max + x_max / 20.0;
+  y_min := y_min - y_min / 20.0;
+  y_max := y_max + y_max / 20.0;
+  
+  x_offset := x_min;
+  y_offset := y_min;
+  
+  x_scale := FLOAT( nx ) / ( x_max - x_min );
+  y_scale := FLOAT( ny ) / ( y_max - y_min );
+
+  BeginVGA; EraseScreen;
+  
+  FOR loop := 1 TO max_loop DO
+  FOR iter := 1 TO max_iter DO
+    Function;
+
+    i := TRUNC( ( x - x_offset ) * x_scale );
+    j := TRUNC( ( y - y_offset ) * y_scale );
+
+    IF ( i > 0 ) & ( i <= nx ) & ( j > 0 ) & ( j <= ny ) THEN
+      Move( i, j ); Dot;
+    END;
+
+  END; END;
+
+  Move( 600, 10 ); Text( 'done' );
+  Read( ch );
+  EndVGA;
+  
+END Symmetry.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/blockio_1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/blockio_1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/blockio_1.mod
@@ -0,0 +1,64 @@
+MODULE FileCopy;
+
+(*
+ show an example of using BlockIO,
+ copy from one file to another,
+ then use VMS DIFFERENCE to make sure they are the same
+ use this to copy .EXE files because the file type created by the OpenOut
+ procedure is the same as for .exe files
+*)
+(* J. Andrea, July 1991 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteCard, WriteString, WriteLn, ReadString, ReadLn;
+FROM BlockIO IMPORT BlockFile, OpenIn, OpenOut, Read, Write, Close, Done;
+
+VAR
+  inf, outf      :BlockFile;
+  infile,outfile :ARRAY [0..80] OF CHAR;
+  block          :ARRAY [0..511] OF CHAR;
+  count, size    :CARDINAL;
+  i, j, n        :CARDINAL;
+
+BEGIN (* Test *)
+
+WriteString( ' input file ? ' );
+ReadString( infile ); ReadLn;
+
+WriteString( ' output file ? ' );
+ReadString( outfile ); ReadLn;
+
+OpenIn( inf, infile );
+
+IF Done() THEN
+
+  OpenOut( outf, outfile );
+
+  IF Done() THEN
+
+    count := 1;
+    Read( inf, count, block, size );
+
+    WHILE Done() DO
+      WriteCard( count, 1 ); WriteString( ' block = ' );
+      WriteCard( size, 1 );  WriteString( ' bytes.' ); WriteLn;
+
+      Write( outf, count, block, size );
+
+      count := count + 1;
+      Read( inf, count, block, size );
+    END;
+
+    Close( outf );
+
+  ELSE
+     WriteString( 'output file not opened' ); WriteLn;
+  END;
+
+  Close( inf );
+
+ELSE
+  WriteString( 'input file not opened' ); WriteLn;
+END;
+
+END FileCopy.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/blockio_2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/blockio_2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/blockio_2.mod
@@ -0,0 +1,83 @@
+MODULE Dump;
+
+(*
+ show an example of using BlockIO,
+ do a file dump
+*)
+(* J. Andrea, July 1991 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteCard, WriteString, WriteLn, ReadString, ReadLn;
+FROM BlockIO IMPORT BlockFile, OpenIn, Read, Close, Done;
+
+VAR
+  f           :BlockFile;
+  filename    :ARRAY [0..80] OF CHAR;
+  block       :ARRAY [0..511] OF CHAR;
+  count, size :CARDINAL;
+
+  (* ----------------------------------------------------------- *)
+  PROCEDURE DoDump;
+  VAR
+     i, j, n :CARDINAL;
+  BEGIN
+
+    i := 0;
+    WHILE i < size + 20 DO
+       IF i + 20 > size THEN
+         n := size - i - 1;
+       ELSE
+          n := 20;
+       END;
+ 
+       (* this first line of the dump is the displayable characters *)
+       FOR j := i TO i + n DO
+          WriteString( '  ' );
+          IF ( block[j] >= ' ' ) & ( block[j] <= '~' ) THEN
+            WriteString( block[j] );
+          ELSE
+            WriteString( '.' );
+          END;
+       END;
+       WriteLn;
+
+       (* this second line is the ascii values *)
+       FOR j := i TO i + n DO
+          WriteCard( ORD( block[j] ), 3 );
+       END;
+       WriteLn;
+
+       i := i + 20;
+     END;
+
+  END DoDump;
+
+BEGIN (* Test *)
+
+WriteString( ' input file ? ' );
+ReadString( filename ); ReadLn;
+
+OpenIn( f, filename );
+
+IF Done() THEN
+
+  count := 1;
+  Read( f, count, block, size );
+
+  WHILE Done() DO
+    WriteCard( count, 1 ); WriteString( ' block = ' );
+    WriteCard( size, 1 );  WriteString( ' bytes.' ); WriteLn;
+
+    DoDump;
+
+    count := count + 1;
+    Read( f, count, block, size );
+  END;
+
+  Close( f );
+
+ELSE
+  WriteString( 'file not opened' ); WriteLn;
+END;
+
+END Dump.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/dirfiles-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/dirfiles-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/dirfiles-1.mod
@@ -0,0 +1,60 @@
+MODULE TestDirFiles;
+
+(* test direct access files *)
+(* revitalized, J. Andrea, Aug.12/91 *)
+(* J. Andrea, 1984 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteString, WriteLn;
+
+FROM DirectAccessFiles IMPORT DirectFile,   DirFileDone, DirFileStatus,
+                              DirectCreate, DirectOpen,
+                              DirectWrite,  DirectRead,  DirectClose;
+
+
+TYPE
+   String = ARRAY [0..80] OF CHAR;
+
+VAR
+   test_string   :String;
+   record_number :CARDINAL;
+   unit_1        :DirectFile;
+
+BEGIN (* TestDirFiles *)
+
+WriteLn;
+
+DirectCreate( unit_1, 'TESTDIR.TMP', 10 );
+IF NOT DirFileDone THEN
+   WriteString('didnt create file'); WriteLn;
+   DirFileStatus;
+   HALT;
+END;
+
+test_string := 'this here is a string';
+
+DirectWrite( unit_1, 5, test_string, 11 );
+IF NOT DirFileDone THEN
+   WriteString('didnt write to file'); WriteLn;
+   DirFileStatus;
+   DirectClose(unit_1);
+   HALT;
+END;
+
+test_string := '_____________________________';
+
+DirectRead( unit_1, 5, test_string, 11 );
+IF NOT DirFileDone THEN
+   WriteString('didnt read from file'); WriteLn;
+   DirFileStatus;
+   DirectClose(unit_1);
+   HALT;
+END;
+
+WriteString(test_string); WriteLn;
+
+DirectClose(unit_1);
+
+WriteString('all done'); WriteLn; WriteLn;
+
+END TestDirFiles.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/dirfiles-2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/dirfiles-2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/dirfiles-2.mod
@@ -0,0 +1,82 @@
+MODULE TestDirFiles2;
+
+(* test direct access files *)
+(* J. Andrea, Aug.12/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteCard, WriteString, WriteLn;
+
+FROM Randomly IMPORT Choose_1_To_N;
+
+FROM DirectAccessFiles IMPORT DirectFile,   DirFileDone, DirFileStatus,
+                              DirectCreate,
+                              DirectWrite,  DirectRead,  DirectClose;
+
+
+CONST
+   n_rec = 10;
+   width = 20;
+
+TYPE
+   String = ARRAY [0..width] OF CHAR;
+
+VAR
+   test_string   :String;
+   i             :CARDINAL;
+   file          :DirectFile;
+
+BEGIN (* TestDirFiles *)
+
+WriteLn;
+
+WriteString( 'creating a file' ); WriteLn;
+
+DirectCreate( file, 'TESTDIR.TMP', n_rec );
+
+IF DirFileDone THEN
+
+  WriteString( 'filling the file with junk' ); WriteLn;
+
+  test_string := 'JUNKJUNKJUNKJUNKJUNK';
+
+  FOR i := 1 TO n_rec DO
+    DirectWrite( file, i, test_string, width );
+  END;
+
+  WriteString( 'now choose a record at random, and put something there' );
+  WriteLn;
+
+  i := Choose_1_To_N( n_rec );
+
+  WriteString( 'record chosen = ' ); WriteCard( i, 0 ); WriteLn;
+
+  test_string := '--here is a record--';
+  DirectWrite( file, i, test_string, width );
+
+  IF DirFileDone THEN
+
+    WriteString( 'read back to whole file in sequence' ); WriteLn;
+    WriteString( 'and display the file to see the non junk' ); WriteLn;
+
+    WriteLn;
+
+    FOR i := 1 TO n_rec DO
+      DirectRead( file, i, test_string, width );
+      WriteString( test_string ); WriteLn;
+    END;
+
+  ELSE
+    WriteString('didnt write to file'); WriteLn;
+    DirFileStatus;
+  END;
+
+  DirectClose( file );
+ 
+ELSE
+   WriteString('didnt create file'); WriteLn;
+   DirFileStatus;
+END;
+
+WriteLn; WriteString('all done'); WriteLn; WriteLn;
+
+END TestDirFiles2.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/foreigncommand.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/foreigncommand.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/foreigncommand.mod
@@ -0,0 +1,40 @@
+MODULE TestForeignCommand;
+
+(* This program shows how to use the module ForeignCommand *)
+(* V1.0, J. Andrea, May.4/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM ForeignCommand IMPORT ReadCommand, NOptions, GetOption;
+FROM InOut IMPORT WriteCard, WriteString, WriteLn;
+
+VAR
+   string :ARRAY [1..80] OF CHAR;
+   len, i :CARDINAL;
+   
+BEGIN
+
+   (* setup the command first *)
+
+   ReadCommand( 'this is a test prompt ? ' );
+
+   WriteString( 'detected ' ); WriteCard( NOptions(), 0 ); 
+   WriteString( ' options' ); WriteLn;
+
+   (* then show the first ten options *)
+
+   FOR i := 1 TO 10 DO
+      WriteString( 'option #' ); WriteCard( i, 2 );
+
+      GetOption( i, string, len );
+
+      IF len = 0 THEN
+        WriteString( ' --none-- ' );
+      ELSE
+        WriteString ( ' is >' );
+        WriteString( string );
+        WriteString( '<' );
+      END;
+      WriteLn;
+   END;
+
+END TestForeignCommand.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/get-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/get-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/get-1.mod
@@ -0,0 +1,49 @@
+MODULE TestGet;
+
+(* an example of how to use the GetCharacter procedures *)
+(* J. Andrea, Aug.21/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM GetCharacter IMPORT StartGet, StopGet, Get, GetNoWait;
+FROM InOut IMPORT WriteString, WriteLn, WriteCard;
+
+VAR
+  c :CHAR;
+  i :CARDINAL;
+
+BEGIN
+
+WriteString( 'about to enter single character mode' ); WriteLn;
+WriteString( 'hit any key, Q to quit' ); WriteLn;
+
+StartGet;
+
+Get( c );
+WHILE CAP( c ) # 'Q' DO
+  WriteString( c ); WriteLn; 
+  Get( c );
+END;
+
+StopGet;
+
+WriteLn; WriteLn;
+WriteString( 'about to enter single character mode with no waiting' ); WriteLn;
+WriteString( 'hit any key to restart, hit Q to quit' ); WriteLn;
+
+StartGet;
+
+GetNoWait( c );  i := 0;
+WHILE CAP( c ) # 'Q' DO
+
+  IF c # 0C THEN
+    i := 0;
+  END;
+
+  WriteCard( i, 0 ); WriteLn;
+
+  GetNoWait( c );   i := i + 1;
+END;
+
+StopGet;
+
+END TestGet.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/get-2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/get-2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/get-2.mod
@@ -0,0 +1,62 @@
+MODULE TestGet;
+
+(* test the GetCharacter module *)
+(* and use this as an example to show how it is used *)
+
+(* revitalized, J. Andrea, Aug.12/91 *)
+(* J. Andrea, 1984 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteCard, WriteLn, WriteString;
+
+FROM GetCharacter IMPORT Get,   SetPassallCharacterMode,
+                              UnSetPassallCharacterMode;
+
+CONST
+   control_z = 32C;
+   max_gets  = 100;
+
+VAR
+   c         :CHAR;
+   v, n_gets :CARDINAL;
+
+BEGIN (* TestGet *)
+
+WriteLn;
+WriteString('This program reads (with no carriage-return needed) a character');
+WriteLn;
+WriteString('until a Control-Z is given.'); WriteLn;
+WriteString('And displays the ASCII number and value of the character.');
+WriteLn; WriteLn;
+WriteString('Because this program cannot be broken');
+WriteString(', a maximum of 100 characters can be given.');
+WriteLn;
+
+SetPassallCharacterMode;
+
+Get(c);   n_gets := 1;
+
+WHILE ( c # control_z ) & ( n_gets < max_gets ) DO
+
+  v := ORD(c);
+
+  WriteCard(v,3); WriteString('  ');   (* show its ascii value *)
+
+  IF c >= ' ' THEN
+     (* just an ordinary character *)
+     WriteString(c);
+  ELSE
+     (* it was a control character, so show which one *)
+     WriteString('^'); WriteString(CHR(v + 64));
+  END;(* if *)
+
+  WriteLn; WriteLn;
+
+  Get(c);    n_gets := n_gets + 1;
+END; (* while *)
+
+UnSetPassallCharacterMode;
+
+WriteLn; WriteString('All done.'); WriteLn;
+
+END TestGet.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/hilbert_regis.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/hilbert_regis.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/hilbert_regis.mod
@@ -0,0 +1,88 @@
+MODULE Hilbert;
+
+(* Draw a Hilbert curve,
+   taken from Algorithms and Data Structures, N. Wirth *)
+(* implemented using REGIS graphics by J. Andrea, May.7/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM Terminal      IMPORT Read, WriteString, WriteLn;
+FROM REGISGraphics IMPORT BeginRegis, EndRegis,
+                          EraseScreen, GetDimensions,
+                          Move, VectorLine;
+
+VAR
+  max_row, max_col :CARDINAL;
+  square_size      :CARDINAL;
+  i, h, x0, y0     :CARDINAL;
+  ch               :CHAR;
+
+  (* ----------------------------------------------------------- *)
+  PROCEDURE line( direction, length :CARDINAL );
+  BEGIN
+    VectorLine( length, FLOAT( direction ) * 45. );
+  END line;
+  
+  (* ----------------------------------------------------------- *)
+  PROCEDURE A( k :CARDINAL );
+  BEGIN
+    IF k > 0 THEN
+      D(k-1); line(4,h); A(k-1); line(6,h); A(k-1); line(0,h); B(k-1);
+    END;
+  END A;
+
+  (* ----------------------------------------------------------- *)
+  PROCEDURE B( k :CARDINAL );
+  BEGIN
+    IF k > 0 THEN
+      C(k-1); line(2,h); B(k-1); line(0,h); B(k-1); line(6,h); A(k-1);
+    END;
+  END B;
+
+  (* ----------------------------------------------------------- *)
+  PROCEDURE C( k :CARDINAL );
+  BEGIN
+    IF k > 0 THEN
+      B(k-1); line(0,h); C(k-1); line(2,h); C(k-1); line(4,h); D(k-1);
+    END;
+  END C;
+
+  (* ----------------------------------------------------------- *)
+  PROCEDURE D( k :CARDINAL );
+  BEGIN
+    IF k > 0 THEN
+      A(k-1); line(6,h); D(k-1); line(4,h); D(k-1); line(2,h); C(k-1);
+    END;
+  END D;
+
+BEGIN
+
+GetDimensions( max_col, max_row );
+IF max_row < max_col THEN
+  square_size := max_row;
+ELSE
+  square_size := max_col;
+END;
+
+WriteLn;
+WriteString( 'Hit RETURN for the next iteration (max=6)' ); WriteLn;
+WriteString( 'or SPACE RETURN to stop the display' ); WriteLn;
+WriteLn;
+Read( ch );
+
+i := 0;  h := square_size;
+x0 := max_col DIV 4;  y0 := max_row DIV 2;
+
+REPEAT
+  i := i + 1;    h := h DIV 2;
+  x0 := x0 + h;  y0 := y0 + h;
+
+  BeginRegis( 'SYS$OUTPUT' );   EraseScreen;
+
+  Move( x0, y0 );  A(i);
+
+  EndRegis;
+
+  Read( ch );
+UNTIL ( i = 7 ) OR ( ch = ' ' );
+
+END Hilbert.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/lookup.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/lookup.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/lookup.mod
@@ -0,0 +1,24 @@
+MODULE TestLookup;
+
+(* test the procedure Lookup, and show how its used *)
+(* J. Andrea, 1984 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut      IMPORT WriteLn, WriteString;
+FROM FileSystem IMPORT File, Lookup, Done;
+
+VAR
+   x : File;
+
+BEGIN (* TestLookup *)
+
+WriteString('about to open the file "X.TMP"'); WriteLn;
+
+Lookup( x, 'X.TMP', TRUE );
+IF Done() THEN
+  WriteString(' worked ok '); WriteLn;
+ELSE
+  WriteString(' didnt work '); WriteLn;
+END; (* if *)
+
+END TestLookup.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/pi.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/pi.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/pi.mod
@@ -0,0 +1,20 @@
+MODULE TestPi;
+
+(* Test the CalcPi routine *)
+(* J. Andrea, 1992 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM RealInOut IMPORT FWriteReal;
+FROM InOut     IMPORT WriteLn;
+FROM MoreMath  IMPORT CalcPi;
+
+VAR
+  x :REAL;
+
+BEGIN
+
+x := CalcPi();
+
+FWriteReal( x, 9, 7 ); WriteLn;
+
+END TestPi.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/pig_latin.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/pig_latin.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/pig_latin.mod
@@ -0,0 +1,179 @@
+MODULE PigLatin;
+
+(* Convert a text file into pig-latin. *)
+(* J. Andrea, Mar./91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT ReadString, ReadLn, WriteString, WriteLn, Done,
+                  OpenInput, CloseInput, OpenOutput, CloseOutput;
+
+CONST
+  nul = 0C;
+
+TYPE
+  String = ARRAY [0..132] OF CHAR;
+
+VAR
+  in_word, out_word  :String;
+  i, j, n, out_len   :CARDINAL;
+  first_word_in_line :BOOLEAN;
+
+      (* ----------------------------------------------------- *)
+      PROCEDURE Alphabet( c :CHAR ) :BOOLEAN;
+      BEGIN
+         c := CAP( c );
+         RETURN ( c >= 'A' ) & ( c <= 'Z' )
+      END Alphabet;
+
+      (* ----------------------------------------------------- *)
+      PROCEDURE Vowel( c :CHAR ) :BOOLEAN;
+      BEGIN
+         c := CAP( c );
+         RETURN ( c = 'A' ) OR ( c = 'E' ) OR ( c = 'I' ) OR
+                ( c = 'O' ) OR ( c = 'U' )
+      END Vowel;
+
+      (* ----------------------------------------------------- *)
+      PROCEDURE StartBufferText;
+      BEGIN (* StartBufferText *)
+        out_len := 0;
+        first_word_in_line := TRUE;
+      END StartBufferText;
+
+      (* ----------------------------------------------------- *)
+      PROCEDURE EndBufferText;
+      BEGIN (* EndBufferText *)
+        IF out_len > 0 THEN
+          WriteLn;
+        END;
+      END EndBufferText;
+
+      (* ----------------------------------------------------- *)
+      PROCEDURE BufferText( string :ARRAY OF CHAR; space :BOOLEAN );
+      CONST
+        max = 75;
+      VAR
+        len :CARDINAL;
+      BEGIN (* BufferText *)
+      
+        len := LEN( string );
+      
+        IF ( len + out_len + 1 > max ) & space THEN
+          WriteLn;
+          out_len := 0;
+          first_word_in_line := TRUE;
+        END;
+
+        IF space & NOT first_word_in_line THEN
+          WriteString( ' ' );
+          out_len := out_len + 1;
+        END;
+      
+        WriteString( string );
+        out_len := out_len + len;
+      
+        first_word_in_line := FALSE;
+      
+      END BufferText;
+
+   (* ----------------------------------------------------- *)
+   PROCEDURE StringToPig( string :ARRAY OF CHAR );
+   (* This word may have a dish in it, or punctuation attached to it,
+      so break it into any subwords, and deal with them one at a time *)
+
+   VAR
+      L, p, q, i, n   :CARDINAL;
+      front, no_vowel :BOOLEAN;
+      first_letter    :CHAR;
+   
+   BEGIN (* StringToPig *)
+      
+     front := TRUE;
+
+     L := LEN( string );
+      
+     p := 0;
+     WHILE p < L DO
+
+       (* find the end of this word *)
+       q := p;
+       WHILE ( q < L ) & Alphabet( string[q] ) DO
+         q := q + 1;
+       END;
+       q := q - 1;
+
+       first_letter := string[p];
+
+       no_vowel := NOT Vowel( first_letter );
+
+       IF no_vowel THEN p := p + 1; END;
+
+       n := 0;
+       FOR i := p TO q DO
+         out_word[n] := string[i];
+         n := n + 1;
+       END;
+       out_word[n] := 0C;
+      
+       BufferText( out_word,  front );     
+
+       IF no_vowel THEN BufferText( first_letter, FALSE ); END;
+
+       BufferText( 'ay', FALSE );
+
+       front := FALSE;
+
+       (* now find any non alphabetic parts and just output them *)
+
+       p := q + 1;
+
+       IF p < L THEN
+
+         q := p;
+         WHILE ( q < L ) & NOT Alphabet( string[q] ) DO
+           q := q + 1;
+         END;
+         q := q - 1;
+
+         n := 0;
+         FOR i := p TO q DO
+           out_word[n] := string[i];
+           n := n + 1;
+         END;
+         out_word[n] := 0C;
+      
+         BufferText( out_word, FALSE );
+
+         p := q + 1;
+       END;
+
+     END;
+
+   END StringToPig;
+
+BEGIN (* PigLatin *)
+
+OpenInput( '.TXT' ); OpenOutput( '.PIG' );
+
+StartBufferText;
+
+ReadString( in_word );
+WHILE Done DO
+
+  IF Alphabet( in_word[0] ) THEN
+
+    StringToPig( in_word );
+
+  ELSE
+    (* ignore anything that doesn't start with a letter *)
+    BufferText( in_word, TRUE );
+  END;
+
+  ReadString( in_word );
+END;
+
+EndBufferText;
+
+CloseInput; CloseOutput;
+
+END PigLatin. 
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/ranplot.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/ranplot.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/ranplot.mod
@@ -0,0 +1,59 @@
+MODULE TestRanPlot;
+
+(* Test the plotter routines and the random number generation *)
+
+(* J. Andrea, Oct.13/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM InOut IMPORT WriteString, WriteCard, WriteLn, WriteReal;
+FROM Plotter IMPORT Plot;
+FROM Randomly IMPORT NormalRandom;
+
+CONST
+  n_bins =  200;
+  n      = 2000;
+  
+VAR
+  i, j :CARDINAL;
+  bottom, middle, top, z, delta :REAL;
+  x, y :ARRAY [1..n_bins] OF REAL;
+   
+BEGIN
+
+  bottom := 100.0;
+  middle := 300.0;
+  top    := 500.0;
+  
+  FOR i := 1 TO n_bins DO
+    y[i] := 0.0;
+  END;
+  delta := ( top - bottom ) / FLOAT( n_bins );
+  x[1] := bottom;
+  FOR i := 2 TO n_bins DO
+    x[i] := x[i-1] + delta;
+  END;
+  WriteString( 'smallest bin: ' ); WriteReal( x[1], 7 ); WriteLn;
+  WriteString( 'biggest  bin: ' ); WriteReal( x[n_bins], 7 ); WriteLn;
+  
+  FOR i := 1 TO n DO
+    z := NormalRandom( middle, 40.0 );
+    IF z <= bottom THEN
+      y[1] := y[1] + 1.0;
+    ELSE
+      IF z >= top THEN
+        y[n_bins] := y[n_bins] + 1.0;
+      ELSE
+      
+        j := 1;
+        WHILE z > x[j] DO
+           j := j + 1;
+        END;
+        y[j] := y[j] + 1.0;
+        
+      END;
+    END;
+  END;
+   
+  Plot( 'test.regis', 'test plot', x, y, n_bins );
+  
+END TestRanPlot.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/regis-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/regis-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/regis-1.mod
@@ -0,0 +1,36 @@
+MODULE TestRegis;
+
+(* do some simple tests of the RegisGraphics module, and show how its used *)
+(* J. Andrea, June 1991 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM REGISGraphics IMPORT BeginRegis, EndRegis,
+                          EraseScreen, GetDimensions,
+                          Dot, Move, Line, Circle, Rectangle, VectorLine;
+
+VAR
+  max_row, max_col :CARDINAL;
+  mid_row, mid_col :CARDINAL;
+
+BEGIN
+
+BeginRegis( 'SYS$OUTPUT' );
+
+EraseScreen;
+
+Move( 200, 200 ); Circle( 50, TRUE );
+Move( 200, 200 ); Line( 300, 300 );
+
+Move( 50, 400 ); Dot;
+
+Move( 50, 50 ); Rectangle( 50, 100, TRUE ); Rectangle( 55, 105, FALSE );
+
+GetDimensions( max_col, max_row );
+mid_row := max_row DIV 2; mid_col := max_col DIV 2;
+
+Move( mid_col, mid_row );
+VectorLine( 100, 0. ); VectorLine( 100, 45. );
+
+EndRegis;
+
+END TestRegis.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/regis-2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/regis-2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/regis-2.mod
@@ -0,0 +1,38 @@
+MODULE TestRegis;
+
+(* test the RegisGraphics module and show how its used *)
+(* J. Andrea, June 1991 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM REGISGraphics IMPORT BeginRegis, EndRegis, GetDimensions,
+                          EraseScreen, Move, VectorLine;
+
+VAR
+  max_row, max_col :CARDINAL;
+  mid_row, mid_col :CARDINAL;
+
+BEGIN
+
+BeginRegis( 'SYS$OUTPUT' );
+
+EraseScreen;
+
+GetDimensions( max_col, max_row );
+mid_row := max_row DIV 2; mid_col := max_col DIV 2;
+
+Move( mid_col, mid_row ); VectorLine( 100, 0. );
+Move( mid_col, mid_row ); VectorLine( 100, 20. );
+Move( mid_col, mid_row ); VectorLine( 100, 45. );
+Move( mid_col, mid_row ); VectorLine( 100, 80. );
+Move( mid_col, mid_row ); VectorLine( 100, 90. );
+Move( mid_col, mid_row ); VectorLine( 100, 100. );
+Move( mid_col, mid_row ); VectorLine( 100, 135. );
+Move( mid_col, mid_row ); VectorLine( 100, 180. );
+Move( mid_col, mid_row ); VectorLine( 100, 225. );
+Move( mid_col, mid_row ); VectorLine( 100, 270. );
+Move( mid_col, mid_row ); VectorLine( 100, 315. );
+Move( mid_col, mid_row ); VectorLine( 100, 360. );
+
+EndRegis;
+
+END TestRegis.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/show_memory_use.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/show_memory_use.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/show_memory_use.mod
@@ -0,0 +1,63 @@
+MODULE ShowMem;
+
+(* Show the usage of dynamic memory *)
+(* V1.0, J. Andrea, Sept.4/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM InOut IMPORT WriteString, WriteCard, WriteLn;
+FROM MemoryStatus IMPORT Used, Available;
+FROM Storage IMPORT ALLOCATE;
+FROM SYSTEM IMPORT TSIZE;
+
+TYPE
+   Big = RECORD
+           value :ARRAY [1..25000] OF CARDINAL;     (* this is a big record *)
+         END;
+
+VAR
+   big     :POINTER TO Big;
+   i, size :CARDINAL;
+   u, a, t :CARDINAL;
+
+   (* ------------------------------------- *)
+   PROCEDURE Show;
+   BEGIN
+     WriteString( 'used =' ); WriteCard( Used(), 9 );  WriteString( ' ' );
+     WriteString( 'avail=' ); WriteCard( Available(), 9 );
+   END Show;
+
+BEGIN
+
+size := TSIZE( Big );
+
+u := Used();   a := Available();
+Show; WriteString( ' initial' ); WriteLn;
+
+t := 0;
+FOR i := 1 TO 9 DO
+   NEW( big );
+   t := t + size;
+
+   Show;
+   WriteString( ' grabbed ' ); WriteCard( size, 0 ); WriteString( ' bytes' );
+   WriteLn;
+END;
+
+WriteLn;
+
+u := Used() - u;
+WriteString( 'difference between initial used and now is ' );
+WriteCard( u, 0 ); WriteLn;
+
+a := a - Available();
+WriteString( 'difference between initial available and now is ' );
+WriteCard( a, 0 ); WriteLn;
+
+WriteString( 'difference those two is ' ); WriteCard( u - a, 0 ); WriteLn;
+
+WriteString( 'amount grabbed is ' ); WriteCard( t, 0 ); WriteLn;
+
+WriteString( 'difference between taken total and report is ' );
+WriteCard( a - t, 0 ); WriteString( ', must be overhead.' ); WriteLn;
+
+END ShowMem.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/sierpinski_regis.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/sierpinski_regis.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/sierpinski_regis.mod
@@ -0,0 +1,91 @@
+MODULE Sierpinski;
+
+(* Draw a Sierpinksi curve, taken from Programming In Modula-2, pp.111 *)
+(* implemented using REGIS graphics by J. Andrea, May.1/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM Terminal      IMPORT Read, WriteString, WriteLn;
+FROM REGISGraphics IMPORT BeginRegis, EndRegis,
+                          EraseScreen, GetDimensions,
+                          Move, VectorLine;
+
+VAR
+  max_row, max_col :CARDINAL;
+  square_size      :CARDINAL;
+  i, h, x0, y0     :CARDINAL;
+  ch               :CHAR;
+
+  (* ----------------------------------------------------------- *)
+  PROCEDURE line( direction, length :CARDINAL );
+  BEGIN
+    VectorLine( length, FLOAT( direction ) * 45. );
+  END line;
+  
+  (* ----------------------------------------------------------- *)
+  PROCEDURE A( k :CARDINAL );
+  BEGIN
+    IF k > 0 THEN
+      A(k-1); line(7,h); B(k-1); line(0,2*h); D(k-1); line(1,h); A(k-1);
+    END;
+  END A;
+
+  (* ----------------------------------------------------------- *)
+  PROCEDURE B( k :CARDINAL );
+  BEGIN
+    IF k > 0 THEN
+      B(k-1); line(5,h); C(k-1); line(6,2*h); A(k-1); line(7,h); B(k-1);
+    END;
+  END B;
+
+  (* ----------------------------------------------------------- *)
+  PROCEDURE C( k :CARDINAL );
+  BEGIN
+    IF k > 0 THEN
+      C(k-1); line(3,h); D(k-1); line(4,2*h); B(k-1); line(5,h); C(k-1);
+    END;
+  END C;
+
+  (* ----------------------------------------------------------- *)
+  PROCEDURE D( k :CARDINAL );
+  BEGIN
+    IF k > 0 THEN
+      D(k-1); line(1,h); A(k-1); line(2,2*h); C(k-1); line(3,h); D(k-1);
+    END;
+  END D;
+
+BEGIN
+
+GetDimensions( max_col, max_row );
+IF max_row < max_col THEN
+  square_size := max_row;
+ELSE
+  square_size := max_col;
+END;
+
+i := 0;  h := square_size DIV 4;
+
+x0 := max_col DIV 2; y0 := max_row DIV 2;
+
+WriteLn;
+WriteString( 'Hit RETURN for the next iteration (max=6)' ); WriteLn;
+WriteString( 'or SPACE RETURN to stop the display' ); WriteLn;
+WriteLn;
+Read( ch );
+
+REPEAT
+  x0 := x0 - h;  y0 := y0 + h;
+
+  BeginRegis( 'SYS$OUTPUT' );   EraseScreen;
+
+  Move( x0, y0 );
+  A(i); line(7,h); B(i); line(5,h); C(i); line(3,h); D(i); line(1,h);
+
+  EndRegis;
+
+  h := h DIV 2;
+
+  i := i + 1;
+  Read( ch );
+UNTIL ( i = 7 ) OR ( ch = ' ' );
+
+END Sierpinski.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/timer.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/timer.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/timer.mod
@@ -0,0 +1,56 @@
+MODULE TestTimer;
+    
+(* an example of how to time a program *)
+(* J. Andrea, Aug.20/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteString, WriteCard, WriteLn, ReadCard, ReadLn;
+
+FROM DateTime IMPORT TimeType, Hours, Minutes, Seconds, Hundredths;
+FROM Measures IMPORT InitTimer, GetTimer, FreeTimer;
+
+VAR
+  elapsed :TimeType;
+  cputime, bufio, dirio, pagefaults :CARDINAL;
+  hundred :CARDINAL;
+  n, i    :CARDINAL;
+  x       :REAL;
+  
+BEGIN
+
+    WriteString( ' how many loops (0 to end) ? ' );
+    ReadCard( n ); ReadLn;
+
+    WHILE n # 0 DO
+
+      InitTimer;
+
+      WriteCard( n, 0 ); WriteString( ' loops:' ); WriteLn;
+
+      x := 0.0;
+      FOR i := 1 TO n DO
+        x := x + 0.5;
+        x := x / 12.0;
+        x := x + 0.5;
+      END;
+
+      GetTimer( elapsed, cputime, bufio, dirio, pagefaults );
+
+      hundred := Hours( elapsed );
+      hundred := hundred * 60  + Minutes( elapsed );
+      hundred := hundred * 60  + Seconds( elapsed );
+      hundred := hundred * 100 + Hundredths( elapsed );
+
+      WriteString( 'took cpu time of '); WriteCard( cputime, 0 );
+      WriteString( ' units of 10 milliseconds' ); WriteLn;
+      
+      WriteString( 'and real time of '); WriteCard( hundred, 0 );
+      WriteString( ' hundredths of seconds.' ); WriteLn;
+
+      WriteLn; WriteString( ' how many loops ? ' );
+      ReadCard( n ); ReadLn;
+   END;
+
+   FreeTimer;
+
+END TestTimer.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/windows.mod b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/windows.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/eth-hamburg/windows.mod
@@ -0,0 +1,71 @@
+MODULE TestWindows;
+
+(* test the simple windows module and show how its used *)
+(* J. Andrea, 1984 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SimpleWindows IMPORT
+      action_status, PasteBoard, Display,
+      CreateDisplay, CreatePasteBoard, DeleteChars,    DeleteDisplay,
+      DeleteLine,    DeletePasteBoard, DrawLine,       DrawRectangle,
+      EraseChars,    EraseDisplay,     EraseLine,      InsertChars,
+      InsertLine,    LabelBorder,      MoveCursor,     MoveDisplay,
+      PasteDisplay,  PopDisplay,       PutChars,       PutLine,
+      PutWithScroll, RepaintScreen,    RepasteDisplay, RestoreScreen,
+      RingBell,      SaveScreen,       SetCursor,      SetPhysicalCursor,
+      ScrollDisplay, UnpasteDisplay,
+      AddBorder,     RemoveBorder,
+      VideoTypes,    VideoAttributes,  ChangeDisplayVideo;
+
+VAR
+  a_board :PasteBoard;
+  a, b, c :Display;
+
+  attr    :VideoAttributes;
+
+BEGIN (* TestWindows *)
+
+(* create displays *)
+CreatePasteBoard( a_board );
+
+CreateDisplay( a, 10, 10, TRUE );
+CreateDisplay( b, 10, 20, TRUE );
+CreateDisplay( c, 10, 10, TRUE );
+
+(* do actions *)
+
+PutLine( a, 'first line', 1 );
+PutLine( b, 'second display', 1 );
+PutLine( c, 'next', 1 );
+
+PasteDisplay( a, a_board, 2, 3 );
+PasteDisplay( b, a_board, 10, 5 );
+PasteDisplay( c, a_board, 16, 20 );
+
+INCL(attr,video_reverse);
+ChangeDisplayVideo( b, attr );
+
+PutLine( a, 'first line', 1 );
+PutLine( b, 'second display', 1 );
+PutLine( c, 'next', 1 );
+
+LabelBorder( b, 'number B' );
+
+RemoveBorder( a );
+RemoveBorder( b );
+RemoveBorder( c );
+
+AddBorder( a );
+AddBorder( b );
+AddBorder( c );
+
+SetPhysicalCursor( a_board, 23, 1 );
+
+DeleteDisplay( b );
+
+(* end actions *)
+
+(* get rid of displays *)
+DeletePasteBoard( a_board );
+
+END TestWindows.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/allqueens.mod b/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/allqueens.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/allqueens.mod
@@ -0,0 +1,62 @@
+MODULE AllQueens;
+(* From "Algorithms and Data Structures", N. Wirth, Prentice Hall, 1986 *)
+(* find all the solutions to the Eight Queens problem *)
+
+FROM InOut IMPORT WriteInt, WriteLn;
+
+VAR
+  i :INTEGER;
+  a :ARRAY [1..8] OF BOOLEAN;
+  b :ARRAY [2..16] OF BOOLEAN;
+  c :ARRAY [-7..7] OF BOOLEAN;
+  x :ARRAY [1..8] OF INTEGER;
+
+  PROCEDURE Print;
+  BEGIN
+    FOR i := 1 TO 8 DO
+       WriteInt( x[i], 4 );
+    END;
+    WriteLn;
+  END Print;
+
+  PROCEDURE Try( i :INTEGER );
+  VAR
+    j :INTEGER;
+  BEGIN
+
+    FOR j := 1 TO 8 DO
+
+       IF a[j] & b[i+j] & c[i-j] THEN
+         x[i] := j;
+         a[j] := FALSE; b[i+j] := FALSE; c[i-j] := FALSE;
+
+         IF i < 8 THEN
+           Try( i+1 );
+         ELSE
+           Print;
+         END;
+
+         a[j] := TRUE; b[i+j] := TRUE; c[i-j] := TRUE;
+       END;
+
+    END;
+
+  END Try;
+
+BEGIN
+
+  FOR i := 1 TO 8 DO
+     a[i] := TRUE;
+  END;
+
+  FOR i := 2 TO 16 DO
+     b[i] := TRUE;
+  END;
+
+  FOR i := -7 TO 7 DO
+     c[i] := TRUE;
+  END;
+
+  Try( 1 );
+
+END AllQueens.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/fractions.mod b/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/fractions.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/fractions.mod
@@ -0,0 +1,50 @@
+MODULE Fractions;
+
+(* Example program from  Programming In Modula-2, N. Wirth, pg.40 *)
+
+FROM InOut IMPORT Write, WriteLn, WriteString, WriteCard;
+
+CONST
+     Base = 10;
+     N = 32;
+
+VAR
+     rem, i, j, m :CARDINAL;
+     d            :ARRAY [1..N] OF CARDINAL;
+     x            :ARRAY [0..N] OF CARDINAL;
+
+BEGIN (* Fractions *)
+
+FOR i := 2 TO N DO
+
+  FOR j := 0 TO i - 1 DO
+     x[j] := 0;
+  END; (* for *)
+
+  m := 0;
+  rem := 1;
+
+  REPEAT
+    m := m + 1;
+    x[rem] := m;
+    rem := Base * rem;
+    d[m] := rem DIV i;
+    rem := rem MOD i;
+  UNTIL x[rem] # 0;
+
+  WriteCard( i, 6 );
+  WriteString( ' 0.' );
+  FOR j := 1 TO x[rem] - 1  DO
+     Write( CHR( d[j] + ORD("0")))
+  END; (* for *)
+
+  Write( "'" );
+  FOR j := x[rem] TO m DO
+    Write( CHR( d[j] + ORD("0")))
+  END; (* for *)
+
+  WriteLn;
+
+END; (* for *)
+
+END Fractions.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/harmonic.mod b/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/harmonic.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/harmonic.mod
@@ -0,0 +1,43 @@
+MODULE Harmonic;
+
+(* Example program from Programming In Modula-2, N. Wirth, pg.26 *)
+
+FROM InOut IMPORT Done, ReadCard, WriteString, WriteLn, WriteReal;
+
+VAR
+   i, n          :CARDINAL;
+   x, d, s1, s2  :REAL; 
+
+BEGIN (* Harmonic *)
+
+WriteString( " n = " );
+ReadCard( n );
+
+WHILE Done DO
+  s1 := 0.0; d := 0.0; i := 0;
+
+  REPEAT
+    d := d + 1.0;
+    i := i + 1;
+    s1 := s1 + 1.0 / d
+  UNTIL i >= n;
+
+  WriteReal( s1, 16 );
+  s2 := 0.0;
+
+  REPEAT
+     s2 := s2 + 1.0 / d;
+     d := d - 1.0;
+     i := i - 1;
+  UNTIL i = 0;
+
+  WriteReal( s2, 16 );
+  WriteLn;
+  WriteString( " n = " );
+  ReadCard( n );
+
+END; (* while *)
+
+WriteLn;
+
+END Harmonic.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/permute.mod b/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/permute.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/permute.mod
@@ -0,0 +1,70 @@
+MODULE Permute;
+
+(* Example program from Programming In Modula-2, N. Wirth, pg. 54 *)
+
+FROM InOut IMPORT Read, Write, WriteLn;
+
+VAR
+  n       :CARDINAL;
+  ch      :CHAR;
+  a       :ARRAY [1..20] OF CHAR;
+
+  (* ----------------------------------------------------- *)
+  PROCEDURE output;
+
+  VAR
+    i  :CARDINAL;
+
+  BEGIN (* output *)
+
+     FOR i := 1 TO n DO
+        Write( a[i] );
+     END; (* for *)
+
+     WriteLn;
+
+  END output;
+
+  (* ----------------------------------------------------- *)
+  PROCEDURE permute( k :CARDINAL );
+
+  VAR
+     i    :CARDINAL;
+     t    :CHAR;
+
+  BEGIN (* permute *)
+
+     IF k = 1 THEN
+       output
+     ELSE
+       permute( k - 1 );
+       FOR i := 1 TO k - 1 DO
+          t := a[i];
+          a[i] := a[k];
+          a[k] := t;
+          permute( k - 1 );
+          t := a[i];
+          a[i] := a[k];
+          a[k] := t;
+       END; (* for *)
+     END; (* if *)
+
+  END permute;
+
+BEGIN (* Permute *)
+
+Write( '>' );
+n := 0;
+Read( ch );
+
+WHILE ch > ' ' DO
+  n := n+ 1;
+  a[n] := ch;
+  Write( ch );
+  Read( ch );
+END; (* while *)
+
+WriteLn;
+permute( n );
+
+END Permute.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/postfix.mod b/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/postfix.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/postfix.mod
@@ -0,0 +1,120 @@
+MODULE Postfix;
+
+(* Example program from Programming In Modula-2, N. Wirth., pg. 56, *)
+(*  - no WINDOWS in this example *)
+
+(* this program translates a small language into postfix form
+ *  the language is
+ *
+ *           expression = term { [ '+' | '-' ] term }
+ *
+ *           term = factor { [ '*' | '/' ] factor }
+ *
+ *           factor = letter | '(' expression ')'
+ *
+ *   try as input
+ *      a+b
+ *      a*b+c
+ *      a+b*c
+ *      a*(b/(c-d))
+ *)
+
+FROM InOut      IMPORT Read, Write, WriteLn, EOL, in;
+FROM FileSystem IMPORT Eof;
+
+TYPE
+    range = [1..80];
+
+VAR
+   ch       :CHAR;
+   done     :BOOLEAN;
+   i, index :range;
+   out_line :ARRAY range OF CHAR;   
+
+   (* -------------------------------------- *)
+   PROCEDURE expression;
+
+   VAR
+      addop :CHAR;
+
+      (* ------------------------------------ *)
+      PROCEDURE term;
+
+      VAR 
+         mulop :CHAR;
+
+         (* --------------------------------- *)
+         PROCEDURE factor;
+
+         BEGIN (* factor *)
+
+             IF ch = '(' THEN
+    
+                Read(ch);
+                expression;
+                WHILE ch # ')' DO
+                   Read(ch)
+                END (* while *)
+
+             ELSE    
+
+                WHILE (ch < 'a') OR (ch > 'z') DO
+                   Read(ch)
+                END; (* while *)
+                out_line[index] := ch;
+                index := index + 1;
+
+             END; (* if *)
+
+             Read(ch);
+
+         END factor;
+
+      BEGIN (* term *)
+
+         factor;
+         WHILE (ch = '*') OR (ch = '/') DO
+            mulop := ch;
+            Read(ch);
+            factor;
+            out_line[index] := mulop;
+            index := index + 1
+         END; (* while *)
+
+      END term;
+
+   BEGIN (* expression *)
+
+     term;
+     WHILE (ch = '+') OR (ch = '-') DO
+        addop := ch;
+        Read(ch);
+        term;
+        out_line[index] := addop;
+        index := index + 1
+     END; (* while *)
+
+   END expression;
+   
+BEGIN (* Postfix *)
+
+  index := 1;
+
+  Write('>');
+  Read(ch);
+  WHILE ch > ' ' DO
+
+     expression;
+
+     FOR i := 1 TO index-1 DO
+       Write(out_line[i]);
+     END; (* for *)
+     WriteLn;
+     index := 1;
+
+     Write('>');
+     Read(ch)
+
+  END; (* while *)
+
+END Postfix.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/powersof2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/powersof2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/powersof2.mod
@@ -0,0 +1,69 @@
+MODULE PowersOf2;
+
+(* Example program from Programming In Modula-2, Niklaus Wirth ,pg.38 *)
+
+FROM InOut IMPORT Write , WriteLn , WriteString , WriteCard;
+
+CONST
+     m = 11;
+     n = 32; (* m ~= n * log(2) *)
+VAR
+     i, j, k, exp, c, r, t :CARDINAL;
+     d, f                  :ARRAY [0..n] OF CARDINAL;
+
+BEGIN (* PowersOf2 *)
+
+d[0] := 1;
+k := 1;
+
+FOR exp := 1 TO n DO     (* compute d =  2^exp by   d := 2*d  *)
+
+    c := 0;  (* carry *)
+
+    FOR i := 0 TO k-1 DO
+        t := 2 * d[i] + c;
+        IF t >= 10 THEN
+           d[i] := t - 10;
+           c := 1
+        ELSE
+           d[i] := t;
+           c := 0
+        END (* if *)
+     END; (* for *)
+     
+     IF c > 0 THEN
+        d[k] := 1;
+        k := k + 1;
+     END; (* if *)
+
+     (* output d[k-1]..d[0] *)
+     i := m;
+     REPEAT
+       i := i - 1;
+       Write(' ')
+     UNTIL i = k;
+     REPEAT
+       i := i - 1;
+       Write(CHR(d[i] + ORD('0')))
+     UNTIL i = 0;
+
+     WriteCard(exp,4);
+     WriteString('  ');
+
+     (* compute and output   f := 2^(-exp) ,by f := f DIV 2 *)
+     WriteString('0.');
+     r := 0; (* remainder *)
+     FOR j := 1 TO exp-1 DO
+         r := 10 * r + f[j];
+         f[j] := r DIV 2;
+         r := r MOD 2;
+         Write(CHR(f[j] + ORD('0')));
+     END; (* for *)
+
+     f[exp] := 5;
+     Write('5');
+     WriteLn;
+
+   END; (* for *)
+
+END PowersOf2.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/primes.mod b/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/primes.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/from-pim2/primes.mod
@@ -0,0 +1,64 @@
+MODULE Primes;
+
+(* Example program from Programming In Modula-2, N. Wirth, pg 41 *)
+
+FROM InOut IMPORT WriteLn, WriteCard;
+
+CONST
+    N = 500; M = 23; (*  M ~ sqrt(N)  *)
+    LL = 10;  (* No. of primes placed on a line *)
+
+VAR
+    i, k, x              :CARDINAL;
+    inc, lim, square, L  :CARDINAL;
+    prime                :BOOLEAN;
+    P, V                 :ARRAY [0..M] OF CARDINAL;
+
+BEGIN (* Primes *)
+
+L := 0;
+x := 1;
+inc := 4;
+lim := 1;
+square := 9;
+
+FOR i := 3 TO N DO  (*  find next prime no. p[i] *)
+
+   REPEAT
+     x := x + inc;
+     inc := 6 - inc;
+
+     IF square <= x THEN 
+        lim := lim + 1;
+        V[lim] := square;
+        square := P[lim + 1] * P[lim + 1]
+     END; (* if *)
+
+     k := 2;
+     prime := TRUE;
+
+     WHILE prime & ( k < lim ) DO
+       k := k + 1;
+       IF V[k] < x THEN 
+          V[k] := V[k] + 2 * P[k]
+       END; (* if *)
+       prime := x # V[k]
+     END; (* while *)
+
+   UNTIL prime;
+
+   IF i <= M THEN
+      P[i] := x
+   END; (* if *)
+
+   WriteCard( x, 6 );
+   L := L + 1;
+
+   IF L = LL THEN
+      WriteLn;
+      L := 0
+   END; (* if *)
+
+END; (* for i *)
+
+END Primes.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/alpha_random.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/alpha_random.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/alpha_random.mod
@@ -0,0 +1,34 @@
+MODULE AlphaRandom;
+
+(* Randomize the alphabet, and show how to use the module Shuffle *)
+(* John Andrea, Apr.2/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM InOut IMPORT WriteLn, WriteString;
+FROM Shuffle IMPORT Deck, Create, Next, Reset;
+
+VAR
+  d                 :Deck;
+  i, j, min, max, n :CARDINAL;
+
+BEGIN
+
+  min := ORD( 'a' );
+  max := ORD( 'z' );
+
+  n   := max - min + 1;
+
+  Create( d, min, max );
+
+  FOR i := 1 TO 10 DO
+
+     WriteString( 'random alphabet = ' );
+     FOR j := 1 TO n DO
+        WriteString( CHR( Next( d ) ) );
+     END;
+     WriteLn;
+
+     Reset( d );
+  END;
+
+END AlphaRandom.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/base2-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/base2-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/base2-1.mod
@@ -0,0 +1,25 @@
+MODULE TestBase2;
+
+(* Test the Base2 module *)
+(* John Andrea, Nov.18/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteCard, WriteString, WriteLn;
+FROM Base2 IMPORT ToBase2, HowMany2;
+
+VAR
+  string2 :ARRAY [0..30] OF CHAR;
+  i :CARDINAL;
+  ok :BOOLEAN;
+
+BEGIN
+
+  FOR i := 0 TO 20 DO
+    WriteCard( i, 2 );
+    ToBase2( i, string2, ok );
+    WriteString( '   base 2 = ' ); WriteString( string2 );
+    WriteString( '   #digits= ' ); WriteCard( HowMany2(i), 0 );
+    WriteLn;
+  END;
+
+END TestBase2.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/base2-2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/base2-2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/base2-2.mod
@@ -0,0 +1,35 @@
+MODULE TestBase2;
+
+(* Test the Base2 module *)
+(* John Andrea, Nov.18/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteCard, WriteString, WriteLn;
+FROM Base2 IMPORT ToBase2, FromBase2;
+
+VAR
+  string2 :ARRAY [0..30] OF CHAR;
+  i, j :CARDINAL;
+  ok, errors :BOOLEAN;
+
+BEGIN
+
+  errors := FALSE;
+
+  FOR i := 0 TO 4000 DO
+    ToBase2( i, string2, ok );
+    FromBase2( string2, j, ok );
+    IF i # j THEN
+      errors := TRUE;
+      WriteCard( i, 2 );
+      WriteString( '   base 2 = ' ); WriteString( string2 );
+      WriteString( ' convert error ' ); WriteCard( j, 0 );
+      WriteLn;
+    END;
+  END;
+
+  IF NOT errors THEN
+    WriteString( 'all ok' ); WriteLn;
+  END;
+
+END TestBase2.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/base2-3.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/base2-3.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/base2-3.mod
@@ -0,0 +1,147 @@
+MODULE TestBase2;
+
+(* Test the Base2 module *)
+(* John Andrea, Nov.18/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteCard, WriteString, WriteLn;
+FROM Base2 IMPORT ToBase2, FromBase2;
+FROM StringOperations IMPORT Equal;
+
+CONST
+  max_known = 48;
+
+VAR
+  string2 :ARRAY [0..30] OF CHAR;
+  i, j :CARDINAL;
+  ok, errors :BOOLEAN;
+
+  known10 :ARRAY [1..max_known] OF CARDINAL;
+  known2  :ARRAY [1..max_known] OF ARRAY [0..30] OF CHAR;
+  
+BEGIN
+
+known10[1] := 0;
+known2[1]  := '0';
+known10[2] := 1;
+known2[2]  := '1';
+known10[3] := 2;
+known2[3]  := '10';
+known10[4] := 3;
+known2[4]  := '11';
+known10[5] := 7;
+known2[5]  := '111';
+known10[6] := 8;
+known2[6]  := '1000';
+known10[7] := 9;
+known2[7]  := '1001';
+known10[8] := 15;
+known2[8]  := '1111';
+known10[9] := 16;
+known2[9]  := '10000';
+known10[10] := 27;
+known2[10]  := '11011';
+known10[11] := 28;
+known2[11]  := '11100';
+known10[12] := 29;
+known2[12]  := '11101';
+known10[13] := 30;
+known2[13]  := '11110';
+known10[14] := 31;
+known2[14]  := '11111';
+known10[15] := 32;
+known2[15]  := '100000';
+known10[16] := 63;
+known2[16]  := '111111';
+known10[17] := 64;
+known2[17]  := '1000000';
+known10[18] := 65;
+known2[18]  := '1000001';
+known10[19] := 99;
+known2[19]  := '1100011';
+known10[20] := 100;
+known2[20]  := '1100100';
+known10[21] := 101;
+known2[21]  := '1100101';
+known10[22] := 127;
+known2[22]  := '1111111';
+known10[23] := 128;
+known2[23]  := '10000000';
+known10[24] := 129;
+known2[24]  := '10000001';
+known10[25] := 199;
+known2[25]  := '11000111';
+known10[26] := 200;
+known2[26]  := '11001000';
+known10[27] := 201;
+known2[27]  := '11001001';
+known10[28] := 254;
+known2[28]  := '11111110';
+known10[29] := 255;
+known2[29]  := '11111111';
+known10[30] := 256;
+known2[30]  := '100000000';
+known10[31] := 257;
+known2[31]  := '100000001';
+known10[32] := 299;
+known2[32]  := '100101011';
+known10[33] := 300;
+known2[33]  := '100101100';
+known10[34] := 301;
+known2[34]  := '100101101';
+known10[35] := 500;
+known2[35]  := '111110100';
+known10[36] := 501;
+known2[36]  := '111110101';
+known10[37] := 511;
+known2[37]  := '111111111';
+known10[38] := 512;
+known2[38]  := '1000000000';
+known10[39] := 513;
+known2[39]  := '1000000001';
+known10[40] := 999;
+known2[40]  := '1111100111';
+known10[41] := 1000;
+known2[41]  := '1111101000';
+known10[42] := 1001;
+known2[42]  := '1111101001';
+known10[43] := 1023;
+known2[43]  := '1111111111';
+known10[44] := 1024;
+known2[44]  := '10000000000';
+known10[45] := 1025;
+known2[45]  := '10000000001';
+known10[46] := 1076;
+known2[46]  := '10000110100';
+known10[47] := 1999;
+known2[47]  := '11111001111';
+known10[48] := 2000;
+known2[48]  := '11111010000';
+
+  errors := FALSE;
+
+  FOR i := 1 TO max_known DO
+    ToBase2( known10[i], string2, ok );
+    IF NOT Equal( string2, known2[i] ) THEN
+      errors := TRUE;
+      WriteCard( i, 0 );
+      WriteString( '   base 2 = ' ); WriteString( string2 );
+      WriteString( ' should be = ' ); WriteString( known2[i] );
+      WriteLn;
+    END;
+
+    FromBase2( known2[i], j, ok );
+    IF known10[i] # j THEN
+      errors := TRUE;
+      WriteString( known2[i] );
+      WriteString( '  base 10 = ' ); WriteCard( j, 0 );
+      WriteString( ' should be = ' ); WriteCard( known10[i], 0 );
+      WriteLn;
+    END;
+  END;
+
+  IF NOT errors THEN
+    WriteString( 'all ok' ); WriteLn;
+  END;
+
+END TestBase2.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/base3-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/base3-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/base3-1.mod
@@ -0,0 +1,25 @@
+MODULE TestBase3;
+
+(* Test the Base3 module *)
+(* J. Andrea, 1992 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteCard, WriteString, WriteLn;
+FROM Base3 IMPORT ToBase3, HowMany3;
+
+VAR
+  string3 :ARRAY [0..30] OF CHAR;
+  i :CARDINAL;
+  ok :BOOLEAN;
+
+BEGIN
+
+  FOR i := 0 TO 20 DO
+    WriteCard( i, 2 );
+    ToBase3( i, string3, ok );
+    WriteString( '   base 3 = ' ); WriteString( string3 );
+    WriteString( '   #digits= ' ); WriteCard( HowMany3(i), 0 );
+    WriteLn;
+  END;
+
+END TestBase3.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/base3-2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/base3-2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/base3-2.mod
@@ -0,0 +1,35 @@
+MODULE TestBase3;
+
+(* Test the Base3 module *
+(* J. Andrea, 1992 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteCard, WriteString, WriteLn;
+FROM Base3 IMPORT ToBase3, FromBase3;
+
+VAR
+  string3 :ARRAY [0..30] OF CHAR;
+  i, j :CARDINAL;
+  ok, errors :BOOLEAN;
+
+BEGIN
+
+  errors := FALSE;
+
+  FOR i := 0 TO 4000 DO
+    ToBase3( i, string3, ok );
+    FromBase3( string3, j, ok );
+    IF i # j THEN
+      errors := TRUE;
+      WriteCard( i, 2 );
+      WriteString( '   base 3 = ' ); WriteString( string3 );
+      WriteString( ' convert error ' ); WriteCard( j, 0 );
+      WriteLn;
+    END;
+  END;
+
+  IF NOT errors THEN
+    WriteString( 'all ok' ); WriteLn;
+  END;
+  
+END TestBase3.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/base3-3.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/base3-3.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/base3-3.mod
@@ -0,0 +1,136 @@
+MODULE TestBase3;
+
+(* Test the Base3 module *)
+(* John Andrea, Nov.18/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteCard, WriteString, WriteLn;
+FROM Base3 IMPORT ToBase3, FromBase3;
+FROM StringOperations IMPORT Equal;
+
+CONST
+  max_known = 42;
+
+VAR
+  string3 :ARRAY [0..30] OF CHAR;
+  i, j :CARDINAL;
+  ok, errors :BOOLEAN;
+
+  known10 :ARRAY [1..max_known] OF CARDINAL;
+  known3  :ARRAY [1..max_known] OF ARRAY [0..30] OF CHAR;
+  
+BEGIN
+
+known10[1] := 0;
+known3[1]  := '0';
+known10[2] := 1;
+known3[2]  := '1';
+known10[3] := 2;
+known3[3]  := '2';
+known10[4] := 3;
+known3[4]  := '10';
+known10[5] := 4;
+known3[5]  := '11';
+known10[6] := 8;
+known3[6]  := '22';
+known10[7] := 9;
+known3[7]  := '100';
+known10[8] := 10;
+known3[8]  := '101';
+known10[9] := 11;
+known3[9]  := '102';
+known10[10] := 17;
+known3[10]  := '122';
+known10[11] := 18;
+known3[11]  := '200';
+known10[12] := 19;
+known3[12]  := '201';
+known10[13] := 27;
+known3[13]  := '1000';
+known10[14] := 28;
+known3[14]  := '1001';
+known10[15] := 29;
+known3[15]  := '1002';
+known10[16] := 47;
+known3[16]  := '1202';
+known10[17] := 48;
+known3[17]  := '1210';
+known10[18] := 79;
+known3[18]  := '2221';
+known10[19] := 80;
+known3[19]  := '2222';
+known10[20] := 81;
+known3[20]  := '10000';
+known10[21] := 82;
+known3[21]  := '10001';
+known10[22] := 99;
+known3[22]  := '10200';
+known10[23] := 100;
+known3[23]  := '10201';
+known10[24] := 101;
+known3[24]  := '10202';
+known10[25] := 126;
+known3[25]  := '11200';
+known10[26] := 161;
+known3[26]  := '12222';
+known10[27] := 162;
+known3[27]  := '20000';
+known10[28] := 163;
+known3[28]  := '20001';
+known10[29] := 216;
+known3[29]  := '22000';
+known10[30] := 242;
+known3[30]  := '22222';
+known10[31] := 243;
+known3[31]  := '100000';
+known10[32] := 244;
+known3[32]  := '100001';
+known10[33] := 406;
+known3[33]  := '120001';
+known10[34] := 485;
+known3[34]  := '122222';
+known10[35] := 486;
+known3[35]  := '200000';
+known10[36] := 487;
+known3[36]  := '200001';
+known10[37] := 999;
+known3[37]  := '1101000';
+known10[38] := 1000;
+known3[38]  := '1101001';
+known10[39] := 1458;
+known3[39]  := '2000000';
+known10[40] := 1459;
+known3[40]  := '2000001';
+known10[41] := 1958;
+known3[41]  := '2200112';
+known10[42] := 2000;
+known3[42]  := '2202002';
+
+  errors := FALSE;
+
+  FOR i := 1 TO max_known DO
+
+    ToBase3( known10[i], string3, ok );
+    IF NOT Equal( string3, known3[i] ) THEN
+      errors := TRUE;
+      WriteCard( i, 0 );
+      WriteString( '   base 3 = ' ); WriteString( string3 );
+      WriteString( ' should be = ' ); WriteString( known3[i] );
+      WriteLn;
+    END;
+
+    FromBase3( known3[i], j, ok );
+    IF known10[i] # j THEN
+      errors := TRUE;
+      WriteString( known3[i] );
+      WriteString( '  base 10 = ' ); WriteCard( j, 0 );
+      WriteString( ' should be = ' ); WriteCard( known10[i], 0 );
+      WriteLn;
+    END;
+  END;
+
+  IF NOT errors THEN
+    WriteString( 'all ok' ); WriteLn;
+  END;
+
+END TestBase3.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/bitmap.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/bitmap.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/bitmap.mod
@@ -0,0 +1,117 @@
+MODULE TestBitmap;
+
+(* Produce a dragon curve to show how to use the bitmaps module *)
+(* J. Andrea, Apr.2/92 *)
+
+FROM BitmapOperations IMPORT Bitmap, Build, Clear, Put, PrintSixel, Line;
+
+CONST
+  rows = 200;  cols = 400;
+
+VAR
+  b :Bitmap;
+  ok :BOOLEAN;
+  x, y, side, angle :CARDINAL;
+
+  (* --------------------------------- *)
+  PROCEDURE Right;
+  BEGIN
+     angle := angle + 90;
+     IF angle >= 360 THEN
+       angle := angle - 360;
+     END;
+  END Right;
+
+  (* --------------------------------- *)
+  PROCEDURE Forward;
+  VAR
+    oldx, oldy :CARDINAL;
+
+    (* -------------------------------- *)
+    PROCEDURE Next( direction :CHAR; old, min, max :CARDINAL ) :CARDINAL;
+    (* don't grow off the ends *)
+    VAR new :CARDINAL;
+    BEGIN
+
+      IF direction = '+' THEN
+
+        IF max - old >= side THEN
+          new := old + side;
+        ELSE
+          new := max;
+        END;
+
+      ELSE
+
+        IF old - min >= side THEN
+          new := old - side;
+        ELSE
+          new := min;
+        END;
+
+      END;
+
+      RETURN new;
+    END Next;
+
+  BEGIN
+
+    oldx  := x;   oldy  := y;
+
+    IF    angle =   0 THEN
+      x := Next( '+', oldx, 1, cols );
+    ELSIF angle =  90 THEN
+      y := Next( '+', oldy, 1, rows );
+    ELSIF angle = 180 THEN
+      x := Next( '-', oldx, 1, cols );
+    ELSE (* 270 *)
+      y := Next( '-', oldy, 1, rows );
+    END;
+
+    Line( b, oldy, oldx, y, x, 1 );
+
+  END Forward;
+
+  (* --------------------------------- *)
+  PROCEDURE Dragon( depth :INTEGER );
+  BEGIN
+
+     IF depth = 0 THEN
+       Forward;
+     ELSE
+
+       IF depth > 0 THEN
+
+         Dragon( + (depth - 1) );
+         Right;
+         Dragon( - (depth - 1) );
+
+       ELSE
+
+         Dragon( - (depth + 1) );
+         Right; Right; Right;
+         Dragon( + (depth + 1) );
+
+       END;
+
+     END;
+
+  END Dragon;
+
+BEGIN
+
+  x := cols DIV 2;             (* start in the middle *)
+  y := rows DIV 2;
+
+  angle := 90;                 (* initial angle *)
+
+  side := 10;                  (* how many pixels to move every line *)
+
+
+  Build( b, rows, cols ); Clear( b );     (* create the bitmap *)
+
+  Dragon( 8 );                            (* draw the curve *)
+
+  PrintSixel( b, "dragon.sixel", ok );    (* put it into a file *)
+
+END TestBitmap.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/dates-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/dates-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/dates-1.mod
@@ -0,0 +1,58 @@
+MODULE TestDates;
+
+FROM InOut IMPORT WriteString, WriteLn, ReadString, WriteCard;
+FROM DateOperations IMPORT Date, StringToDate, DateToString,
+                           PhaseOfMoon, DayOfWeek, Today;
+                          
+VAR
+   string, name :ARRAY [1..30] OF CHAR;
+   date :Date;
+   
+   PROCEDURE Perform( date :Date );
+   VAR
+     continue :BOOLEAN;
+
+   BEGIN
+  
+      IF date.true THEN
+        WriteString( 'thats a valid date, lets continue' );
+        continue := TRUE;
+      ELSE
+        WriteString( 'thats NOT a valid date !' );
+        continue := FALSE;
+      END;
+      WriteLn;
+
+      WriteString( 'day=' ); WriteCard( date.day, 0 ); WriteLn;
+      WriteString( 'month=' ); WriteCard( date.month, 0 ); WriteLn;
+      WriteString( 'year=' ); WriteCard( date.year, 0 ); WriteLn;
+        
+      IF continue THEN
+        DateToString( date, string );
+        WriteString( 'shows as ' ); WriteString( string ); WriteLn;
+  
+        PhaseOfMoon( date, name );
+        WriteString( 'phase of moon =' ); WriteString( name ); WriteLn;
+      
+        DayOfWeek( date, name );
+        WriteString( 'day of week   =' ); WriteString( name ); WriteLn;
+      END;
+
+   END Perform;
+
+BEGIN
+  
+  Today( date );
+  DateToString( date, string );
+  WriteString( 'today is ' ); WriteString( string ); WriteLn;
+  Perform( date );
+  
+  WriteLn; WriteLn;
+  WriteString( 'now you pick a date !' ); WriteLn;
+
+  WriteString( 'date ? ' ); ReadString( string ); WriteLn;
+  WriteString( 'you typed in date=' ); WriteString( string ); WriteLn;
+  StringToDate( string, date );
+  Perform( date );
+
+END TestDates.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/dates-2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/dates-2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/dates-2.mod
@@ -0,0 +1,45 @@
+MODULE TestDates;
+
+FROM InOut IMPORT WriteString, WriteLn, ReadString, WriteCard, ReadCard;
+FROM DateOperations IMPORT Date, StringToDate, DateToString,
+                      AddDays, SubtractDays;
+ 
+TYPE
+  DateProc = PROCEDURE( Date, CARDINAL, VAR Date );
+   
+   (* --------------------------------- *)
+   PROCEDURE Run( sum :CHAR; DayProc :DateProc );
+   VAR
+   
+     string :ARRAY [1..30] OF CHAR;
+     date1, date2 :Date;
+     x :CARDINAL;
+     
+   BEGIN
+     WriteString( 'date (stop with q) ? ' ); ReadString( string ); WriteLn;
+     WHILE CAP( string[1] ) # 'Q' DO
+        StringToDate( string, date1 );
+        
+        WriteString( 'how many days ? ' ); ReadCard( x ); WriteLn;
+        DayProc( date1, x, date2 );
+        
+        DateToString( date1, string );
+        WriteString( string ); WriteString( ' ' ); WriteString( sum );
+        WriteString( ' ' ); WriteCard( x, 0 ); WriteString( ' days = ' );
+        DateToString( date2, string );
+        WriteString( string ); WriteLn;
+           
+        WriteString( 'date (stop with q) ? ' ); ReadString( string ); WriteLn;
+     END;
+   END Run;
+   
+BEGIN
+  
+  WriteString( 'first add some days' ); WriteLn;
+  Run( '+', AddDays );
+
+  WriteLn;  
+  WriteString( 'now subtract some days' ); WriteLn;
+  Run( '-', SubtractDays );
+   
+END TestDates.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/demo.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/demo.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/demo.mod
@@ -0,0 +1,58 @@
+MODULE Demo;    
+
+(* demonstrate the scope of:
+      variables, procedures, and action across modules *)
+(* J. Andrea, 1983 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteString, WriteCard, WriteLn;
+FROM DemoModule IMPORT const_a, type_b, var_c, proc_d, proc_e;
+
+CONST
+    a = 10;
+
+TYPE
+    b = ARRAY ['a'..'z'] OF CARDINAL;
+
+VAR
+    c : CARDINAL;
+   bb : type_b;
+
+    (* ------------------------------------------------ *)
+    PROCEDURE d;
+
+    BEGIN (* d *)
+
+      WriteLn;
+      WriteString('-begin Demo.d ');
+      WriteLn;
+      WriteString('-var_c =');
+      WriteCard(var_c,5);
+      WriteLn;
+      WriteString('-end Demo.d ');
+      WriteLn;
+ 
+    END d;
+
+BEGIN (* Demo *)
+
+WriteLn;
+WriteString('begin Demo');
+WriteLn;
+
+d;
+
+WriteString('inside Demo - change var_c ');
+WriteLn;
+var_c := 42;
+
+d;
+proc_d;
+
+proc_e;
+
+WriteLn;
+WriteString('end Demo');
+WriteLn;
+
+END Demo.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/demomodul.def b/examples/Modula-2_Libraries/andrea-m2/examples/generic/demomodul.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/demomodul.def
@@ -0,0 +1,19 @@
+DEFINITION MODULE DemoModule;
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED const_a , type_b , var_c , proc_d , proc_e;
+
+CONST
+    const_a = 20;
+
+TYPE
+   type_b = ARRAY [0..2] OF CARDINAL;
+
+VAR
+   var_c : CARDINAL;
+
+   PROCEDURE proc_d;
+
+   PROCEDURE proc_e;
+
+END DemoModule.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/demomodul.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/demomodul.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/demomodul.mod
@@ -0,0 +1,70 @@
+IMPLEMENTATION MODULE DemoModule;
+
+(* J. Andrea, 1983 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteString, WriteCard, WriteLn;
+
+VAR
+   local : CARDINAL;  (* notice how this totally local var stays alive
+                         while the calling module is active            *)
+
+   (* ---------------------------------------------------- *)
+   PROCEDURE proc_d;
+
+   BEGIN (* proc_d *)
+
+      WriteLn;
+      WriteString(' -----begin DemoModule.proc_d');
+      WriteLn;
+      WriteString(' -----var_c = ');
+      WriteCard(var_c,5);
+      WriteLn;
+      WriteString(' -----end DemoModule.proc_d');
+      WriteLn;
+
+   END proc_d;
+
+   (* ---------------------------------------------------- *)
+   PROCEDURE proc_e;
+
+   BEGIN (* proc_e *)
+
+      WriteLn;
+      WriteString(' -----begin DemoModule.proc_e');
+      WriteLn;
+      WriteString(' -----local=');
+      WriteCard(local,3);
+      WriteLn;
+      WriteString(' -----end DemoModule.proc_e');
+      WriteLn;
+
+   END proc_e;
+
+BEGIN (* DemoModule *)
+
+(* notice now all this action takes place BEFORE the calling module
+   is activated                                                     *)
+
+WriteLn;
+WriteString(' --begin DemoModule');
+WriteLn;
+
+local := 700;
+WriteString(' --local=');
+WriteCard(local,3);
+WriteLn;
+WriteString(' --now change local');
+local := local + 1;
+WriteLn;
+
+var_c := 21;
+WriteString(' --var_c = ');
+WriteCard(var_c,5);
+WriteLn;
+
+WriteLn;
+WriteString(' --end DemoModule');
+WriteLn;
+
+END DemoModule.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/dynamic_array-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/dynamic_array-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/dynamic_array-1.mod
@@ -0,0 +1,91 @@
+MODULE DynamicArray;
+
+(* This program shows how to build and use dynamic memory as if its an array *)
+(* This specific example shows the use of memory as an ARRAY OF CARDINAL *)
+(* J. Andrea, Mar.16/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SYSTEM  IMPORT ADDRESS, TSIZE;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+FROM InOut IMPORT WriteLn, WriteCard;
+
+TYPE
+  Dyn = RECORD                   (*this type contains the two essential items *)
+          size  :CARDINAL;       (* the size of the array, and *)
+          start :ADDRESS;        (* the memory address of the first element *)
+        END;
+
+VAR
+  dyn       :Dyn;                      (* simple example here, use a variable *)
+  type_size :CARDINAL;                 (* this will be size of items *)
+  adr       :POINTER TO CARDINAL;      (* pointer to any single item *)
+  i, n      :CARDINAL;                 (* typical counters *)
+
+
+  (* ------------------------------------------------- *)
+  PROCEDURE Make( length :CARDINAL );
+  (* create a new dynamic array with the number of elements in 'length' *)
+  BEGIN
+     dyn.size := length;
+
+     ALLOCATE( dyn.start, type_size * length );    (* grab the memory *)
+                                                   (* specify number of bytes *)
+  END Make;
+
+  (* ------------------------------------------------- *)
+  PROCEDURE Put( pos :CARDINAL; value :CARDINAL );
+  (* put 'value' into the array at element 'pos' *)
+  BEGIN
+
+    (* make sure the specified element is available *)
+    IF ( pos >= 1 ) & ( pos <= dyn.size ) THEN
+
+      adr  := dyn.start + ( pos - 1 ) * type_size;   (* calculate the address *)
+                                                     (* by offset from #1     *)
+
+      adr^ := value;                                 (* point to that element *)
+
+    END;
+         
+  END Put;
+
+  (* ------------------------------------------------- *)
+  PROCEDURE Get( pos :CARDINAL ) :CARDINAL;
+  (* return the element at position 'pos' *)
+
+  VAR
+    value :CARDINAL;
+  BEGIN
+
+    (* make sure the specified element is available *)
+    IF ( pos >= 1 ) & ( pos <= dyn.size ) THEN
+
+      adr   := dyn.start + ( pos - 1 ) * type_size;   (* calculate to address *)
+                                                      (* by offset from #1 *)
+
+      value := adr^;                                  (* point to it *)
+
+    ELSE
+      value := 0;
+    END;
+         
+    RETURN value;
+  END Get;
+
+BEGIN
+
+  type_size := TSIZE( CARDINAL );     (*get the number of bytes in a CARDINAL *)
+
+  n := 10;                            (* choose 10 elements *)
+
+  Make( n );                          (* create the dynamic array *)
+
+  FOR i := 1 TO n DO                  (* load the values 10,9,8,7... *)
+    Put( i, n+1-i );
+  END;
+
+  FOR i := 1 TO n DO                     (* read the items and print them *)
+    WriteCard( Get( i ), 0 ); WriteLn;
+  END;
+
+END DynamicArray.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/dynamic_array-2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/dynamic_array-2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/dynamic_array-2.mod
@@ -0,0 +1,119 @@
+MODULE DynamicArray;
+
+(* This program shows how to build and use dynamic memory as if its a matrix *)
+(* This specific example shows the use of memory as an
+   ARRAY OF ARRAY OF CARDINAL *)
+(* J. Andrea, Mar.29/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SYSTEM  IMPORT ADDRESS, TSIZE;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+FROM InOut IMPORT WriteLn, WriteCard;
+
+TYPE
+  Dyn = RECORD                   (*this type contains the two essential items *)
+          rows, cols :CARDINAL;  (* the size of the matrix *)
+          start      :ADDRESS;   (* the memory address of the first element *)
+        END;
+
+VAR
+  dyn       :Dyn;                      (* simple example here, use a variable *)
+  type_size :CARDINAL;                 (* this will be size of items *)
+  adr       :POINTER TO CARDINAL;      (* pointer to any single item *)
+
+
+  (* ------------------------------------------------- *)
+  PROCEDURE Offset( r, c :CARDINAL ) :CARDINAL;
+  BEGIN
+     RETURN type_size * ( ( r - 1 ) * dyn.cols  + c - 1 );
+  END Offset;
+
+  (* ------------------------------------------------- *)
+  PROCEDURE Make( r, c :CARDINAL );
+  (* create a new dynamic matrix *)
+  BEGIN
+     dyn.rows := r;
+     dyn.cols := c;
+
+     ALLOCATE( dyn.start, type_size * r * c );    (* grab the memory *)
+                                                  (* specify number of bytes *)
+  END Make;
+
+  (* ------------------------------------------------- *)
+  PROCEDURE Put( r, c :CARDINAL; value :CARDINAL );
+  (* put 'value' into the array at element 'r,c' *)
+  BEGIN
+
+    (* make sure the specified element is available *)
+    IF ( r >= 1 ) & ( r <= dyn.rows ) & ( c >= 1 ) & ( c <= dyn.cols ) THEN
+
+      adr  := dyn.start + Offset( r, c );            (* calculate the address *)
+                                                     (* by offset from #1     *)
+
+      adr^ := value;                                 (* point to that element *)
+
+    END;
+         
+  END Put;
+
+  (* ------------------------------------------------- *)
+  PROCEDURE Get( r, c :CARDINAL ) :CARDINAL;
+  (* return the element at position 'r,c' *)
+
+  VAR
+    value :CARDINAL;
+  BEGIN
+
+    (* make sure the specified element is available *)
+    IF ( r >= 1 ) & ( r <= dyn.rows ) & ( c >= 1 ) & ( c <= dyn.cols ) THEN
+
+      adr   := dyn.start + Offset( r, c );            (* calculate to address *)
+                                                      (* by offset from #1 *)
+
+      value := adr^;                                  (* point to it *)
+
+    ELSE
+      value := 0;
+    END;
+         
+    RETURN value;
+  END Get;
+
+  (* ------------------------------------------------- *)
+  PROCEDURE Fill;
+  VAR
+    r, c, x :CARDINAL;
+  BEGIN
+    x := 1;
+    FOR r := 1 TO dyn.rows DO
+      FOR c := 1 TO dyn.cols DO
+         Put( r, c, x );
+         x := x + 1;
+      END;
+    END;
+  END Fill;
+
+  (* ------------------------------------------------- *)
+  PROCEDURE Show;
+  VAR
+    r, c :CARDINAL;
+  BEGIN
+    FOR r := 1 TO dyn.rows DO
+      FOR c := 1 TO dyn.cols DO
+         WriteCard( Get( r, c ), 5 );
+      END;
+      WriteLn;
+    END;
+  END Show;
+
+BEGIN
+
+  type_size := TSIZE( CARDINAL );     (*get the number of bytes in a CARDINAL *)
+
+  Make( 6, 4 );                       (* create the dynamic matrix *)
+
+  Fill;                               (* load with sequential values *)
+
+  Show;
+
+END DynamicArray.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/dynamic_array-3.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/dynamic_array-3.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/dynamic_array-3.mod
@@ -0,0 +1,140 @@
+MODULE DynamicArray;
+
+(* This program shows how to build and use dynamic memory as if its a matrix *)
+(* This specific example shows the use of memory as an
+   ARRAY OF ARRAY OF CARDINAL *)
+(* This example also shows how to use this technique to perform global operations *)
+(* J. Andrea, Mar.31/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SYSTEM  IMPORT ADDRESS, TSIZE;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+FROM InOut IMPORT WriteLn, WriteCard;
+
+TYPE
+  Dyn = RECORD                   (*this type contains the two essential items *)
+          rows, cols :CARDINAL;  (* the size of the matrix *)
+          start      :ADDRESS;   (* the memory address of the first element *)
+        END;
+
+VAR
+  dyn       :Dyn;                      (* simple example here, use a variable *)
+  type_size :CARDINAL;                 (* this will be size of items *)
+  adr       :POINTER TO CARDINAL;      (* pointer to any single item *)
+
+
+  (* ------------------------------------------------- *)
+  PROCEDURE Offset( r, c :CARDINAL ) :CARDINAL;
+  BEGIN
+     RETURN type_size * ( ( r - 1 ) * dyn.cols  + c - 1 );
+  END Offset;
+
+  (* ------------------------------------------------- *)
+  PROCEDURE Make( r, c :CARDINAL );
+  (* create a new dynamic matrix *)
+  BEGIN
+     dyn.rows := r;
+     dyn.cols := c;
+
+     ALLOCATE( dyn.start, type_size * r * c );    (* grab the memory *)
+                                                  (* specify number of bytes *)
+  END Make;
+
+  (* ------------------------------------------------- *)
+  PROCEDURE Put( r, c :CARDINAL; value :CARDINAL );
+  (* put 'value' into the array at element 'r,c' *)
+  BEGIN
+
+    (* make sure the specified element is available *)
+    IF ( r >= 1 ) & ( r <= dyn.rows ) & ( c >= 1 ) & ( c <= dyn.cols ) THEN
+
+      adr  := dyn.start + Offset( r, c );            (* calculate the address *)
+                                                     (* by offset from #1     *)
+
+      adr^ := value;                                 (* point to that element *)
+
+    END;
+         
+  END Put;
+
+  (* ------------------------------------------------- *)
+  PROCEDURE Get( r, c :CARDINAL ) :CARDINAL;
+  (* return the element at position 'r,c' *)
+
+  VAR
+    value :CARDINAL;
+  BEGIN
+
+    (* make sure the specified element is available *)
+    IF ( r >= 1 ) & ( r <= dyn.rows ) & ( c >= 1 ) & ( c <= dyn.cols ) THEN
+
+      adr   := dyn.start + Offset( r, c );            (* calculate to address *)
+                                                      (* by offset from #1 *)
+
+      value := adr^;                                  (* point to it *)
+
+    ELSE
+      value := 0;
+    END;
+         
+    RETURN value;
+  END Get;
+
+  (* ------------------------------------------------- *)
+  PROCEDURE Fill;
+  VAR
+    r, c, x :CARDINAL;
+  BEGIN
+    x := 1;
+    FOR r := 1 TO dyn.rows DO
+      FOR c := 1 TO dyn.cols DO
+         Put( r, c, x );
+         x := x + 1;
+      END;
+    END;
+  END Fill;
+
+  (* ------------------------------------------------- *)
+  PROCEDURE Show;
+  VAR
+    r, c :CARDINAL;
+  BEGIN
+    WriteLn; WriteLn;
+    FOR r := 1 TO dyn.rows DO
+      FOR c := 1 TO dyn.cols DO
+         WriteCard( Get( r, c ), 5 );
+      END;
+      WriteLn;
+    END;
+  END Show;
+
+  (* ------------------------------------------------- *)
+  PROCEDURE Scale( value :CARDINAL );
+  (* this procedure performs the exact same operation on every element *)
+  (* so run through memory sequentially, and quickly *)
+  VAR
+    i, n :CARDINAL;
+  BEGIN
+    n := 0;
+    FOR i := 1 TO dyn.rows * dyn.cols DO
+      adr  := dyn.start + n;
+      adr^ := value * adr^;
+      n    := n + type_size;
+    END;
+  END Scale;
+
+BEGIN
+
+  type_size := TSIZE( CARDINAL );     (*get the number of bytes in a CARDINAL *)
+
+  Make( 6, 4 );                       (* create the dynamic matrix *)
+
+  Fill;                               (* load with sequential values *)
+
+  Show;
+
+  Scale( 2 );
+
+  Show;
+
+END DynamicArray.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/entier.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/entier.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/entier.mod
@@ -0,0 +1,32 @@
+MODULE TestEntier;
+
+(* test the entier function *)
+(* revitalized, J. Andrea, Aug.12/91 *)
+(* J. Andrea, 1984 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut     IMPORT WriteString, WriteInt, WriteReal, WriteLn;
+FROM MoreMath  IMPORT entier;
+
+VAR
+   x :REAL;
+   i :INTEGER;
+
+BEGIN
+
+  WriteLn;
+
+  x := -2.5;
+  FOR i := 1 TO 9 DO
+
+     WriteString( ' for x = '); WriteReal( x, 0 );
+
+     WriteString( '  entier(x)=' ); WriteInt( entier(x), 12 );
+     WriteLn;
+
+     x := x + 0.5;
+  END; (* for *)
+
+  WriteLn;
+
+END TestEntier.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/graphics_1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/graphics_1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/graphics_1.mod
@@ -0,0 +1,43 @@
+MODULE Graphics;
+
+(* J. Andrea, 1991 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM VeryScreen IMPORT Box, Home, EraseScreen;
+FROM InOut IMPORT WriteString, WriteLn;
+FROM GetCharacter IMPORT StartGet, StopGet, Get, GetNoWait;
+
+CONST
+  nul = 0C;
+
+VAR
+  r1, r2, c1, c2 :CARDINAL;
+  c :CHAR;
+
+BEGIN
+
+
+  WriteString( 'Hit any key to start program' ); WriteLn;
+  WriteString( 'Hit any key to end program' ); WriteLn;
+
+  StartGet;
+
+  Get( c );  c := nul;
+  WHILE c = nul DO
+    Home; EraseScreen;
+
+    r1 := 8;        c1 := 28;
+    r2 := r1 + 11;  c2 := c1 + 20;
+
+    WHILE ( c = nul ) & ( r1 < r2 ) DO
+      Box( r1, c1, r2, c2 );
+      GetNoWait( c );
+      r1 := r1 + 1; c1 := c1 + 1;
+      r2 := r2 - 1; c2 := c2 - 1;
+    END;
+
+  END;
+
+  StopGet;
+
+END Graphics.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/graphics_2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/graphics_2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/graphics_2.mod
@@ -0,0 +1,56 @@
+MODULE Graphics;
+
+(* J. Andrea, 1991 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM VeryScreen IMPORT Line, Home, EraseScreen;
+FROM InOut IMPORT WriteString, WriteLn;
+FROM GetCharacter IMPORT StartGet, StopGet, Get, GetNoWait;
+FROM Randomly IMPORT Choose_1_To_N;
+
+CONST
+  nul = 0C;
+
+VAR
+  r1, r2, c1, c2 :CARDINAL;
+  c :CHAR;
+
+BEGIN
+
+
+  WriteString( 'Hit any key to start program' ); WriteLn;
+  WriteString( 'Hit SPACE to clear the screen, any other key to end program');
+  WriteLn;
+
+  StartGet;
+
+  Get( c );  c := ' ';
+
+  WHILE c = ' ' DO
+    c := nul;
+
+    Home; EraseScreen;
+
+    WHILE c = nul DO
+
+      r1 := Choose_1_To_N( 23 );
+      c1 := Choose_1_To_N( 79 );
+
+      IF Choose_1_To_N( 100 ) < 51 THEN
+        r2 := r1;
+        c2 := Choose_1_To_N( 79 - c1 );
+      ELSE
+        r2 := Choose_1_To_N( 23 - r1 );
+        c2 := c1;
+      END;
+
+      Line( r1, c1, r2, c2 );
+
+      GetNoWait( c );
+    END;
+
+  END;
+
+  StopGet;
+
+END Graphics.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/hash.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/hash.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/hash.mod
@@ -0,0 +1,33 @@
+MODULE TestHash;
+
+(* test the WordHash module and show how its used *)
+(* J. Andrea, 1984 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT Write, WriteLn, WriteString, WriteCard,
+                  ReadString,     ReadLn;
+
+FROM WordHash IMPORT not_a_reserved_word, HashValue;
+
+VAR
+  string : ARRAY [0..80] OF CHAR;
+  x      : CARDINAL;
+
+BEGIN (* TestHash *)
+
+  WriteString(' >');  ReadString(string);  ReadLn;
+  WHILE LEN(string) > 0 DO
+
+     x := HashValue( string );
+     IF x = not_a_reserved_word THEN
+       WriteString(' no ');
+     ELSE
+       WriteCard( x, 10 );
+     END; (* if *)
+     WriteLn;
+
+     WriteString(' >');  ReadString(string);  ReadLn;
+
+  END; (* while *)
+
+END TestHash.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/hello.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/hello.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/hello.mod
@@ -0,0 +1,9 @@
+MODULE Hello;
+
+FROM InOut IMPORT WriteString, WriteLn;
+
+BEGIN
+
+   WriteString( 'Hello World!' ); WriteLn;
+
+END Hello.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/largenum-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/largenum-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/largenum-1.mod
@@ -0,0 +1,61 @@
+MODULE TestLarge;
+
+FROM InOut IMPORT WriteString, WriteLn;
+FROM StringOperations IMPORT Compare;
+FROM LargeNumbers IMPORT NumType, NumToString, StringToNum, SetDigits,
+                         Add, Multiply, Divide, Subtract;
+
+CONST
+  max = 100;
+  
+VAR
+  string :ARRAY [1..max] OF CHAR;
+  a, b, c :NumType;
+  
+  PROCEDURE Perform( in_a, in_b :ARRAY OF CHAR; operation :CHAR;
+                     expected_result :ARRAY OF CHAR );
+  BEGIN
+    WriteString( 'result should be ' );
+    WriteString( in_a );
+    WriteString( ' ' ); WriteString( operation ) ; WriteString( ' ' );
+    WriteString( in_b );
+    WriteString( ' = ' ); WriteString( expected_result ); WriteLn;
+
+    StringToNum( in_a, a );
+    NumToString( a, string ); WriteString( string );
+    WriteString( ' ' ); WriteString( operation ) ; WriteString( ' ' );
+
+    StringToNum( in_b, b );
+    NumToString( b, string ); WriteString( string );
+    WriteString( ' = ' );
+
+    CASE operation OF
+  '+' :Add( a, b, c );
+| '-' :Subtract( a, b, c );
+| '*' :Multiply( a, b, c );
+| '/' :WriteLn;
+       Divide( a, b, c );
+    ELSE
+      WriteString( 'unknown operation' ); WriteLn;
+    END;
+
+    NumToString( c, string ); WriteString( string ); WriteLn;
+
+    IF Compare( string, '=', expected_result ) THEN
+      WriteString( 'tests ok' );
+    ELSE
+      WriteString( 'not as expected' );
+    END;
+    WriteLn; WriteLn;
+ 
+  END Perform;
+
+BEGIN
+ 
+  SetDigits( 4 );   Perform( '11.2', '23.5', '+', '3.47E1' );
+ 
+  SetDigits( 5 );   Perform( '23.14', '5.0', '*', '1.157E2' );
+
+  SetDigits( 20 );   Perform( '125.', '5.', '/', '2.5E1' );
+ 
+END TestLarge.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/largenum-2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/largenum-2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/largenum-2.mod
@@ -0,0 +1,59 @@
+MODULE TestLarge;
+
+FROM InOut IMPORT WriteString, WriteLn, WriteCard;
+FROM LargeNumbers IMPORT NumType, NumToString, SetDigits,
+                         Add, Multiply, Divide, zero, one;
+
+CONST
+  max = 100;
+  max_factorial = 40;
+  
+VAR
+  string :ARRAY [1..max] OF CHAR;
+  Fact :ARRAY [0..max_factorial] OF NumType;
+  e :NumType;
+  i :CARDINAL;
+  
+  (* -------------------------- *)
+  PROCEDURE FactTable;
+  VAR
+    i :CARDINAL;
+    N :NumType;
+  BEGIN
+    Fact[0] := one;
+    N       := one;
+    FOR i := 1 TO max_factorial DO
+      WriteCard( i, 2 ); WriteString( ' ' );
+      Multiply( N, Fact[i-1], Fact[i] );
+      NumToString( Fact[i], string ); WriteString( string ); WriteLn;
+      Add( N, one, N );
+    END;
+  END FactTable;
+   
+  (* -------------------------- *)
+  PROCEDURE Exp( VAR exp :NumType; power :NumType );
+  VAR
+    i :CARDINAL;
+    numerator, quotient :NumType;
+  BEGIN
+    exp := zero;
+    numerator := one;
+    FOR i := 0 TO max_factorial DO
+      Divide( numerator, Fact[i], quotient );
+      Add( exp, quotient, exp );
+      Multiply( power, numerator, numerator );
+    END;
+  END Exp;
+  
+BEGIN
+
+ SetDigits( 30 );
+ 
+ FactTable;
+ 
+ (* calculate and print e *)
+ Exp( e, one );
+ NumToString( e, string );
+ WriteString( 'e = ' ); WriteString( string ); WriteLn;
+ 
+END TestLarge.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/largenum-3.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/largenum-3.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/largenum-3.mod
@@ -0,0 +1,37 @@
+MODULE TestLarge;
+
+FROM InOut IMPORT WriteString, WriteLn, WriteCard;
+FROM LargeNumbers IMPORT NumType, NumToString, SetDigits,
+                         Add, Multiply, zero, one;
+
+CONST
+  max = 70;
+  max_factorial = 200;
+  
+VAR
+  string :ARRAY [1..max+5] OF CHAR;
+  
+  (* -------------------------- *)
+  PROCEDURE FactTable;
+  VAR
+    i :CARDINAL;
+    N, f0, f1 :NumType;
+  BEGIN
+    f0 := one;
+    N  := one;
+    FOR i := 1 TO max_factorial DO
+      WriteCard( i, 2 ); WriteString( ' ' );
+      Multiply( N, f0, f1 );
+      NumToString( f1, string ); WriteString( string ); WriteLn;
+      Add( N, one, N );
+      f0 := f1;
+    END;
+  END FactTable;
+   
+BEGIN
+
+ SetDigits( max );
+ 
+ FactTable;
+ 
+END TestLarge.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/matrix-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/matrix-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/matrix-1.mod
@@ -0,0 +1,231 @@
+MODULE TestMatrix;
+
+(* Test the module MatrixOperations *)
+(* J. Andrea, Mar.1992 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteReal, WriteString, WriteLn, Read;
+FROM MatrixOperations IMPORT Matrix, Build, Destroy,
+                             Copy, Ident, Get, Put, Compare,
+                             Size, Transpose, Invert, Multiply, Scale, Add,
+                             Min, Max;
+
+VAR
+  a, b, c :Matrix;
+  ok      :BOOLEAN;
+  ch      :CHAR;
+  x       :REAL;
+
+  (* ----------------------------------------------------- *)
+  PROCEDURE Show( m :Matrix );
+  VAR i, j, r, c :CARDINAL;
+  BEGIN
+    Size( m, r, c );
+    FOR i := 1 TO r DO
+       FOR j := 1 TO c DO
+          WriteReal( Get( m, i, j ), 11 );
+       END;
+       WriteLn;
+     END;
+  END Show;
+
+  (* ----------------------------------------------------- *)
+  PROCEDURE NumFill( m :Matrix );
+  VAR i, j, r, c, n :CARDINAL;
+  BEGIN
+    Size( m, r, c );
+    n := 1;
+    FOR i := 1 TO r DO
+       FOR j := 1 TO c DO
+          Put( m, i, j, FLOAT(n) );
+          n := n + 1;
+       END;
+       WriteLn;
+     END;
+  END NumFill;
+
+  (* ----------------------------------------------------- *)
+  PROCEDURE ExpectX( exact, found :REAL );
+  BEGIN
+    IF found = exact THEN
+      WriteString( 'as expected, ' ); WriteReal( found, 11 );
+    ELSE
+      WriteString( 'in error !' ); WriteLn;
+      WriteString( 'produced is' ); WriteReal( found, 11 );  WriteLn;
+      WriteString( 'expected is' ); WriteReal( exact, 11 ); WriteLn;
+    END;
+    WriteLn;
+  END ExpectX;
+
+  (* ----------------------------------------------------- *)
+  PROCEDURE Expect( a, b :Matrix );
+  BEGIN
+    IF Compare( a, b ) THEN
+      WriteString( 'as expected' );
+    ELSE
+      WriteString( 'in error !' ); WriteLn;
+      WriteString( 'produced matrix is' ); WriteLn; Show( b );
+      WriteString( 'expected matrix is' ); WriteLn; Show( a );
+    END;
+    WriteLn;
+  END Expect;
+
+BEGIN
+
+  Build( a, 3, 4 ); Ident( a );
+
+  WriteLn; WriteString( 'identity' ); WriteLn;
+  Show( a );
+
+  WriteLn; WriteString( 'hit CR' ); Read(ch);
+
+        (* ----------------new test ------------------*)
+
+  Copy( a, b );
+
+  WriteLn; WriteString( 'compared to a copy of itself ' ); WriteLn;
+  IF Compare( a, b ) THEN
+    WriteString( 'same, as expected' );
+  ELSE
+    WriteString( 'not same, error !' );
+  END;
+  WriteLn;
+
+  WriteLn; WriteString( 'hit CR' ); Read(ch);
+
+        (* ----------------new test ------------------*)
+
+  WriteLn; WriteString( 'modify copy' ); WriteLn;
+  Put( b, 1, 3, 42.0 );
+
+  Show( b );
+
+  WriteLn; WriteString( 'compare to modified ' ); WriteLn;
+  IF Compare( a, b ) THEN
+    WriteString( 'same, error !' );
+  ELSE
+    WriteString( 'not same, as expected' );
+  END;
+  WriteLn;
+
+  WriteLn; WriteString( 'hit CR' ); Read(ch);
+
+        (* ----------------new test ------------------*)
+
+  NumFill( b );
+
+  WriteLn; WriteString( 'before transpose' ); WriteLn;
+  Show( b );
+
+  Transpose( b, c );
+
+  WriteLn; WriteString( 'after transpose' ); WriteLn;
+  Show( c );
+
+  Destroy( a );
+
+  Build( a, 4, 3 );
+  Put( a, 1, 1, 1.0 );   Put( a, 1, 2, 5.0 );   Put( a, 1, 3,  9.0 );
+  Put( a, 2, 1, 2.0 );   Put( a, 2, 2, 6.0 );   Put( a, 2, 3, 10.0 );
+  Put( a, 3, 1, 3.0 );   Put( a, 3, 2, 7.0 );   Put( a, 3, 3, 11.0 );
+  Put( a, 4, 1, 4.0 );   Put( a, 4, 2, 8.0 );   Put( a, 4, 3, 12.0 );
+
+  WriteLn; WriteString( 'transpose ' );   Expect( c, a );
+
+  WriteLn; WriteString( 'hit CR' ); Read(ch);
+  Destroy( b ); Destroy( c );
+
+        (* ----------------new test ------------------*)
+
+  Build( a, 3, 3 );
+  Put( a, 1, 1, 1.0 );   Put( a, 1, 2, 3.0 );    Put( a, 1, 3, -1.0 );
+  Put( a, 2, 1, -2.0 );  Put( a, 2, 2, 0.0 );    Put( a, 2, 3,  1.0 );
+  Put( a, 3, 1, 2.0 );   Put( a, 3, 2, -1.0 );   Put( a, 3, 3,  0.0 );
+
+  WriteLn; WriteString( 'original' ); WriteLn;
+  Show( a );
+
+  Invert( a, b, ok );
+
+  WriteLn;  WriteString( 'invert ' );
+  IF ok THEN
+    WriteLn; Show( b );
+
+    Build( c, 3, 3 );
+
+    Put( c, 1, 1, 0.2 );   Put( c, 1, 2, 0.2 );    Put( c, 1, 3, 0.6 );
+    Put( c, 2, 1, 0.4 );   Put( c, 2, 2, 0.4 );    Put( c, 2, 3, 0.2 );
+    Put( c, 3, 1, 0.4 );   Put( c, 3, 2, 1.4 );    Put( c, 3, 3, 1.2 );
+
+    WriteString( 'inverted matrix ' );    Expect( b, c );
+
+    Destroy( c );
+  ELSE
+    WriteString( 'failed !' );
+  END;
+  WriteLn;
+
+  Destroy( a ); Destroy( b );
+  WriteLn; WriteString( 'hit CR' ); Read(ch);
+
+        (* ----------------new test ------------------*)
+
+  Build( a, 4, 4 );  NumFill( a );   Copy( a, b );
+  Add( a, b, c, ok );
+
+  WriteLn; WriteString( 'addition ' );
+  IF ok THEN
+    Scale( a, 2.0 );
+    Expect( a, c );
+    Destroy( c );
+  ELSE
+    WriteString( 'failed !' );
+  END;
+  WriteLn;
+    
+  Destroy( a ); Destroy( b );
+  WriteLn; WriteString( 'hit CR' ); Read(ch);
+
+        (* ----------------new test ------------------*)
+
+  Build( a, 3, 2 );
+  Put( a, 1, 1, 2.0 );   Put( a, 1, 2, -1.0 );
+  Put( a, 2, 1, 1.0 );   Put( a, 2, 2,  4.0 );
+  Put( a, 3, 1, -3.0 );  Put( a, 3, 2,  0.0 );
+
+  Build( b, 2, 2 );
+  Put( b, 1, 1, 2.0 );   Put( b, 1, 2, 3.0 );
+  Put( b, 2, 1, -5.0 );  Put( b, 2, 2, 1.0 );
+
+  Multiply( a, b, c, ok );
+
+  WriteLn; WriteString( 'multiply ' );
+  IF ok THEN
+    Destroy(a);
+
+    Build( a, 3, 2 );
+    Put( a, 1, 1, 9.0 );    Put( a, 1, 2,  5.0 );
+    Put( a, 2, 1, -18.0 );  Put( a, 2, 2,  7.0 );
+    Put( a, 3, 1, -6.0 );   Put( a, 3, 2, -9.0 );
+
+    Expect( a, c );
+  ELSE
+    WriteString( 'failed !' );
+  END;
+  WriteLn;
+
+  Destroy( a ); Destroy( b );
+  WriteLn; WriteString( 'hit CR' ); Read(ch);
+
+        (* ----------------new test ------------------*)
+
+  x := 2.5;
+  Build( a, 6, 4 ); NumFill( a ); Scale( a, 2.5 );
+  WriteString( 'given' ); WriteLn; Show( a );
+
+  WriteLn; WriteString( 'minimum ' );  ExpectX( x, Min(a) );
+
+  x := x * 6.0 * 4.0;
+  WriteLn; WriteString( 'maximum ' );  ExpectX( x, Max(a) );
+
+END TestMatrix.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/matrix-2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/matrix-2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/matrix-2.mod
@@ -0,0 +1,161 @@
+MODULE TestMatrix;
+
+(* Test the Determinant routine of module MatrixOperations *)
+(* J. Andrea, Mar.1992 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM RealInOut IMPORT WriteReal;
+FROM InOut IMPORT WriteString, WriteLn, Read;
+FROM MatrixOperations IMPORT Matrix, Build, Destroy,
+                             Get, Put, Determinant,
+                             Size;
+VAR
+  a :Matrix;
+  ok      :BOOLEAN;
+  ch      :CHAR;
+  x       :REAL;
+
+  (* ----------------------------------------------------- *)
+  PROCEDURE Show( m :Matrix );
+  VAR i, j, r, c :CARDINAL;
+  BEGIN
+    Size( m, r, c );
+    FOR i := 1 TO r DO
+       FOR j := 1 TO c DO
+          WriteReal( Get( m, i, j ), 1 );
+       END;
+       WriteLn;
+     END;
+  END Show;
+
+  (* ----------------------------------------------------- *)
+  PROCEDURE NumFill( m :Matrix );
+  VAR i, j, r, c, n :CARDINAL;
+  BEGIN
+    Size( m, r, c );
+    n := 1;
+    FOR i := 1 TO r DO
+       FOR j := 1 TO c DO
+          Put( m, i, j, FLOAT(n) );
+          n := n + 1;
+       END;
+       WriteLn;
+     END;
+  END NumFill;
+
+  (* ----------------------------------------------------- *)
+  PROCEDURE ExpectX( exact, found :REAL );
+  BEGIN
+    IF found = exact THEN
+      WriteString( 'as expected, ' ); WriteReal( found, 11 );
+    ELSE
+      WriteString( 'in error !' ); WriteLn;
+      WriteString( 'produced is' ); WriteReal( found, 11 );  WriteLn;
+      WriteString( 'expected is' ); WriteReal( exact, 11 ); WriteLn;
+    END;
+    WriteLn;
+  END ExpectX;
+
+BEGIN
+
+        (* ----------------new test ------------------*)
+
+  Build( a, 2, 2 ); NumFill( a );
+
+  WriteString( 'given' ); WriteLn;
+  Show( a );
+  Determinant( a, x, ok );
+
+  WriteLn; WriteString( 'determinant ' );
+  IF ok THEN
+    ExpectX( -2.0, x );
+  ELSE
+    WriteString( 'failed !' );
+  END;
+  WriteLn;
+
+  WriteLn; WriteString( 'hit CR' ); Read(ch);
+  Destroy( a );
+
+        (* ----------------new test ------------------*)
+  
+  Build( a, 3, 3 );
+  Put( a, 1, 1, 2.0 );   Put( a, 1, 2, 2.0 );  Put( a, 1, 3, -2.0 );
+  Put( a, 2, 1, 1.0 );   Put( a, 2, 2, 2.0 );  Put( a, 2, 3,  3.0 );
+  Put( a, 3, 1, 2.0 );   Put( a, 3, 2, 3.0 );  Put( a, 3, 3,  4.0 );
+
+  WriteLn;
+  WriteString( 'given' ); WriteLn;
+  Show( a );
+  Determinant( a, x, ok );
+
+  WriteLn; WriteString( 'determinant ' );
+  IF ok THEN
+    ExpectX( 4.0, x );
+  ELSE
+    WriteString( 'failed !' );
+  END;
+  WriteLn;
+
+  WriteLn; WriteString( 'hit CR' ); Read(ch);
+  Destroy( a );
+
+        (* ----------------new test ------------------*)
+   
+  Build( a, 4, 4 );
+  Put( a, 1, 1,  2.0 );   Put( a, 1, 2,  3.0 );  Put( a, 1, 3, -2.0 );
+  Put( a, 1, 4,  4.0 );
+  Put( a, 2, 1,  3.0 );   Put( a, 2, 2, -2.0 );  Put( a, 2, 3,  1.0 );
+  Put( a, 2, 4,  2.0 );
+  Put( a, 3, 1,  3.0 );   Put( a, 3, 2,  2.0 );  Put( a, 3, 3,  3.0 );
+  Put( a, 3, 4,  4.0 );
+  Put( a, 4, 1, -2.0 );   Put( a, 4, 2,  4.0 );  Put( a, 4, 3,  0.0 );
+  Put( a, 4, 4,  5.0 );
+
+  WriteLn;
+  WriteString( 'given' ); WriteLn;
+  Show( a );
+  Determinant( a, x, ok );
+
+  WriteLn; WriteString( 'determinant ' );
+  IF ok THEN
+    ExpectX( -286.0, x );
+  ELSE
+    WriteString( 'failed !' );
+  END;
+  WriteLn;
+
+  WriteLn; WriteString( 'hit CR' ); Read(ch);
+  Destroy( a );
+
+        (* ----------------new test ------------------*)
+  
+  Build( a, 5, 5 );
+  Put( a, 1, 1,  1.0 );   Put( a, 1, 2, -2.0 );  Put( a, 1, 3,  3.0 );
+  Put( a, 1, 4, -2.0 );   Put( a, 1, 5, -2.0 );
+  Put( a, 2, 1,  2.0 );   Put( a, 2, 2, -1.0 );  Put( a, 2, 3,  1.0 );
+  Put( a, 2, 4,  3.0 );   Put( a, 2, 5,  2.0 );
+  Put( a, 3, 1,  1.0 );   Put( a, 3, 2,  1.0 );  Put( a, 3, 3,  2.0 );
+  Put( a, 3, 4,  1.0 );   Put( a, 3, 5,  1.0 );
+  Put( a, 4, 1,  1.0 );   Put( a, 4, 2, -4.0 );  Put( a, 4, 3, -3.0 );
+  Put( a, 4, 4, -2.0 );   Put( a, 4, 5, -5.0 );
+  Put( a, 5, 1,  3.0 );   Put( a, 5, 2, -2.0 );  Put( a, 5, 3,  2.0 );
+  Put( a, 5, 4,  2.0 );   Put( a, 5, 5, -2.0 );
+
+  WriteLn;
+  WriteString( 'given' ); WriteLn;
+  Show( a );
+  Determinant( a, x, ok );
+
+  WriteLn; WriteString( 'determinant ' );
+  IF ok THEN
+    ExpectX( 118.0, x );
+  ELSE
+    WriteString( 'failed !' );
+  END;
+  WriteLn;
+
+  WriteLn; WriteString( 'hit CR' ); Read(ch);
+  Destroy( a );
+
+END TestMatrix.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/packarray-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/packarray-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/packarray-1.mod
@@ -0,0 +1,53 @@
+MODULE Test;
+
+(* Test the module PackArray *)
+(* J. Andrea, Jun.15/93 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM InOut IMPORT WriteString, WriteCard, WriteLn;
+FROM PackArray IMPORT Array, Build, Get, Put, Size;
+
+CONST
+  min =  0;
+  max = 17;
+  range = max - min;
+  n   = range + 1;
+
+VAR
+  a :Array;
+  bits, bytes, elem :CARDINAL;
+
+  i, x :CARDINAL;
+  list :ARRAY [1..n] OF CARDINAL;
+  
+BEGIN
+
+  WriteString( 'creating array with' ); WriteLn;
+  WriteString( '   min/max = ' ); WriteCard( min, 0 ); 
+  WriteString( '/' ); WriteCard( max, 0 ); WriteLn;
+  WriteString( '   elements = ' ); WriteCard( n, 0 ); WriteLn;
+
+  Build( a, min, max, n );
+
+  Size( a, bits, bytes, i );
+  WriteString( 'takes ' ); WriteCard( bits, 0 ); WriteString( ' bits for data' );
+  WriteLn;
+  WriteString( 'whole array is ' ); WriteCard( bytes, 0 ); WriteString( ' bytes' );
+  WriteLn;
+
+  (* fill the array *)
+  FOR i := 1 TO n DO
+     list[i] := min + i - 1;
+     Put( a, i, list[i] );
+  END;
+
+  WriteString( 'put     got' ); WriteLn;
+  FOR i := 1 TO n DO
+     x := Get( a, i );
+     WriteCard( list[i], 0 ); WriteString( '      ' );
+     WriteCard( x, 0 );
+     IF x # list[i] THEN WriteString( ' <---- error' ) END;
+     WriteLn;
+  END;
+
+END Test.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/packarray-2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/packarray-2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/packarray-2.mod
@@ -0,0 +1,53 @@
+MODULE Test;
+
+(* Test the module PackArray *)
+(* J. Andrea, Jun.15/93 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM InOut IMPORT WriteString, WriteCard, WriteLn;
+FROM PackArray IMPORT Array, Build, Get, Put, Size;
+FROM Randomly IMPORT Choose_0_To_N;
+
+CONST
+  min = 110;
+  max = 130;
+  range = max - min;
+  n   = range + 1;
+
+VAR
+  a :Array;
+  bits, bytes, elem :CARDINAL;
+
+  i, x :CARDINAL;
+  list :ARRAY [1..n] OF CARDINAL;
+  
+BEGIN
+
+  WriteString( 'creating array with' ); WriteLn;
+  WriteString( '   min/max = ' ); WriteCard( min, 0 ); 
+  WriteString( '/' ); WriteCard( max, 0 ); WriteLn;
+  WriteString( '   elements = ' ); WriteCard( n, 0 ); WriteLn;
+
+  Build( a, min, max, n );
+
+  Size( a, bits, bytes, i );
+  WriteString( 'takes ' ); WriteCard( bits, 0 ); WriteString( ' bits for data' );
+  WriteString( ', whole array is ' ); WriteCard( bytes, 0 ); WriteString( ' bytes' );
+  WriteLn;
+
+  (* fill the array *)
+  FOR i := 1 TO n DO
+     list[i] := min + Choose_0_To_N( range );
+     Put( a, i, list[i] );
+  END;
+
+  WriteString( 'put     got' ); WriteLn;
+  FOR i := 1 TO n DO
+     x := Get( a, i );
+     WriteCard( list[i], 0 ); WriteString( '      ' );
+     WriteCard( x, 0 );
+     IF x # list[i] THEN WriteString( ' <----error' ) END;
+     WriteLn;
+  END;
+
+END Test.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/paint.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/paint.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/paint.mod
@@ -0,0 +1,622 @@
+MODULE XPaint;
+
+(* a very simple screen paint program *)
+(* J. Andrea, 1992 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM GetCharacter IMPORT StartGet,  StopGet,   Get;
+FROM VeryScreen   IMPORT PutString, PutCursor, EraseScreen, Home, EraseLine,
+                         Line, Box;
+FROM TTIO         IMPORT Write;
+FROM Conversions  IMPORT CardToString;
+FROM Storage      IMPORT ALLOCATE, DEALLOCATE;
+FROM InOut        IMPORT OpenOutput, CloseOutput, OpenInput, CloseInput, Done,
+                         WriteCard, WriteString, WriteLn,
+                         EOL, Read, ReadCard, ReadLn;
+
+CONST
+   control_z = 32C;  esc = 33C;
+   max_string = 80;
+
+TYPE
+   LineP    = POINTER TO LineData;
+   LineData = RECORD
+               r1, c1, r2, c2 :CARDINAL;
+               next :LineP;
+              END;
+
+   BoxP     = POINTER TO BoxData;
+   BoxData  = RECORD
+               r1, c1, r2, c2 :CARDINAL;
+               next :BoxP;
+              END;
+
+   TextP    = POINTER TO TextData;
+   TextData = RECORD
+               r1, c1, r2, c2 :CARDINAL;
+               string :ARRAY [0..max_string] OF CHAR;
+               next   :TextP;
+              END;
+
+VAR
+   c        :CHAR;
+   row, col :CARDINAL;
+   first_row, first_col :CARDINAL;
+   begin_r,   end_r     :CARDINAL;
+   begin_c,   end_c     :CARDINAL;
+
+   line1, l, pl :LineP;
+   box1,  b, pb :BoxP;
+   text1, t, pt :TextP;
+
+   (* ------------------------------------------------- *)
+   PROCEDURE Beep;
+   BEGIN
+     Write( 7C );
+   END Beep;
+
+   (* ------------------------------------------------- *)
+   PROCEDURE Message( message :ARRAY OF CHAR );
+   BEGIN
+     PutString( message, 24, 1 );  EraseLine;
+   END Message;
+
+   (* ------------------------------------------------- *)
+   PROCEDURE ShowPos;
+   VAR string :ARRAY [1..3] OF CHAR;
+   BEGIN
+     CardToString( row, 2, string );
+     PutString( string, 24, 74 );
+
+     PutString( ',',    24, 76 );
+
+     CardToString( col, 3, string );
+     PutString( string, 24, 77 );
+
+     PutCursor( row, col );
+   END ShowPos;
+
+   (* ------------------------------------------------- *)
+   PROCEDURE ShowMenu;
+   BEGIN
+     Message( 
+     '^Z=exit B=box L=line T=text R=redraw D=delete P=print S=save G=get' );
+     ShowPos;
+   END ShowMenu;
+
+   (* ------------------------------------------------- *)
+   PROCEDURE Redraw;
+   VAR i :CARDINAL;
+   BEGIN
+      Home;  EraseScreen;
+
+      l := line1;
+      WHILE l # NIL DO
+         Line( l^.r1, l^.c1, l^.r2, l^.c2 );
+         l := l^.next;
+      END;
+
+      b := box1;
+      WHILE b # NIL DO
+         Box( b^.r1, b^.c1, b^.r2, b^.c2 );
+         b := b^.next;
+      END;
+
+      t := text1;
+      WHILE t # NIL DO
+         PutString( t^.string, t^.r1, t^.c1 );
+         t := t^.next;
+      END;
+
+      ShowMenu;
+   END Redraw;
+
+   (* ------------------------------------------------- *)
+   PROCEDURE Move( key :CHAR );
+   (* the arrow keys send 3 characters in a row,
+      escape, '[', then one of 'A' 'B' 'C' or 'D',
+      this procedure is called after the escape and '[' have been
+      detected and the movement is to be determined *)
+   BEGIN
+       IF    key = 'A' THEN
+          IF row > 1 THEN row := row - 1; END;
+       ELSIF key = 'B' THEN
+          IF row < 23 THEN row := row + 1; END;
+       ELSIF key = 'C' THEN
+          IF col < 80 THEN col := col + 1; END;
+       ELSIF key = 'D' THEN
+          IF col > 1 THEN col := col - 1; END;
+       END;
+
+       ShowPos;
+   END Move;
+
+   (* ------------------------------------------------- *)
+   PROCEDURE NewBox( row1, col1, row2, col2 :CARDINAL );
+   BEGIN
+
+      IF row2 > row1 THEN
+        begin_r := row1;
+        end_r   := row2;
+      ELSE
+        begin_r := row2;
+        end_r   := row1;
+      END;
+      IF col2 > col1 THEN
+        begin_c := col1;
+        end_c   := col2;
+      ELSE
+        begin_c := col2;
+        end_c   := col1;
+      END;
+
+       IF box1 = NIL THEN
+         NEW( b );
+         box1 := b;
+       ELSE
+         b := box1;
+         WHILE b # NIL DO
+            pb := b;
+            b  := b^.next;
+         END;
+         NEW( b );
+         pb^.next := b;
+       END;
+
+       b^.r1   := begin_r;
+       b^.c1   := begin_c;
+       b^.r2   := end_r;
+       b^.c2   := end_c;
+       b^.next := NIL;
+
+       Box( begin_r, begin_c, end_r, end_c );
+   END NewBox;
+
+   (* ------------------------------------------------- *)
+   PROCEDURE NewLine( row1, col1, row2, col2 :CARDINAL );
+   BEGIN
+      IF col1 # col2 THEN
+        begin_r := row1;
+        end_r   := row1;
+        IF col2 > col1 THEN
+          begin_c := col1;
+          end_c   := col2;
+        ELSE
+          begin_c := col2;
+          end_c   := col1;
+        END;
+      ELSE
+        begin_c := col1;
+        end_c   := col1;
+        IF row2 > row1 THEN
+          begin_r := row1;
+          end_r   := row2;
+        ELSE
+          begin_r := row2;
+          end_r   := row1;
+        END;
+      END;
+
+      IF line1 = NIL THEN
+        NEW( l );
+        line1 := l;
+      ELSE
+        l := line1;
+        WHILE l # NIL DO
+           pl := l;
+           l  := l^.next;
+        END;
+        NEW( l );
+        pl^.next := l;
+      END;
+
+      l^.r1   := begin_r;
+      l^.c1   := begin_c;
+      l^.r2   := end_r;
+      l^.c2   := end_c;
+      l^.next := NIL;
+
+      Line( begin_r, begin_c, end_r, end_c );
+   END NewLine;
+
+   (* ------------------------------------------------- *)
+   PROCEDURE NewText( row1, col1 :CARDINAL; string :ARRAY OF CHAR );
+   VAR i, j :CARDINAL;
+   BEGIN
+
+     IF text1 = NIL THEN
+       NEW( t );
+       text1 := t;
+     ELSE
+       t := text1;
+       WHILE t # NIL DO
+          pt := t;
+          t  := t^.next;
+       END;
+       NEW( t );
+       pt^.next := t;
+     END;
+     t^.r1   := row1;
+     t^.c1   := col1;
+     t^.r2   := row1;
+     t^.c2   := col1 - 1;
+     t^.next := NIL;
+
+     i := 0; j := 0;
+     WHILE ( j < max_string ) & ( i < LEN( string ) ) DO
+        c := string[i];
+        IF ( c >= ' ') & ( c <= '~' ) THEN
+          t^.string[j] := c;
+          j := j + 1;
+          t^.c2 := t^.c2 + 1;
+        END;
+        i := i + 1;
+     END;
+     t^.string[j] := 0C;
+
+     PutString( t^.string, t^.r1, t^.c1 );
+   END NewText;
+
+   (* ------------------------------------------------- *)
+   PROCEDURE PaintBox;
+   BEGIN
+     Message( 'move to other corner, then type B again' );  ShowPos;
+
+     first_row := row; first_col := col;
+
+     Get( c );
+     WHILE c = esc DO
+        Get( c );
+        IF c = '[' THEN
+          Get( c ); Move( c ); Get( c );
+        END;
+     END;
+
+     IF CAP( c ) = 'B' THEN
+       NewBox( first_row, first_col, row, col );
+     END;
+
+     ShowMenu;
+   END PaintBox;
+
+   (* ------------------------------------------------- *)
+   PROCEDURE PaintLine;
+   BEGIN
+     Message( 'move to end of line, then type L again' );  ShowPos;
+
+     first_row := row; first_col := col;
+
+     Get( c );
+     WHILE c = esc DO
+        Get( c );
+        IF c = '[' THEN
+          Get( c ); Move( c ); Get( c );
+        END;
+     END;
+
+     IF CAP( c ) = 'L' THEN
+       NewLine( first_row, first_col, row, col );
+     END;
+
+     ShowMenu;
+   END PaintLine;
+
+   (* ------------------------------------------------- *)
+   PROCEDURE PaintText;
+   VAR
+      i      :CARDINAL;
+      string :ARRAY [0..max_string] OF CHAR;
+   BEGIN
+     Message( 'control-Z to end text' );  ShowPos;
+
+     i := 0;
+     Get( c );
+     WHILE ( i < max_string ) & ( c # control_z ) DO
+        IF ( c >= ' ') & ( c <= '~' ) THEN
+          PutString( c, row, col+i );
+          string[i] := c;  i := i + 1;
+        END;
+        Get( c );
+     END;
+     string[i] := 0C;
+
+     NewText( row, col, string );
+
+     ShowMenu;
+   END PaintText;
+
+   (* ------------------------------------------------- *)
+   PROCEDURE Delete;
+   VAR found, test :BOOLEAN;
+   BEGIN
+     Message( 'move to an objects corner, type D again, then redraw' );
+     ShowPos;
+
+     Get( c );
+     WHILE c = esc DO
+        Get( c );
+        IF c = '[' THEN
+          Get( c ); Move( c ); Get( c );
+        END;
+     END;
+
+     IF CAP( c ) = 'D' THEN
+
+      found := FALSE;
+
+      l := line1;
+      WHILE ( NOT found ) & ( l # NIL ) DO
+         IF ( ( l^.r1 = row ) & ( l^.c1 = col ) ) OR
+            ( ( l^.r2 = row ) & ( l^.c2 = col ) ) THEN
+           found := TRUE;
+           IF l = line1 THEN
+             line1 := l^.next;
+           ELSE
+             pl^.next := l^.next;
+           END;
+           (* dispose of l *)
+         ELSE
+           pl := l;
+           l  := l^.next;
+         END;
+      END;
+
+      IF NOT found THEN
+
+        b := box1;
+        WHILE ( NOT found ) & ( b # NIL ) DO
+          
+          test := ( ( b^.r2 = row ) & ( b^.c1 = col ) );
+          IF ( ( b^.r1 = row ) & ( b^.c1 = col ) ) OR
+             ( ( b^.r2 = row ) & ( b^.c2 = col ) ) OR
+             ( ( b^.r1 = row ) & ( b^.c2 = col ) ) OR test THEN
+            found := TRUE;
+            IF b = box1 THEN
+              box1 := b^.next;
+            ELSE
+              pb^.next := b^.next;
+            END;
+            (* dispose of b *)
+          ELSE
+            pb := b;
+            b  := b^.next;
+          END;
+        END;
+
+        IF NOT found THEN
+
+          t := text1;
+          WHILE ( NOT found ) & ( t # NIL ) DO
+             found := TRUE;
+             IF ( ( t^.r1 = row ) & ( t^.c1 = col ) ) OR
+                ( ( t^.r2 = row ) & ( t^.c2 = col ) ) THEN
+               IF t = text1 THEN
+                 text1 := t^.next;
+               ELSE
+                 pt^.next := t^.next;
+               END;
+               (* dispose of t *)
+             ELSE
+               pt := t;
+               t  := t^.next;
+             END;
+          END;
+
+        END;
+      END;
+     END;
+
+     ShowMenu;
+   END Delete;
+
+   (* ------------------------------------------------- *)
+   PROCEDURE Print;
+   BEGIN
+      Message( 'print file  ' );
+
+      OpenOutput( 'ps' );
+      WriteString( '%!PS-Adobe' ); WriteLn;
+      WriteString( '/F 9.375 def' ); WriteLn;
+      WriteString( '/L { moveto lineto stroke } bind def' ); WriteLn;
+      WriteString( '/B { moveto lineto lineto lineto closepath stroke} bind def' );
+      WriteLn;
+      WriteString( '/T { moveto show } bind def' ); WriteLn;
+      WriteString( '/Courier findfont F scalefont setfont' ); WriteLn;
+      WriteString( '612 0 translate 90 rotate' ); WriteLn;
+      WriteString( '18 200 translate' ); WriteLn;
+
+      l := line1;
+      WHILE l # NIL DO
+         WriteCard( l^.c2,      4 ); WriteString( ' F mul ' );
+         WriteCard( 25 - l^.r2, 4 ); WriteString( ' F mul ' );
+
+         WriteCard( l^.c1,      4 ); WriteString( ' F mul ' );
+         WriteCard( 25 - l^.r1, 4 ); WriteString( ' F mul ' );
+
+         WriteString( ' L' ); WriteLn;
+         l := l^.next;
+      END;
+
+      b := box1;
+      WHILE b # NIL DO
+         WriteCard( b^.c1,      4 ); WriteString( ' F mul ' );
+         WriteCard( 25 - b^.r2, 4 );  WriteString( ' F mul ' );
+
+         WriteCard( b^.c2,      4 ); WriteString( ' F mul ' );
+         WriteCard( 25 - b^.r2, 4 ); WriteString( ' F mul ' );
+
+         WriteCard( b^.c2,      4 ); WriteString( ' F mul ' );
+         WriteCard( 25 - b^.r1, 4 ); WriteString( ' F mul ' );
+
+         WriteCard( b^.c1,      4 ); WriteString( ' F mul ' );
+         WriteCard( 25 - b^.r1, 4 ); WriteString( ' F mul ' );
+
+         WriteString( ' B' ); WriteLn;
+         b := b^.next;
+      END;
+
+      t := text1;
+      WHILE t # NIL DO
+         WriteString( '(' );
+         WriteString( t^.string );
+         WriteString( ') ' );
+         WriteCard( t^.c1, 4 );    WriteString( ' F mul ' );
+         WriteCard( 25-t^.r1, 4 ); WriteString( ' F mul ' );
+
+         WriteString( ' T' ); WriteLn;
+         t := t^.next;
+      END;
+
+      WriteString( 'showpage' ); WriteString( 4C );
+      CloseOutput;
+      Beep;
+      Redraw;
+   END Print;
+
+   (* ------------------------------------------------- *)
+   PROCEDURE SaveFile;
+   BEGIN
+      Message( 'save as ' );
+
+      OpenOutput( 'dat' );
+
+      l := line1;
+      WHILE l # NIL DO
+         WriteString( 'L ' );
+         WITH l^ DO
+            WriteCard( r1, 4 );  WriteCard( c1, 4 );
+            WriteCard( r2, 4 );  WriteCard( c2, 4 );
+         END;
+         WriteLn;
+         l := l^.next;
+      END;
+
+      b := box1;
+      WHILE b # NIL DO
+         WriteString( 'B ' );
+         WITH b^ DO
+            WriteCard( r1, 4 );  WriteCard( c1, 4 );
+            WriteCard( r2, 4 );  WriteCard( c2, 4 );
+         END;
+         WriteLn;
+         b := b^.next;
+      END;
+
+      t := text1;
+      WHILE t # NIL DO
+         WriteString( 'T ' );
+         WriteCard( t^.r1, 4 );  WriteCard( t^.c1, 4 );
+         WriteString( ' ' );
+         WriteString( t^.string );
+         WriteLn;
+         t := t^.next;
+      END;
+
+      CloseOutput;
+      Beep;
+      Redraw;
+   END SaveFile;
+
+   (* ------------------------------------------------- *)
+   PROCEDURE LoadFile;
+   VAR
+      r1, r2, c1, c2 :CARDINAL;
+      string         :ARRAY [0..max_string] OF CHAR;
+      i              :CARDINAL;
+
+   BEGIN
+      Message( 'load file ' );
+
+      OpenInput( 'dat' );
+      IF Done THEN
+
+        Read( c );
+        WHILE Done DO
+          c := CAP( c );
+          IF c = 'L' THEN
+            ReadCard( r1 );  ReadCard( c1 );  ReadCard( r2 );  ReadCard( c2 );
+            ReadLn;
+            NewLine( r1, c1, r2, c2 );
+          ELSIF c = 'B' THEN
+            ReadCard( r1 );  ReadCard( c1 );  ReadCard( r2 );  ReadCard( c2 );
+            ReadLn;
+            NewBox( r1, c1, r2, c2 );
+          ELSIF c = 'T' THEN
+            ReadCard( r1 );  ReadCard( c1 );
+            i := 0;
+            Read(c);
+            WHILE ( i < max_string ) & ( c # EOL ) DO
+              IF ( c >= ' ' ) & ( c <= '~' ) THEN
+                string[i] := c;
+                i := i + 1;
+              END;
+              Read(c);
+            END;
+            string[i] := 0C;
+            ReadLn;
+            NewText( r1, c1, string );
+          ELSE
+            ReadLn;
+          END;
+
+          Read( c );
+        END;
+
+        CloseInput;
+      END;
+
+      Redraw;
+   END LoadFile;
+
+BEGIN
+
+  row := 1; col := 1;
+
+  line1 := NIL;   box1 := NIL;   text1 := NIL;
+
+  Redraw;
+
+  StartGet;
+
+  Get( c );
+  WHILE c # control_z DO
+
+   c := CAP( c );
+
+   IF c = esc THEN
+     (* motion consists of three characters, see the Move procedure *)
+     Get( c );
+
+     IF c = '[' THEN
+       Get( c );
+       Move( c );
+     END;
+
+   ELSIF c = 'B' THEN
+     PaintBox;
+   ELSIF c = 'L' THEN
+     PaintLine;
+   ELSIF c = 'T' THEN
+     PaintText;
+   ELSIF c = 'R' THEN
+     Redraw;
+   ELSIF c = 'D' THEN
+     Delete;
+   ELSIF c = 'P' THEN
+     Print;
+   ELSIF c = 'S' THEN
+     SaveFile;
+   ELSIF c = 'G' THEN
+     LoadFile;
+   ELSE
+     Beep;
+   END;
+
+    Get( c );
+  END;
+
+  PutCursor( 24, 1 );
+
+  StopGet;
+
+END XPaint.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/queues-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/queues-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/queues-1.mod
@@ -0,0 +1,108 @@
+MODULE TestQueues;
+
+(* Test the procedures in the module Queues, and show how they work. *)
+(* J. Andrea, Oct.11/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut  IMPORT WriteCard, WriteString, WriteLn;
+FROM Queues IMPORT Queue, Directions, InitQueue, DelQueue, Pop, Push, QueueInfo;
+
+VAR
+   a, b  :ARRAY [0..9] OF CHAR;
+   queue :Queue;
+   error :BOOLEAN;
+   i, j  :CARDINAL;
+
+   (* -------------------------------------------------- *)
+   PROCEDURE Show( string :ARRAY OF CHAR );
+   BEGIN
+      WriteString( 'string is >' ); WriteString( string ); WriteString( '<' );
+      WriteLn;
+   END Show;
+
+BEGIN
+
+       (*0123456789*)
+   a := 'abcdefghji';
+   b := '          ';
+
+   WriteString( 'create a queue' ); WriteLn;
+   InitQueue( queue );
+   QueueInfo( queue, Top, i, j );
+   WriteString( 'queue has ' ); WriteCard( i, 0 ); WriteString( ' items' );
+   WriteString( ' and top has ' ); WriteCard( j, 0 ); WriteString( ' bytes' );
+   WriteLn;
+
+   WriteString( 'now just delete that queue' ); WriteLn;
+
+   DelQueue( queue );
+
+   WriteLn;  WriteLn;  WriteLn;
+   WriteString( 'create a queue' ); WriteLn;
+   InitQueue( queue );
+
+   Show( a );
+
+   WriteString( 'push ' ); WriteLn;
+   Push( queue, Top, a );
+
+   WriteString( 'push ' ); WriteLn;
+   Push( queue, Top, a );
+
+   WriteString( 'push ' ); WriteLn;
+   Push( queue, Top, a );
+
+   QueueInfo( queue, Top, i, j );
+   WriteString( 'queue has ' ); WriteCard( i, 0 ); WriteString( ' items' );
+   WriteString( ' and top has ' ); WriteCard( j, 0 ); WriteString( ' bytes' );
+   WriteLn;
+
+   WriteString( 'delete that queue' ); WriteLn;
+   DelQueue( queue );
+
+
+   WriteLn;  WriteLn;   WriteLn;
+   WriteString( 'create a queue' ); WriteLn;
+   InitQueue( queue );
+
+   Show( a );
+
+   WriteString( 'push ' ); WriteLn;
+   Push( queue, Top, a );
+
+   WriteString( 'pop ' ); WriteLn;
+   Pop( queue, Top, b, error );
+
+   IF error THEN
+     WriteString( 'somethings wrong, shouldnt be empty' ); WriteLn;
+   ELSE
+
+     Show( b );
+
+     error := FALSE;
+     FOR i := 0 TO 9 DO
+        IF a[i] # b[i] THEN
+          error := TRUE;
+        END;
+     END;
+     IF error THEN
+       WriteString( 'compared strings are different !' );
+     ELSE
+       WriteString( 'strings ok' );
+     END;
+     WriteLn;
+
+     WriteLn;
+     Pop( queue, Top, b, error );
+     IF error THEN
+       WriteString( 'ok, empty as expected' );
+     ELSE
+       WriteString( 'the queue should be empty but isnt' );
+     END;
+     WriteLn;
+
+     DelQueue( queue );
+
+  END;
+
+END TestQueues.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/queues-2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/queues-2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/queues-2.mod
@@ -0,0 +1,150 @@
+MODULE TestQueues;
+
+(* Test the procedures in the module Queues, and show how they work. *)
+(* J. Andrea, Oct.11/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut  IMPORT WriteString, WriteCard, WriteLn;
+FROM Queues IMPORT Queue, Directions, InitQueue, DelQueue, Pop, Push,
+                   QueueInfo;
+
+VAR
+   a, b  :ARRAY [0..9] OF CHAR;
+   queue :Queue;
+   error :BOOLEAN;
+   i, j  :CARDINAL;
+
+   (* -------------------------------------------------- *)
+   PROCEDURE Show( string :ARRAY OF CHAR );
+   BEGIN
+      WriteString( 'string is >' ); WriteString( string ); WriteString( '<' );
+      WriteLn;
+   END Show;
+
+BEGIN
+
+       (*0123456789*)
+   a := 'abcdefghji';
+   b := '          ';
+
+
+   WriteString( 'create a queue, and push TOP one char at a time' ); WriteLn;
+   InitQueue( queue );
+
+   FOR i := 0 TO 9 DO
+     WriteString( 'push ' ); WriteString(a[i]); WriteString( ',' );
+     Push( queue, Top, a[i] );
+   END;
+   WriteLn;
+
+   QueueInfo( queue, Top, i, j );
+   WriteString( 'queue has ' ); WriteCard( i, 0 ); WriteString( ' items' );
+   WriteString( ' and top is ' ); WriteCard( j, 0 ); WriteString( ' bytes' );
+   WriteLn;
+
+   WriteString( 'now pop one char at a time, from TOP' ); WriteLn;
+
+   FOR i := 0 TO 9 DO
+     WriteString( 'pop ' );
+     Pop( queue, Top, b[i], error ); WriteString(b[i]); WriteString(',');
+   END;
+   WriteLn;
+
+   WriteString( 'they should be in reverse order'); WriteLn;
+   Show(a); Show(b);
+
+   WriteString( 'delete that queue' ); WriteLn;
+   DelQueue( queue );
+
+
+
+   WriteLn;  WriteLn;  WriteLn;
+   WriteString( 'create a queue, and push BOTTOM one char at a time' ); WriteLn;
+   InitQueue( queue );
+
+   FOR i := 0 TO 9 DO
+     WriteString( 'push ' ); WriteString(a[i]); WriteString( ',' );
+     Push( queue, Bottom, a[i] );
+   END;
+   WriteLn;
+
+   QueueInfo( queue, Bottom, i, j );
+   WriteString( 'queue has ' ); WriteCard( i, 0 ); WriteString( ' items' );
+   WriteString( ' and top is ' ); WriteCard( j, 0 ); WriteString( ' bytes' );
+   WriteLn;
+
+   WriteString( 'now pop one char at a time, from BOTTOM' ); WriteLn;
+
+   FOR i := 0 TO 9 DO
+     WriteString( 'pop ' );
+     Pop( queue, Bottom, b[i], error ); WriteString(b[i]); WriteString(',');
+   END;
+   WriteLn;
+
+   WriteString( 'they should be in reverse order'); WriteLn;
+   Show(a); Show(b);
+
+   WriteString( 'delete that queue' ); WriteLn;
+   DelQueue( queue );
+
+
+   WriteLn;  WriteLn;  WriteLn;
+   InitQueue( queue );
+   WriteString( 'create a queue, and push TOP one char at a time' ); WriteLn;
+
+   FOR i := 0 TO 9 DO
+     WriteString( 'push ' ); WriteString(a[i]); WriteString( ',' );
+     Push( queue, Top, a[i] );
+   END;
+   WriteLn;
+
+   QueueInfo( queue, Top, i, j );
+   WriteString( 'queue has ' ); WriteCard( i, 0 ); WriteString( ' items' );
+   WriteString( ' and top has ' ); WriteCard( j, 0 ); WriteString( ' bytes' );
+   WriteLn;
+
+   WriteString( 'now pop one char at a time, BOTTOM end of queue' ); WriteLn;
+
+   FOR i := 0 TO 9 DO
+     WriteString( 'pop ' );
+     Pop( queue, Bottom, b[i], error ); WriteString(b[i]); WriteString( ',' );
+   END;
+   WriteLn;
+
+   WriteString( 'they should be in the same order' ); WriteLn;
+   Show(a); Show(b);
+
+   WriteString( 'delete that queue' ); WriteLn;
+   DelQueue( queue );
+
+
+   WriteLn;  WriteLn;  WriteLn;
+   InitQueue( queue );
+   WriteString( 'create a queue, and push BOTTOM one char at a time' ); WriteLn;
+
+   FOR i := 0 TO 9 DO
+     WriteString( 'push ' ); WriteString(a[i]); WriteString( ',' );
+     Push( queue, Bottom, a[i] );
+   END;
+   WriteLn;
+
+   QueueInfo( queue, Top, i, j );
+   WriteString( 'queue has ' ); WriteCard( i, 0 ); WriteString( ' items' );
+   WriteString( ' and top has ' ); WriteCard( j, 0 ); WriteString( ' bytes' );
+   WriteLn;
+
+   WriteString( 'now pop one char at a time, TOP end of queue' ); WriteLn;
+
+   FOR i := 0 TO 9 DO
+     WriteString( 'pop ' );
+     Pop( queue, Top, b[i], error ); WriteString(b[i]); WriteString( ',' );
+   END;
+   WriteLn;
+
+   WriteString( 'they should be in the same order' ); WriteLn;
+   Show(a); Show(b);
+
+   WriteString( 'delete that queue' ); WriteLn;
+   DelQueue( queue );
+
+END TestQueues.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/randomly.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/randomly.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/randomly.mod
@@ -0,0 +1,73 @@
+MODULE TestRandomly;
+
+(* Test the random number functions and show how they're used *)
+(* J. Andrea, Aug.12/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM Randomly IMPORT Choose_0_To_N, Choose_1_To_N, 
+                     Choose_0_To_N_Minus_1, Choose_1_To_N_Minus_1;
+FROM InOut IMPORT ReadCard, WriteCard, WriteString, WriteLn;
+
+VAR
+  n, m, i, x, min, max :CARDINAL;
+
+BEGIN
+
+WriteString( 'input a number to test (555 to exit) ? ' );
+ReadCard( n );
+WHILE n # 555 DO
+
+   WriteString( 'how many times for the test ? ' );
+   ReadCard( m );
+
+   WriteString( 'testing Choose_0_To_N for N=' ); WriteCard( n, 0 );
+   WriteString( ', ' ); WriteCard( m, 0 ); WriteString( ' times ');
+   WriteLn;
+
+   min := n + 1;
+   max := 0;
+   FOR i := 1 TO m DO
+      x := Choose_0_To_N( n );
+      IF x < min THEN min := x; END;
+      IF x > max THEN max := x; END;
+      (* WriteCard( x, 0 ); WriteLn; *)
+   END;
+
+   WriteString( 'found min = ' ); WriteCard( min, 0 ); WriteLn;
+   WriteString( 'found max = ' ); WriteCard( max, 0 ); WriteLn;
+
+   WriteString( 'testing Choose_1_To_N for N=' ); WriteCard( n, 0 );
+   WriteString( ', ' ); WriteCard( m, 0 ); WriteString( ' times ');
+   WriteLn;
+
+   min := n + 1;
+   max := 0;
+   FOR i := 1 TO m DO
+      x := Choose_1_To_N( n );
+      IF x < min THEN min := x; END;
+      IF x > max THEN max := x; END;
+   END;
+
+   WriteString( 'found min = ' ); WriteCard( min, 0 ); WriteLn;
+   WriteString( 'found max = ' ); WriteCard( max, 0 ); WriteLn;
+
+   WriteString( 'testing Choose_0_To_N-1 for N=' ); WriteCard( n, 0 );
+   WriteString( ', ' ); WriteCard( m, 0 ); WriteString( ' times ');
+   WriteLn;
+
+   min := n + 1;
+   max := 0;
+   FOR i := 1 TO m DO
+      x := Choose_0_To_N_Minus_1( n );
+      IF x < min THEN min := x; END;
+      IF x > max THEN max := x; END;
+   END;
+
+   WriteString( 'found min = ' ); WriteCard( min, 0 ); WriteLn;
+   WriteString( 'found max = ' ); WriteCard( max, 0 ); WriteLn;
+
+   WriteString( 'input a number to test (555 to exit) ? ' );
+   ReadCard( n );
+END;
+
+END TestRandomly.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/roman-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/roman-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/roman-1.mod
@@ -0,0 +1,53 @@
+MODULE TestRoman;
+
+(* Test the RomanNumerals procedures *)
+(* J. Andrea, 1992 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteString, WriteCard, WriteLn, Read, ReadCard;
+FROM RomanNumerals IMPORT FromRoman, ToRoman;
+
+VAR
+   a, b, i, x :CARDINAL;
+   string     :ARRAY [0..132] OF CHAR;
+   display    :BOOLEAN;
+   errors     :CARDINAL;
+
+BEGIN
+
+   WriteString( 'what starting decimal value ? ' ); ReadCard( a );
+   WriteString( 'what ending   decimal value ? ' ); ReadCard( b );
+
+   WriteString( 'do you want display on (y/n) ? ' ); Read( string[0] );
+   display := CAP( string[0] ) = 'Y';
+
+   errors := 0;
+
+   FOR i := a TO b DO
+      IF display THEN WriteCard( i, 1 ); WriteString( ' roman>' ); END;
+
+      ToRoman( i, string );
+
+      IF display THEN WriteString( string ); WriteString( '<' ); END;
+
+      FromRoman( string, x );
+
+      IF i = x THEN
+        IF display THEN WriteString( ' ok' ); END;
+      ELSE
+        errors := errors + 1;
+        IF display THEN WriteString( ' ----not same '); WriteCard( x, 1 ); END;
+      END;
+
+      IF display THEN WriteLn; END;
+   END;
+
+   WriteLn;
+   IF errors = 0 THEN
+     WriteString( 'no conversion problems found' );
+   ELSE
+     WriteCard( errors, 0 ); WriteString( ' conversion errors !' );
+   END;
+   WriteLn;
+
+END TestRoman.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/roman-2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/roman-2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/roman-2.mod
@@ -0,0 +1,136 @@
+MODULE TestRoman;
+
+(* Test the RomanNumerals procedures *)
+(* J. Andrea, Jun.5/92 -better looking numerals *)
+(* J. Andrea, 1992 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteString, WriteCard, WriteLn;
+FROM RomanNumerals IMPORT FromRoman, ToRoman;
+FROM StringOperations IMPORT Equal;
+
+VAR
+   i, x       :CARDINAL;
+   string     :ARRAY [0..132] OF CHAR;
+   errors     :CARDINAL;
+   known      :ARRAY [1..249] OF ARRAY [0..30] OF CHAR;
+
+BEGIN
+
+known[1] := "I";             known[2] := "II";            known[3] := "III";           
+known[4] := "IV";            known[5] := "V";             known[6] := "VI";            
+known[7] := "VII";           known[8] := "VIII";          known[9] := "IX";           
+known[10] := "X";            known[11] := "XI";           known[12] := "XII";          
+known[13] := "XIII";         known[14] := "XIV";          known[15] := "XV";           
+known[16] := "XVI";          known[17] := "XVII";         known[18] := "XVIII";        
+known[19] := "XIX";          known[20] := "XX";           known[21] := "XXI";          
+known[22] := "XXII";         known[23] := "XXIII";        known[24] := "XXIV";         
+known[25] := "XXV";          known[26] := "XXVI";         known[27] := "XXVII";        
+known[28] := "XXVIII";       known[29] := "XXIX";         known[30] := "XXX";          
+known[31] := "XXXI";         known[32] := "XXXII";        known[33] := "XXXIII";       
+known[34] := "XXXIV";        known[35] := "XXXV";         known[36] := "XXXVI";        
+known[37] := "XXXVII";       known[38] := "XXXVIII";      known[39] := "XXXIX";       
+known[40] := "XL";           known[41] := "XLI";          known[42] := "XLII";         
+known[43] := "XLIII";        known[44] := "XLIV";         known[45] := "XLV";          
+known[46] := "XLVI";         known[47] := "XLVII";        known[48] := "XLVIII";       
+known[49] := "XLIX";         known[50] := "L";            known[51] := "LI";           
+known[52] := "LII";          known[53] := "LIII";         known[54] := "LIV";          
+known[55] := "LV";           known[56] := "LVI";          known[57] := "LVII";         
+known[58] := "LVIII";        known[59] := "LIX";          known[60] := "LX";           
+known[61] := "LXI";          known[62] := "LXII";         known[63] := "LXIII";        
+known[64] := "LXIV";         known[65] := "LXV";          known[66] := "LXVI";         
+known[67] := "LXVII";        known[68] := "LXVIII";       known[69] := "LXIX";         
+known[70] := "LXX";          known[71] := "LXXI";         known[72] := "LXXII";        
+known[73] := "LXXIII";       known[74] := "LXXIV";        known[75] := "LXXV";         
+known[76] := "LXXVI";        known[77] := "LXXVII";       known[78] := "LXXVIII";      
+known[79] := "LXXIX";        known[80] := "LXXX";         known[81] := "LXXXI";        
+known[82] := "LXXXII";       known[83] := "LXXXIII";      known[84] := "LXXXIV";       
+known[85] := "LXXXV";        known[86] := "LXXXVI";       known[87] := "LXXXVII";      
+known[88] := "LXXXVIII";     known[89] := "LXXXIX";       known[90] := "XC";          
+known[91] := "XCI";          known[92] := "XCII";         known[93] := "XCIII";       
+known[94] := "XCIV";         known[95] := "XCV";          known[96] := "XCVI";        
+known[97] := "XCVII";        known[98] := "XCVIII";       known[99] := "XCIX";        
+known[100] := "C";           known[101] := "CI";          known[102] := "CII";         
+known[103] := "CIII";        known[104] := "CIV";         known[105] := "CV";          
+known[106] := "CVI";         known[107] := "CVII";        known[108] := "CVIII";       
+known[109] := "CIX";         known[110] := "CX";          known[111] := "CXI";         
+known[112] := "CXII";        known[113] := "CXIII";       known[114] := "CXIV";        
+known[115] := "CXV";         known[116] := "CXVI";        known[117] := "CXVII";       
+known[118] := "CXVIII";      known[119] := "CXIX";        known[120] := "CXX";         
+known[121] := "CXXI";        known[122] := "CXXII";       known[123] := "CXXIII";      
+known[124] := "CXXIV";       known[125] := "CXXV";        known[126] := "CXXVI";       
+known[127] := "CXXVII";      known[128] := "CXXVIII";     known[129] := "CXXIX";       
+known[130] := "CXXX";        known[131] := "CXXXI";       known[132] := "CXXXII";      
+known[133] := "CXXXIII";     known[134] := "CXXXIV";      known[135] := "CXXXV";       
+known[136] := "CXXXVI";      known[137] := "CXXXVII";     known[138] := "CXXXVIII";    
+known[139] := "CXXXIX";      known[140] := "CXL";         known[141] := "CXLI";        
+known[142] := "CXLII";       known[143] := "CXLIII";      known[144] := "CXLIV";       
+known[145] := "CXLV";        known[146] := "CXLVI";       known[147] := "CXLVII";      
+known[148] := "CXLVIII";     known[149] := "CXLIX";       known[150] := "CL";          
+known[151] := "CLI";         known[152] := "CLII";        known[153] := "CLIII";       
+known[154] := "CLIV";        known[155] := "CLV";         known[156] := "CLVI";        
+known[157] := "CLVII";       known[158] := "CLVIII";      known[159] := "CLIX";        
+known[160] := "CLX";         known[161] := "CLXI";        known[162] := "CLXII";       
+known[163] := "CLXIII";      known[164] := "CLXIV";       known[165] := "CLXV";        
+known[166] := "CLXVI";       known[167] := "CLXVII";      known[168] := "CLXVIII";     
+known[169] := "CLXIX";       known[170] := "CLXX";        known[171] := "CLXXI";       
+known[172] := "CLXXII";      known[173] := "CLXXIII";     known[174] := "CLXXIV";      
+known[175] := "CLXXV";       known[176] := "CLXXVI";      known[177] := "CLXXVII";     
+known[178] := "CLXXVIII";    known[179] := "CLXXIX";      known[180] := "CLXXX";       
+known[181] := "CLXXXI";      known[182] := "CLXXXII";     known[183] := "CLXXXIII";    
+known[184] := "CLXXXIV";     known[185] := "CLXXXV";      known[186] := "CLXXXVI";     
+known[187] := "CLXXXVII";    known[188] := "CLXXXVIII";   known[189] := "CLXXXIX";     
+known[190] := "CXC";         known[191] := "CXCI";        known[192] := "CXCII";      
+known[193] := "CXCIII";      known[194] := "CXCIV";       known[195] := "CXCV";       
+known[196] := "CXCVI";       known[197] := "CXCVII";      known[198] := "CXCVIII";    
+known[199] := "CXCIX";       known[200] := "CC";          known[201] := "CCI";         
+known[202] := "CCII";        known[203] := "CCIII";       known[204] := "CCIV";        
+known[205] := "CCV";         known[206] := "CCVI";        known[207] := "CCVII";       
+known[208] := "CCVIII";      known[209] := "CCIX";        known[210] := "CCX";         
+known[211] := "CCXI";        known[212] := "CCXII";       known[213] := "CCXIII";      
+known[214] := "CCXIV";       known[215] := "CCXV";        known[216] := "CCXVI";       
+known[217] := "CCXVII";      known[218] := "CCXVIII";     known[219] := "CCXIX";       
+known[220] := "CCXX";        known[221] := "CCXXI";       known[222] := "CCXXII";      
+known[223] := "CCXXIII";     known[224] := "CCXXIV";      known[225] := "CCXXV";       
+known[226] := "CCXXVI";      known[227] := "CCXXVII";     known[228] := "CCXXVIII";    
+known[229] := "CCXXIX";      known[230] := "CCXXX";       known[231] := "CCXXXI";      
+known[232] := "CCXXXII";     known[233] := "CCXXXIII";    known[234] := "CCXXXIV";     
+known[235] := "CCXXXV";      known[236] := "CCXXXVI";     known[237] := "CCXXXVII";    
+known[238] := "CCXXXVIII";   known[239] := "CCXXXIX";     known[240] := "CCXL";        
+known[241] := "CCXLI";       known[242] := "CCXLII";      known[243] := "CCXLIII";     
+known[244] := "CCXLIV";      known[245] := "CCXLV";       known[246] := "CCXLVI";      
+known[247] := "CCXLVII";     known[248] := "CCXLVIII";    known[249] := "CCXLIX";      
+
+   errors := 0;
+
+   FOR i := 1 TO 249 DO
+
+      ToRoman( i, string );
+      IF NOT Equal( string, known[i] ) THEN
+        errors := errors + 1;
+        WriteCard( i, 0 );
+        WriteString( ', known=' ); WriteString( known[i] );
+        WriteString( ' but conversion=' );
+        WriteString( string );
+        WriteLn;
+      END;
+
+      FromRoman( known[i], x );
+      IF i # x THEN
+        errors := errors + 1;
+        WriteCard( i, 0 ); WriteString( ' expected, found=' );
+        WriteCard( x, 0 );
+        WriteLn;
+      END;
+
+   END;
+
+   WriteLn;
+   IF errors = 0 THEN
+     WriteString( 'no conversion problems found' );
+   ELSE
+     WriteCard( errors, 0 ); WriteString( ' conversion errors !' );
+   END;
+   WriteLn;
+
+END TestRoman.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/say-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/say-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/say-1.mod
@@ -0,0 +1,28 @@
+MODULE TestSay;
+
+(* Make a cardinal number into a phrase of words of numbers *)
+(* V1.0, J. Andrea, Oct.11/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM InOut IMPORT WriteString, WriteLn, WriteCard, ReadCard, ReadLn;
+FROM SayNumbers IMPORT SayCard;
+
+VAR
+  x    :CARDINAL;
+  word :ARRAY [1..200] OF CHAR;
+
+BEGIN
+
+  WriteString( 'a number ? ' );
+  ReadCard( x );  ReadLn;
+  WHILE x # 0 DO
+    WriteCard( x, 0 ); WriteString( ' ' );
+    SayCard( x, word );
+    WriteString( word ); WriteLn;
+    WriteLn;
+    WriteString( 'a number (zero to exit) ? ' );
+    ReadCard( x ); ReadLn;
+  END;
+  WriteLn;
+
+END TestSay.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/say-2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/say-2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/say-2.mod
@@ -0,0 +1,40 @@
+MODULE TestSay;
+
+(* Make a cardinal number into a phrase of words of numbers *)
+(* V1.0, J. Andrea, Oct.11/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM InOut IMPORT WriteString, WriteLn, WriteCard;
+FROM SayNumbers IMPORT SayCard;
+FROM StringOperations IMPORT Length;
+
+CONST
+  n = 100;
+
+VAR
+  i, x, max, len :CARDINAL;
+  word           :ARRAY [1..200] OF CHAR;
+
+BEGIN
+
+  max := 0;
+  len := 0;
+
+  FOR i := 0 TO n DO
+
+     SayCard( i, word );
+     x := Length( word );
+     IF x > len THEN
+       max := i; len := x;
+     END;
+  END;
+
+  WriteString( 'up to ' ); WriteCard( n, 0 );
+  WriteString( ' max length is ' ); WriteCard( len, 0 );
+  WriteString( ' at value ' ); WriteCard( max, 0 );
+
+  SayCard( max, word );
+  WriteString( ' "' ); WriteString( word ); WriteString( '"' );
+  WriteLn;
+
+END TestSay.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/screen.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/screen.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/screen.mod
@@ -0,0 +1,30 @@
+MODULE Screen;
+
+(* test out some simple screen handling *)
+(* J. Andrea, 1984 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SimpleScreen IMPORT ErasePage, PutScreen, SetCursor, ScreenFinished;
+
+CONST
+  max = 20;
+
+VAR
+  row, col :CARDINAL;
+
+BEGIN (* Screen *)
+
+ErasePage(1,1);
+
+FOR row := 1 TO 20 DO
+   col := row;
+   PutScreen( 'xyzzy', (max-row+1), col );
+END; (* for *)
+
+PutScreen('all done',1,70);
+
+SetCursor(23,1);
+
+ScreenFinished;
+
+END Screen.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/show-bits-small.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/show-bits-small.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/show-bits-small.mod
@@ -0,0 +1,39 @@
+MODULE ShowBitsSmall;
+
+(* This is a small program to show how to use the BITSET conversion
+   to test for bits inside a number. *)
+(* J. Andrea, Jun.14/93 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM InOut IMPORT WriteString, WriteLn, WriteCard;
+
+CONST
+  max_value = 5;
+  max_bit   = 3;
+
+VAR
+  i, j :CARDINAL;
+  x    :BITSET;
+BEGIN
+
+   FOR i := 0 TO max_value DO
+      WriteString( 'value = ' ); WriteCard( i, 0 ); WriteLn;
+
+      x := BITSET( i );
+
+      FOR j := 0 TO max_bit DO
+         WriteString( '     bit ' ); WriteCard( j, 0 );
+         WriteString( ': ' );
+
+         IF j IN x THEN
+           WriteString( 'on' );
+         ELSE
+           WriteString( 'off' );
+         END;
+
+         WriteLn;
+      END;
+
+   END;
+
+END ShowBitsSmall.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/show_high-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/show_high-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/show_high-1.mod
@@ -0,0 +1,28 @@
+MODULE ShowHigh;
+
+(* show some examples of using objects passed as ARRAY OF BYTE and HIGH *)
+(* Jaa, Oct.3/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteString, WriteCard, WriteLn;
+FROM SYSTEM IMPORT BYTE;
+
+VAR
+  s :ARRAY [0..20] OF CHAR;
+  x :REAL;
+  b :BOOLEAN;
+  c :CARDINAL;
+
+  (* ----------------------------------------- *)
+  PROCEDURE Show( data :ARRAY OF BYTE );
+  BEGIN
+     WriteString( 'HIGH+1 gives ' ); WriteCard( HIGH(data)+1, 0 );
+  END Show;
+
+BEGIN
+
+  WriteString( 'using string   ' ); Show( s ); WriteLn;
+  WriteString( 'using real     ' ); Show( x ); WriteLn;
+  WriteString( 'using boolean  ' ); Show( b ); WriteLn;
+  WriteString( 'using cardinal ' ); Show( c ); WriteLn;
+END ShowHigh.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/show_high_2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/show_high_2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/show_high_2.mod
@@ -0,0 +1,41 @@
+MODULE ShowHigh;
+
+(* show some examples of using objects passed as ARRAY OF BYTE and HIGH *)
+(* Jaa, Oct.3/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteString, WriteInt, WriteLn;
+FROM SYSTEM IMPORT BYTE;
+FROM Conversions IMPORT ByteToInt;
+
+VAR
+  s :ARRAY [0..9] OF CHAR;
+  x :REAL;
+  b :BOOLEAN;
+  c :CARDINAL;
+
+  (* ----------------------------------------- *)
+  PROCEDURE Show( data :ARRAY OF BYTE );
+
+  VAR
+    i :CARDINAL;
+
+  BEGIN
+     FOR i := 0 TO HIGH(data) DO
+       WriteInt( ByteToInt(data[i]), 4 );
+     END;
+  END Show;
+
+BEGIN
+
+  s := 'abcdefghij';
+  x := 1.0;
+  b := TRUE;
+  c := 1;
+
+  WriteString( 'using string   ' ); WriteLn; Show( s ); WriteLn;
+  WriteString( 'using real     ' ); WriteLn; Show( x ); WriteLn;
+  WriteString( 'using boolean  ' ); WriteLn; Show( b ); WriteLn;
+  WriteString( 'using cardinal ' ); WriteLn; Show( c ); WriteLn;
+
+END ShowHigh.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/showbits.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/showbits.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/showbits.mod
@@ -0,0 +1,104 @@
+MODULE ShowBits;
+
+(* test the bitwise logical functions *)
+(* J. Andrea, 1984 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteString, WriteLn, WriteCard;
+
+FROM BitsetFunctions IMPORT Or, Nor, Xor, And, Nand, Xand, Not,
+                            ShiftRight, ShiftLeft;
+
+VAR
+  a, b, c :BITSET;
+
+   (* ------------------------------------------ *)
+   PROCEDURE StartResults;
+   (* begin a truth table *)
+   BEGIN (* StartResults *)
+       WriteLn;
+       WriteString('operation 0  1  value'); WriteLn;
+       WriteString('         -----       '); WriteLn;
+   END StartResults;
+
+   (* ------------------------------------------ *)
+   PROCEDURE ShowResults( type : ARRAY OF CHAR);
+
+   BEGIN (* ShowResults *)
+      WriteString(type); WriteString(' 0    ');
+      IF 0 IN c THEN
+        WriteString('1  ');
+      ELSE 
+        WriteString('0  ');
+      END;
+      IF 1 IN c THEN
+        WriteString('1');
+      ELSE 
+        WriteString('0');
+      END;
+
+      (* show the value of the result too,
+         but if its a negation type function then subtract
+         all those other bits that were negated too *)
+      IF type[0] # 'N' THEN
+         WriteCard(CARDINAL(c),6);
+      ELSE
+         WriteCard(CARDINAL(c)-4294967280,6);
+      END; (* if *)
+      WriteLn;
+         
+      WriteString('     1    ');
+      IF 2 IN c THEN
+        WriteString('1  ');
+      ELSE 
+        WriteString('0  ');
+      END;
+      IF 3 IN c THEN
+        WriteString('1');
+      ELSE 
+        WriteString('0');
+      END;
+      WriteLn;
+      WriteString('         -----       '); WriteLn;
+   END ShowResults;
+
+BEGIN (* ShowBits *)
+
+(* initialize a and b for testing *)
+a := {3,2};  (* 1100 *)
+b := {3,1};  (* 1010 *)
+
+WriteLn;
+WriteString('a=1100,'); WriteCard( CARDINAL(a), 5 ); WriteLn;
+WriteString('b=1010,'); WriteCard( CARDINAL(b), 5 ); WriteLn;
+WriteLn;
+StartResults;
+
+c := Or(a,b);   ShowResults('OR  ');
+c := Nor(a,b);  ShowResults('NOR ');
+c := Xor(a,b);  ShowResults('XOR ');
+c := And(a,b);  ShowResults('AND ');
+c := Nand(a,b); ShowResults('NAND');
+c := Xand(a,b); ShowResults('XAND');
+c := Not(a);    ShowResults('NOT ');
+
+(* now test the shift functions *)
+
+WriteLn;
+WriteString( '12 shifted right twice should give 3 right !' ); WriteLn;
+WriteCard( CARDINAL( ShiftRight(a,2) ), 10 );
+WriteString('    right ?'); WriteLn;
+
+WriteString( 'and 12 shifted left twice should give 48 right !' ); WriteLn;
+WriteCard( CARDINAL( ShiftLeft(a,2) ), 10);
+WriteString('    right ?'); WriteLn;
+WriteLn;
+
+WriteString( '1 shifted right once should give 2^31 !' ); WriteLn;
+WriteCard( CARDINAL( ShiftRight(BITSET(1),1) ), 10 ); WriteLn;
+
+WriteString( 'and 2^31 shifted left once should give 1 !' ); WriteLn;
+WriteCard( CARDINAL( ShiftLeft({31},1) ), 10 ); WriteLn;
+
+WriteLn;
+END ShowBits.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/shuffle-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/shuffle-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/shuffle-1.mod
@@ -0,0 +1,41 @@
+MODULE TestShuffle;
+
+(* This program show how to use the module Shuffle *)
+(* John Andrea, Apr.2/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM InOut IMPORT ReadCard, WriteCard, WriteLn, WriteString;
+FROM Shuffle IMPORT Deck, Create, Next, Reset;
+
+VAR
+  d :Deck;
+  n, m, i, j :CARDINAL;
+
+BEGIN
+
+  WriteString( 'what size list ? ' ); ReadCard( n );
+  WriteString( 'how many runs  ? ' ); ReadCard( m );
+
+  (* set some maximums *)
+  IF n > 30 THEN
+    n := 30;
+    WriteString( 'list size truncated to ' ); WriteCard( n, 0 ); WriteLn;
+  END;
+  IF m > 20 THEN
+    m := 20;
+    WriteString( 'number of runs truncated to ' ); WriteCard( m, 0 ); WriteLn;
+  END;
+
+  Create( d, 1, n );
+
+  FOR i := 1 TO m DO
+     Reset( d );
+
+     FOR j := 1 TO n DO
+        WriteCard( Next( d ), 0 ); WriteString( ' ' );
+     END;
+     WriteLn;
+
+  END;
+
+END TestShuffle.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/shuffle-2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/shuffle-2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/shuffle-2.mod
@@ -0,0 +1,55 @@
+MODULE TestShuffle;
+
+(* This program show test the module Shuffle *)
+(* John Andrea, Apr.2/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM InOut IMPORT WriteCard, WriteLn, WriteString;
+FROM Shuffle IMPORT Deck, Create, Next, Reset;
+
+CONST
+  size  = 100;
+  tries = 300;
+
+VAR
+  d      :Deck;
+  i, j   :CARDINAL;
+  test   :ARRAY [1..size] OF CARDINAL;
+  errors :CARDINAL;
+
+BEGIN
+
+  Create( d, 1, size );
+
+  errors := 0;
+
+  WriteString( 'size of deck = ' ); WriteCard( size, 0 );
+  WriteString( ' being tested ' ); WriteCard( tries, 0 );
+  WriteString( ' times' ); WriteLn;
+
+  FOR i := 1 TO tries DO
+     Reset( d );
+
+     FOR j := 1 TO size DO
+        test[j] := 0;
+     END;
+
+     FOR j := 1 TO size DO
+        INC( test[ Next( d ) ] );
+     END;
+
+     (* each number should be used once, and only once *)
+     FOR j := 1 TO size DO
+        IF test[j] # 1 THEN errors := errors + 1 END;
+     END;
+
+  END;
+
+  IF errors = 0 THEN
+    WriteString( 'no errors found' );
+  ELSE
+    WriteCard( errors, 0 ); WriteString( ' errors found' );
+  END;
+  WriteLn;
+
+END TestShuffle.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/shuffle-3.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/shuffle-3.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/shuffle-3.mod
@@ -0,0 +1,65 @@
+MODULE TestShuffle;
+
+(* This program show test the module Shuffle *)
+(* John Andrea, Apr.6/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM InOut IMPORT WriteCard, WriteLn, WriteString;
+FROM Shuffle IMPORT Deck, Create, Next, Reset;
+
+CONST
+  min = 102;
+  max = 151;
+  try =  50;
+
+VAR
+  d       :Deck;
+  i, j, k :CARDINAL;
+  test    :ARRAY [min..max] OF CARDINAL;
+  errors  :CARDINAL;
+
+BEGIN
+
+  Create( d, min, max );
+
+  errors := 0;
+
+  WriteString( 'size of deck = ' ); WriteCard( max - min + 1, 0 );
+  WriteString( ' being tested ' ); WriteCard( try, 0 );
+  WriteString( ' times' ); WriteLn;
+
+  FOR i := 1 TO try DO
+     Reset( d );
+
+     FOR j := min TO max DO
+        test[j] := 0;
+     END;
+
+     FOR j := min TO max DO
+        k := Next( d );
+        IF k < min THEN
+          errors := errors + 1;
+        ELSE
+          IF k > max THEN
+            errors := errors + 1;
+          ELSE
+            INC( test[k] );
+          END;
+        END;
+     END;
+
+     (* each number should be used once, and only once *)
+     FOR j := min TO max DO
+        IF test[j] # 1 THEN errors := errors + 1 END;
+     END;
+
+  END;
+
+  IF errors = 0 THEN
+    WriteString( 'no errors found' );
+  ELSE
+    WriteCard( errors, 0 ); WriteString( ' errors found' );
+  END;
+  WriteLn;
+
+END TestShuffle.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/shuffle-cards.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/shuffle-cards.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/shuffle-cards.mod
@@ -0,0 +1,110 @@
+MODULE ShuffleCards;
+
+(* This program shows how to use the module Shuffle, as it might be used
+   in a card game program *)
+
+(* J. Andrea, Jun.22/93 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM InOut IMPORT WriteString, WriteCard, WriteLn;
+FROM Shuffle IMPORT Deck, Create, Next;
+FROM StringOperations IMPORT Assign, Append;
+FROM Break IMPORT EnableBreak;
+
+CONST
+   n_suits  = 4;
+   per_suit = 13;
+   
+   n_cards  = n_suits * per_suit;
+   
+   n_hands  = 4;
+   per_hand = 4;
+   
+TYPE
+  CardName = ARRAY [1..18] OF CHAR;
+  
+VAR
+  card :ARRAY [1..n_cards] OF CardName;
+  deck :Deck;
+  i, j :CARDINAL;
+  
+  (* ------------------------------------------------ *)
+  PROCEDURE MakeCards;
+  (* Give names to the cards *)
+
+  TYPE
+    SuitNames = ARRAY [1..8] OF CHAR;
+  VAR
+    n    :CARDINAL;
+    suit :ARRAY [1..n_suits] OF SuitNames;
+    
+    (* ------------------------------------ *)
+    PROCEDURE MakeSuit( name :ARRAY OF CHAR );
+    BEGIN
+      n := n + 1;
+      Assign( name, suit[n] );
+    END MakeSuit;
+    
+    (* ------------------------------------ *)
+    PROCEDURE MakeCard( name :ARRAY OF CHAR );
+    VAR
+      i, m :CARDINAL;
+    BEGIN
+      n := n + 1;
+      FOR i := 1 TO n_suits DO
+        m := n + ( i - 1 ) * per_suit;
+        Assign( name,    card[m] );
+        Append( ' of ',  card[m] );
+        Append( suit[i], card[m] );
+      END;
+    END MakeCard;
+    
+  BEGIN
+
+    n := 0;  
+    MakeSuit( 'Diamonds' );  MakeSuit( 'Hearts' );
+    MakeSuit( 'Spades' );    MakeSuit( 'Clubs' );
+
+    IF n # n_suits THEN
+      WriteString( '!WARNING! programmer error' );
+      WriteLn;
+      WriteString( 'The number of suits defined doesnt equal the expected number' );
+      WriteLn;
+      WriteString( 'The results might not be what you expect' );
+      WriteLn;
+    END;
+    
+    n := 0;
+    MakeCard( 'Ace' );   MakeCard( 'Two' );   MakeCard( 'Three' );
+    MakeCard( 'Four' );  MakeCard( 'Five' );  MakeCard( 'Six' );
+    MakeCard( 'Seven' ); MakeCard( 'Eight' ); MakeCard( 'Nine' );
+    MakeCard( 'Ten' );   MakeCard( 'Jack' );  MakeCard( 'Queen' );
+    MakeCard( 'King' );
+
+    IF n # per_suit THEN
+      WriteString( '!WARNING! programmer error' );
+      WriteLn;
+      WriteString( 'The number of cards defined doesnt equal the expected number' );
+      WriteLn;
+      WriteString( 'The results might not be what you expect' );
+      WriteLn;
+    END;
+
+  END MakeCards;
+  
+BEGIN EnableBreak;
+
+  MakeCards;
+
+  Create( deck, 1, n_cards );
+    
+  FOR i := 1 TO n_hands DO
+    WriteLn;
+    WriteString( 'Hand ' ); WriteCard( i, 0 ); WriteLn;
+    
+    FOR j := 1 TO per_hand DO
+       WriteString( card[ Next( deck ) ] ); WriteLn;
+    END;
+  END;
+  
+END ShuffleCards.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/shufflefast.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/shufflefast.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/shufflefast.mod
@@ -0,0 +1,55 @@
+MODULE TestShuffleFast;
+
+(* This program show test the module Shuffle *)
+(* John Andrea, Apr.2/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM InOut IMPORT WriteCard, WriteLn, WriteString;
+FROM ShuffleFast IMPORT Deck, Create, Next, Reset;
+
+CONST
+  size  = 100;
+  tries = 300;
+
+VAR
+  d      :Deck;
+  i, j   :CARDINAL;
+  test   :ARRAY [1..size] OF CARDINAL;
+  errors :CARDINAL;
+
+BEGIN
+
+  Create( d, size );
+
+  errors := 0;
+
+  WriteString( 'size of deck = ' ); WriteCard( size, 0 );
+  WriteString( ' being tested ' ); WriteCard( tries, 0 );
+  WriteString( ' times' ); WriteLn;
+
+  FOR i := 1 TO tries DO
+     Reset( d );
+
+     FOR j := 1 TO size DO
+        test[j] := 0;
+     END;
+
+     FOR j := 1 TO size DO
+        INC( test[ Next( d ) ] );
+     END;
+
+     (* each number should be used once, and only once *)
+     FOR j := 1 TO size DO
+        IF test[j] # 1 THEN errors := errors + 1 END;
+     END;
+
+  END;
+
+  IF errors = 0 THEN
+    WriteString( 'no errors found' );
+  ELSE
+    WriteCard( errors, 0 ); WriteString( ' errors found' );
+  END;
+  WriteLn;
+
+END TestShuffleFast.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/solve_word_puzzle.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/solve_word_puzzle.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/solve_word_puzzle.mod
@@ -0,0 +1,374 @@
+MODULE SolveWordPuzzle;
+
+(*
+  Solve word puzzles by brute force as an example of backtracking.
+  The puzzles are of the form of sums of words, where each letter
+  represents a different character, and the words sum to form the total
+  which is the last word. Some examples:
+
+  ONLY   2306       A   1       A    2
+  LION   0823     + B   2    +  B    9
+  LOIN   0283     ---  --    ----  ---
++ UPON   5723     = C   3    =  CC  11
+------  -----
+= MENU   9135
+
+  If some smarts were added to this program to try to decide before hand
+  some invalid choices ( like humans do ) then it would complete much sooner.
+*)
+(* J. Andrea, Feb.19/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut    IMPORT WriteString, WriteCard, WriteLn, Read, ReadLn, EOL, Done;
+
+CONST
+  max_lines    = 10;
+  max_per_line = 10;
+
+TYPE
+  String = ARRAY [0..max_per_line] OF CHAR;
+
+VAR
+  char_used   :ARRAY ["A".."Z"] OF BOOLEAN;
+  char_value  :ARRAY ["A".."Z"] OF CARDINAL;
+  digit_taken :ARRAY [0..9] OF BOOLEAN;
+
+  char_list   :ARRAY [1..26] OF CHAR;
+  n_char_used :CARDINAL;
+
+  puzzle_line :ARRAY [1..max_lines] OF String;
+  line_len    :ARRAY [1..max_lines] OF CARDINAL;
+  n_lines     :CARDINAL;
+
+  continue    :BOOLEAN;
+  solved      :BOOLEAN;
+
+  attempts    :CARDINAL;
+
+  (* -------------------------------------------------- *)
+  PROCEDURE ReadPuzzle;
+
+  VAR
+    c :CHAR;
+    i :CARDINAL;
+
+  BEGIN (* ReadPuzzle *)
+
+    continue := TRUE;
+
+    WriteString( 'Enter the puzzle, line by line' ); WriteLn;
+    WriteString( 'Enter control-Z at end of input' ); WriteLn;
+    WriteLn;
+
+    n_lines := 0;
+
+    Read( c );
+    WHILE Done AND continue DO
+
+      n_lines := n_lines + 1;
+
+      IF n_lines > max_lines THEN
+        WriteLn;
+        WriteString('Attempt to add more lines than the program can handle');
+        WriteLn;
+        WriteString( 'The program will not continue' );
+        WriteLn;
+        continue := FALSE;
+      ELSE
+
+        i := 0;
+        WHILE ( c # EOL ) AND continue DO
+
+          IF i > max_per_line THEN
+            WriteLn;
+            WriteString('Attempt to add a line longer than the ');
+            WriteString('program can handle');
+            WriteLn;
+            WriteString( 'The program will not continue' );
+            WriteLn;
+            continue := FALSE;
+          ELSE
+
+            c := CAP( c );
+            IF ( c < 'A' ) OR ( c > 'Z' ) THEN
+              WriteLn;
+              WriteString('Input characters limited to a-Z' );
+              WriteLn;
+              WriteString( 'The program will not continue' );
+              WriteLn;
+              continue := FALSE;
+            ELSE
+
+              puzzle_line[n_lines][i] := c;
+              Read( c );   i := i + 1;
+
+            END;
+
+          END;
+
+        END;
+
+        Read( c );
+
+      END;
+
+    END;
+
+    IF continue THEN
+      IF n_lines < 3 THEN
+        WriteLn;
+        WriteString( 'Must have 3 lines or more' );
+        WriteLn;
+        WriteString( 'The program will not continue' );
+        WriteLn;
+        continue := FALSE;
+      END;
+    END;
+
+  END ReadPuzzle;
+
+  (* -------------------------------------------------- *)
+  PROCEDURE SetupPuzzle;
+
+  VAR
+    c       :CHAR;
+    i, j, l :CARDINAL;
+
+  BEGIN (* SetupPuzzle *)
+
+     FOR i := 0 TO 9 DO
+        digit_taken[i] := FALSE;
+     END;
+
+     FOR c := 'A' TO 'Z' DO
+        char_used[c]  := FALSE;
+        char_value[c] := 0;
+     END;
+
+     FOR i := 1 TO n_lines DO
+
+        l := LEN( puzzle_line[i] );
+        line_len[i] := l;
+
+        FOR j := 0 TO l-1 DO
+           c := puzzle_line[i][j];
+           char_used[c] := TRUE;
+        END;
+     END;
+
+     n_char_used := 0;
+     FOR c := 'A' TO 'Z' DO
+        IF char_used[c] THEN
+          n_char_used            := n_char_used + 1;
+          char_list[n_char_used] := c;
+        END;
+     END;
+
+     IF n_char_used > 10 THEN
+       WriteString( 'There cant be more than 10 different characters' );
+       WriteLn;
+       continue := FALSE;
+     END;
+
+  END SetupPuzzle;
+
+
+  (* -------------------------------------------------- *)
+  PROCEDURE PrintAttempts;
+  BEGIN (* PrintAttempts *)
+
+    WriteLn;
+    WriteString( 'After ' ); WriteCard( attempts, 0 );
+    WriteString( ' attempts' );
+    WriteLn;
+
+  END PrintAttempts;
+
+
+  (* -------------------------------------------------- *)
+  PROCEDURE TestSolution;
+  (* convert each of the lines into a number, add them together *)
+  (* and see if they add up to the last line *)
+
+  VAR
+     x, sum, total :CARDINAL;
+     i             :CARDINAL;
+     lines         :ARRAY [1..max_lines] OF CARDINAL;
+     c             :CHAR; (* debug *)
+
+    (* -------------------------------------------------- *)
+    PROCEDURE LineToValue( string :String; len :CARDINAL ) :CARDINAL;
+
+    (* convert the given line into a value using the current *)
+    (* choices of digits for letters *)
+
+    VAR
+      i, j, sum :CARDINAL;
+      c         :CHAR;
+
+    BEGIN (* LineToValue *)
+
+      sum := 0;
+      FOR i := 0 TO len DO
+         c   := string[i];
+         sum := 10 * sum + char_value[ c ];
+      END;
+
+      RETURN sum;
+
+    END LineToValue;
+
+    (* -------------------------------------------------- *)
+    PROCEDURE PrintSolution;
+
+    CONST
+
+      space_between = 2;
+
+    VAR
+      i, j, line :CARDINAL;
+      size       :CARDINAL;
+
+    BEGIN (* PrintSolution *)
+
+      size := 0;
+      FOR i := 1 TO n_lines DO
+        IF line_len[i] > size THEN size := line_len[i]; END;
+      END;
+      size := size + 2;
+
+      WriteLn;
+      FOR i := 1 TO n_lines DO
+
+        IF i = n_lines THEN     (* before last line output a total bar *)
+          FOR j := 1 TO size DO
+             WriteString( '-' );
+          END;
+          FOR j := 1 TO space_between DO
+             WriteString( ' ' );
+          END;
+          FOR j := 1 TO size DO
+             WriteString( '-' );
+          END;
+          WriteLn;
+        END;
+
+        (* output enough spaces first to line up this line *)
+        FOR j := line_len[i] TO size - 1 DO
+           WriteString( ' ' );
+        END;
+
+        (* output the original puzzle line *)
+
+        WriteString( puzzle_line[i] );
+
+        FOR j := 1 TO space_between DO
+           WriteString( ' ' );
+        END;
+
+        (* output enough spaces first to line up this line *)
+        FOR j := line_len[i] TO size - 1 DO
+           WriteString( ' ' );
+        END;
+
+        (* output the result characters for this line *)
+
+        FOR j := 0 TO line_len[i]-1 DO
+          WriteCard( char_value[puzzle_line[i][j]], 1 );
+        END;
+
+        WriteLn;
+      END;
+
+    END PrintSolution;
+
+  BEGIN (* TestSolution *)
+
+     attempts := attempts + 1;
+
+     sum := 0;
+     FOR i := 1 TO n_lines -1 DO
+        sum := sum + LineToValue( puzzle_line[i], line_len[i]-1 );
+     END;
+    
+     total := LineToValue( puzzle_line[n_lines], line_len[n_lines]-1 );
+
+     IF sum = total THEN
+       solved := TRUE;
+       PrintSolution;
+     END;
+
+  END TestSolution;
+
+
+  (* -------------------------------------------------- *)
+  PROCEDURE SolvePuzzle( next_char :CARDINAL );
+
+  VAR
+     d  :CARDINAL;
+     c  :CHAR;
+
+  BEGIN (* SolvePuzzle *)
+
+    IF next_char > n_char_used THEN
+
+      TestSolution; (* attempt to solve the puzzle *)
+
+    ELSE
+
+      (* get the next available character *)
+
+      c := char_list[ next_char ];
+
+      (* now try all the available digits for this character *)
+
+      d := 0;
+      WHILE ( d < 10 ) & ( NOT solved ) DO 
+
+        IF NOT digit_taken[d] THEN
+
+          digit_taken[d] := TRUE;
+          char_value[c]  := d;
+
+          SolvePuzzle( next_char + 1 );
+
+          digit_taken[d] := FALSE;
+
+        END;
+
+        d := d + 1;   (* choose the next digit for this character *)
+      END;
+
+    END;
+
+  END SolvePuzzle;
+
+
+BEGIN (* SolveWordPuzzle *)
+
+  ReadPuzzle;
+
+  IF continue THEN
+
+    SetupPuzzle;
+
+    IF continue THEN
+
+      solved := FALSE;    attempts := 0;
+
+      WriteString( 'Starting to solve the puzzle, this may take some time...' );
+      WriteLn;
+
+      SolvePuzzle( 1 );
+
+      IF NOT solved THEN
+        WriteString( 'impossible' );  WriteLn;
+      END;
+   
+    END;
+
+    PrintAttempts;
+
+  END;
+
+END SolveWordPuzzle.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/somebits.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/somebits.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/somebits.mod
@@ -0,0 +1,40 @@
+MODULE SomeBits;
+
+(* test out some bitset operations *)
+(* J. Andrea, 1984 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteCard, WriteString, WriteLn;
+
+VAR
+  a_card, i  :CARDINAL;
+  some_bits  :BITSET;
+
+BEGIN
+
+WriteLn; WriteString('Show off some BITSET properties '); WriteLn; WriteLn;
+
+(* subtract 8 the long way *)
+
+a_card := 25;
+some_bits := BITSET(a_card);       (* get the bit representation of 25 *)
+EXCL(some_bits,3);                 (* remove 2^3 from the bits         *)
+a_card := CARDINAL(some_bits);     (* make it a number again           *)
+WriteString('25-8='); WriteCard(a_card,5); WriteLn;
+
+
+WriteLn;
+
+(* now show the largest integer *)
+
+some_bits := {};
+
+(* set all the bits to ON *)
+FOR i := 0 TO 31 DO
+   INCL(some_bits,i);
+END; (* for *)
+
+a_card := CARDINAL(some_bits);
+WriteString('MaxCard='); WriteCard(a_card,20); WriteLn;
+
+END SomeBits.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/sort-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/sort-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/sort-1.mod
@@ -0,0 +1,219 @@
+MODULE TestSort;
+
+(* Test the sorting module *)
+(* J. Andrea, 1992 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut    IMPORT WriteReal, WriteCard, WriteString, WriteLn;
+FROM Sorting  IMPORT CardBSort, RealBSort, 
+                     CardQSort, CardQSortIndex, RealQSortIndex;
+
+CONST
+  n = 20;
+
+VAR
+  a     :ARRAY [1..n] OF CARDINAL;
+  x     :ARRAY [1..n] OF REAL;
+  index :ARRAY [1..n] OF CARDINAL;
+  i     :CARDINAL;
+  ok    :BOOLEAN;
+
+     (* ------------------------------------------- *)
+     PROCEDURE Forward;
+     BEGIN
+        FOR i := 1 TO n DO
+           a[i] := i;
+        END;
+     END Forward;
+
+     (* ------------------------------------------- *)
+     PROCEDURE Reverse;
+     BEGIN
+        FOR i := 1 TO n DO
+           a[i] := n + 1 - i;
+        END;
+     END Reverse;
+
+     (* ------------------------------------------- *)
+     PROCEDURE ReverseReal;
+     BEGIN
+        FOR i := 1 TO n DO
+           x[i] := FLOAT( n - i ) + 1.0;;
+        END;
+     END ReverseReal;
+
+     (* ------------------------------------------- *)
+     PROCEDURE ShowCardArray;
+     BEGIN
+        FOR i := 1 TO n DO
+          WriteCard( a[i], 3 );
+        END;
+        WriteLn;
+     END ShowCardArray;
+
+     (* ------------------------------------------- *)
+     PROCEDURE ShowCardIndex;
+     BEGIN
+        FOR i := 1 TO n DO
+          WriteCard( a[index[i]+1], 3 );
+        END;
+        WriteLn;
+     END ShowCardIndex;
+
+     (* ------------------------------------------- *)
+     PROCEDURE CheckCardArray;
+     BEGIN
+        ok := TRUE;
+        FOR i := 2 TO n DO
+          IF a[i] < a[i-1] THEN
+            ok := FALSE;
+            WriteString( 'bad pair '); WriteCard( a[i-1], 2 );
+            WriteString( ' ' );        WriteCard( a[i], 2 ); WriteLn;
+          END;
+        END;
+
+        IF ok THEN
+          WriteString( 'all ok' ); WriteLn;
+        END;
+
+     END CheckCardArray;
+
+     (* ------------------------------------------- *)
+     PROCEDURE CheckCardIndex;
+     BEGIN
+        ok := TRUE;
+        FOR i := 2 TO n DO
+          IF a[index[i]+1] < a[index[i-1]+1] THEN
+            ok := FALSE;
+            WriteString( 'bad pair '); WriteCard( a[index[i-1]+1], 2 );
+            WriteString( ' ' );        WriteCard( a[index[i]+1], 2 ); WriteLn;
+          END;
+        END;
+
+        IF ok THEN
+          WriteString( 'all ok' ); WriteLn;
+        END;
+
+     END CheckCardIndex;
+
+     (* ------------------------------------------- *)
+     PROCEDURE CheckSameArray;
+     BEGIN
+        ok := TRUE;
+        FOR i := 1 TO n DO
+          IF a[i] # i THEN
+            ok := FALSE;
+            WriteString( 'bad match '); WriteCard( a[i], 2 ); WriteLn;
+          END;
+        END;
+
+        IF ok THEN
+          WriteString( 'all ok' ); WriteLn;
+        END;
+
+     END CheckSameArray;
+
+     (* ------------------------------------------- *)
+     PROCEDURE CheckSameIndex;
+     BEGIN
+        ok := TRUE;
+        FOR i := 1 TO n DO
+          IF a[index[i]+1] # i THEN
+            ok := FALSE;
+            WriteString( 'bad match ' ); WriteCard( a[index[i]+1], 2 ); WriteLn;
+          END;
+        END;
+
+        IF ok THEN
+          WriteString( 'all ok' ); WriteLn;
+        END;
+
+     END CheckSameIndex;
+
+     (* ------------------------------------------- *)
+     PROCEDURE CheckSameRealArray;
+     BEGIN
+        ok := TRUE;
+        FOR i := 1 TO n DO
+          IF x[i] # FLOAT(i) THEN
+            ok := FALSE;
+            WriteString( 'bad match '); WriteReal( x[i], 7 ); WriteLn;
+          END;
+        END;
+
+        IF ok THEN
+          WriteString( 'all ok' ); WriteLn;
+        END;
+
+     END CheckSameRealArray;
+
+     (* ------------------------------------------- *)
+     PROCEDURE CheckSameRealIndex;
+     BEGIN
+        ok := TRUE;
+        FOR i := 1 TO n DO
+          IF x[index[i]+1] # FLOAT(i) THEN
+            ok := FALSE;
+            WriteString( 'bad match ' ); WriteReal( x[index[i]+1], 7 ); WriteLn;
+          END;
+        END;
+
+        IF ok THEN
+          WriteString( 'all ok' ); WriteLn;
+        END;
+
+     END CheckSameRealIndex;
+
+BEGIN
+
+  WriteLn; WriteString( 'bubblesort forward cardinal test' ); WriteLn;
+  Forward;
+  WriteString('before'); ShowCardArray;
+  CardBSort( a, n );
+  WriteString('after '); ShowCardArray; CheckSameArray;
+
+  WriteLn; WriteString( 'bubble reverse cardinals test' ); WriteLn;
+  Reverse;
+  WriteString('before'); ShowCardArray;
+  CardBSort( a, n );
+  WriteString('after '); ShowCardArray; CheckSameArray;
+
+  WriteLn; WriteString( 'bubble reverse reals test' ); WriteLn;
+  ReverseReal;
+  RealBSort( x, n );
+  CheckSameRealArray;
+
+
+
+
+  WriteLn; WriteString( 'quicksort forward cardinal test' ); WriteLn;
+  Forward;
+  WriteString('before'); ShowCardArray;
+  CardQSort( a, n );
+  WriteString('after '); ShowCardArray; CheckSameArray;
+
+  WriteLn; WriteString( 'quicksort reverse cardinals test' ); WriteLn;
+  Reverse;
+  WriteString('before'); ShowCardArray;
+  CardQSort( a, n );
+  WriteString('after '); ShowCardArray; CheckSameArray;
+
+
+  WriteLn; WriteString( 'quicksort forward cardinal index test' ); WriteLn;
+  Forward;
+  WriteString('before'); ShowCardArray;
+  CardQSortIndex( a, n, index );
+  WriteString('after '); ShowCardIndex; CheckSameIndex;
+
+  WriteLn; WriteString( 'quicksort reverse cardinals index test' ); WriteLn;
+  Reverse;
+  WriteString('before'); ShowCardArray;
+  CardQSortIndex( a, n, index );
+  WriteString('after '); ShowCardIndex; CheckSameIndex;
+
+  WriteLn; WriteString( 'quicksort reverse reals index test' ); WriteLn;
+  ReverseReal;
+  RealQSortIndex( x, n, index );
+  CheckSameRealIndex;
+
+END TestSort.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/sort-2.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/sort-2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/sort-2.mod
@@ -0,0 +1,169 @@
+MODULE TestSort;
+
+(* Test the sorting module *)
+(* J. Andrea, 1992 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut    IMPORT WriteReal, WriteCard, WriteString, WriteLn;
+FROM Sorting  IMPORT CardBSort, RealBSort,
+                     CardQSort, CardQSortIndex, RealQSortIndex;
+FROM Randomly IMPORT RandomReal, Choose_0_To_N, Choose_1_To_N_Minus_1;
+
+CONST
+  max_n = 20;
+
+VAR
+  n     :CARDINAL;
+  a     :ARRAY [1..max_n] OF CARDINAL;
+  x     :ARRAY [1..max_n] OF REAL;
+  index :ARRAY [1..max_n] OF CARDINAL;
+  i     :CARDINAL;
+  ok    :BOOLEAN;
+
+     (* ------------------------------------------- *)
+     PROCEDURE RandomCard( VAR n :CARDINAL );
+     BEGIN
+        n := Choose_1_To_N_Minus_1( max_n ) + 1; (* minimum of 2 *)
+        FOR i := 1 TO n DO
+           a[i] := Choose_0_To_N( 99 );
+        END;
+     END RandomCard;
+
+     (* ------------------------------------------- *)
+     PROCEDURE RandomR( VAR n :CARDINAL );
+     BEGIN
+        n := Choose_1_To_N_Minus_1( max_n ) + 1; (* minimum of 2 *)
+        FOR i := 1 TO n DO
+           x[i] := RandomReal( 1., 100. );
+        END;
+     END RandomR;
+
+     (* ------------------------------------------- *)
+     PROCEDURE ShowCardArray;
+     BEGIN
+        FOR i := 1 TO n DO
+          WriteCard( a[i], 3 );
+        END;
+        WriteLn;
+     END ShowCardArray;
+
+     (* ------------------------------------------- *)
+     PROCEDURE ShowCardIndex;
+     BEGIN
+        FOR i := 1 TO n DO
+          WriteCard( a[index[i]+1], 3 );
+        END;
+        WriteLn;
+     END ShowCardIndex;
+
+     (* ------------------------------------------- *)
+     PROCEDURE CheckCardArray;
+     BEGIN
+        ok := TRUE;
+        FOR i := 2 TO n DO
+          IF a[i] < a[i-1] THEN
+            ok := FALSE;
+            WriteString( 'bad pair '); WriteCard( a[i-1], 2 );
+            WriteString( ' ' );        WriteCard( a[i], 2 ); WriteLn;
+          END;
+        END;
+
+        IF ok THEN
+          WriteString( 'all ok' ); WriteLn;
+        END;
+
+     END CheckCardArray;
+
+     (* ------------------------------------------- *)
+     PROCEDURE CheckCardIndex;
+     BEGIN
+        ok := TRUE;
+        FOR i := 2 TO n DO
+          IF a[index[i]+1] < a[index[i-1]+1] THEN
+            ok := FALSE;
+            WriteString( 'bad pair '); WriteCard( a[index[i-1]+1], 2 );
+            WriteString( ' ' );        WriteCard( a[index[i]+1], 2 ); WriteLn;
+          END;
+        END;
+
+        IF ok THEN
+          WriteString( 'all ok' ); WriteLn;
+        END;
+
+     END CheckCardIndex;
+
+     (* ------------------------------------------- *)
+     PROCEDURE CheckRealArray;
+     BEGIN
+        ok := TRUE;
+        FOR i := 2 TO n DO
+          IF x[i] < x[i-1] THEN
+            ok := FALSE;
+            WriteString( 'bad pair '); WriteReal( x[i-1], 7 );
+            WriteString( ' ' );        WriteReal( x[i], 7 ); WriteLn;
+          END;
+        END;
+
+        IF ok THEN
+          WriteString( 'all ok' ); WriteLn;
+        END;
+
+     END CheckRealArray;
+
+     (* ------------------------------------------- *)
+     PROCEDURE CheckRealIndex;
+     BEGIN
+        ok := TRUE;
+        FOR i := 2 TO n DO
+          IF x[index[i]+1] < x[index[i-1]+1] THEN
+            ok := FALSE;
+            WriteString( 'bad pair '); WriteReal( x[index[i-1]+1], 7 );
+            WriteString( ' ' );        WriteReal( x[index[i]+1], 7 ); WriteLn;
+          END;
+        END;
+
+        IF ok THEN
+          WriteString( 'all ok' ); WriteLn;
+        END;
+
+     END CheckRealIndex;
+
+BEGIN
+
+  WriteLn; WriteString( 'bubblesort random cardinal test ' );
+  RandomCard( n );
+  WriteCard( n, 0 ); WriteString( ' elements' ); WriteLn;
+  WriteString('before'); ShowCardArray;
+  CardBSort( a, n );
+  WriteString('after '); ShowCardArray; CheckCardArray;
+
+  WriteLn; WriteString( 'bubble random reals test ' );
+  RandomR( n );
+  WriteCard( n, 0 ); WriteString( ' elements' ); WriteLn;
+  RealBSort( x, n );
+  CheckRealArray;
+
+
+
+  WriteLn; WriteString( 'quicksort random cardinal test ' );
+  RandomCard( n );
+  WriteCard( n, 0 ); WriteString( ' elements' ); WriteLn;
+  WriteString('before'); ShowCardArray;
+  CardQSort( a, n );
+  WriteString('after '); ShowCardArray; CheckCardArray;
+
+
+  WriteLn; WriteString( 'quicksort random cardinal index test ' );
+  RandomCard( n );
+  WriteCard( n, 0 ); WriteString( ' elements' ); WriteLn;
+  WriteString('before'); ShowCardArray;
+  CardQSortIndex( a, n, index );
+  WriteString('after '); ShowCardIndex; CheckCardIndex;
+
+  WriteLn; WriteString( 'quicksort random reals index test ' );
+  RandomR( n );
+  WriteCard( n, 0 ); WriteString( ' elements' ); WriteLn;
+  RealQSortIndex( x, n, index );
+  CheckRealIndex;
+
+END TestSort.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/stacks-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/stacks-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/stacks-1.mod
@@ -0,0 +1,71 @@
+MODULE TestStacks;
+
+(* Test the procedures in the module Stacks, and show how they work. *)
+(* J. Andrea, Oct.3/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut  IMPORT WriteString, WriteLn;
+FROM Stacks IMPORT InitStack, DelStack, Pop, Push, Stack;
+
+VAR
+   a, b  :ARRAY [0..9] OF CHAR;
+   stack :Stack;
+   error :BOOLEAN;
+   i     :CARDINAL;
+
+   (* -------------------------------------------------- *)
+   PROCEDURE Show( string :ARRAY OF CHAR );
+   BEGIN
+      WriteString( 'string is >' ); WriteString( string ); WriteString( '<' );
+      WriteLn;
+   END Show;
+
+BEGIN
+
+       (*0123456789*)
+   a := 'abcdefghji';
+   b := '          ';
+
+   InitStack( stack );
+
+   Show( a );
+
+   WriteString( 'push ' ); WriteLn;
+   Push( stack, a );
+
+   WriteString( 'pop ' ); WriteLn;
+   Pop( stack, b, error );
+
+   IF error THEN
+     WriteString( 'somethings wrong, shouldnt be empty' ); WriteLn;
+   ELSE
+
+     Show( b );
+
+     error := FALSE;
+     FOR i := 0 TO 9 DO
+        IF a[i] # b[i] THEN
+          error := TRUE;
+        END;
+     END;
+     IF error THEN
+       WriteString( 'compared strings are different !' );
+     ELSE
+       WriteString( 'strings ok' );
+     END;
+     WriteLn;
+
+     WriteLn;
+     Pop( stack, b, error );
+     IF error THEN
+       WriteString( 'ok, empty as expected' );
+     ELSE
+       WriteString( 'the stack should be empty but isnt' );
+     END;
+     WriteLn;
+
+     DelStack( stack );
+
+  END;
+
+END TestStacks.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/strings.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/strings.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/strings.mod
@@ -0,0 +1,287 @@
+MODULE TestStrings;
+
+(* test some of the extended string handling procedures, and show
+   how they are used *)
+(* J. Andrea, Aug.12/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteString, ReadCard, WriteCard, WriteLn, Read, ReadLn;
+FROM StringOperations IMPORT Equal, Compare, Index, Append, Concat, Trim,
+                             SubString, Upper, Lower, Insert, Delete, Replace;
+FROM MoreStrings IMPORT CaseCompare, WildcardMatch, ReadLine, Locate,
+                        EqualSubString, Contains;
+
+VAR
+   c                  :CHAR;
+   one, two, three    :ARRAY [0..11] OF CHAR;
+   result, start, len :CARDINAL;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE GetTest( VAR c :CHAR );
+   BEGIN
+
+      WriteString( 'a   Equal' ); WriteLn;
+      WriteString( 'b   Index' ); WriteLn;
+      WriteString( 'c   Concat' ); WriteLn;
+      WriteString( 'd   Compare' ); WriteLn;
+      WriteString( 'e   WildcardMatch' ); WriteLn;
+      WriteString( 'f   Trim' ); WriteLn;
+      WriteString( 'g   Append' ); WriteLn;
+      WriteString( 'h   Locate' ); WriteLn;
+      WriteString( 'i   SubString' ); WriteLn;
+      WriteString( 'j   Upper' ); WriteLn;
+      WriteString( 'k   Lower' ); WriteLn;
+      WriteString( 'l   Delete' ); WriteLn;
+      WriteString( 'm   Insert' ); WriteLn;
+      WriteString( 'n   EqualSubString' ); WriteLn;
+      WriteString( 'o   CaseCompare' ); WriteLn;
+      WriteString( 'p   Replace' ); WriteLn;
+      WriteString( 'q   Contains' ); WriteLn;
+      WriteString( 'X   exit' ); WriteLn;
+      WriteString( 'which procedure to test ? ' ); Read( c ); ReadLn;
+      WriteLn;
+
+      c := CAP( c );
+   END GetTest;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE GetString( prompt :ARRAY OF CHAR; VAR string :ARRAY OF CHAR );
+   BEGIN
+
+       WriteString( prompt );
+       ReadLine( string );
+
+       WriteString( '>' ); WriteString( string ); WriteString( '<' ); WriteLn;
+   END GetString;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE GetCard( prompt :ARRAY OF CHAR; VAR x :CARDINAL );
+   BEGIN
+
+       WriteString( prompt );
+       ReadCard( x ); ReadLn;
+
+       WriteCard( x, 0 ); WriteLn;
+   END GetCard;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE DoCompare( a, b, op :ARRAY OF CHAR );
+   BEGIN
+
+       IF Compare( a, op, b ) THEN
+         WriteString( 'TRUE with '); WriteString( op );
+       ELSE
+         WriteString( 'FALSE with '); WriteString( op );
+       END;
+       WriteLn;
+
+   END DoCompare;
+
+BEGIN (* TestMoreStrings *)
+
+WriteLn;
+WriteString( 'the strings used here are all of length ' );
+WriteCard( HIGH(one) + 1, 0 );
+WriteLn;
+
+GetTest( c );
+
+WHILE c # 'X' DO
+
+IF c = 'A' THEN  (* Equal *)
+
+  GetString( 'enter the first  string ? ', one );
+  GetString( 'enter the second string ? ', two );
+
+  IF Equal( one, two ) THEN
+    WriteString( 'equal' );
+  ELSE
+    WriteString( 'NOT equal' );
+  END;
+  WriteLn;
+
+ELSIF c = 'B' THEN (* Index *)
+
+  GetString( 'enter the long string ? ', one );
+  GetString( 'enter the  sub-string ? ', two );
+
+  result := Index( one, two );
+
+  IF result = 0 THEN
+    WriteString( 'not found' );
+  ELSE
+    WriteString( 'position ' ); WriteCard( result, 0 );
+  END;
+  WriteLn;
+
+ELSIF c = 'C' THEN  (* Concat *)
+
+  GetString( 'enter the first  string ? ', one );
+  GetString( 'enter the second string ? ', two );
+
+  Concat( one, two, three );
+
+  WriteString( '>' ); WriteString( three ); WriteString( '<' );
+  WriteLn;
+
+ELSIF c = 'D' THEN  (* Compare *)
+
+  GetString( 'enter the first  string ? ', one );
+  GetString( 'enter the second string ? ', two );
+
+  DoCompare( one, two, '=' );    DoCompare( one, two, '#' );
+  DoCompare( one, two, '>' );    DoCompare( one, two, '<' );
+  DoCompare( one, two, '>=' );   DoCompare( one, two, '<=' );
+
+ELSIF c = 'E' THEN  (* WildCardMatch *)
+
+  GetString( 'enter the  string ? ', one );
+  GetString( 'enter the pattern ? ', two );
+
+  IF WildcardMatch( one, two ) THEN
+    WriteString( 'equal' );
+  ELSE
+    WriteString( 'NOT equal' );
+  END;
+  WriteLn;
+
+ELSIF c = 'F' THEN (* Trim *)
+
+  GetString( 'enter the string ? ', one );
+
+  Trim( one );
+
+  WriteString( '>' ); WriteString( one ); WriteString( '<' );
+  WriteLn;
+
+ELSIF c = 'G' THEN  (* Append *)
+
+  GetString( 'enter the first  string ? ', one );
+  GetString( 'enter the second string ? ', two );
+
+  Append( one, two );
+
+  WriteString( '>' ); WriteString( two ); WriteString( '<' ); WriteLn;
+
+ELSIF c = 'H' THEN  (* Locate *)
+
+  GetString( 'enter the long string ? ', one );
+  GetString( 'enter the     pattern ? ', two );
+  GetCard( 'start location ? ', start );
+
+  result := Locate( one, two, start );
+
+  IF result = 0 THEN
+    WriteString( 'not found' );
+  ELSE
+    WriteString( 'position ' ); WriteCard( result, 0 );
+  END;
+  WriteLn;
+
+ELSIF c = 'I' THEN  (* SubString *)
+
+  GetString( 'enter the string ? ', one );
+  GetCard( 'start location ? ', start );
+  GetCard( 'how many characters ? ', len );
+
+  SubString( one, start, len, two );
+
+  WriteString( '>' ); WriteString( two ); WriteString( '<' ); WriteLn;
+
+ELSIF c = 'J' THEN  (* Upper *)
+
+  GetString( 'enter the string ? ', one );
+
+  Upper( one );
+
+  WriteString( '>' ); WriteString( one ); WriteString( '<' ); WriteLn;
+
+ELSIF c = 'K' THEN  (* Lower *)
+
+  GetString( 'enter the string ? ', one );
+
+  Lower( one );
+
+  WriteString( '>' ); WriteString( one ); WriteString( '<' ); WriteLn;
+
+ELSIF c = 'L' THEN  (* Delete *)
+
+  GetString( 'enter the string ? ', one );
+  GetCard( 'start location ? ', start );
+  GetCard( 'how many characters ? ', len );
+
+  Delete( one, start, len );
+
+  WriteString( '>' ); WriteString( one ); WriteString( '<' ); WriteLn;
+
+ELSIF c = 'M' THEN  (* Insert *)
+
+  GetString( 'enter the string to insert ? ', one );
+  GetString( 'enter the source ? ', two );
+  GetCard( 'start location ? ', start );
+
+  Insert( one, start, two );
+
+  WriteString( '>' ); WriteString( two ); WriteString( '<' ); WriteLn;
+
+ELSIF c = 'N' THEN  (* EqualSubString *)
+
+  GetString( 'enter the first  string ? ', one );
+  GetString( 'enter the second string ? ', two );
+  GetCard( 'start location ? ', start );
+  GetCard( 'how many characters ? ', len );
+
+  IF EqualSubString( one, two, start, len ) THEN
+    WriteString( 'equal' );
+  ELSE
+    WriteString( 'NOT equal' );
+  END;
+  WriteLn;
+
+ELSIF c = 'O' THEN  (* CaseCompare *)
+
+  GetString( 'enter the first  string ? ', one );
+  GetString( 'enter the second string ? ', two );
+
+  c := CaseCompare( one, two, TRUE );
+
+  WriteString( 'result with    case-sensitive: ' ); WriteString( c );
+  WriteLn;
+
+  c := CaseCompare( one, two, FALSE );
+
+  WriteString( 'result without case-sensitive: ' ); WriteString( c );
+  WriteLn;
+
+ELSIF c = 'P' THEN  (* Replace *)
+
+  GetString( 'enter the first       string ? ', one );
+  GetString( 'enter the replacement string ? ', two );
+  GetCard( 'start location ? ', start );
+
+  Replace( two, start, one );
+
+  WriteString( '>' ); WriteString( one ); WriteString( '<' ); WriteLn;
+
+ELSIF c = 'Q' THEN  (* Contains *)
+
+  GetString( 'enter the  string ? ', one );
+  GetString( 'enter the pattern ? ', two );
+
+  IF Contains( one, two ) THEN
+    WriteString( 'is contained' );
+  ELSE
+    WriteString( 'NOT contained' );
+  END;
+  WriteLn;
+
+END;
+
+WriteLn;
+WriteString( 'hit RETURN' ); ReadLn;
+WriteLn; WriteLn; WriteLn;
+
+GetTest( c );
+END; (* while *)
+
+END TestStrings.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/tablehand.def b/examples/Modula-2_Libraries/andrea-m2/examples/generic/tablehand.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/tablehand.def
@@ -0,0 +1,14 @@
+DEFINITION MODULE TableHandler;
+ EXPORT QUALIFIED
+  LineWidth,WordLength,Table,overflow,
+  InitTable,Record,Tabulate;
+
+ CONST LineWidth = 80; WordLength = 24;
+ TYPE Table;
+ VAR overflow: CARDINAL; (* >0 means table full *)
+
+ PROCEDURE InitTable(VAR t:Table);
+ PROCEDURE Record(t: Table; VAR x: ARRAY OF CHAR; n: INTEGER);
+  (*enter x,n in table t; string must end with a blank*)
+ PROCEDURE Tabulate(t: Table);
+END TableHandler.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/tablehand.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/tablehand.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/tablehand.mod
@@ -0,0 +1,148 @@
+IMPLEMENTATION MODULE TableHandler;
+ FROM InOut IMPORT Write,WriteLn,WriteInt;
+ FROM Storage IMPORT ALLOCATE;
+
+ CONST TableLength = 3000;
+
+ TYPE
+  TreePtr = POINTER TO Word;
+  ListPtr = POINTER TO Item;
+  Item = RECORD
+          num: INTEGER;
+          next: ListPtr
+         END;
+  Word = RECORD
+          key: CARDINAL; (*table index*)
+          first: ListPtr; (*list head*)
+          left,right: TreePtr
+         END;
+  Table = TreePtr;
+
+ VAR
+  id: ARRAY [0..WordLength] OF CHAR;
+  ascinx: CARDINAL;
+  asc: ARRAY [0..TableLength-1] OF CHAR;
+
+ PROCEDURE InitTable(VAR t: Table);
+ BEGIN
+  NEW(t); t^.right := NIL
+ END InitTable;
+
+ PROCEDURE Search(p: TreePtr): TreePtr;
+  (*search node with name equal to id*)
+  TYPE Relation = (less,equal,greater);
+  VAR q: TreePtr;
+   r: Relation; i: CARDINAL;
+
+  PROCEDURE rel(k: CARDINAL): Relation;
+  (*compare id with asc[k]*)
+   VAR i: CARDINAL;
+    R: Relation; x,y: CHAR;
+   BEGIN
+    i := 0; R := equal;
+    LOOP
+     x := id[i]; y := asc[k];
+     IF CAP(x) # CAP(y) THEN EXIT END;
+     IF x <= " " THEN RETURN R END;
+     IF x < y THEN R := less ELSIF x > y THEN R := greater
+     END;
+     i := i+1; k := k+1;
+    END;
+    IF CAP(x) > CAP(y) THEN RETURN greater ELSE RETURN less
+    END
+   END rel;
+
+  BEGIN
+   q := p^.right; r := greater;
+   WHILE q # NIL DO
+    p := q; r := rel(p^.key);
+    IF r=equal THEN RETURN p
+    ELSIF r=less THEN q := p^.left
+    ELSE q := p^.right
+    END
+   END;
+   NEW(q); (*not found, hence insert*)
+   IF q # NIL THEN
+    WITH q^ DO
+     key := ascinx; first := NIL; left := NIL; right := NIL;
+    END;
+    IF r=less THEN p^.left := q ELSE p^.right := q END;
+    i := 0; (*copy identifier into asc table*)
+    WHILE id[i] > " " DO
+     IF ascinx = TableLength THEN
+      asc[ascinx] := " "; id[i] := " "; overflow := 1;
+     ELSE asc[ascinx] := id[i]; ascinx := ascinx+1; i := i+1;
+     END
+    END;
+    asc[ascinx] := " "; ascinx := ascinx+1;
+   END;
+   RETURN q
+  END Search;
+
+  PROCEDURE Record(t: Table; VAR x: ARRAY OF CHAR; n: INTEGER);
+   VAR p: TreePtr; q: ListPtr; i: CARDINAL;
+  BEGIN
+   i := 0;
+
+   REPEAT
+     id[i] := x[i]; 
+
+      i := i+1;
+   UNTIL (id[i-1] = " ") OR (i = WordLength);
+   p := Search(t);
+   IF p = NIL THEN
+     overflow := 2;
+   ELSE 
+     NEW(q);
+     IF q = NIL THEN
+       overflow := 3;
+     ELSE
+       q^.num := n; q^.next := p^.first; p^.first := q;
+     END
+   END
+  END Record;
+
+  PROCEDURE Tabulate(t: Table);
+
+   PROCEDURE PrintItem(p: TreePtr);
+    CONST L = 6;
+     N = (LineWidth-WordLength) DIV L;
+    VAR ch: CHAR;
+     i,k: CARDINAL; q: ListPtr;
+    BEGIN
+     i := WordLength+1; k := p^.key;
+     REPEAT ch := asc[k];
+      i := i-1; k := k+1; Write(ch);
+     UNTIL ch <= " ";
+     WHILE i > 0 DO
+      Write (" "); i := i-1;
+     END;
+     q := p^.first; i := N;
+     WHILE q # NIL DO
+      IF i = 0 THEN
+       WriteLn; i := WordLength+1;
+       REPEAT Write(" "); i := i-1;
+       UNTIL i = 0;
+       i := N;
+      END;
+      WriteInt(q^.num,L); q := q^.next; i := i-1;
+     END;
+    WriteLn;
+   END PrintItem;
+
+   PROCEDURE TraverseTree(p: TreePtr);
+   BEGIN
+    IF p # NIL THEN
+     TraverseTree(p^.left);
+     PrintItem(p);
+     TraverseTree(p^.right);
+    END
+   END TraverseTree;
+
+  BEGIN
+   WriteLn; TraverseTree(t^.right);
+  END Tabulate;
+
+ BEGIN
+  ascinx := 0; id[WordLength] := " "; overflow := 0;
+ END TableHandler.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/till_eof.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/till_eof.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/till_eof.mod
@@ -0,0 +1,47 @@
+MODULE TillEof;
+
+(*
+ This program reads a file and counts the number of characters in
+ each line. It is intended to be an example of using read statements
+ to read through a file.
+*)
+(* John Andrea, Oct.15/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT OpenInput, CloseInput, Read, EOL, in, Done,
+                  WriteString, WriteCard, WriteLn;
+FROM FileSystem IMPORT Eof;
+
+VAR
+  line, count :CARDINAL;
+  c           :CHAR;
+
+BEGIN
+
+  OpenInput( '.TXT' );
+  IF Done THEN
+
+    line := 0;
+
+    Read( c );
+
+    WHILE NOT Eof( in ) DO
+       line := line + 1;
+
+       count := 0;
+
+       WHILE NOT Eof( in ) & ( c # EOL ) DO
+         count := count + 1;
+         Read( c );
+       END;
+
+       WriteString( 'line #' ); WriteCard( line, 0 ); WriteString( ' has ' );
+       WriteCard( count, 0 ); WriteString( ' characters' ); WriteLn;
+
+       Read( c );
+    END;
+
+    CloseInput;
+  END;
+
+END TillEof.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/topo-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/topo-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/topo-1.mod
@@ -0,0 +1,85 @@
+MODULE TopoSortTest;
+
+(* Test the Topological sorting procedure with a simple list of numbers *)
+(* J. Andrea, Dec.19/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT WriteString, WriteLn, WriteCard;
+FROM Sorting IMPORT TopoSort;
+
+CONST
+  max = 5;
+
+VAR
+  x_index, y_index :ARRAY [1..max] OF CARDINAL;
+  i, j             :CARDINAL;
+
+  (* -------------------------------------------------- *)
+  PROCEDURE DoSort;
+  VAR
+    solution         :ARRAY [1..max+1] OF CARDINAL;
+    n_solution       :CARDINAL;
+
+    error, sorted, ok :BOOLEAN;
+
+    i                :CARDINAL;
+
+  BEGIN
+
+      WriteLn; WriteString( 'the list is:' ); WriteLn;
+      FOR i := 1 TO max DO
+         WriteCard( x_index[i], 2 ); WriteString( '   ' );
+         WriteCard( y_index[i], 2 ); WriteLn;
+      END;
+
+      WriteLn;   ok := TRUE;
+
+      TopoSort( x_index, y_index, max, solution, n_solution, error, sorted );
+
+      WriteString( 'topologically sorted is: ' );
+
+      IF error THEN
+        WriteString( 'error in passing solution' ); WriteLn;
+        ok := FALSE;
+      ELSE
+
+        FOR i := 1 TO n_solution DO
+           WriteCard( solution[i], 0 ); WriteString( '  ' );
+           IF solution[i] # i THEN ok := FALSE; END;
+        END;
+        WriteLn;
+
+        IF NOT sorted THEN
+          WriteString( 'set is not partially ordered' ); WriteLn;
+          ok := FALSE;
+        END;
+
+      END;
+
+      IF ok THEN
+        WriteString( 'results as expected, all ok' );
+      ELSE
+        WriteString( 'something wrong !, not as expected !' );
+      END;
+      WriteLn;
+
+    END DoSort;
+
+BEGIN
+
+  (* forward pointing list *)
+  FOR i := 1 TO max DO
+    x_index[i] := i;
+    y_index[i] := i + 1;
+  END;
+  DoSort;
+
+  (* backward pointing list *)
+  FOR i := 1 TO max DO
+    j := max + 1 - i;
+    x_index[j] := i;
+    y_index[j] := i + 1;
+  END;
+  DoSort;
+
+END TopoSortTest.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/veryscreen.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/veryscreen.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/veryscreen.mod
@@ -0,0 +1,21 @@
+MODULE TestVeryScreen;
+
+(* test the very simple screen handling module, and show how its used *)
+(* John Andrea, Feb.1/1991 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM VeryScreen IMPORT Home, EraseScreen, PutCursor, CursorOn, PutString;
+
+BEGIN
+
+      Home;   EraseScreen;
+
+      CursorOn( FALSE ); 
+
+      PutString( 'at top of screen', 1, 1 );
+
+      PutString( 'middle of screen', 10, 20 );
+
+      CursorOn( TRUE );
+
+END TestVeryScreen.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/generic/wator.mod b/examples/Modula-2_Libraries/andrea-m2/examples/generic/wator.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/generic/wator.mod
@@ -0,0 +1,820 @@
+MODULE WaTor;
+
+(* John Andrea, reserected, July 1991 - but no population logging to file *)
+(* John Andrea, Dec 1984 *)
+(* this third version uses 4 or 8 directions for the neighbourhood *)
+(* original idea from Scientific American Mathematical Games 1984 sometime *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+(*
+* Gotta shake your tail to make a wave
+* fish
+* Gotta shake your tail to make a wave
+* shark
+* Gotta shake your tail to make a wave
+* fish
+* Gotta shake your tail to make a wave
+* shark
+* Get hot , red hot
+* Everybody create , create your fate
+* Everybody create , before its too late
+* Live life like a diamond ring
+*
+*               - The Only Star In Heaven
+*                 Frankie Goes To Hollywood
+*)
+
+FROM Conversions  IMPORT CardToString;
+
+FROM VeryScreen IMPORT Home, EraseScreen, PutString, PutCursor, CursorOn;
+
+FROM InOut IMPORT WriteString, WriteLn, WriteCard, Done,
+                  ReadString,  ReadLn, ReadCard, ReadInt,
+                  OpenOutput,  CloseOutput, out;
+
+FROM Randomly IMPORT Choose_0_To_N_Minus_1, Choose_0_To_N, Choose_1_To_N;
+
+FROM FileSystem IMPORT Name;
+
+CONST
+    screen_row_min = 2;      (* the coordinates of the playing field *)
+    screen_row_max = 23;
+    screen_col_min = 2;
+    screen_col_max = 50;
+
+    title_row = 4;          (* the title *)
+    title_col = 55;
+
+    label_1_row =  8;       (* fish population *)
+    label_1_col = 55;
+    label_2_row = 10;       (* shark population *)
+    label_2_col = 55;
+    label_4_row = 12;       (* the generation # *)
+    label_4_col = 55;
+    label_3_row = 15;       (* parameters *)
+    label_3_col = 55;
+    label_5_row = 21;       (* logging ? *)
+    label_5_col = 55;
+    
+    row_min = 1;           (* the size of the planet - related to the screen *)
+    row_max = screen_row_max - screen_row_min + 1;
+    col_min = 1;
+    col_max = screen_col_max - screen_col_min + 1;
+
+    max_spots = (row_max - row_min + 1) * (col_max - col_min + 1);
+    max_neighbours = 8;
+
+TYPE
+    String  = ARRAY [0..80] OF CHAR;
+
+    Species = ( empty, fish, shark );
+
+    Position = RECORD
+               row, col :CARDINAL;
+               END;
+
+    Chronon   = CARDINAL;
+
+    Directions= ( north, south, east, west,
+                 north_east, north_west, south_east, south_west );
+
+    WaTorSpot = RECORD
+                next  :ARRAY [north..south_west]  OF   Position;
+                life_form                       :Species;
+                time_to_breed , time_to_starve  :Chronon;
+                END;
+
+    PlanetSurface = ARRAY [row_min..row_max] OF
+                    ARRAY [col_min..col_max] OF WaTorSpot;
+  
+    ScreenMap   = ARRAY [row_min..row_max] OF
+                  ARRAY [col_min..col_max] OF CHAR;
+  
+    NeighbourList = ARRAY [1..max_neighbours] OF Position;
+
+
+VAR
+    dead_planet, old, new :PlanetSurface;
+    max_direction         :Directions;
+
+    n_fish, n_sharks, 
+    default_n_fish, default_n_sharks :CARDINAL;
+
+    fish_breed, shark_breed, shark_starve,
+    default_fish_breed, default_shark_breed, default_shark_starve :Chronon;
+
+    fish_population, shark_population, population :CARDINAL;
+
+    screen    :ScreenMap;
+    picture   :ARRAY [empty..shark] OF CHAR;
+      
+    row, col    :CARDINAL;
+
+    (* ---------------------------------------------------- *)
+    PROCEDURE SpawnFish( row, col :CARDINAL);
+
+    BEGIN (* SpawnFish *)
+
+        new[row,col].life_form      := fish;
+        new[row,col].time_to_breed  := Choose_0_To_N(fish_breed);
+        new[row,col].time_to_starve := 0;
+        fish_population             := fish_population + 1;
+
+    END SpawnFish;
+
+    (* ---------------------------------------------------- *)
+    PROCEDURE SpawnSharks( row, col :CARDINAL);
+
+    BEGIN (* SpawnSharks *)
+
+        new[row,col].life_form      := shark;
+        new[row,col].time_to_breed  := Choose_0_To_N(shark_breed);
+        new[row,col].time_to_starve := Choose_0_To_N(shark_starve);
+        shark_population            := shark_population + 1;
+
+    END SpawnSharks;
+
+    (* ---------------------------------------------------- *)
+    PROCEDURE Initialize;
+    (* set up all the parameters for the game, and seed the planet *)
+
+    VAR
+      n      :CARDINAL;
+      answer :CHAR;
+      i, j   :CARDINAL;
+
+        (* ----------------------------------------------------- *)
+        PROCEDURE Spawn( animal :Species );
+
+        VAR
+          row, col :CARDINAL;
+
+        BEGIN (* Spawn *)
+
+          row := Choose_0_To_N(row_max-row_min) + row_min;
+          col := Choose_0_To_N(col_max-col_min) + col_min;
+
+          IF new[row,col].life_form = empty THEN
+             IF animal = fish THEN
+                SpawnFish( row, col);
+             ELSE
+                SpawnSharks( row, col);
+             END; (* if *)
+          END; (* if *)
+
+        END Spawn;
+
+       (* ----------------------------------------------- *)
+       PROCEDURE DrawScreen;
+
+       VAR
+         number :String;
+
+       BEGIN (* DrawScreen *)
+
+         (* initialize the screen *)
+         Home; EraseScreen;
+
+         (* draw up a box around the playing field *)
+         FOR col := screen_col_min -1 TO screen_col_max +1 DO
+            PutString('-',screen_row_min-1,col);
+            PutString('-',screen_row_max+1,col);
+         END; (* for *)
+         FOR row := screen_row_min -1 TO screen_row_max +1 DO
+            PutString('|',row,screen_col_min-1);
+            PutString('|',row,screen_col_max+1);
+         END; (* for *)
+
+         PutString('Wa Tor',title_row,title_col);
+         IF max_direction = west THEN
+           PutString('(4 neighbours)',title_row,title_col+8)
+         ELSE
+           PutString('(8 neighbours)',title_row,title_col+8)
+         END; (* if *)
+
+         PutString('fish population:',label_1_row,label_1_col);
+         PutString('shark population:',label_2_row,label_2_col);
+         PutString('generation:',label_4_row,label_4_col);
+
+         PutString('n_fish: ',label_3_row,label_3_col);
+         PutString('n_sharks: ',label_3_row+1,label_3_col);
+         PutString('fish breed: ',label_3_row+2,label_3_col);
+         PutString('shark breed: ',label_3_row+3,label_3_col);
+         PutString('shark starve: ',label_3_row+4,label_3_col);
+
+         CardToString(n_fish,5,number);
+         PutString(number,label_3_row,label_3_col+15);
+
+         CardToString(n_sharks,5,number);
+         PutString(number,label_3_row+1,label_3_col+15);
+
+         CardToString(fish_breed,5,number);
+         PutString(number,label_3_row+2,label_3_col+15);
+
+         CardToString(shark_breed,5,number);
+         PutString(number,label_3_row+3,label_3_col+15);
+
+         CardToString(shark_starve,5,number);
+         PutString(number,label_3_row+4,label_3_col+15);
+
+       END DrawScreen;
+
+
+    BEGIN (* Initialize *)
+
+      population       := 0;
+      shark_population := 0;
+      fish_population  := 0;
+
+      WriteLn;
+      WriteString('You must control Y to stop the game'); WriteLn;
+
+      WriteLn;
+      WriteString('How many neighbours ( 4 or 8 ) ? ');
+      ReadCard(n); ReadLn;
+      IF (n # 4) & (n # 8) THEN n := 8; END;
+      IF n = 4 THEN
+         max_direction := west;
+      ELSE
+         max_direction := south_west;
+      END; (* if *)
+
+      WriteLn;
+      WriteString('How many fish ?');
+      ReadCard(n_fish);
+      IF n_fish = 0 THEN
+         n_fish := default_n_fish;
+      END; (* if *)
+      ReadLn;
+      
+      WriteLn;
+      WriteString('How many sharks ?');
+      ReadCard(n_sharks);
+      IF n_sharks = 0 THEN
+         n_sharks := default_n_sharks;
+      END; (* if *)
+      ReadLn;
+      
+      WriteLn;
+      WriteString('What is the fish breeding time ?');
+      ReadCard(fish_breed);
+      IF fish_breed = 0 THEN
+         fish_breed := default_fish_breed;
+      END; (* if *)
+      ReadLn;
+      
+      WriteLn;
+      WriteString('What is the shark breeding time ?');
+      ReadCard(shark_breed);
+      IF shark_breed = 0 THEN
+         shark_breed := default_shark_breed;
+      END; (* if *)
+      ReadLn;
+      
+      WriteLn;
+      WriteString('What is the shark starving time ?');
+      ReadCard(shark_starve);
+      IF shark_starve = 0 THEN
+         shark_starve := default_shark_starve;
+      END; (* if *)
+      ReadLn;
+      
+      (* now allocate all the fishies *)
+      IF n_fish > max_spots THEN n_fish := max_spots END;
+      FOR n := 1 TO n_fish DO
+         Spawn(fish);
+      END; (* for *)
+
+      IF n_sharks > max_spots THEN n_sharks := max_spots END;
+      FOR n := 1 TO n_sharks DO
+         Spawn(shark);
+      END; (* for *)
+
+      population := fish_population + shark_population;
+
+      DrawScreen;
+
+    END Initialize;
+
+
+    (* ---------------------------------------------------- *)
+    PROCEDURE Play;
+
+    VAR
+      number :String;
+
+      n_neighbours :CARDINAL;
+
+      move_row, move_col    :CARDINAL;
+      n_changes, generation :CARDINAL;
+
+       (* ----------------------------------------------- *)
+       PROCEDURE ShowChanges;
+
+       VAR
+         row, col :CARDINAL;
+         c        :CHAR;
+
+        BEGIN (* ShowChanges *)
+
+          n_changes := 0;
+          FOR row := row_min TO row_max DO
+             FOR col := col_min TO col_max DO
+                 c := picture[old[row,col].life_form];
+                 IF c # screen[row,col] THEN
+                    n_changes := n_changes + 1;
+                    screen[row,col] := c;
+                    PutString(c,
+                       screen_row_min+(row-row_min),
+                       screen_col_min+(col-col_min));
+                 END; (* if *)
+             END; (* for *) (* col *)
+          END; (* for *) (* row *)
+
+        END ShowChanges;
+
+       (* --------------------------------------------- *)
+       PROCEDURE Kill( row, col :CARDINAL; VAR nuke :PlanetSurface);
+       (* make a spot empty *)
+
+       BEGIN (* Kill *)
+
+         nuke[row,col].life_form      := empty;
+         nuke[row,col].time_to_breed  := 0;
+         nuke[row,col].time_to_starve := 0;
+
+       END Kill;
+
+
+       (* --------------------------------------------- *)
+       PROCEDURE Swim(row,col :CARDINAL; spot :WaTorSpot) :BOOLEAN;
+       (* here's a function with side effects *)
+       (* if the thing can move, then do it and return true *)
+
+       VAR
+         neighbours   :NeighbourList;
+         new_position :Position;
+
+          (* --------------------------------------------- *)
+          PROCEDURE SearchBoth( catch :Species ) :BOOLEAN;
+          (* another function with side-effects *)
+          (* look around the neighbourhood for 'catch', and gather them up *)
+
+          VAR
+            close :Directions;
+            close_row, close_col :CARDINAL;
+
+          BEGIN (* SearchBoth *)
+
+              n_neighbours := 0;
+              FOR close := north TO max_direction DO
+
+                 close_row := spot.next[close].row;
+                 close_col := spot.next[close].col;
+                 (* look in both the old and the new neighbourhoods *)
+                 IF (old[close_row,close_col].life_form = catch) &
+                    (new[close_row,close_col].life_form = catch) THEN
+                    n_neighbours := n_neighbours + 1;
+                    neighbours[n_neighbours] := spot.next[close];
+                 END; (* if *)
+
+              END; (* for *)
+
+              RETURN (n_neighbours > 0 );
+
+          END SearchBoth;
+
+       BEGIN (* Swim *)
+
+          IF SearchBoth( empty ) THEN
+
+             (* it can be moved *)
+             new_position := neighbours[Choose_1_To_N(n_neighbours)];
+             move_row := new_position.row;
+             move_col := new_position.col;
+
+             (* turn off the old position *)
+             Kill(row,col,old);
+
+             (* and move this one *)
+             new[move_row,move_col].life_form      := spot.life_form;
+             new[move_row,move_col].time_to_breed  := spot.time_to_breed;
+             new[move_row,move_col].time_to_starve := spot.time_to_starve;
+
+             RETURN TRUE;
+
+          ELSE
+             RETURN FALSE;
+          END; (* if *)
+
+       END Swim;
+
+       (* --------------------------------------------- *)
+       PROCEDURE FishAction;
+
+       VAR
+         this_fish :WaTorSpot;
+         row, col  :CARDINAL;
+
+       BEGIN (* FishAction *)
+
+          (* scan the whole planet *)
+          FOR row := row_min TO row_max DO
+             FOR col := col_min TO col_max DO
+
+                 this_fish := old[row,col];
+                 IF this_fish.life_form = fish THEN
+
+                    (* this spot is a fish so do it *)
+                    IF this_fish.time_to_breed # 0 THEN
+                       this_fish.time_to_breed := this_fish.time_to_breed - 1;
+                    END; (* if *)
+
+                    IF Swim(row,col,this_fish) THEN
+
+                       (* is it time for this guy to breed too *)
+                       IF this_fish.time_to_breed = 0 THEN
+                          (* yes, time to breed *)
+                          SpawnFish(row,col);
+ 
+                          (* and the older one must wait again *)
+                          new[move_row,move_col].time_to_breed := fish_breed;
+                       END; (* if *)
+
+                    ELSE
+                       (* can't be moved, just reset it *)
+                       new[row,col].life_form      := fish;
+                       new[row,col].time_to_breed  := this_fish.time_to_breed;
+                       new[row,col].time_to_starve := 0;
+                    END; (* if *)
+
+                 END; (* if *)
+
+             END; (* for *) (* col *)
+          END; (* for *) (* row *)
+
+       END FishAction;
+
+       (* --------------------------------------------- *)
+       PROCEDURE SharkAction;
+
+       VAR
+         this_shark :WaTorSpot;
+         row, col   :CARDINAL;
+         moved      :BOOLEAN;
+
+         (* --------------------------------------------- *)
+         PROCEDURE Eat( row, col :CARDINAL; spot :WaTorSpot ) :BOOLEAN;
+         (* still another function with side-effects *)
+
+         VAR
+           neighbours   :NeighbourList;
+           n_neighbours :CARDINAL;
+           new_position :Position;
+
+            (* --------------------------------------------- *)
+            PROCEDURE Search( catch :Species ) :BOOLEAN;
+            (* another function with side-effects *)
+            (* look around the neighbourhood for 'catch', and gather them up *)
+
+            VAR
+              close :Directions;
+              close_row, close_col :CARDINAL;
+
+            BEGIN (* Search *)
+
+                n_neighbours := 0;
+                FOR close := north TO max_direction DO
+
+                   close_row := spot.next[close].row;
+                   close_col := spot.next[close].col;
+                   (* look only in the new neighbourhood *)
+                   IF new[close_row,close_col].life_form = catch THEN
+                      n_neighbours := n_neighbours + 1;
+                      neighbours[n_neighbours] := spot.next[close];
+                   END; (* if *)
+
+                END; (* for *)
+ 
+                RETURN (n_neighbours > 0 );
+
+            END Search;
+
+         BEGIN (* Eat *)
+             
+             IF Search(fish) THEN
+
+                (* it found a victim *)
+                new_position := neighbours[Choose_1_To_N(n_neighbours)];
+                move_row := new_position.row;
+                move_col := new_position.col;
+
+                (* turn off the victim *)
+                Kill(move_row,move_col,new);  Kill(move_row,move_col,old);
+                fish_population := fish_population - 1;
+
+                (* and move this one *)
+                new[move_row,move_col].life_form      := shark;
+                new[move_row,move_col].time_to_breed  :=
+                                                      this_shark.time_to_breed;
+                new[move_row,move_col].time_to_starve := shark_starve;
+
+               RETURN TRUE;
+
+            ELSE
+
+               RETURN FALSE;
+
+            END; (* if *)
+
+         END Eat;
+
+
+       BEGIN (* SharkAction *)
+
+          (* scan the whole planet *)
+          FOR row := row_min TO row_max DO
+            FOR col := col_min TO col_max DO
+
+             this_shark := old[row,col];
+             IF this_shark.life_form = shark THEN
+                (* this spot is a shark so do it *)
+                moved := FALSE;
+
+                IF this_shark.time_to_breed # 0 THEN
+                   this_shark.time_to_breed := this_shark.time_to_breed - 1;
+                END; (* if *)
+
+               IF Eat(row,col,this_shark) THEN
+  
+                  moved := TRUE;
+
+               ELSE
+
+                  (* found no victims, try to move it *)
+                  IF this_shark.time_to_starve # 0 THEN
+                     this_shark.time_to_starve := this_shark.time_to_starve-1;
+                  END; (* if *)
+
+                  (* unless its time to starve *)
+                  IF this_shark.time_to_starve = 0 THEN
+
+                     Kill(row,col,new);
+                     shark_population := shark_population - 1;
+
+                  ELSE
+
+                     IF Swim(row,col,this_shark) THEN
+                        moved := TRUE;
+                     ELSE
+
+                        (* can't be moved, just reset it *)
+                        new[row,col].life_form := shark;
+                        new[row,col].time_to_breed := this_shark.time_to_breed;
+                        new[row,col].time_to_starve :=
+                                                     this_shark.time_to_starve;
+                     END; (* if *)
+
+                  END; (* if *) (* starved *)
+                END; (* if *)
+
+                IF moved THEN
+                   (* is it time for this guy to breed too *)
+                   IF this_shark.time_to_breed = 0 THEN
+                      (* yes, time to breed *)
+                      SpawnSharks(row,col);
+
+                      (* and the older one must wait again *)
+                      new[move_row,move_col].time_to_breed := shark_breed;
+                   END; (* if *)
+                END; (* if *)
+
+              END; (* if *)
+
+            END; (* for *) (* col *)
+          END; (* for *) (* row *)
+
+       END SharkAction;
+
+
+    BEGIN (* Play *)
+
+      generation := 1;
+
+      WHILE (fish_population > 0) & (shark_population > 0 ) DO
+
+          FOR row := row_min TO row_max DO
+            FOR col := col_min TO col_max DO
+               new[row,col] := dead_planet[row,col];
+            END; (* col *)
+          END; (* row *)
+
+          ShowChanges;
+
+          (* population numbers *)
+
+          CardToString(fish_population,5,number);
+          PutString(number,label_1_row,label_1_col+18);
+
+          CardToString(shark_population,5,number);
+          PutString(number,label_2_row,label_2_col+18);
+
+          CardToString(generation,5,number);
+          PutString(number,label_4_row,label_4_col+18);
+
+          FishAction;
+
+          SharkAction;
+
+          population := fish_population + shark_population;
+          generation := generation + 1;
+
+          FOR row := row_min TO row_max DO
+            FOR col := col_min TO col_max DO
+              old[row,col] := new[row,col];
+            END; (* col *)
+          END; (* row *)
+
+
+      END; (* while *)
+
+      (* finish up *)
+      IF fish_population = 0 THEN
+         PutString('Fish extinct',screen_row_max,1);
+      ELSE
+         PutString('Sharks extinct',screen_row_max,1);
+      END;
+      PutCursor(screen_row_max,1);   WriteLn;
+
+
+    END Play;
+
+
+    (* ------------------------------------------------------ *)
+    PROCEDURE SetNeighbours;
+    (* now define the neighbour spots for every spot on the surface *)
+    (* remember that the planet is a torus *)
+
+
+     TYPE
+        map_parts = RECORD
+                     row, col :INTEGER;
+                     END;
+
+     VAR
+        wrap_map :ARRAY [north..south_west] OF map_parts;
+        compass  :Directions;
+        integer_row_min, integer_row_max,
+          integer_col_min, integer_col_max :INTEGER;
+
+        (* --------------------------------------------------------- *)
+        PROCEDURE SetWrapMap;
+        (* these are the values to be added to the given row,col to find
+         *  the torus'ly wrapped position on a square grid *)
+
+        BEGIN (* SetWrapMap *)
+
+           wrap_map[north].row      := -1;
+           wrap_map[north].col      :=  0;
+           wrap_map[south].row      :=  1;
+           wrap_map[south].col      :=  0;
+           wrap_map[east].row       :=  0;
+           wrap_map[east].col       :=  1;
+           wrap_map[west].row       :=  0;
+           wrap_map[west].col       := -1;
+           wrap_map[north_east].row := -1;
+           wrap_map[north_east].col :=  1;
+           wrap_map[north_west].row := -1;
+           wrap_map[north_west].col := -1;
+           wrap_map[south_east].row :=  1;
+           wrap_map[south_east].col :=  1;
+           wrap_map[south_west].row :=  1;
+           wrap_map[south_west].col := -1;
+
+           (* and define the corresponding integer values *)
+           integer_row_min := INTEGER(row_min);
+           integer_row_max := INTEGER(row_max);
+           integer_col_min := INTEGER(col_min);
+           integer_col_max := INTEGER(col_max);
+
+        END SetWrapMap;
+
+        (* ---------------------------------------------------- *)
+        PROCEDURE NewRow( row :CARDINAL; direction :Directions ) :CARDINAL;
+        (* define the position of the wrapped row, if it needs to wrap *)
+
+        VAR
+          new_row :INTEGER;
+
+        BEGIN (* NewRow *)
+
+            new_row := INTEGER(row) + wrap_map[direction].row;
+
+            IF new_row < integer_row_min THEN
+              new_row := integer_row_max;
+            ELSIF new_row > integer_row_max THEN
+              new_row := integer_row_min;
+            END; (* if *)
+
+            RETURN CARDINAL(new_row);
+
+        END NewRow;
+
+        (* ---------------------------------------------------- *)
+        PROCEDURE NewCol( col :CARDINAL; direction :Directions ) :CARDINAL;
+        (* define the position of the wrapped column, if it needs to wrap *)
+
+        VAR
+          new_col :INTEGER;
+
+        BEGIN (* NewCol *)
+
+            new_col := INTEGER(col) + wrap_map[direction].col;
+
+            IF new_col < integer_col_min THEN
+              new_col := integer_col_max;
+            ELSIF new_col > integer_col_max THEN
+              new_col := integer_col_min;
+            END; (* if *)
+
+            RETURN CARDINAL(new_col);
+
+        END NewCol;
+
+    BEGIN (* SetNeighbours *)
+
+      (* this algorithm only works if the minimum row or column is not zero,
+       *  i.e. the array bounds for the planet cannot start at zero
+       *  thats why the following check is included *)
+      IF (row_min < 1) OR (col_min < 1) THEN
+         (* somebody screwed up when they set up the constants *)
+         WriteLn; WriteLn;
+         WriteString(' Implementation ERROR '); WriteLn;
+         WriteString(' detected in the procedure SetNeighbours'); WriteLn;
+         IF row_min < 1 THEN
+            WriteString(' the value of row_min cannot be zero'); WriteLn;
+         END; (* if *)
+         IF col_min < 1 THEN
+            WriteString(' the value of col_min cannot be zero'); WriteLn;
+         END; (* if *)
+         WriteString(' reset the CONST value'); WriteLn;
+         WriteLn;
+         HALT;
+      END; (* if *)
+
+
+      SetWrapMap;
+
+      (* set up the pseudo-pointers for all the neighbours in the matrix *)
+      FOR row := row_min TO row_max DO
+         FOR col := col_min TO col_max DO
+
+            (* empty out the arrays too *)
+            screen[row,col]                     := picture[empty];
+            dead_planet[row,col].life_form      := empty;
+            dead_planet[row,col].time_to_breed  := 0;
+            dead_planet[row,col].time_to_starve := 0;
+
+            FOR compass := north TO south_west DO
+               dead_planet[row,col].next[compass].row := NewRow(row,compass);
+               dead_planet[row,col].next[compass].col := NewCol(col,compass);
+            END; (* for *) (* compass *)
+
+         END; (* for *) (* col *)
+      END; (* for *) (* row *)
+
+    END SetNeighbours;
+
+BEGIN (* WaTor *)
+
+(* what the fish look like *)
+picture[empty] := ' ';
+picture[fish]  := '.';
+picture[shark] := 'o';
+
+(* set the defaults *)
+default_n_fish       := 200;
+default_n_sharks     := 20;
+default_fish_breed   := 3;
+default_shark_breed  := 10;
+default_shark_starve := 3;
+
+SetNeighbours;
+
+FOR row := row_min TO row_max DO
+  FOR col := col_min TO col_max DO
+    new[row,col] := dead_planet[row,col];
+  END; (* for *) (* col *)
+END; (* for *) (* row *)
+
+Initialize;
+
+FOR row := row_min TO row_max DO
+  FOR col := col_min TO col_max DO
+    old[row,col] := new[row,col];
+  END; (* for *) (* col *)
+END; (* for *) (* row *)
+
+Play;
+
+END WaTor.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/multiscope/forms-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/multiscope/forms-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/multiscope/forms-1.mod
@@ -0,0 +1,70 @@
+MODULE Test;
+
+(* Test the FormEdit module *)
+(* J. Andrea, Jun.1993 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM FormEdit IMPORT SetLine, GetLine, DoEditing;
+FROM InOut IMPORT WriteString, Write, WriteLn;
+FROM Break IMPORT EnableBreak;
+
+TYPE
+  LongString = ARRAY [1..60] OF CHAR;
+  ShortString = ARRAY [1..5] OF CHAR;
+
+VAR
+  done :BOOLEAN;
+
+  card_type    :CHAR;
+  prof_name,
+  out_file     :LongString;
+  class_name,
+  class_number,
+  class_sect,
+  card_size,
+  n_id, n_answers :ShortString;
+
+BEGIN EnableBreak; (* ------------------------------------------------ *)
+
+    SetLine( 1, 'Test or Evaluation', 'T', 1, done );
+
+    SetLine( 3, 'Prof name', 'no name', 40, done );
+    SetLine( 4, 'Class name', 'Chem', 4, done );
+    SetLine( 5, 'Class number', '100', 3, done );
+    SetLine( 6, 'Class section', '10', 2, done );
+
+    SetLine( 8, 'Card size', '50', 3, done );
+    SetLine( 9, 'Id size', '6', 1, done );
+    SetLine( 10, 'Number of answers', '50', 3, done );
+
+    SetLine( 12, 'Out file', 'out.out', 12, done );
+
+
+    DoEditing( 0, 30, FALSE );
+
+
+    GetLine( 1, card_type, done );
+
+    GetLine( 3, prof_name, done );
+    GetLine( 4, class_name, done );
+    GetLine( 5, class_number, done );
+    GetLine( 6, class_sect, done );
+
+    GetLine( 8, card_size, done );
+    GetLine( 9, n_id, done );
+    GetLine( 10, n_answers, done );
+
+    GetLine( 12, out_file, done );
+
+
+    WriteString( card_type );    WriteString( ' !Test or Evaluation' ); WriteLn;
+    WriteString( class_name );   WriteString( ' !class name' ); WriteLn;
+    WriteString( class_number ); WriteString( ' !class number' ); WriteLn;
+    WriteString( class_sect );   WriteString( ' !class section' ); WriteLn;
+    WriteString( prof_name );    WriteString( ' !prof name' ); WriteLn;
+    WriteString( card_size );    WriteString( ' !card size' ); WriteLn;
+    WriteString( n_id );         WriteString( ' !size of id number' ); WriteLn;
+    WriteString( n_answers );    WriteString( ' !size of answer data' ); WriteLn;
+    WriteString( out_file );     WriteString( ' !out file' ); WriteLn;
+
+END Test.
diff --git a/examples/Modula-2_Libraries/andrea-m2/examples/multiscope/readkey-1.mod b/examples/Modula-2_Libraries/andrea-m2/examples/multiscope/readkey-1.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/examples/multiscope/readkey-1.mod
@@ -0,0 +1,38 @@
+MODULE Test;
+
+(* Test the procedure ReadKey from ScreenIO *)
+(* J.Andrea, Jun.1993 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM InOut IMPORT WriteString, WriteLn;
+FROM ScreenIO IMPORT ReadKey;
+FROM Break IMPORT EnableBreak;
+
+VAR
+  ch :CHAR;
+  shift, control, alt, function, arrow, special :BOOLEAN;
+
+BEGIN EnableBreak;
+
+  WriteString( 'hit any key and see what description gets displayed ' );
+  WriteLn;
+  WriteString( 'the program stops when anything involving an X is hit' );
+  WriteLn; WriteLn;
+
+  REPEAT
+     ReadKey( ch, shift, control, alt, function, arrow, special );
+     IF shift THEN WriteString( 'shift ' ) END;
+     IF control THEN WriteString( 'control ' ) END;
+     IF alt THEN WriteString( 'alt ' ) END;
+     IF function THEN WriteString( 'function ' ) END;
+     IF arrow THEN WriteString( 'arrow ' ) END;
+     IF special THEN WriteString( 'special ' ) END;
+     IF ch = ' ' THEN
+       WriteString( 'space' );
+     ELSE
+       WriteString( ch );
+     END;
+     WriteLn;
+  UNTIL ch = 'x';
+
+END Test.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/binaryino.def b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/binaryino.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/binaryino.def
@@ -0,0 +1,17 @@
+DEFINITION MODULE BinaryInOut;
+
+(* Provide some simple binary, record oriented i/o *)
+(* J. Andrea, Sept.4/92 *)
+
+FROM SYSTEM IMPORT BYTE;
+FROM FileSystem IMPORT File;
+
+EXPORT QUALIFIED ReadBlock, WriteBlock;
+
+      PROCEDURE ReadBlock( in :File; VAR rec :ARRAY OF BYTE );
+      (* read a record from the file *)
+
+      PROCEDURE WriteBlock( out :File; rec :ARRAY OF BYTE );
+      (* write a record to the file *)
+
+END BinaryInOut.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/binaryino.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/binaryino.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/binaryino.mod
@@ -0,0 +1,26 @@
+IMPLEMENTATION MODULE BinaryInOut;
+
+FROM SYSTEM IMPORT BYTE;
+FROM FileSystem IMPORT File, ReadRecord, WriteRecord;
+
+(* V1.0, Jaa, Sept.4/92 *)
+
+VAR
+  how_many_bytes :CARDINAL;
+
+   (* --------------------------------------- *)
+   PROCEDURE ReadBlock( in :File; VAR rec :ARRAY OF BYTE );
+   BEGIN
+      how_many_bytes := HIGH( rec ) + 1;
+      ReadRecord( in, rec, how_many_bytes );
+   END ReadBlock;
+
+   (* --------------------------------------- *)
+   PROCEDURE WriteBlock( out :File; rec :ARRAY OF BYTE );
+   BEGIN
+      how_many_bytes := HIGH( rec ) + 1;
+      WriteRecord( out, rec, how_many_bytes );
+   END WriteBlock;
+
+BEGIN
+END BinaryInOut.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/blockio.def b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/blockio.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/blockio.def
@@ -0,0 +1,68 @@
+DEFINITION MODULE BlockIO;
+
+(*
+  This module is for doing block i/o to/from files.
+  This method of i/o is faster than standard record i/o and also allows
+  for the reading of any file type no matter what format or record size.
+
+  Typically one block of data (512 bytes) is read/written at a time, however
+  less or more data may be moved, but the data is always started at a
+  block boundary and users must always specify which block number in the
+  file to read/write from/to. If reading/writing more than one block
+  at a time you should skip by n = ( size + 511 ) / 512 blocks.
+
+  Any data structure can be read/written from/to a file since the data
+  is passed as an array of bytes (meaning unknown structure).
+
+  Files created using the OpenOut procedure are created with fixed length
+  records of 512 bytes and no record format (this format is similar to
+  .EXE files)
+
+  The file type used here may not be compatible with the file type
+  from FileSystem.
+*)
+(* J. Andrea, June.4/91, taken from FileSystem from ETH V3.1 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SYSTEM IMPORT BYTE;
+
+EXPORT QUALIFIED  BlockFile,
+                  OpenIn, OpenOut, Close,
+                  Read, Write,
+                  Done, Status, ShowStatus;
+
+TYPE BlockFile; (* hidden *)
+
+PROCEDURE Done() :BOOLEAN;
+
+PROCEDURE OpenIn( VAR f :BlockFile; filename :ARRAY OF CHAR );
+          (* opens an existing file for readonly block i/o *)
+
+PROCEDURE OpenOut( VAR f :BlockFile; filename :ARRAY OF CHAR );
+          (* opens a new file for writeonly block i/o *)
+          (* these files are created with 512 byte fixed length records,
+             and no record structures *) 
+
+PROCEDURE Close( VAR f :BlockFile );
+          (* closes file, modifications become permanent *)
+
+PROCEDURE Read( VAR f :BlockFile; count :CARDINAL;
+                VAR block :ARRAY OF BYTE; VAR size :CARDINAL );
+          (* read the count'th block, starting at 1 *)
+          (* the number of bytes read is returned in 'size', often
+             the last block of a file is not filled *)
+
+PROCEDURE Write( VAR f :BlockFile; count :CARDINAL;
+                 block :ARRAY OF BYTE; size :CARDINAL );
+          (* write the count'th block, starting at 1 *)
+          (* if size=0 then the whole structure is output
+                otherwise only the given number of bytes are written *)
+
+PROCEDURE Status(): CARDINAL;
+          (* returns the VAX/VMS status code of the last RMS operation *)
+
+PROCEDURE ShowStatus;
+          (* should be called if not Done() to display
+             the corresponding error message on the terminal *)
+
+END BlockIO. 
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/blockio.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/blockio.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/blockio.mod
@@ -0,0 +1,202 @@
+IMPLEMENTATION MODULE BlockIO;
+
+(* J. Andrea, 1991, see the definition file for details *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+IMPORT RMSFiles;
+
+FROM SYSTEM IMPORT BYTE, ADR, SIZE;
+FROM RMSDefinitions IMPORT RMS$_EOF,RMS$_NORMAL,RMS$_CUR;
+FROM RMS IMPORT FAB, NAM, RAB,
+                ORG$SEQ,
+                FACset, FOPset, RATset, RFMset, SHRset,
+                FACtype, FOPtype, ORGtype, RATtype, RFMtype, SHRtype,
+                ROPtype, ROPset;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+
+CONST
+    MaxRecordSize = 512;
+
+TYPE
+    RecordSize = [0..MaxRecordSize];
+
+    BlockFile = POINTER TO FileBlock;
+
+    FileBlock = RECORD
+                  fab: FAB;
+                  nam: NAM;
+                  rab: RAB;
+                  trn: BOOLEAN;
+                  fna: ARRAY [0..127] OF CHAR;
+                END;
+
+VAR
+  status :CARDINAL;
+  lf     :FileBlock;
+  op     :ARRAY [0..9] OF CHAR; (* used by ShowStatus *)
+
+
+(* ------------------------------------------------------------------ *)
+PROCEDURE Done(): BOOLEAN;
+BEGIN
+    RETURN ODD(status);
+END Done;
+
+
+(* ------------------------------------------------------------------ *)
+PROCEDURE InitFileBlock( f :BlockFile );
+BEGIN
+   f^.trn := FALSE;
+END InitFileBlock;
+
+(* ------------------------------------------------------------------ *)
+PROCEDURE OpenIn( VAR f :BlockFile; filename: ARRAY OF CHAR );
+BEGIN
+
+   NEW(f);
+
+   RMSFiles.Open( f^.fab, f^.nam, filename, FACset{FAC$BRO,FAC$GET}, FOPset{},
+                  SHRset{}, f^.fna, status);
+
+   IF ODD(status) THEN
+     RMSFiles.Connect( f^.fab, f^.rab, ROPset{ROP$BIO}, status );
+     InitFileBlock(f);
+   END;
+
+   IF NOT ODD(status) THEN
+      lf := f^;
+      op := "Open";
+      DISPOSE(f)
+   END;
+
+END OpenIn;
+
+(* ------------------------------------------------------------------ *)
+PROCEDURE Close( VAR f :BlockFile);
+BEGIN
+  IF f <> NIL THEN
+    RMSFiles.Disconnect( f^.rab, status );
+    RMSFiles.Close( f^.fab, status );
+    IF NOT ODD(status) THEN
+      lf := f^;
+      op := "Close";
+    END;
+    DISPOSE(f);
+  ELSE
+    status := RMS$_NORMAL
+  END;
+END Close;
+
+(* ------------------------------------------------------------------ *)
+PROCEDURE OpenOut( VAR f :BlockFile; filename: ARRAY OF CHAR );
+          (* create and open a new file *)
+VAR
+  rfm: RFMtype;
+  mrs: CARDINAL;
+
+BEGIN
+
+  rfm := RFM$FIX;
+  mrs := MaxRecordSize;
+
+  NEW(f);
+
+  RMSFiles.Create( f^.fab, f^.nam, filename,
+                   FACset{FAC$BRO,FAC$PUT,FAC$TRN}, FOPset{},
+                   SHRset{}, RATset{}, rfm, ORG$SEQ, mrs, 0, 0,
+                   f^.fna, status );
+
+  IF ODD(status) THEN
+    RMSFiles.Connect( f^.fab, f^.rab, ROPset{}, status );
+    InitFileBlock(f);
+  END;
+
+  IF NOT ODD(status) THEN
+    lf := f^;
+    op := "Create";
+    DISPOSE(f)
+  END;
+
+END OpenOut;
+
+
+(* ------------------------------------------------------------------ *)
+PROCEDURE Read( VAR f     :BlockFile; count :CARDINAL;
+                VAR block :ARRAY OF BYTE; VAR size :CARDINAL );
+BEGIN
+
+  size := SIZE( block );
+
+  RMSFiles.Read( f^.rab, count, ADR(block), size, status );
+
+  size := CARDINAL( f^.rab.RSZ );
+
+  IF NOT ODD(status) THEN
+    IF status # RMS$_EOF THEN
+      RMSFiles.SignalIOStatus( "Read", f^.fna, f^.rab.STS, f^.rab.STV);
+    END;
+  END;
+END Read;
+
+(* ------------------------------------------------------------------ *)
+PROCEDURE Write( VAR f :BlockFile; count :CARDINAL;
+                 block :ARRAY OF BYTE; size :CARDINAL );
+          (* write the count'th block *)
+BEGIN
+
+  IF f^.trn THEN
+
+    RMSFiles.Truncate( f^.rab, status );
+
+    IF status = RMS$_CUR THEN (*no current record*)
+      RMSFiles.Find( f^.rab,status);
+      IF NOT ODD(status) THEN
+        IF status = RMS$_EOF THEN
+          status := RMS$_NORMAL;
+        ELSE
+           RMSFiles.SignalIOStatus( "Find",f^.fna,f^.rab.STS,f^.rab.STV);
+        END;
+      ELSE
+        RMSFiles.Truncate(f^.rab, status);
+      END;
+    END;
+
+    IF NOT ODD(status) THEN
+      RMSFiles.SignalIOStatus( "Truncate on Put",f^.fna,f^.rab.STS,f^.rab.STV)
+    END;
+    f^.trn := FALSE;
+  END;
+
+  IF size = 0 THEN
+    size := SIZE( block );
+  END;
+
+  RMSFiles.Write( f^.rab, count, ADR(block), size, status );
+  
+  IF NOT ODD(status) THEN
+    RMSFiles.SignalIOStatus( "Put", f^.fna, f^.rab.STS, f^.rab.STV )
+  END;
+
+END Write;
+
+(* ------------------------------------------------------------------ *)
+PROCEDURE Status(): CARDINAL;
+BEGIN
+    RETURN status;
+END Status;
+
+
+(* ------------------------------------------------------------------ *)
+PROCEDURE ShowStatus;
+BEGIN
+    IF status = lf.fab.STS THEN
+      RMSFiles.ShowIOStatus( op, lf.fna, status, lf.fab.STV );
+    ELSIF status = lf.rab.STS THEN
+      RMSFiles.ShowIOStatus( op, lf.fna, status, lf.rab.STV );
+    ELSE
+      RMSFiles.ShowIOStatus( "", "", status, 0 );
+    END
+END ShowStatus;
+
+BEGIN (* BlockIO *)
+END BlockIO.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/break.def b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/break.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/break.def
@@ -0,0 +1,12 @@
+DEFINITION MODULE Break;
+
+(* This module provided to help with porting code from some DOS compilers *)
+(* The procedures here currently do nothing *)
+(* John Andrea, Sept.8/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED EnableBreak;
+
+PROCEDURE EnableBreak;
+
+END Break.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/break.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/break.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/break.mod
@@ -0,0 +1,13 @@
+IMPLEMENTATION MODULE Break;
+
+(* This module provided to help with porting code from some DOS compilers *)
+(* The procedures here currently do nothing *)
+(* John Andrea, Sept.8/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+      PROCEDURE EnableBreak;
+      BEGIN
+      END EnableBreak;
+
+BEGIN
+END Break.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/cmdline.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/cmdline.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/cmdline.mod
@@ -0,0 +1,55 @@
+IMPLEMENTATION MODULE CmdLine;
+
+(* J. Andrea, Oct.13/92 -vms version *)
+(* Implementation by J. Andrea, Jun.28/92 -dos version *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+IMPORT ForeignCommand;
+
+VAR
+  length :CARDINAL;
+
+
+  (* ------------------------------------------- *)
+  PROCEDURE WholeCommandLine( VAR line :ARRAY OF CHAR );
+  BEGIN
+     ForeignCommand.GetAll( line, length );
+     IF length = 0 THEN
+       line[0] := 0C;
+     END;
+  END WholeCommandLine;
+
+  (* ------------------------------------------- *)
+  PROCEDURE Nargs() :CARDINAL;
+  BEGIN
+    RETURN ForeignCommand.NOptions();
+  END Nargs;
+
+  (* ------------------------------------------- *)
+  PROCEDURE GetArg( n :CARDINAL; VAR arg :ARRAY OF CHAR );
+  BEGIN
+    ForeignCommand.GetOption( n, arg, length );
+    IF length = 0 THEN
+      arg[0] := 0C;
+    END;
+  END GetArg;
+
+BEGIN
+END CmdLine.
+
+
+
+PROCEDURE ReadCommand( prompt :ARRAY OF CHAR );
+(* First step in getting options, this must be called before GetOption   *)
+(* and should be called only once. The prompt is shown if the user types *)
+(* the command line with no options. *)
+
+
+PROCEDURE NOptions() :CARDINAL;
+(* return the number of options given *)
+
+
+PROCEDURE GetOption( i :CARDINAL; VAR option :ARRAY OF CHAR;
+                                  VAR length :CARDINAL );
+(* Get the i'th option string, need not be called in order *)
+(* A returned 'length' of zero means that that option is not available. *)
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/dateopera.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/dateopera.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/dateopera.mod
@@ -0,0 +1,511 @@
+IMPLEMENTATION MODULE DateOperations;
+
+(* V1.1, J. Andrea, Sept.8/92 -correct today output if day < 10 *)
+(* V1.0, J. Andrea, Aug.16/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM StringOperations IMPORT Length, Assign;
+FROM CommonInputOutputProcedures IMPORT LIB$DATE_TIME;
+
+CONST
+  min_day_number =  73355; (* Jan.1/1901  *)
+  max_day_number = 146038; (* Dec.31/2099 *)
+  date_length = 11;    (* size of a vms style date string dd-mmm-yyyy *)
+  
+VAR
+  months :ARRAY [1..12] OF ARRAY [0..2] OF CHAR;
+  days   :ARRAY [1..12] OF CARDINAL;
+  digits :ARRAY [0..9] OF CHAR;
+  false_date :Date;
+      
+   (* --------------------------------------------------------- *)
+   PROCEDURE Today( VAR date :Date );
+   VAR
+     today :ARRAY [1..date_length] OF CHAR;
+     status :CARDINAL;
+   BEGIN
+
+     status := LIB$DATE_TIME( today );
+
+     IF today[1] = ' ' THEN
+       today[1] := '0';
+     END;
+
+     StringToDate( today, date );
+
+   END Today;
+   
+   (* --------------------------------------------------------- *)
+   PROCEDURE MakeDate( day, month, year :CARDINAL; VAR date :Date );
+   BEGIN
+   
+     date.true := TRUE;
+     date.day  := day;  date.month := month;  date.year := year;
+      
+     IF ( date.day = 0 ) OR ( date.day > 31 ) THEN
+       date.true := FALSE;
+     ELSE
+         
+       IF date.month > 12 THEN
+         date.true := FALSE;
+       ELSE
+          
+         IF ( date.year < 1901 ) OR ( date.year > 2099 ) THEN
+           date.true := FALSE;
+         ELSE
+            
+           (* test for day in month *)
+           IF date.day > days[date.month] THEN
+             IF date.month # 2 THEN
+               date.true := FALSE;
+             ELSE
+               IF NOT LeapYear( date.year ) THEN
+                 date.true := FALSE;
+               END; 
+             END;
+           END;
+              
+           (* precompute some stuff *)
+           IF date.true THEN
+             date.number := DayNumber( date );
+           END;
+              
+          END;
+        END;
+      END;
+    END MakeDate;
+       
+   (* --------------------------------------------------------- *)
+   PROCEDURE StringToDate( string :ARRAY OF CHAR; VAR date :Date );
+   VAR
+      i, l, p :CARDINAL;
+      mmm     :ARRAY [0..2] OF CHAR;
+      ok      :BOOLEAN;
+      d, m, y :CARDINAL;
+      
+      (* --------------------------- *)
+      PROCEDURE Digit( c :CHAR ) :CARDINAL;
+      BEGIN
+         IF ( c >= '1' ) & ( c <= '9' ) THEN
+           RETURN ORD( c ) - ORD( '0' );
+         ELSE
+           RETURN 0;
+         END;
+      END Digit;
+      
+      (* ------------------------------------- *)
+      PROCEDURE MatchMonth( i :CARDINAL ) :BOOLEAN;
+      BEGIN
+        IF mmm[0] = months[i][0] THEN
+          IF mmm[1] = months[i][1] THEN
+            RETURN mmm[2] = months[i][2];
+          ELSE
+            RETURN FALSE
+          END;
+        ELSE
+          RETURN FALSE
+        END;
+      END MatchMonth;
+      
+   BEGIN
+      
+     date.true := FALSE;
+     
+     l := Length( string );
+     IF l >= date_length - 1 THEN
+       (* its got to be at least 10 chars d-mmm-yyy *)
+     
+       (* parse out the day *)
+       
+       d := 0;  ok := TRUE;
+       p := 0;
+       WHILE ( p < l ) & ok DO
+         IF ( string[p] >= '0' ) & ( string[p] <= '9' ) THEN
+           d := d * 10 + Digit( string[p] );
+           p := p + 1;
+         ELSE
+           ok := FALSE;
+         END;
+       END;
+
+       (* need a dash here *)
+       IF string[p] = '-' THEN
+         
+         p := p + 1;   (* skip the dash *)
+         
+         (* take the next 3 chars as the month *)
+         
+         FOR i := 0 TO 2 DO
+           mmm[i] := CAP(string[p]);  p := p + 1;
+         END;
+        
+         (* need a dash here too *)
+         IF string[p] = '-' THEN
+         
+           (* try to match the month name *)
+      
+           m := 1;
+           WHILE ( m <= 12 ) & NOT MatchMonth( m ) DO
+             m := m + 1;
+           END;
+           
+           IF m < 13 THEN
+           
+             p := p + 1; (* skip the dash *)
+          
+             (* take the rest of the string as a year *)
+             ok := TRUE;
+             y  := 0;
+             WHILE ( p < l ) & ok DO
+               IF ( string[p] >= '0' ) & ( string[p] <= '9' ) THEN
+                 y := y * 10 + Digit( string[p] );
+                 p := p + 1;
+               ELSE
+                 ok := FALSE;
+               END;
+             END;
+            
+             IF ok THEN
+               MakeDate( d, m, y, date );
+             END;
+           END;
+         END;
+        END;
+      END;
+    END StringToDate;
+    
+    (* ------------------------------------------------- *)
+    PROCEDURE DateToString( date :Date; VAR string :ARRAY OF CHAR );
+    VAR
+      d, y :CARDINAL;
+      
+        (* -------------------------------- *)
+        PROCEDURE Digit( x :CARDINAL ) :CHAR;
+        BEGIN
+           IF x < 10 THEN
+             RETURN digits[x];
+           ELSE
+             RETURN ' ';
+           END;
+        END Digit;
+        
+    BEGIN
+      IF date.true THEN
+      
+        (* make sure the string is long enough to hold the date *)
+        IF HIGH( string ) + 1 >= date_length THEN
+        
+          d := date.day DIV 10;
+          string[0] := Digit( d );
+          
+          d := date.day - d * 10;
+          string[1] := Digit( d );
+          
+          string[2] := '-';
+          
+          string[3] := months[date.month][0];
+          string[4] := months[date.month][1];
+          string[5] := months[date.month][2];
+
+          string[6] := '-';
+          
+          y := date.year;
+          d := y DIV 1000;
+          string[7] := Digit( d );
+          y := y - d * 1000;
+          d := y DIV 100;
+          string[8] := Digit( d );
+          y := y - d * 100;
+          d := y DIV 10;
+          string[9] := Digit( d );
+          d := y - d * 10;
+          string[10] := Digit( d );  (* offset by zero, so this is 11th char *)
+          
+          IF HIGH( string ) + 1 > date_length THEN
+            string[11] := 0C;  (* string is offset by zero *)
+          END;
+          
+        ELSE
+          string[0] := 0C;
+        END;
+      ELSE
+        string[0] := 0C;
+      END;
+    END DateToString;
+   
+   (* -------------------------------------------------- *)
+   PROCEDURE LeapYear( year :CARDINAL ) :BOOLEAN;
+   BEGIN
+      IF year MOD 4 = 0 THEN
+        IF year MOD 100 = 0 THEN
+          RETURN FALSE;
+        ELSE
+          RETURN TRUE;
+        END;
+      ELSE
+        RETURN FALSE;
+      END;
+   END LeapYear;
+   
+   (* -------------------------------------------------- *)
+   PROCEDURE DayOfYear( date :Date ) :CARDINAL;
+   VAR i, sum :CARDINAL;
+   BEGIN
+      IF date.true THEN
+      
+        sum := date.day;
+        FOR i := 1 TO date.month - 1 DO
+          sum := sum + days[i];
+        END;
+      
+        IF LeapYear( date.year ) THEN
+          IF ( date.month > 2 ) OR ( ( date.month = 2 ) & ( date.day = 28 ) ) THEN
+            sum := sum + 1;
+          END;
+        END;
+      ELSE
+        sum := 0;
+      END;
+      
+      RETURN sum;
+   END DayOfYear;
+     
+   (* -------------------------------------------------- *)
+   PROCEDURE DayOfWeek( date :Date; VAR day_name :ARRAY OF CHAR );
+   BEGIN
+    
+    IF date.true THEN
+                   
+        CASE date.number MOD 7 OF
+       0 :Assign( 'Sunday', day_name );
+     | 1 :Assign( 'Monday', day_name );
+     | 2 :Assign( 'Tuesday', day_name );
+     | 3 :Assign( 'Wednesday', day_name );
+     | 4 :Assign( 'Thursday', day_name );
+     | 5 :Assign( 'Friday', day_name );
+     | 6 :Assign( 'Saturday', day_name );
+       END; (* case *)
+ 
+     ELSE
+       day_name[0] := 0C;
+     END;
+     
+   END DayOfWeek;
+   
+   (* -------------------------------------------------- *)
+   PROCEDURE DayNumber( date :Date ) :INTEGER;
+   (* algotithm from Hewlett Packard HP-25 Calculator Applications Programs *)
+   (* valid for Mar.1/1700 to Feb.28/2100, but simplified here for
+      1-jan-1901 to 31-dec-2099 *)
+   VAR
+      sum, y, m, d :INTEGER;
+   BEGIN
+    
+    IF date.true THEN
+       
+       IF date.month <= 2 THEN
+         y := date.year - 1;
+         m := date.month + 13;
+       ELSE
+         y := date.year;
+         m := date.month + 1;
+       END;
+       d := date.day;
+       
+       sum := 365 * y + y DIV 4;     (*  365.25 times year  *)
+       
+       sum := sum + 30 * m + ( 6 * m ) DIV 10;  (*  30.6 times month  *)
+       
+       sum := sum + d - 621049;
+
+       RETURN sum;
+     ELSE
+       RETURN 0;
+     END;
+     
+   END DayNumber;
+   
+   (* ------------------------------------------------------ *)
+   PROCEDURE DaysBetween( date1, date2 :Date ) :INTEGER;
+   BEGIN
+     IF date1.true & date2.true THEN
+       RETURN date1.number - date2.number;
+     ELSE
+       RETURN 0;
+     END;
+   END DaysBetween;
+   
+   (* ------------------------------------------------------ *)
+   PROCEDURE AddDays( in_date :Date; delta_days :CARDINAL;
+                      VAR out_date :Date );
+   VAR
+     d, m, y, i :CARDINAL;
+     long_days  :INTEGER;
+   BEGIN
+   
+     IF in_date.true THEN
+       IF delta_days = 0 THEN
+         out_date := in_date;
+       ELSE
+
+         long_days := delta_days;       
+         IF in_date.number + long_days > max_day_number THEN
+           out_date := false_date;
+         ELSE
+         
+           (* do it the hard way, just add a day at a time *)
+           d := in_date.day;   m := in_date.month;   y := in_date.year;
+
+           FOR i := 1 TO delta_days DO
+             d := d + 1;
+             IF d > days[m] THEN
+               IF NOT ( LeapYear( y ) & ( m = 2 ) & ( d = 29 ) ) THEN
+                 d := 1;
+                 m := m + 1;
+                 IF m > 12 THEN
+                   m := 1;
+                   y := y + 1;
+                 END;
+               END;
+             END;
+           END;
+           
+           MakeDate( d, m, y, out_date );
+           
+         END; 
+       END;
+     ELSE
+       out_date := false_date;
+     END;
+   END AddDays;
+   
+   (* ------------------------------------------------------ *)
+   PROCEDURE SubtractDays( in_date :Date; delta_days :CARDINAL;
+                      VAR out_date :Date );
+   VAR
+     d, m, y, i :CARDINAL;
+     long_days  :INTEGER;
+   BEGIN
+     IF in_date.true THEN
+       IF delta_days = 0 THEN
+         out_date := in_date;
+       ELSE
+       
+         long_days := delta_days;
+         IF in_date.number - long_days < min_day_number THEN
+           out_date := false_date;
+         ELSE
+         
+           (* do it the hard way, just subtract a day at a time *)
+           d := in_date.day;   m := in_date.month;   y := in_date.year;
+
+           FOR i := 1 TO delta_days DO
+             d := d - 1;
+             IF d = 0 THEN
+               m := m - 1;
+               IF m = 0 THEN
+                 m := 12;
+                 y := y - 1;
+               END;
+               IF LeapYear( y ) & ( m = 2 ) THEN
+                 d := 29;
+               ELSE
+                 d := days[m];
+               END;
+             END;
+           END;
+           
+           MakeDate( d, m, y, out_date );
+
+         END; 
+       END;
+     ELSE
+       out_date := false_date;
+     END;
+   END SubtractDays;
+   
+   (* -------------------------------------------------- *)
+   PROCEDURE Compare( date1, date2 :Date ) :CHAR;
+   VAR c :CHAR;
+   BEGIN
+      IF date1.true & date2.true THEN
+        IF date1.number = date2.number THEN
+          c := '=';
+        ELSIF date1.number > date2.number THEN
+          c := '>';
+        ELSE
+          c := '<';
+        END;
+      ELSE
+        c := 0C;
+      END;
+      RETURN c;
+   END Compare;
+   
+   
+   (* -------------------------------------------------- *)
+   PROCEDURE PhaseOfMoon( date :Date; VAR phase_name :ARRAY OF CHAR );
+   (* algorithm from TECO, or so says some people on the net *)
+   CONST
+     multiplier = 64;
+   VAR
+     century, golden, epact, period, eighth, sixteenth, phase :CARDINAL;
+   BEGIN
+    
+     IF date.true THEN
+
+       century := date.year DIV 100 + 1;
+       golden  := date.year - ( (date.year DIV 19) * 19 ) + 1;
+       
+       epact   := golden * 11 + 20 + ( (8 * century + 5) DIV 25 - 5) -
+                  (3 * century DIV 4 - 12 );
+       epact   := epact - ( (epact DIV 30) * 30 );
+       IF ( epact = 25 ) & ( golden > 11 ) THEN epact := 26; END;
+       IF epact = 24 THEN epact := 25; END;
+
+       period := 29 * multiplier + multiplier DIV 2;
+       eighth := period DIV 8;
+       sixteenth := eighth DIV 2;
+       
+       phase := ( DayOfYear( date ) + epact - 1 ) * multiplier + sixteenth;
+       phase := phase - ( (phase DIV period) * period);
+       phase := phase DIV eighth;
+       phase := phase MOD 8;
+       
+       CASE phase OF
+       0 :Assign( 'New', phase_name );
+     | 1 :Assign( 'Waxing Crescent', phase_name );
+     | 2 :Assign( 'First Quarter', phase_name );
+     | 3 :Assign( 'Waxing Gibbous', phase_name );
+     | 4 :Assign( 'Full', phase_name );
+     | 5 :Assign( 'Waning Gibbous', phase_name );
+     | 6 :Assign( 'Last Quarter', phase_name );
+     | 7 :Assign( 'Waning Crescent', phase_name );
+       ELSE
+          phase_name[0] := 0C;
+       END; (* case *)
+       
+     ELSE
+       phase_name[0] := 0C;
+     END;
+     
+   END PhaseOfMoon;
+ 
+BEGIN
+ 
+  months[1]  := 'JAN'; months[2]  := 'FEB'; months[3]  := 'MAR';
+  months[4]  := 'APR'; months[5]  := 'MAY'; months[6]  := 'JUN';
+  months[7]  := 'JUL'; months[8]  := 'AUG'; months[9]  := 'SEP';
+  months[10] := 'OCT'; months[11] := 'NOV'; months[12] := 'DEC';
+  days[1]  := 31;      days[2]  := 28;      days[3]  := 31;
+  days[4]  := 30;      days[5]  := 31;      days[6]  := 30;
+  days[7]  := 31;      days[8]  := 31;      days[9]  := 30;
+  days[10] := 31;      days[11] := 30;      days[12] := 31;
+  
+  false_date.true := FALSE;
+  false_date.day  := 0;  false_date.month := 0; false_date.year := 0;
+  false_date.number := 0;
+  
+  Assign( '0123456789', digits );
+
+END DateOperations.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/directacc.def b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/directacc.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/directacc.def
@@ -0,0 +1,78 @@
+DEFINITION MODULE DirectAccessFiles;
+
+(* Use direct access files *)
+(* This method uses the FORTRAN style of file open write|read close *)
+
+(* J. Andrea, Aug/8/91 - revitalized *)
+(* J. Andrea, 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SYSTEM IMPORT BYTE;
+
+EXPORT QUALIFIED DirectFile,   DirFileDone, DirFileStatus,
+                 DirectCreate, DirectOpen,  DirectClose,
+                 DirectWrite,  DirectRead;
+
+TYPE
+    DirectFile = CARDINAL; (* export *)
+
+VAR
+   DirFileDone    :BOOLEAN;  (* export *)
+
+   PROCEDURE DirectCreate( VAR file :DirectFile;
+                           name     :ARRAY OF CHAR;
+                           maxrec   :CARDINAL );
+   (*
+     Create a direct access file of the given filename 'name',
+     the maximum possible number of records for the file must also
+        be specified as 'maxrec',
+     the file handle is returned in 'file' which must be of type DirectFile.
+     The file created will have a record length of 512 bytes.
+     DirFileDone is set to FALSE if the file cannot be created.
+
+     A successful create operation leaves the file in an "open" state.
+   *)
+
+   PROCEDURE DirectOpen( VAR file :DirectFile;
+                         name     :ARRAY OF CHAR );
+   (*
+     Open a direct access file for reading and writing, random record access.
+     If the file cannot be accessed, or is not suitable for random access then
+     DirFileDone is returned as FALSE.
+   *)
+
+   PROCEDURE DirectClose( file :DirectFile );
+   (*
+     Close a currently open file.
+   *)
+
+   PROCEDURE DirectWrite( file          :DirectFile;
+                          record_number :CARDINAL;
+                          record        :ARRAY OF BYTE;
+                          n_bytes       :CARDINAL );
+   (*
+     Write a record into a direct access file at any record within
+     the limits specified during file creation.
+     Specify the record number in the file in 'record_number',
+     give any object for output as 'record', and
+     also specify the number of bytes of the output object in 'n_bytes'.
+   *)
+
+   PROCEDURE DirectRead( file          :DirectFile;
+                         record_number :CARDINAL;
+                         VAR record    :ARRAY OF BYTE;
+                         n_bytes       :CARDINAL );
+   (*
+     Read a record from a direct access file at any record within
+     the limits specified during file creation.
+     Specify the record number in the file in 'record_number',
+     specify any object to receive the data as 'record', and
+     also specify the number of bytes to read in 'n_bytes'.
+   *)
+
+   PROCEDURE DirFileStatus;
+   (*
+     Print information about the last accessed file on standard output.
+   *)
+
+END DirectAccessFiles.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/directacc.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/directacc.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/directacc.mod
@@ -0,0 +1,189 @@
+IMPLEMENTATION MODULE DirectAccessFiles;
+
+(* Use direct access files - see the definition module for details *)
+(* J. Andrea, Aug.8/91 - revitalized *)
+(* J. Andrea, 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SYSTEM IMPORT BYTE, ADR;
+
+FROM InOut IMPORT WriteLn, WriteString, WriteCard;
+
+FROM FortranDirectAccess IMPORT For$DirCreate, For$DirOpen, For$DirClose,
+                                For$DirRead, For$DirWrite;
+
+CONST
+    min_file = 10;   max_file = 90;   (* allow for 80 files in this range *)
+
+TYPE
+    FilesReady = ( available, notavailable );
+
+VAR
+    last_file      :DirectFile;
+    status         :CARDINAL;
+    file_slots     :ARRAY [min_file..max_file] OF FilesReady;
+
+   (* -------------------------------------------------- *)
+   PROCEDURE DirectCreate( VAR file :DirectFile;
+                           name     :ARRAY OF CHAR;
+                           maxrec   :CARDINAL );
+   (* create a file, and leave it in an open state *)
+
+   BEGIN (* DirectCreate *)
+
+        (* find the first open file *)
+        file := min_file;
+        WHILE ( file <= max_file ) & ( file_slots[file] # available ) DO
+           file := file + 1;
+        END; (* while *)
+
+        IF file > max_file THEN
+
+           last_file := 0;   status := 1;
+
+           DirFileDone := FALSE;
+
+        ELSE
+
+          last_file := file;
+
+          For$DirCreate( file, name, maxrec, status );
+
+          DirFileDone := status = 0;
+
+          IF DirFileDone THEN
+            file_slots[file] := notavailable
+          END;
+
+        END; (* if *)
+
+   END DirectCreate;
+
+   (* -------------------------------------------------- *)
+   PROCEDURE DirectOpen( VAR file :DirectFile;
+                         name     :ARRAY OF CHAR );
+
+   BEGIN (* DirectOpen *)
+
+        (* find the first open file *)
+        file := min_file;
+        WHILE ( file <= max_file ) & ( file_slots[file] # available ) DO
+           file := file + 1;
+        END; (* while *)
+
+        IF file > max_file THEN
+
+           last_file := 0;   status := 1;
+
+           DirFileDone := FALSE;
+
+        ELSE
+
+          last_file := file;
+
+          For$DirOpen( file, name, status );
+
+          DirFileDone := status = 0;
+
+          IF DirFileDone THEN
+            file_slots[file] := notavailable;
+          END;
+
+        END; (* if *)
+
+   END DirectOpen;
+
+   (* -------------------------------------------------- *)
+   PROCEDURE DirectClose( file :DirectFile );
+
+   BEGIN (* DirectClose *)
+
+      last_file := file;
+
+      IF file_slots[file] = notavailable THEN
+
+         For$DirClose( file, status );
+
+         DirFileDone := status = 0;
+
+         IF DirFileDone THEN
+           file_slots[file] := available;
+         END;
+
+      ELSE
+         DirFileDone := FALSE;
+         status      := 29;
+      END;
+
+   END DirectClose;
+
+   (* -------------------------------------------------- *)
+   PROCEDURE DirectWrite( file          :DirectFile;
+                          record_number :CARDINAL;
+                          record        :ARRAY OF BYTE;
+                          n_bytes       :CARDINAL );
+
+   BEGIN (* DirectWrite *)
+
+      last_file := file;
+
+      IF file_slots[file] = notavailable THEN
+
+         For$DirWrite( file, record_number, ADR(record[0]), n_bytes,
+                      status );
+
+         DirFileDone := status = 0;
+
+      ELSE
+         DirFileDone := FALSE;
+         status      := 29;
+      END;
+
+   END DirectWrite;
+
+   (* -------------------------------------------------- *)
+   PROCEDURE DirectRead( file          :DirectFile;
+                         record_number :CARDINAL;
+                         VAR record    :ARRAY OF BYTE;
+                         n_bytes       :CARDINAL );
+
+   BEGIN (* DirectRead *)
+
+      last_file := file;
+
+      IF file_slots[file] = notavailable THEN
+
+        For$DirRead( file, record_number, ADR(record[0]), n_bytes,
+                     status );
+
+        DirFileDone := status = 0;
+
+      ELSE
+         DirFileDone := FALSE;
+         status      := 29;
+      END;
+
+   END DirectRead;
+
+   (* -------------------------------------------------- *)
+   PROCEDURE DirFileStatus;
+   (* return the status, and the unit number of the last operation *)
+
+   BEGIN (* DirFileStatus *)
+
+      WriteString('File Unit  ='); WriteCard( last_file, 5 );   WriteLn;
+      WriteString('I/O Status ='); WriteCard( status, 5 );      WriteLn;
+
+   END DirFileStatus;
+
+BEGIN (* DirectAccessFiles *)
+
+DirFileDone := FALSE;
+
+FOR last_file := min_file TO max_file DO
+   file_slots[last_file] := available;
+END; (* for *)
+
+last_file := 0;
+
+END DirectAccessFiles.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/extendstr.def b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/extendstr.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/extendstr.def
@@ -0,0 +1,30 @@
+DEFINITION MODULE ExtendStrings;
+
+(* Some string functions *)
+(* V1.0, J. Andrea, Jun.17/93 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+
+EXPORT QUALIFIED CaseCompare, WildcardMatch;
+
+
+PROCEDURE CaseCompare( a, b :ARRAY OF CHAR; case_specific :BOOLEAN ) :CHAR;
+(*
+ Compare the two string 'a' and 'b' and return one of the three
+ characters '=' '>' or '<'.
+ '=' means that the strings are equal,
+ '>' means that 'a' is lexigraphically greater than 'b', and
+ '<' means that 'a' is less than 'b'
+
+ Set 'case_specific' to TRUE if the comparison requires that
+ the characters be of the same case.
+*)
+
+
+PROCEDURE WildcardMatch( string, pattern :ARRAY OF CHAR ) :BOOLEAN;
+(*
+ Determine if the wildcard string 'pattern' matches 'string'
+ Wildcard characters are "*" and "%".
+*)
+
+END ExtendStrings.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/extendstr.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/extendstr.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/extendstr.mod
@@ -0,0 +1,46 @@
+IMPLEMENTATION MODULE ExtendStrings;
+
+(* misc. extra string functions *)
+
+(* see definition module for algorithm notes *)
+(* V1.0, J. Andrea, Jun.17/93 -taken from MoreStrings *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM STRDefinitions IMPORT STR$_NOMATCH, STR$_MATCH;
+FROM StringHandlingProcedures IMPORT STR$COMPARE, STR$CASE_BLIND_COMPARE,
+                                     STR$MATCH_WILD;
+
+VAR
+   result :INTEGER;
+
+    (* ---------------------------------------------------------------- *)
+    PROCEDURE CaseCompare( a, b :ARRAY OF CHAR; case_specific :BOOLEAN ) :CHAR;
+    BEGIN
+
+       IF case_specific THEN
+         result := STR$COMPARE( a, b );
+       ELSE
+         result := STR$CASE_BLIND_COMPARE( a, b );
+       END;
+
+       IF result = 0 THEN
+         RETURN '=';
+       ELSE
+         IF result > 0 THEN
+           RETURN '>';
+         ELSE
+           RETURN '<';
+         END;
+       END;
+
+    END CaseCompare;
+
+
+    (* ---------------------------------------------------------------- *)
+    PROCEDURE WildcardMatch( string, pattern :ARRAY OF CHAR ) :BOOLEAN;
+    BEGIN
+      RETURN STR$MATCH_WILD( string, pattern ) = STR$_MATCH;
+    END WildcardMatch;
+
+BEGIN
+END ExtendStrings.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/foreignco.def b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/foreignco.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/foreignco.def
@@ -0,0 +1,46 @@
+DEFINITION MODULE ForeignCommand;
+
+(*
+ This module provides an easy interface to a foreign command line in VMS.
+ A foreign command comes from a simple DCL symbol definition of the form:
+
+        command :== $device:[directory]program
+
+ then the program is run like this:
+
+        command  abc def
+
+  or
+
+        command
+        prompt? abc def
+
+ All parsing of options must be done by the user.
+*)
+
+(* V1.0, J. Andrea, May.4/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED ReadCommand, NOptions, GetAll, GetOption;
+
+
+PROCEDURE ReadCommand( prompt :ARRAY OF CHAR );
+(* First step in getting options, this must be called before GetOption   *)
+(* and should be called only once. The prompt is shown if the user types *)
+(* the command line with no options. *)
+
+
+PROCEDURE NOptions() :CARDINAL;
+(* return the number of options given *)
+
+
+PROCEDURE GetAll( VAR whole_line :ARRAY OF CHAR; VAR length :CARDINAL );
+(* Return the whole command line, and its length *)
+
+
+PROCEDURE GetOption( i :CARDINAL; VAR option :ARRAY OF CHAR;
+                                  VAR length :CARDINAL );
+(* Get the i'th option string, need not be called in order *)
+(* A returned 'length' of zero means that that option is not available. *)
+
+END ForeignCommand.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/foreignco.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/foreignco.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/foreignco.mod
@@ -0,0 +1,100 @@
+IMPLEMENTATION MODULE ForeignCommand;
+
+(* Get options from the command line *)
+(* V1.0, J. Andrea, May.4/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM CommonInputOutputProcedures IMPORT LIB$GET_FOREIGN;
+FROM StringOperations IMPORT NextBlank, NextNonBlank, SubString, Assign;
+
+CONST
+   max_options  = 30;      (* maximum number of options on a line *)
+   max_line_len = 255;     (* maximum size of the command line    *)
+
+VAR
+   command_line :ARRAY [1..max_line_len] OF CHAR;
+
+   endpoints :ARRAY [1..max_options] OF RECORD
+                                          start, end :CARDINAL;
+                                        END;
+
+   command_len, n_options :CARDINAL;
+   command_read           :BOOLEAN;
+
+
+   (* -------------------------------------------------- *)
+   PROCEDURE ReadCommand( prompt :ARRAY OF CHAR );
+   VAR
+      status        :CARDINAL;
+      prompt_forced :BOOLEAN;
+      start, end    :CARDINAL;
+   BEGIN
+      IF NOT command_read THEN
+        command_read := TRUE;
+
+        prompt_forced := FALSE;
+
+        status := LIB$GET_FOREIGN( command_line, prompt, command_len,
+                                   prompt_forced );
+
+
+        (* now find all the option strings *)
+
+        start := NextNonBlank( command_line, 1 );
+        WHILE ( n_options < max_options ) & ( start # 0 ) DO
+           end := NextBlank( command_line, start );
+
+           n_options := n_options + 1;
+           endpoints[n_options].start := start;
+           endpoints[n_options].end   := end - 1;
+
+           start := NextNonBlank( command_line, end );
+        END;
+
+      END;
+   END ReadCommand;
+
+   (* -------------------------------------------------- *)
+   PROCEDURE NOptions() :CARDINAL;
+   BEGIN
+      RETURN n_options;
+   END NOptions;
+
+   (* -------------------------------------------------- *)
+   PROCEDURE GetAll( VAR whole_line :ARRAY OF CHAR;
+                     VAR length :CARDINAL );
+   BEGIN
+      IF command_read THEN
+        length := command_len;
+        Assign( command_line, whole_line );
+      ELSE
+        length := 0;
+      END;
+   END GetAll;
+
+   (* -------------------------------------------------- *)
+   PROCEDURE GetOption( i :CARDINAL; VAR option :ARRAY OF CHAR;
+                                     VAR length :CARDINAL );
+   BEGIN
+      IF command_read THEN
+        IF n_options >= i THEN
+
+          length := endpoints[i].end - endpoints[i].start + 1;
+
+          SubString( command_line, endpoints[i].start, length, option );
+
+        ELSE
+          length := 0;
+        END;
+      ELSE
+        length := 0;
+      END;
+
+   END GetOption;
+
+
+BEGIN
+   command_read := FALSE;
+   command_len  := 0;
+   n_options    := 0;
+END ForeignCommand.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/fortrandi.def b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/fortrandi.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/fortrandi.def
@@ -0,0 +1,44 @@
+%FOREIGN DEFINITION MODULE FortranDirectAccess;
+
+(*
+   Allow for direct access files in Modula-2,
+   but actually do the work by using calls to FORTRAN routines.
+   This work could be done by making the proper called to RMS routines
+   which are already setup in the module FileSystem, but that route
+   would take considerably more work than this route.
+*)
+
+(* V2.0, J. Andrea, Aug.8/91 - rename module *)
+(* V1.0, J. Andrea, 1984 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SYSTEM IMPORT ADDRESS;
+
+EXPORT QUALIFIED  For$DirCreate, For$DirOpen, For$DirClose,
+                  For$DirRead, For$DirWrite;
+
+PROCEDURE For$DirCreate( %REF file     :CARDINAL;
+                         %STDESCR name :ARRAY OF CHAR;
+                         %REF maxrec   :CARDINAL;
+                         %REF status   :CARDINAL );
+
+PROCEDURE For$DirOpen( %REF file     :CARDINAL;
+                       %STDESCR name :ARRAY OF CHAR;
+                       %REF status   :CARDINAL );
+
+PROCEDURE For$DirClose( %REF file   :CARDINAL;
+                        %REF status :CARDINAL );
+
+PROCEDURE For$DirWrite( %REF file          :CARDINAL;
+                        %REF record_number :CARDINAL;
+                        %IMMED record      :ADDRESS;
+                        %REF n_bytes       :CARDINAL;
+                        %REF status        :CARDINAL );
+
+PROCEDURE For$DirRead( %REF file          :CARDINAL;
+                       %REF record_number :CARDINAL;
+                       %IMMED record      :ADDRESS;
+                       %REF n_bytes       :CARDINAL;
+                       %REF status        :CARDINAL );
+
+END FortranDirectAccess.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/fortranfo.def b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/fortranfo.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/fortranfo.def
@@ -0,0 +1,37 @@
+%FOREIGN DEFINITION MODULE FortranFormat;
+
+(*
+ Use some FORTRAN routines to do formatting of real numbers in Modula-2.
+*)
+
+(* V1.0, J. Andrea, Aug.8/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SYSTEM IMPORT ADDRESS;
+
+EXPORT QUALIFIED  For$FFormat, For$EFormat;
+
+
+PROCEDURE For$FFormat( %REF x                  :REAL;
+                       %REF width              :CARDINAL;
+                       %REF digits             :CARDINAL;
+                       VAR %STDESCR out_string :ARRAY OF CHAR );
+(*
+  This procedure formats a real number into a string in fixed decimal point
+  FORTRAN F style, with the given field width and number of digits,
+  like F<width>.<digits>
+ *)
+
+
+PROCEDURE For$EFormat( %REF x                  :REAL;
+                       %REF width              :CARDINAL;
+                       %REF digits             :CARDINAL;
+                       VAR %STDESCR out_string :ARRAY OF CHAR );
+(*
+  This procedure formats a real number into a string in exponential format,
+  FORTRAN E style, with the given field width and number of digits,
+  like E<width>.<digits>
+ *)
+
+
+END FortranFormat.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/fortranjp.def b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/fortranjp.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/fortranjp.def
@@ -0,0 +1,21 @@
+%FOREIGN DEFINITION MODULE FortranJPI;
+
+(*
+   Allow for easy use of LIB$GETJPI routines
+   but actually do the work by using calls to FORTRAN routines.
+*)
+
+(* V1.0, J. Andrea, Sept.4/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SYSTEM IMPORT BYTE;
+
+EXPORT QUALIFIED  For$LibJPI;
+
+PROCEDURE For$LibJPI( %REF         item   :INTEGER;
+                      VAR %REF     value  :ARRAY OF BYTE;
+                      VAR %STDESCR name   :ARRAY OF CHAR;
+                      VAR %REF     len    :CARDINAL;
+                      VAR %REF     status :CARDINAL );
+
+END FortranJPI.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/getcharac.def b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/getcharac.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/getcharac.def
@@ -0,0 +1,58 @@
+DEFINITION MODULE GetCharacter;
+
+(*
+  GET a single character from the terminal,
+  without first setting the proper mode, ordinary non-GET mode is used
+  wherein a RETURN is needed to input data.
+
+  Use StartGet and StopGet to turn on and off single-character-mode.
+
+  Set character modes on and off with the SET procedures,
+  both PASSALL (all control characters passed to GET) and
+     NOPASSALL (control characters not trapped) modes are available,
+*)
+(* J. Andrea, 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED
+  Get, StartGet, StopGet,
+  SetPassallCharacterMode, UnSetPassallCharacterMode,
+  SetNoPassallCharacterMode ,UnSetNoPassallCharacterMode,
+  GetNoWait;
+
+
+  PROCEDURE Get(VAR ch :CHAR);
+  (* return a single character, no Carriage-Return needed *)
+
+
+  PROCEDURE GetNoWait(VAR ch :CHAR);
+  (* return a single character, no Carriage-Return needed *)
+  (* and don't wait till a character occurs, returns null character if there
+   * is no character in the buffer *)
+
+
+  PROCEDURE StartGet;
+  (* Enter single character mode *)
+
+
+  PROCEDURE StopGet;
+  (* Exit single character mode *)
+  (* And return to "carriage-return needed for input" mode *)
+
+
+  PROCEDURE SetPassallCharacterMode;
+  (* turn on the GET mode, trap control characters *)
+
+
+  PROCEDURE UnSetPassallCharacterMode;
+  (* turn off the GET mode, trap control characters *)
+
+
+  PROCEDURE SetNoPassallCharacterMode;
+  (* turn on the GET mode, don't trap control characters *)
+
+
+  PROCEDURE UnSetNoPassallCharacterMode;
+  (* turn off the GET mode, don't trap control characters *)
+
+END GetCharacter.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/getcharac.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/getcharac.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/getcharac.mod
@@ -0,0 +1,189 @@
+IMPLEMENTATION MODULE GetCharacter;
+
+(* GET a single character from the terminal ,
+   without first setting the proper mode, ordinary non-GET mode is used.
+
+   Use StartGet and StopGet to enter and exit single-character-mode.
+
+   Set character modes on and off with the SET procedures,
+   both PASSALL (all control characters passed to GET) and
+      NOPASSALL (control characters not trapped) modes are available,
+
+*)
+(* bastardization of M. Mall's TTIO from ETH by Jaa, 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+  
+FROM SYSTEM                      IMPORT WORD, ADDRESS, ADR;
+FROM VMS                         IMPORT SYS$ASSIGN, SYS$ALLOC, SYS$QIOW;
+FROM ConditionHandlingProcedures IMPORT LIB$SIGNAL;
+FROM IODefinitions               IMPORT IO$_TTYREADALL, IO$_READVBLK;
+
+CONST
+    IO$M_NOFILTR = 200H;
+    IO$M_NOECHO  = 40H;
+    IO$_WRITEVBLK= 30H;
+    IO$_SENSEMODE= 27H;
+    IO$M_TYPEAHDCNT=40H;
+     
+VAR 
+    usegetln:    BOOLEAN;   (* read in complete lines        *)
+    mustagain:   BOOLEAN;  (* procedure readagain was called*)
+    bufferempty: BOOLEAN; 
+    lfpending:   BOOLEAN;  (* a line feed must next be output*)
+    oldch:       CHAR;	   (* last character read           *)
+    buffer:      ARRAY [0..255] OF CHAR; (* holds one line of input *)
+    size:        CARDINAL;      (* number of chars in buffer     *)
+    pos:         CARDINAL;       (* next char to read from buffer *)
+    inChannel,           (* input channel assigned by VMS *)
+    outChannel:  CARDINAL;(* output channel assigned by VMS*)
+    PhysDevNam:  ARRAY [0..29] OF CHAR; (* physical device name *)
+    mode:        CARDINAL;      (* mode bits for input operations*)
+    Result:      CARDINAL;    (* status code returned from VMS *)
+    iosb:        RECORD c1, c2: CARDINAL END;
+                           (* input/output status block     *)
+                           (* filled by QIO system service  *)
+                  
+
+  (* --------------------------------------------------------------- *)
+  PROCEDURE Get(VAR ch: CHAR);
+
+  BEGIN (* Get *)
+
+    IF mustagain THEN
+      ch := oldch;
+      mustagain := FALSE
+    ELSIF bufferempty THEN
+
+      IF usegetln THEN 
+        (* note - MODE only as the qualifier on the read *)
+        Result := SYS$QIOW(0,inChannel,mode,ADR(iosb),ADDRESS(0),
+		           0,ADR(buffer),256,0,0,0,0);
+        IF NOT ODD(Result) THEN LIB$SIGNAL(Result) END;
+        pos := 1;
+        bufferempty := FALSE;
+        size := iosb.c1 DIV 10000H + iosb.c2 DIV 10000H - 1;
+        ch := buffer[0];
+        IF size < pos THEN
+          bufferempty := TRUE
+        END
+      ELSE 
+        Result := SYS$QIOW(0,inChannel,mode,ADR(iosb),ADDRESS(0),
+		           0,ADR(ch),1,0,0,0,0);
+        IF NOT ODD(Result) THEN LIB$SIGNAL(Result) END;
+      END
+    ELSE
+      ch := buffer[pos]; INC(pos);
+      IF size < pos THEN
+        bufferempty := TRUE;
+      END;
+    END;
+
+    oldch := ch;
+    lfpending := ch = 15C;
+
+  END Get;
+ 
+  (* --------------------------------------------------------------- *)
+  PROCEDURE GetNoWait(VAR ch: CHAR);
+
+  VAR
+     getln : BOOLEAN;
+
+  BEGIN (* GetNoWait *)
+
+    IF mustagain OR NOT bufferempty THEN
+       Get(ch);
+    ELSE 
+        Result := SYS$QIOW(0,inChannel,
+                           IO$M_TYPEAHDCNT+IO$_SENSEMODE,
+                           ADDRESS(0),ADDRESS(0),
+                           0,ADR(iosb),0,0,0,0,0);
+        IF NOT ODD(Result) THEN LIB$SIGNAL(Result) END;
+        IF iosb.c1 MOD 10000H > 0 THEN
+           (* there is a character in the type ahead buffer *)
+           getln := usegetln;
+           usegetln := FALSE;
+           Get(ch);
+           usegetln := getln;
+        ELSE
+           ch := 0C;
+        END;
+    END;
+
+  END GetNoWait;
+ 
+  (* --------------------------------------------------------------- *)
+  PROCEDURE StartGet;
+  (* Turn on single character mode *)
+  BEGIN
+     SetNoPassallCharacterMode;
+  END StartGet;
+
+  (* --------------------------------------------------------------- *)
+  PROCEDURE StopGet;
+  (* Turn off single character mode *)
+  BEGIN
+     UnSetNoPassallCharacterMode;
+  END StopGet;
+
+  (* --------------------------------------------------------------- *)
+  PROCEDURE SetMode(m: CARDINAL; getln: BOOLEAN);
+    (* m= modifier bits from VMS *)
+
+  BEGIN (* SetMode *)
+
+    mode := m;
+    usegetln := getln;
+
+  END SetMode;
+
+  (* ------------------------------------------------------------ *)
+  PROCEDURE SetPassallCharacterMode;
+
+  BEGIN (* SetCharacterMode *)
+ 
+    SetMode(IO$M_NOECHO + IO$_TTYREADALL , FALSE );
+
+  END SetPassallCharacterMode;
+
+  (* ------------------------------------------------------------ *)
+  PROCEDURE UnSetPassallCharacterMode;
+
+  BEGIN (* UnSetPassallCharacterMode *)
+ 
+    SetMode( 0 , TRUE );
+
+  END UnSetPassallCharacterMode;
+
+  (* ------------------------------------------------------------ *)
+  PROCEDURE SetNoPassallCharacterMode;
+
+  BEGIN (* SetNoPassallCharacterMode *)
+
+    SetMode(IO$M_NOECHO + IO$_READVBLK , FALSE );
+
+  END SetNoPassallCharacterMode;
+
+  (* ------------------------------------------------------------ *)
+  PROCEDURE UnSetNoPassallCharacterMode;
+
+  BEGIN (* UnSetNopassallCharacterMode *)
+
+    SetMode( 0 , TRUE );
+
+  END UnSetNoPassallCharacterMode;
+
+
+BEGIN (* GetCharacter *)
+
+  Result := SYS$ASSIGN("TT",outChannel,0,ADDRESS(0));
+  IF NOT ODD(Result) THEN LIB$SIGNAL(Result) END;
+  inChannel := outChannel;
+  mustagain := FALSE;
+  oldch := 0C;
+  usegetln := FALSE;
+  bufferempty := TRUE;
+  lfpending := TRUE;
+  SetMode(0,TRUE);
+
+END GetCharacter.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/memorysta.def b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/memorysta.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/memorysta.def
@@ -0,0 +1,17 @@
+DEFINITION MODULE MemoryStatus;
+
+(* Return some information about memory use *)
+(* J. Andrea, Sept.4/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED   Used, Available;
+
+
+PROCEDURE Used() :CARDINAL;
+(* return the number of bytes of memory that have been used up *)
+
+PROCEDURE Available() :CARDINAL;
+(* return the number of bytes of memory that are still available *)
+
+
+END MemoryStatus.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/memorysta.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/memorysta.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/memorysta.mod
@@ -0,0 +1,32 @@
+IMPLEMENTATION MODULE MemoryStatus;
+
+(* Return some information about memory use *)
+(* J. Andrea, Sept.4/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM JPIDefinitions IMPORT JPI$_FREPTECNT, JPI$_PGFLQUOTA;
+FROM FortranJPI IMPORT For$LibJPI;
+
+VAR
+   status :CARDINAL;
+   string :ARRAY [0..1] OF CHAR;
+   len    :CARDINAL;
+   value  :CARDINAL;
+
+
+   (* ---------------------------------------------- *)
+   PROCEDURE Used() :CARDINAL;
+   BEGIN
+     For$LibJPI( JPI$_PGFLQUOTA, value, string, len, status );
+     RETURN ( value * 512 ) - Available();
+   END Used;
+
+   (* ---------------------------------------------- *)
+   PROCEDURE Available() :CARDINAL;
+   BEGIN
+     For$LibJPI( JPI$_FREPTECNT, value, string, len, status );
+     RETURN value * 512;
+   END Available;
+
+BEGIN
+END MemoryStatus.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/moremath.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/moremath.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/moremath.mod
@@ -0,0 +1,222 @@
+IMPLEMENTATION MODULE MoreMath;
+
+(* misc. extra math functions *)
+(* new functions - J. Andrea, Aug.13/91 *)
+(* J. Andrea, 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM MathematicsProcedures IMPORT OTS$POWJJ, OTS$POWLULU, OTS$POWRLU,
+                                  MTH$AMIN1, MTH$AMAX1,
+                                  MTH$JMIN0, MTH$JMAX0,
+                                  MTH$UMIN,  MTH$UMAX;
+FROM MathLib0 IMPORT sqrt, ln;
+
+
+    (* -------------------------------------------- *)
+    PROCEDURE IModulus( a, b :INTEGER ) :INTEGER;
+    (* return the integer modulus of two numbers
+       handles a negative 'a' value (unlike the languages built in MOD) *)
+    BEGIN
+
+       IF a < 0 THEN
+         RETURN b - (ABS(a) MOD b);
+       ELSE
+         RETURN a MOD b;
+       END; (* if *)
+
+    END IModulus;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE CardPower( base, exponent :CARDINAL ) :CARDINAL;
+    (* raise a cardinal to a cardinal power *)
+    BEGIN
+
+       RETURN OTS$POWLULU( base, exponent );
+
+    END CardPower;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE RealPower( base :REAL; exponent :CARDINAL ) :REAL;
+    (* raise a real value to a cardinal power *)
+    BEGIN
+
+       RETURN OTS$POWRLU( base, exponent );
+
+    END RealPower;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE IntPower( base, exponent :INTEGER ) :INTEGER;
+    (* raise an integer to an integer power *)
+    BEGIN
+
+      RETURN OTS$POWJJ( base, exponent );
+
+    END IntPower;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE entier( a :REAL ) :INTEGER;
+    (* return the nearest integer *)
+    BEGIN
+
+      IF ( a < -2147483648.0 ) OR ( a > 2147483647.0 ) THEN
+	RETURN 0
+      ELSE
+        RETURN INTEGER( TRUNC( a ) )
+      END (* if *);
+
+    END entier;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE MinReal( a, b :REAL ) :REAL;
+    BEGIN
+
+       RETURN MTH$AMIN1( a, b );
+
+    END MinReal;
+
+    (* -------------------------------------------------- *)
+    PROCEDURE MaxReal( a, b :REAL ) :REAL;
+    BEGIN
+
+       RETURN MTH$AMAX1( a, b );
+
+    END MaxReal;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE MinInt( a, b :INTEGER ) :INTEGER;
+    BEGIN
+
+       RETURN MTH$JMIN0( a, b );
+
+    END MinInt;
+
+    (* -------------------------------------------------- *)
+    PROCEDURE MaxInt( a, b :INTEGER ) :INTEGER;
+    BEGIN
+
+       RETURN MTH$JMAX0( a, b );
+
+    END MaxInt;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE MinCard( a, b :CARDINAL ) :CARDINAL;
+    BEGIN
+
+       RETURN MTH$UMIN( a, b );
+
+    END MinCard;
+
+    (* -------------------------------------------------- *)
+    PROCEDURE MaxCard( a, b :CARDINAL ) :CARDINAL;
+    BEGIN
+
+       RETURN MTH$UMAX( a, b );
+
+    END MaxCard;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE SizeCard( a :CARDINAL ) :CARDINAL;
+    BEGIN
+
+       IF a < 10 THEN
+         RETURN 1;
+       ELSE
+         RETURN 1 + SizeCard( a DIV 10 );
+       END;
+
+    END SizeCard;
+
+    (* -------------------------------------------------- *)
+    PROCEDURE SizeInt( a :INTEGER ) :CARDINAL;
+    BEGIN
+
+       IF ABS( a ) < 10 THEN
+         IF a < 0 THEN
+           RETURN 2;
+         ELSE
+           RETURN 1;
+         END;
+       ELSE
+         RETURN 1 + SizeInt( a DIV 10 );
+       END;
+
+    END SizeInt;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE CalcPi() :REAL;
+
+    CONST
+      one  = 1.0;
+      two  = 2.0;
+      four = 4.0;
+      six  = 6.0;
+      
+    VAR
+      root_two, last, out, y, a, d, e :REAL;
+      i                               :CARDINAL;
+
+    BEGIN
+
+      root_two := sqrt( two );
+
+      last := 0.0;
+
+      y := root_two - one;
+      a := six - four * root_two;
+
+      out := one / a;
+
+      i := 0;
+      WHILE out # last DO
+        last := out;
+
+        d := one - RealPower( y, 4 );
+        d := sqrt( sqrt( d ) );
+
+        y := ( one - d ) / ( one + d );
+
+        i := i + 1;
+
+        e := RealPower(two, 2*i+1) * y * ( one + y + y * y );
+        a := RealPower(one+y, 4) * a - e;
+
+        out := one / a;
+
+      END;
+      
+      RETURN out;
+
+    END CalcPi;
+
+
+    (* -------------------------------------------- *)
+    PROCEDURE Log10( x :REAL ) :REAL;
+    BEGIN
+      IF x <= 0.0 THEN
+        RETURN 0.0;
+      ELSE
+        RETURN ln( x ) / ln( 10.0 );
+      END;
+    END Log10;
+
+    (* -------------------------------------------- *)
+    PROCEDURE Log2( x :REAL ) :REAL;
+    BEGIN
+      IF x <= 0.0 THEN
+        RETURN 0.0;
+      ELSE
+        RETURN ln( x ) / ln( 2.0 );
+      END;
+    END Log2;
+
+BEGIN
+END MoreMath.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/plotter.def b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/plotter.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/plotter.def
@@ -0,0 +1,15 @@
+DEFINITION MODULE Plotter;
+
+(* X-Y Plotting into a Regis graphics file. *)
+
+(* J. Andrea, Jul.11/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+EXPORT QUALIFIED Plot;
+
+  PROCEDURE Plot( out_file :ARRAY OF CHAR;
+                  title :ARRAY OF CHAR; x, y :ARRAY OF REAL; n :CARDINAL );
+  (* Create a file 'out_file' containing Regis graphics commands,
+     given the data points in 'x,y', with 'n' being the number of points *)
+
+END Plotter.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/plotter.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/plotter.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/plotter.mod
@@ -0,0 +1,266 @@
+IMPLEMENTATION MODULE Plotter;
+
+FROM LewertsScale IMPORT Scale;
+FROM REGISGraphics IMPORT BeginRegis, EndRegis,
+                          GetDimensions,
+                          Move, Line, Text;
+FROM CardArrays IMPORT CardArray, Build, Destroy, Put, Get;
+ 
+  (* ---------------------------------------- *)
+  PROCEDURE Plot( out_file :ARRAY OF CHAR;
+                  title :ARRAY OF CHAR; x, y :ARRAY OF REAL; n :CARDINAL );
+
+  VAR
+    x_min, x_max, y_min, y_max,
+    x_scale_min, x_scale_max,
+    y_scale_min, y_scale_max,
+    x_scale_inc, y_scale_inc :REAL;
+
+    i, j  :CARDINAL;
+    index :CardArray;
+
+    (* ------------------------------------------ *)
+    PROCEDURE SetScale( min, max :REAL;
+                        VAR scale_min, scale_max, scale_inc :REAL );
+    VAR
+      tenth :REAL;
+    BEGIN
+      IF min = max THEN
+        (* its flat, so fake it *)
+        tenth := min / 10.0;
+        min := min - tenth;
+        max := max + tenth; 
+      END;
+
+      (* get nice scaling parameters *)
+      Scale( min, max, 7, scale_min, scale_max, scale_inc );
+    END SetScale;
+    
+  BEGIN
+  
+    Build( index, 0, n-1 ); (* create a temporary array for sorting index *)
+    
+    XYSort( x, y, n, index );
+    
+    x_min := x[Get(index,0)];  x_max := x[Get(index,n-1)];
+    
+    (* but we must run over the array to get y range *)
+    y_min := y[Get(index,0)];  y_max := y[Get(index,0)];
+    FOR i := 1 TO n-1 DO
+      j := Get( index, i );
+      IF y[j] < y_min THEN y_min := y[j] END;
+      IF y[j] > y_max THEN y_max := y[j] END;
+    END;
+    
+    SetScale( x_min, x_max, x_scale_min, x_scale_max, x_scale_inc );
+    SetScale( y_min, y_max, y_scale_min, y_scale_max, y_scale_inc );
+    
+    MakePlot( out_file,
+               title, x, y, n, index,
+               x_scale_min, x_scale_max, y_scale_min, y_scale_max,
+               x_scale_inc, y_scale_inc );
+            
+    Destroy( index ); (* all done, get rid of the temporary index *)
+    
+  END Plot;
+
+  (* ---------------------------------------------------- *)
+  PROCEDURE MakePlot( file :ARRAY OF CHAR;
+                      title :ARRAY OF CHAR;
+                      x, y :ARRAY OF REAL; n :CARDINAL; index :CardArray;
+                      x_min, x_max, y_min, y_max, x_inc, y_inc :REAL );
+
+  CONST
+     tic_len = 11;
+       
+  VAR
+    x_size, y_size :REAL;
+    i, j           :CARDINAL; 
+    z              :REAL;
+
+    x_range, y_range, x_scale, y_scale :REAL;
+    x_pos, y_pos                       :REAL;
+
+  BEGIN
+        
+    GetDimensions( i, j );
+    x_size := FLOAT( i );
+    y_size := FLOAT( j );
+
+    x_range := x_max - x_min;
+    x_scale := x_size / x_range;
+
+    y_range := y_max - y_min;
+    y_scale := y_size / y_range;
+
+    BeginRegis( file );
+      
+    (* draw the axis *)
+    Move( 0, 0 ); Line( TRUNC( x_size ), 0 );
+    Move( 0, 0 ); Line( 0, TRUNC( y_size ) );
+      
+    (* put in the tick marks *)
+      
+    (* run along the x axis, putting in the numbers *)
+    (* run along the y axis, putting in the numbers *)
+    (* now draw the actual data points *)
+
+    (* go to the first data point *)
+
+    i := 0;
+    j := Get( index, i );
+    x_pos := ( x[j] - x_min ) * x_scale;
+    y_pos := ( y[j] - y_min ) * y_scale;
+    Move( TRUNC(x_pos), TRUNC(y_pos) );
+
+    FOR i := 1 TO n-1 DO
+
+       j := Get( index, i );
+       x_pos := ( x[j] - x_min ) * x_scale;
+       y_pos := ( y[j] - y_min ) * y_scale;
+               
+       Line( TRUNC(x_pos), TRUNC(y_pos) );
+
+    END;
+
+    Move( 100, 500 ); Text( title, 1 );
+
+    EndRegis;
+      
+  END MakePlot;
+    
+  (* ----------------------------------------------------- *)
+  PROCEDURE XYSort( x, y :ARRAY OF REAL; array_len :CARDINAL;
+                    index :CardArray );
+      
+  CONST
+    max_stack = 20;
+    n_small   = 6; (* use a simple sort for this size and smaller *)
+
+  VAR
+    L, R, i, j, k, n :INTEGER;
+
+    tos            :CARDINAL;
+    Lstack, Rstack :ARRAY [1..max_stack] OF INTEGER;
+
+    median :REAL;
+
+    (* -------------------------------- *)
+    PROCEDURE Swap( i, j :CARDINAL );
+    VAR  ctemp :CARDINAL;
+    BEGIN
+      ctemp := Get(index,i);
+      Put( index, i, Get(index,j) );
+      Put( index, j, ctemp );
+    END Swap;
+    
+  BEGIN
+
+    n := INTEGER( array_len ) - 1; (* back to zero offset *)
+
+    (* initialize the index *)
+    FOR i := 0 TO n DO
+       Put( index, i, i );
+    END;
+
+    tos := 0;
+
+    L := 0;  R := n;
+
+    (* PUSH very first set *)
+    tos := tos + 1;  Lstack[tos] := L;  Rstack[tos] := R;
+
+    REPEAT
+
+      (* POP *)
+      L := Lstack[tos];  R := Rstack[tos];  tos := tos - 1;
+
+      IF R - L + 1 > n_small THEN
+
+        REPEAT
+          i := L;  j := R;    median := x[Get(index,( L + R ) DIV 2)];
+
+          REPEAT
+            WHILE x[Get(index,i)] < median DO
+              i := i + 1;
+            END;
+            WHILE median < x[Get(index,j)] DO
+              j := j - 1;
+            END;
+
+            IF i <= j THEN
+              Swap( i, j );
+              i := i + 1;  j := j - 1;
+            END;
+          UNTIL i > j;
+
+          IF j - L < R - i THEN
+            IF i < R THEN (* PUSH *)
+              tos := tos + 1;  Lstack[tos] := i;  Rstack[tos] := R;
+            END;
+            R := j;
+          ELSE
+            IF L < j THEN (* push *)
+              tos := tos + 1;  Lstack[tos] := L;  Rstack[tos] := j;
+            END;
+            L := i;
+          END;
+
+        UNTIL L >= R;
+
+     ELSE
+
+       (* small sort for small number of values *)
+       FOR i := L TO R - 1 DO
+          FOR j := i TO R DO
+             IF x[Get(index,i)] > x[Get(index,j)] THEN
+               Swap( i, j );
+             END;
+          END;
+       END;
+
+     END; (* check for small *)
+
+   UNTIL tos = 0;
+ 
+   (* now look for duplicates of x, and sort those by y *)
+        
+   k := 1; (* start at second element *)
+   WHILE k <= n DO
+
+     IF x[Get(index,k)] = x[Get(index,k-1)] THEN
+
+       L := k - 1;    (* first of the duplicated x's *)
+
+       (* search for more duplictes *)
+       j := k;
+       WHILE ( j <= n ) & ( x[Get(index,L)] = x[Get(index,j)] ) DO
+         j := j + 1;
+       END;
+            
+       R := j - 1;   (* last of the duplicated x's *)
+
+       (* now sort between first and last by Y *)
+       FOR i := L TO R - 1 DO
+          FOR j := i TO R DO
+             IF y[Get(index,i)] > y[Get(index,j)] THEN
+               Swap( i, j );
+             END;
+          END;
+       END;
+
+       (* and advance the current index to the last of the duplicates *)
+       (* because all these values have been examined *)
+
+       k := R;
+            
+     END;
+          
+     k := k + 1;
+   END;
+
+ END XYSort;
+
+
+BEGIN
+END Plotter.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/randomly.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/randomly.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/randomly.mod
@@ -0,0 +1,169 @@
+IMPLEMENTATION MODULE Randomly;
+
+(* procedures for getting random numbers *)
+
+(* J. Andrea, Jun.2/92 - add NormalRandom *)
+(* J. Andrea, Oct.4/91, add min and max to RandomReal *)
+(* reorganized, J. Andrea, Aug.12/91 *)
+(* J. Andrea, 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM DateTime IMPORT TimeType, Time, ConvertTime;
+FROM MathLib0 IMPORT random, sqrt;
+
+VAR
+  seed :INTEGER;
+
+
+    (* --------------------------------------------- *)
+    PROCEDURE RandomReal( min, max :REAL ) :REAL;
+    (* return a real number X, such that min >= X < max *)
+
+    BEGIN
+
+       RETURN min + ( max - min ) * random( seed );
+
+    END RandomReal;
+
+    (* --------------------------------------------- *)
+    PROCEDURE NormalRandom( mean, sigma :REAL ) :REAL;
+    (* from CACM Aug.63, algorithm #200 *)
+    CONST
+       n = 13;
+    VAR
+       i   :CARDINAL;
+       sum :REAL;
+    BEGIN
+
+       sum := 0.0;
+       FOR i := 1 TO n DO
+         sum := sum + RandomReal( -1.0, +1.0 );
+       END;
+       RETURN mean + sigma * sum * sqrt( 3.0 / FLOAT( n ) );
+
+    END NormalRandom;
+
+    (* --------------------------------------------- *)
+    PROCEDURE Choose_0_To_N( n :CARDINAL) :CARDINAL;
+    (* return a value in the range  [0..n] *)
+
+    BEGIN
+
+       RETURN TRUNC( random(seed) * FLOAT(n+1) );
+
+    END Choose_0_To_N;
+
+    (* --------------------------------------------- *)
+    PROCEDURE Choose_0_To_N_Minus_1( n :CARDINAL) :CARDINAL;
+    (* return a value in the range  [0..n-1] *)
+
+    BEGIN
+
+       IF n < 2 THEN
+         RETURN 0;
+       ELSE
+
+         RETURN TRUNC( random(seed) * FLOAT(n) );
+
+       END;
+
+    END Choose_0_To_N_Minus_1;
+
+
+    (* --------------------------------------------- *)
+    PROCEDURE Choose_1_To_N( n :CARDINAL) :CARDINAL;
+    (* return a value in the range  [1..n] *)
+
+    BEGIN
+
+       IF n < 2 THEN
+         RETURN 1;
+       ELSE
+
+         RETURN TRUNC( random(seed) * FLOAT(n) ) + 1;
+
+       END;
+
+    END Choose_1_To_N;
+
+
+    (* --------------------------------------------- *)
+    PROCEDURE Choose_1_To_N_Minus_1( n :CARDINAL) :CARDINAL;
+    (* return a value in the range  [1..n-1] *)
+
+    BEGIN
+
+       IF n < 2 THEN
+         RETURN 1;
+       ELSE
+
+         RETURN TRUNC( random(seed) * FLOAT(n-1) ) + 1;
+
+       END;
+
+    END Choose_1_To_N_Minus_1;
+
+
+    (* --------------------------------------------- *)
+    PROCEDURE InputSeed( a_seed :INTEGER );
+    (* build a seed from a value from the input value *)
+
+    VAR
+      x :REAL;
+    BEGIN
+
+      (* make sure the seed is a positive large odd integer *)
+      seed := ABS(a_seed);
+      IF seed = 0 THEN
+         seed := 654321;
+      END; (* if *)
+
+      WHILE seed < 1000000 DO
+         seed := seed * 11;
+      END; (* while *)
+      IF NOT ODD(seed) THEN
+         seed := seed + 1;
+      END; (* if *)
+
+      (* call random a couple of times to get the seed going *)
+      x := random( seed );
+      x := random( seed );
+      x := random( seed );
+      
+    END InputSeed;
+
+    (* --------------------------------------------- *)
+    PROCEDURE MakeSeed;
+    (* build a seed from time of day *)
+
+    VAR
+      time_string          :ARRAY [0..80] OF CHAR;
+      now                  :TimeType;
+      seconds , i , factor :CARDINAL;
+      seed                 :INTEGER;
+
+    BEGIN
+
+      Time( now );     ConvertTime( now, time_string );
+
+      seconds := 0;
+      factor  := 3600;
+
+      FOR i := 12 TO 18 BY 3 DO
+         seconds := seconds + factor * 10 * ( ORD( time_string[i]   ) - 48 );
+         seconds := seconds + factor *      ( ORD( time_string[i+1] ) - 48 );
+         factor  := factor DIV 60;
+      END; (* for *)
+
+      (* give it the number of seconds since midnight *)
+      seed := INTEGER( seconds);
+
+      InputSeed( seed ); 
+
+    END MakeSeed;
+
+BEGIN
+
+   MakeSeed;
+
+END Randomly.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/realinout.def b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/realinout.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/realinout.def
@@ -0,0 +1,114 @@
+DEFINITION MODULE RealInOut;
+
+(*
+  This module provides procedures for the reading/writing and
+  formatting of floating point numbers.
+
+  Based loosely on the module of the same name as described in
+  Programming In Modula-2 3th edition
+*)
+(* Implemented by J. Andrea, Aug.8/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+
+EXPORT QUALIFIED Done, ReadReal, WriteReal, FWriteReal, EWriteReal,
+                 ToFString, ToEString;
+
+
+
+VAR
+   Done :BOOLEAN;  (* test Done after each I/O operation *)
+
+
+PROCEDURE ReadReal( VAR x :REAL );
+(*
+  Read a real number from standard input.
+  This procedure actually calls InOut.ReadReal so see that
+  procedure for details.
+*)
+
+
+
+PROCEDURE WriteReal( x :REAL; width :CARDINAL );
+(*
+  Write a real number to standard output.
+  This procedure actually calls InOut.WriteReal so see that
+  procedure for details.
+*)
+
+
+
+PROCEDURE FWriteReal( x :REAL; width, decimals :CARDINAL );
+(*
+  Write a real number to standard output with numeric formatting
+  as specified by the parameters 'width' and 'decimals'.
+  This procedure calls ToFString then InOut.WriteString so see
+  those procedures for details.
+*)
+
+PROCEDURE EWriteReal( x :REAL; width, decimals :CARDINAL );
+(*
+  Write a real number to standard output with numeric formatting
+  as specified by the parameters 'width' and 'decimals'.
+  This procedure calls ToEString then InOut.WriteString so see
+  those procedures for details.
+*)
+
+
+
+
+PROCEDURE ToFString( x :REAL; width, decimals :CARDINAL;
+                     VAR out_string :ARRAY OF CHAR );
+(*
+  This procedure will convert a real number (VAX F-Floating),
+    into a character string representation of that number using
+    the specified formatting parameters. The formatting is performed
+    in the same style as FORTRAN F formatting.
+
+  'width' is the total width of the output number representation, and
+  'decimals' is the number of places after the decimal point.
+
+  Be sure to consider the decimal point which is always printed,
+    and a possible negative sign when choosing a width.
+  If the number cannot be represented in 'width' characters then
+    the output string will contain all astreks.
+  A 'width' of zero will cause a null string to be returned.
+  If the size of the string is less than 'width' then 'width' will
+    be reduced to the size of the string.
+  If 'decimals' is >= 'width' then 'decimals' will be set to 'width'-1.
+  Examples:   number     width  decimals   output
+            12345.678      9      3       "12345.678"
+            12345.678      9      2       " 12345.68"
+            12345.678      9      1       "  12345.7"
+            12345.678      9      0       "   12346."
+            12345.678     10      4      "12345.6777"
+            12345.678      9      4       "*********"
+            12345.678      6      0          "12346."
+            12345.678      6      1          "******"
+           -12345.678     10      3      "-12345.678"
+           -12345.678      9      3       "*********"
+*)
+
+
+
+PROCEDURE ToEString( x :REAL; width, decimals :CARDINAL;
+                     VAR out_string :ARRAY OF CHAR );
+(*
+  This procedure will convert a real number (VAX F-Floating),
+    into a character string representation of that number using
+    the specified formatting parameters. The formatting is performed
+    in the same style as FORTRAN E formatting.
+
+  The operation of this procedure is similar to ToFString.
+  Examples:   number     width  decimals   output
+             12345.678       9       3       "0.123E+05"
+             12345.678       8       3       ".123E+05"
+             12345.678       7       3       "*******"
+             12345.678      12       6       "0.123457E+05"
+             12345.678      13       8       ".12345678E+05"
+             12345.678      14       9       ".123456777E+05"
+       0.0000012345678       9       3       "0.123E-05"
+       0.0000012345678       8       3       ".123E-05"
+*)
+
+END RealInOut.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/realinout.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/realinout.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/realinout.mod
@@ -0,0 +1,140 @@
+IMPLEMENTATION MODULE RealInOut;
+
+(* see the definition module for details *)
+(* Implemented by J. Andrea, Aug.8/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+IMPORT InOut;
+FROM FortranFormat IMPORT For$FFormat, For$EFormat;
+
+VAR string :ARRAY [0..132] OF CHAR;
+
+(* ---------------------------------------------------------------- *)
+PROCEDURE ReadReal( VAR x :REAL );
+BEGIN
+   InOut.ReadReal( x );            Done := InOut.Done;
+END ReadReal;
+
+
+(* ---------------------------------------------------------------- *)
+PROCEDURE WriteReal( x :REAL; width :CARDINAL );
+BEGIN
+   InOut.WriteReal( x, width );    Done := InOut.Done;
+END WriteReal;
+
+
+(* ---------------------------------------------------------------- *)
+PROCEDURE FWriteReal( x :REAL; width, decimals :CARDINAL);
+BEGIN (* FWriteReal *)
+
+   ToFString( x, width, decimals, string );
+
+   InOut.WriteString( string );     Done := InOut.Done;
+
+END FWriteReal;
+
+
+(* ---------------------------------------------------------------- *)
+PROCEDURE EWriteReal( x :REAL; width, decimals :CARDINAL);
+BEGIN (* EWriteReal *)
+
+   ToEString( x, width, decimals, string );
+
+   InOut.WriteString( string );     Done := InOut.Done;
+
+END EWriteReal;
+
+
+(* ---------------------------------------------------------------- *)
+PROCEDURE ToFString( x :REAL; width, decimals :CARDINAL;
+                     VAR string :ARRAY OF CHAR );
+
+VAR
+   len :CARDINAL;
+
+BEGIN (* ToFString *)
+
+  IF width = 0 THEN
+    (* impossible width, return nothing *)
+    string[0] := 0C;
+  ELSE
+
+    len := HIGH( string );
+
+    (* this set of code is an attempt to give something to the *)
+    (* user, even if the user has specified an invalid set of parameters *)
+
+    (* so the values of width and decimals which get used may may be *)
+    (* different here, from what was passed in as parameters *)
+
+    IF width > len THEN
+      (* if the specified width is longer than the output string *)
+      (* then choose a smaller width *)
+      width := len;
+    END;
+
+    IF decimals >= width THEN
+      (* decimal places can't be more than the total width *)
+      (* and there has to be one place for the decimal point too *)
+      decimals := width - 1;
+    END;
+
+    For$FFormat( x, width, decimals, string );
+
+    (* if possible, add a proper end to the output string *)
+    IF width < len THEN
+      string[width] := 0C;
+    END;
+
+  END;
+
+  Done := TRUE;
+
+END ToFString;
+
+
+(* ---------------------------------------------------------------- *)
+PROCEDURE ToEString( x :REAL; width, decimals :CARDINAL;
+                     VAR string :ARRAY OF CHAR );
+
+VAR
+   len :CARDINAL;
+
+BEGIN (* ToEString *)
+
+  IF width = 0 THEN
+    (* impossible width, return nothing *)
+    string[0] := 0C;
+  ELSE
+
+    len := HIGH( string );
+
+    (* this set of code is an attempt to give something to the *)
+    (* user, even if the user has specified an invalid set of parameters *)
+
+    (* so the values of width and decimals which get used may may be *)
+    (* different here, from what was passed in as parameters *)
+
+    IF width > len THEN
+      (* if the specified width is longer than the output string *)
+      (* then choose a smaller width *)
+      width := len;
+    END;
+
+    (* allow the lower level routine to handle an invalid 'decimals' *)
+
+    For$EFormat( x, width, decimals, string );
+
+    (* if possible, add a proper end to the output string *)
+    IF width < len THEN
+      string[width] := 0C;
+    END;
+
+  END;
+
+  Done := TRUE;
+
+END ToEString;
+
+BEGIN (* RealInOut *)
+END RealInOut.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/regisgrap.def b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/regisgrap.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/regisgrap.def
@@ -0,0 +1,84 @@
+DEFINITION MODULE REGISGraphics;
+
+(* simple REGIS Graphics routines *)
+(* J. Andrea, Apr.30/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+(*
+ This type of graphics is available on VT240, VT241, VT330, and VT430
+ terminals, which includes DECWindows DECTerm windows as well.
+
+ These modules differ slightly from standard REGIS calls in that the
+ standard is to have row values increasing from top to bottom, this set
+ of routines is more geared to X-Y graphics and so:
+ X direction is across columns, increasing from left to right, and
+ Y direction is along rows, increasing from top to bottom.
+
+ There is one known bug in these routines, if SYS$OUTPUT is the output
+ file for interactive graphics then the output may not be flushed after
+ every command so some segments may be missing. A way around this is to
+ close/open the output file after each screen is complete.
+*)
+
+
+EXPORT QUALIFIED
+   BeginRegis, EndRegis,
+   EraseScreen, GetDimensions,  GetPosition,
+   Border, Move, Dot, Line, Circle, Rectangle, VectorMove, VectorLine, Text,
+   Command;
+
+
+PROCEDURE BeginRegis( filename :ARRAY OF CHAR );
+(* define the output file to hold the graphics commands,
+   if interactive graphics then define filename as SYS$OUTPUT *)
+
+PROCEDURE EndRegis;
+(* close the current output file *)
+
+
+PROCEDURE EraseScreen;
+(* erase the whole display *)
+
+PROCEDURE GetDimensions( VAR x, y :CARDINAL );
+(* return the maximum possible dimensions of the display *)
+
+PROCEDURE GetPosition( VAR x, y :CARDINAL );
+(* return the current location of the cursor *)
+
+
+PROCEDURE Border;
+(* draw a border around the largest dimensions *)
+
+PROCEDURE Move( x, y :CARDINAL );
+(* move to the new location, make it the current point *)
+
+PROCEDURE Dot;
+(* draw a dot at the current location *)
+
+PROCEDURE Line( x, y :CARDINAL );
+(* draw a line from the current point to the new point,
+   and the new point will become the current point *)
+
+PROCEDURE Circle( radius :CARDINAL; filled :BOOLEAN );
+(* draw a circle of the given radius from the current point *)
+
+PROCEDURE Rectangle( width, height :CARDINAL; filled :BOOLEAN );
+(* draw a rectangle, one corner at current point,
+   opposite corner at current+width,current+height *)
+
+PROCEDURE VectorMove( length :CARDINAL; angle :REAL );
+(* move from the current location given a length and angle *)
+
+PROCEDURE VectorLine( length :CARDINAL; angle :REAL );
+(* draw a line from the current location given a length and angle,
+   and the new point will become the current point *)
+
+PROCEDURE Text( string :ARRAY OF CHAR; size :CARDINAL );
+(* put some text at the current location *)
+
+
+PROCEDURE Command( string :ARRAY OF CHAR );
+(* put some other REGIS command into the output stream *)
+
+
+END REGISGraphics.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/regisgrap.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/regisgrap.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/regisgrap.mod
@@ -0,0 +1,447 @@
+IMPLEMENTATION MODULE REGISGraphics;
+
+(* simple REGIS Graphics routines *)
+(* the offsets are used, but as far as the user is concerned there is
+   no offset, just that smaller dimensions are used *)
+(* J. Andrea, Apr.30/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM FileSystem IMPORT Done, Create, Close, WriteChar, File;
+FROM MathLib0   IMPORT sin, cos;
+
+CONST
+   absolute_rows = 475;
+   absolute_cols = 790;
+
+   row_offset    = 20;
+   col_offset    =  0;
+
+   max_rows      = absolute_rows - row_offset;
+   max_cols      = absolute_cols - col_offset;
+
+   esc = 33C;
+
+VAR
+  current_row, current_col :CARDINAL;
+  true_row,    true_col    :CARDINAL;
+
+  output_open, regis_on :BOOLEAN;
+
+  biggest :CARDINAL;
+
+  digits  :ARRAY [0..9] OF CHAR;
+  i       :CARDINAL;
+
+  outf :File;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE CheckLocation( row, col :CARDINAL; VAR new_row, new_col :CARDINAL );
+(* don't allow new position to be out of bounds *)
+BEGIN
+   IF row > max_rows THEN row := max_rows; END;
+   IF col > max_cols THEN col := max_cols; END;
+   new_row := row;   new_col := col;
+END CheckLocation;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE TrueLocation;
+(* and invert positions so that y (rows) run bottom to top,
+   and apply offsets as required *)
+BEGIN
+   true_row := absolute_rows - current_row;
+   true_col := current_col + col_offset;
+END TrueLocation;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Output( string :ARRAY OF CHAR );
+(* write the given string to the output file *)
+VAR i, L :CARDINAL;
+BEGIN
+  L := LEN( string ) - 1;
+  FOR i := 0 TO L DO
+    WriteChar( outf, string[i] );
+  END;
+END Output;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE OutputNumber( x :CARDINAL );
+(* assumption that x is less than 1000 *)
+
+BEGIN
+
+  IF x > 99 THEN
+
+    (* 3 digits *)
+
+    i := x DIV 100;
+    WriteChar( outf, digits[i] );
+    x := x - 100 * i;
+    i := x DIV 10;
+    WriteChar( outf, digits[i] );
+    x := x - 10 * i;
+    WriteChar( outf, digits[x] );
+
+  ELSE
+    IF x > 9 THEN
+
+      (* 2 digits *)
+
+      i := x DIV 10;
+      WriteChar( outf, digits[i] );
+      x := x - 10 * i;
+      WriteChar( outf, digits[x] );
+
+    ELSE
+
+      (* 1 digit *)
+
+      WriteChar( outf, digits[x] );
+
+    END;
+  END;
+
+END OutputNumber;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE BeginRegis( filename :ARRAY OF CHAR );
+(* define the output file to hold the graphics commands,
+   if interactive graphics then define filename as SYS$OUTPUT *)
+BEGIN
+  IF output_open THEN  EndRegis;  END;
+
+  Create( outf, filename, TRUE, FALSE );
+
+  IF Done() THEN
+    output_open := TRUE;
+    RegisOn;
+  END;
+END BeginRegis;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE EndRegis;
+(* close the current output file *)
+BEGIN
+  IF output_open THEN
+    RegisOff;
+    Close( outf );
+    output_open := FALSE;
+  END;
+END EndRegis;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE RegisOn;
+(* enter REGIS mode, this is required *)
+BEGIN
+  IF NOT regis_on THEN
+    regis_on := TRUE;
+    Output( esc ); Output( 'Pp' );
+    EraseScreen;  (* this seems to be required *)
+  END;
+END RegisOn;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE RegisOff;
+(* exit REGIS mode, this is required *)
+BEGIN
+  IF regis_on THEN
+    Output( esc ); Output( '\' );   regis_on := FALSE;
+  END;
+END RegisOff;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE EraseScreen;
+(* erase the whole display *)
+BEGIN
+  IF output_open THEN
+    Output( 'S(E)' );
+  END;
+END EraseScreen;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE GetDimensions( VAR columns, rows :CARDINAL );
+(* return the dimensions of the display *)
+BEGIN
+  columns := max_cols;
+  rows    := max_rows;
+END GetDimensions;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE GetPosition( VAR column, row :CARDINAL );
+(* return the current location of the cursor *)
+BEGIN
+  column := current_col;
+  row    := current_row;
+END GetPosition;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Border;
+(* draw a border *)
+BEGIN
+  IF output_open THEN
+    (* move to the corner *)
+    Output( 'P[0,' ); OutputNumber( row_offset ); Output( ']' );
+
+    (* output the lines to draw the border, using relative motion *)
+    Output( 'V(B)' );
+    Output( '[,+' ); OutputNumber( max_rows );
+    Output( '[+,' ); OutputNumber( max_cols );
+    Output( '[,-' ); OutputNumber( max_rows );
+    Output( '(E)' );
+  END;
+END Border;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Move( column, row :CARDINAL );
+(* move to the new location, make it the current point *)
+BEGIN
+  IF output_open THEN
+    CheckLocation( row, column, current_row, current_col );
+    TrueLocation;
+
+    Output( 'P[' );
+    OutputNumber( true_col );
+    Output( ',' );
+    OutputNumber( true_row );
+    Output( ']' );
+  END;
+END Move;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Dot;
+(* draw a dot at the current location *)
+BEGIN
+  IF output_open THEN
+    TrueLocation;
+
+    Output( 'P[' );
+    OutputNumber( true_col );
+    Output( ',' );
+    OutputNumber( true_row );
+    Output( ']V[]' );
+  END;
+END Dot;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Line( column, row :CARDINAL );
+(* draw a line from the current point to the new point *)
+BEGIN
+  IF output_open THEN
+    CheckLocation( row, column, current_row, current_col );
+    TrueLocation;
+
+    Output( 'V(S)[' );
+    OutputNumber( true_col );
+    Output( ',' );
+    OutputNumber( true_row );
+    Output( '](E)' );
+  END;
+END Line;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Circle( radius :CARDINAL; filled :BOOLEAN );
+(* draw a circle of the given radius from the current point *)
+BEGIN
+  IF output_open THEN
+    IF radius > biggest THEN radius := biggest; END;
+
+    IF filled THEN Output( 'F(' ); END;
+
+    Output( 'C[+' );
+    OutputNumber( radius );
+    Output( ']' );
+
+    IF filled THEN Output( ')' ); END;
+  END;
+END Circle;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Rectangle( width, height :CARDINAL; filled :BOOLEAN );
+(* draw a rectangle, one corner at current point,
+   opposite corner at current+width,current+height *)
+BEGIN
+  IF output_open THEN
+    IF width  + current_col > max_cols THEN
+      width  := max_cols - current_col; END;
+    IF height + current_row > max_rows THEN
+      height := max_rows - current_row; END;
+
+    IF filled THEN Output( 'F(' ); END;
+
+    Output( 'V(B)' );
+    Output( '[+' );
+    OutputNumber( width );
+    Output( ']' );
+    Output( '[,-' );
+    OutputNumber( height );
+    Output( ']' );
+    Output( '[-' );
+    OutputNumber( width );
+    Output( ']' );
+    Output( '(E)' );
+
+    IF filled THEN Output( ')' ); END;
+  END;
+END Rectangle;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Vector( length :CARDINAL; angle :REAL;
+                  VAR new_col, new_row :CARDINAL );
+
+VAR
+  a, z  :REAL;
+  delta :CARDINAL;
+
+  (* ------------------------ *)
+  PROCEDURE Delta( length :REAL ) :CARDINAL;
+  BEGIN
+    length := ABS( length );
+    IF length > FLOAT( biggest ) THEN
+      RETURN biggest;
+    ELSE
+      RETURN CARDINAL( TRUNC( length ) );
+    END;
+  END Delta;
+
+BEGIN
+
+   IF length > biggest THEN
+     length := biggest;
+   END;
+
+   a := ABS( angle );
+
+   WHILE a >= 360. DO
+     a := a - 360.
+   END;
+
+   IF angle >= 0. THEN
+     angle := a;
+   ELSE
+     angle := 360. - a;
+   END;
+
+   IF ( angle <= 1. ) OR ( angle >= 359. ) THEN
+     new_col := current_col + length;
+     new_row := current_row;
+   ELSE
+     IF ( angle >= 89. ) AND ( angle <= 91. ) THEN
+       new_row := current_row + length;
+       new_col := current_col;
+     ELSE
+       IF ( angle >= 179. ) AND ( angle <= 181. ) THEN
+         IF length >= current_col THEN
+           new_col := 0;
+         ELSE
+           new_col := current_col - length;
+         END;
+         new_row := current_row;
+       ELSE
+         IF ( angle >= 269. ) AND ( angle <= 271. ) THEN
+           IF length >= current_row THEN
+             new_row := 0;
+           ELSE
+             new_row := current_row - length;
+           END;
+           new_col := current_col;
+         ELSE
+
+           a := angle * 3.141592653 / 180.;
+
+           z := FLOAT( length ) * sin( a );
+
+           IF z >= 0. THEN
+             new_row := current_row + Delta(z);
+           ELSE
+             delta := Delta(z);
+             IF delta >= current_row THEN
+               new_row := 0;
+             ELSE
+               new_row := current_row - delta;
+             END;
+           END;
+
+           z := FLOAT( length ) * cos( a );
+
+           IF z >= 0. THEN
+             new_col := current_col + Delta(z);
+           ELSE
+             delta := Delta(z);
+             IF delta >= current_col THEN
+               new_col := 0;
+             ELSE
+               new_col := current_col - delta;
+             END;
+           END;
+
+         END;
+       END;
+     END;
+   END;
+
+END Vector;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE VectorLine( length :CARDINAL; angle :REAL );
+(* draw a line from the current location given a length and angle *)
+VAR
+  new_row, new_col :CARDINAL;
+
+BEGIN
+  IF output_open THEN
+    Vector( length, angle, new_col, new_row );
+    Line( new_col, new_row );
+  END;
+END VectorLine;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE VectorMove( length :CARDINAL; angle :REAL );
+(* move from the current location given a length and angle *)
+VAR
+  new_row, new_col :CARDINAL;
+
+BEGIN
+  IF output_open THEN
+    Vector( length, angle, new_col, new_row );
+    Move( new_col, new_row );
+  END;
+END VectorMove;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Text( string :ARRAY OF CHAR; size :CARDINAL );
+(* put up some text at the current location *)
+BEGIN
+  IF output_open THEN
+    IF size > biggest THEN size := biggest END;
+
+    Output( 'T(S' ); OutputNumber( size ); Output( ')' );
+    Output( "'" ); Output( string ); Output( "'" );
+  END;
+END Text;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Command( string :ARRAY OF CHAR );
+(* put some other REGIS command into the output stream *)
+BEGIN
+  IF output_open THEN
+    Output( string );
+  END;
+END Command;
+
+BEGIN (* REGISGraphics *)
+
+   current_row := 0; current_col := 0;
+
+   output_open := FALSE;
+   regis_on    := FALSE;
+
+   IF absolute_rows > absolute_cols THEN
+     biggest := absolute_rows;
+   ELSE
+     biggest := absolute_cols;
+   END;
+
+   FOR i := 0 TO 9 DO
+      digits[i] := CHAR( i + 48 );
+   END;
+
+END REGISGraphics.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/simplescr.def b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/simplescr.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/simplescr.def
@@ -0,0 +1,43 @@
+DEFINITION MODULE SimpleScreen;
+
+(*
+ Screen procedures with simple syntax
+
+ The procedure ErasePage must be called first to set up the display,
+ and afterwords the procedure ScreenFinished should be called to
+ exit screen mode and use ordinary IO again.
+*)
+
+(* J. Andrea Dec 1985,  using VMS V4 screen manipulation *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+
+EXPORT QUALIFIED
+   ErasePage,  EraseLine,  PutScreen,  SetCursor,  ReDrawScreen,
+   ScreenFinished;
+
+
+
+PROCEDURE ErasePage( row, col :CARDINAL );
+  (* move the cursor to the given row and column on the screen *)
+
+
+PROCEDURE EraseLine( row, col :CARDINAL );
+  (* erase the line from the given coordinates to the end of the screen *)
+
+
+PROCEDURE PutScreen( text :ARRAY OF CHAR; row, col :CARDINAL);
+  (* put output on the screen, no special features *)
+
+
+PROCEDURE SetCursor( row, col :CARDINAL);
+  (* move the cursor to the given row and column on the screen *)
+
+
+PROCEDURE ReDrawScreen;
+
+
+PROCEDURE ScreenFinished;
+
+
+END SimpleScreen.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/simplescr.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/simplescr.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/simplescr.mod
@@ -0,0 +1,135 @@
+IMPLEMENTATION MODULE SimpleScreen;
+
+(* J. Andrea Dec 1985,  VMS V4 screen manipulation *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SYSTEM IMPORT ADDRESS;
+
+FROM SSDefinitions IMPORT SS$_NORMAL;
+
+FROM SMGDefinitions IMPORT
+      SMG$C_ASCII,  SMG$V_BORDER,  SMG$M_NORMAL;
+
+FROM ScreenManagementProcedures IMPORT
+      SMG$CREATE_PASTEBOARD,         SMG$CREATE_VIRTUAL_DISPLAY,
+      SMG$DELETE_PASTEBOARD,
+      SMG$ERASE_DISPLAY,             SMG$ERASE_LINE,
+      SMG$PASTE_VIRTUAL_DISPLAY,     SMG$PUT_CHARS,
+      SMG$REPAINT_SCREEN,            SMG$SET_CURSOR_ABS;
+
+
+VAR
+   status, paste_board, virtual_display  :CARDINAL;
+   display_exists                        :BOOLEAN;
+   max_rows, max_cols                    :CARDINAL;
+
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE ErasePage( row, col :CARDINAL );
+
+      (* -------------------------------------------------------------- *)
+      PROCEDURE BuildDisplay;
+
+      BEGIN (* BuildDisplay *)
+         status := SMG$CREATE_PASTEBOARD( paste_board, 'TT:',
+                                          max_rows, max_cols, 0 );
+
+         IF status = SS$_NORMAL THEN
+            status := SMG$CREATE_VIRTUAL_DISPLAY( max_rows, max_cols,
+                                                  virtual_display,
+                                           BITSET(SMG$V_BORDER),
+                                           BITSET(SMG$M_NORMAL),
+                                                  SMG$C_ASCII );
+
+            IF status = SS$_NORMAL THEN
+               status := SMG$PASTE_VIRTUAL_DISPLAY( virtual_display,
+                                                    paste_board,
+                                                    1, 1,
+                                           ADDRESS( virtual_display ) );
+
+               IF status = SS$_NORMAL THEN
+                  display_exists := TRUE;
+               ELSE
+                 display_exists := FALSE;
+               END; (* if *)
+
+            ELSE
+               display_exists := FALSE;
+            END; (* if *)
+
+         ELSE
+            display_exists := FALSE;
+         END; (* if *)
+
+      END BuildDisplay;
+
+   BEGIN
+
+      IF display_exists THEN
+
+         status := SMG$ERASE_DISPLAY( virtual_display,
+                   INTEGER(row), INTEGER(col), max_rows, max_cols );
+
+      ELSE
+         BuildDisplay;
+      END; (* if *)
+ 
+   END ErasePage;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE ScreenFinished;
+   BEGIN (* ScreenFinished *)
+
+      IF display_exists THEN
+
+         status := SMG$DELETE_PASTEBOARD( paste_board, BITSET(0) );
+
+      END; (* if *)
+
+   END ScreenFinished;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE EraseLine( row, col :CARDINAL );
+   BEGIN (* EraseLine *)
+
+      status := SMG$ERASE_LINE( virtual_display,
+                                INTEGER(row), INTEGER(col) );
+
+   END EraseLine;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE PutScreen( text :ARRAY OF CHAR; row, col :CARDINAL);
+   BEGIN (* PutScreen *)
+
+      status := SMG$PUT_CHARS( virtual_display, text,
+                               INTEGER(row), INTEGER(col), 0,
+                        BITSET(SMG$M_NORMAL),
+                        BITSET(SMG$M_NORMAL),
+                               SMG$C_ASCII );
+
+   END PutScreen;
+
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE SetCursor( row, col :CARDINAL);
+   BEGIN (* SetCursor *)
+
+      status := SMG$SET_CURSOR_ABS( virtual_display,
+                                    INTEGER(row), INTEGER(col) );
+
+   END SetCursor;
+ 
+   (* ------------------------------------ *)
+   PROCEDURE ReDrawScreen;
+
+   BEGIN (* ReDrawScreen *)
+
+      status := SMG$REPAINT_SCREEN( paste_board );
+
+   END ReDrawScreen;
+
+BEGIN (* SimpleScreen *)
+
+   display_exists := FALSE;
+
+END SimpleScreen.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/simplewin.def b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/simplewin.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/simplewin.def
@@ -0,0 +1,152 @@
+DEFINITION MODULE SimpleWindows;
+
+(*
+ Simple windowing procedures based upon  VAX SMG$ Run Time Library procedures.
+ This set of procedures provides a simpler method of accessing the SMG$
+*)
+
+(* J. Andrea, 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED
+      action_status, PasteBoard, Display,
+      CreateDisplay, CreatePasteBoard, DeleteChars,    DeleteDisplay,
+      DeleteLine,    DeletePasteBoard, DrawLine,       DrawRectangle,
+      EraseChars,    EraseDisplay,     EraseLine,      InsertChars,
+      InsertLine,    LabelBorder,      MoveCursor,     MoveDisplay,
+      PasteDisplay,  PopDisplay,       PutChars,       PutLine,
+      PutWithScroll, RepaintScreen,    RepasteDisplay, RestoreScreen,
+      RingBell,      SaveScreen,       SetCursor,      SetPhysicalCursor,
+      ScrollDisplay, UnpasteDisplay,
+
+      AddBorder,     RemoveBorder,
+
+      VideoTypes,    VideoAttributes,   ChangeDisplayVideo;
+
+(* -------------------------------------------------------------------------- *)
+
+VAR
+   action_status :BOOLEAN;
+
+TYPE
+   PasteBoard; (* hidden *)
+   Display;    (* hidden *)
+
+
+TYPE
+   VideoTypes      = ( video_normal, video_bold, video_reverse, video_blink,
+                       video_underline );
+   VideoAttributes = SET OF VideoTypes;
+
+(* -------------------------------------------------------------------------- *)
+
+PROCEDURE CreateDisplay( VAR  display  :Display;
+                         rows, cols    :CARDINAL;
+                         border        :BOOLEAN );
+   
+PROCEDURE CreatePasteBoard( VAR  pasteboard :PasteBoard );
+
+PROCEDURE DeleteChars( display  :Display;
+                       n_chars  :CARDINAL;
+                       row, col :CARDINAL );
+
+PROCEDURE DeleteDisplay( display :Display );
+
+PROCEDURE DeleteLine( display    :Display;
+                      start_row  :CARDINAL;
+                      n_rows     :CARDINAL );
+
+PROCEDURE DeletePasteBoard( pasteboard :PasteBoard );
+
+PROCEDURE DrawLine( display              :Display;
+                    start_row, start_col :CARDINAL;
+                    end_row, end_col     :CARDINAL );
+
+PROCEDURE DrawRectangle( display       :Display;
+                         top_left_row  :CARDINAL;
+                         top_left_col  :CARDINAL;
+                         bot_right_row :CARDINAL;
+                         bot_right_col :CARDINAL );
+
+PROCEDURE EraseChars( display  :Display;
+                      n_chars  :CARDINAL;
+                      row, col :CARDINAL );
+
+PROCEDURE EraseDisplay( display              :Display;
+                        start_row, start_col :CARDINAL;
+                        end_row, end_col     :CARDINAL );
+
+PROCEDURE EraseLine( display  :Display;
+                     row, col :CARDINAL );
+
+PROCEDURE InsertChars( display  :Display;
+                       text     :ARRAY OF CHAR;
+                       row, col :CARDINAL );
+
+PROCEDURE InsertLine( display  :Display;
+                      row      :CARDINAL;
+                      text     :ARRAY OF CHAR );
+
+PROCEDURE LabelBorder( display :Display;
+                       text    :ARRAY OF CHAR );
+
+PROCEDURE MoveCursor( display              :Display;
+                      delta_row, delta_col :CARDINAL );
+
+PROCEDURE MoveDisplay( display     :Display;
+                       pasteboard  :PasteBoard;
+                       row, col    :CARDINAL );
+
+PROCEDURE PasteDisplay( display    :Display;
+                        pasteboard :PasteBoard;
+                        row, col   :CARDINAL );
+
+PROCEDURE PopDisplay( display    :Display;
+                      pasteboard :PasteBoard );
+
+PROCEDURE PutChars( display   :Display;
+                    text      :ARRAY OF CHAR;
+                    row, col  :CARDINAL );
+
+PROCEDURE PutLine( display   :Display;
+                   text      :ARRAY OF CHAR;
+                   line_adv  :CARDINAL );
+
+PROCEDURE PutWithScroll( display :Display;
+                         text    :ARRAY OF CHAR );
+
+PROCEDURE RepaintScreen( pasteboard :PasteBoard );
+
+PROCEDURE RepasteDisplay( display    :Display;
+                          pasteboard :PasteBoard;
+                          row, col   :CARDINAL );
+
+PROCEDURE RestoreScreen( pasteboard :PasteBoard;
+                         display    :Display );
+   
+PROCEDURE RingBell( display  :Display );
+
+PROCEDURE SaveScreen( pasteboard   :PasteBoard;
+                      VAR  display :Display );
+
+PROCEDURE SetCursor( display  :Display;
+                     row, col :CARDINAL );
+
+PROCEDURE SetPhysicalCursor( pasteboard :PasteBoard;
+                             row, col   :CARDINAL );
+
+PROCEDURE ScrollDisplay( display   :Display;
+                         direction :CARDINAL;
+                         count     :CARDINAL );
+
+PROCEDURE UnpasteDisplay( display    :Display;
+                          pasteboard :PasteBoard );
+
+PROCEDURE AddBorder( display :Display );
+
+PROCEDURE RemoveBorder( display :Display );
+
+PROCEDURE ChangeDisplayVideo( display   :Display;
+                              new_video :VideoAttributes );
+
+END SimpleWindows.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/simplewin.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/simplewin.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/simplewin.mod
@@ -0,0 +1,579 @@
+IMPLEMENTATION MODULE SimpleWindows;
+
+(* SMG Window management with a simple syntax *)
+(* J. Andrea, Aug.12/91 - routines updated *)
+(* JAA, Dec 1985, with regards to Gary Doucette *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SYSTEM IMPORT ADDRESS;
+
+FROM SSDefinitions IMPORT   SS$_NORMAL;
+
+FROM SMGDefinitions IMPORT
+      (* constants *)
+      SMG$C_ASCII,
+      SMG$K_TOP,     SMG$M_BORDER,  SMG$V_BORDER,
+      SMG$M_UP,
+      SMG$M_NORMAL,  SMG$M_BOLD, SMG$M_REVERSE,
+      SMG$M_BLINK,   SMG$M_UNDERLINE;
+
+FROM ScreenManagementProcedures IMPORT
+      (* procedures  *)
+      SMG$CREATE_PASTEBOARD,            SMG$CREATE_VIRTUAL_DISPLAY,
+      SMG$DELETE_CHARS,
+      SMG$DELETE_LINE,                  SMG$DELETE_PASTEBOARD,
+      SMG$DELETE_VIRTUAL_DISPLAY,       
+      SMG$DRAW_LINE,                    SMG$DRAW_RECTANGLE,
+      SMG$ERASE_CHARS,                  SMG$ERASE_DISPLAY,
+      SMG$ERASE_LINE,                   SMG$GET_DISPLAY_ATTR,
+      SMG$INSERT_CHARS,                 SMG$INSERT_LINE,
+      SMG$LABEL_BORDER,                 SMG$MOVE_VIRTUAL_DISPLAY,
+      SMG$PASTE_VIRTUAL_DISPLAY,        SMG$POP_VIRTUAL_DISPLAY,
+      SMG$PUT_CHARS,                    SMG$PUT_LINE,
+      SMG$PUT_WITH_SCROLL,              
+      SMG$REPAINT_SCREEN,
+      SMG$REPASTE_VIRTUAL_DISPLAY,      SMG$RESTORE_PHYSICAL_SCREEN,
+      SMG$RING_BELL,                    SMG$SAVE_PHYSICAL_SCREEN,
+      SMG$SET_CURSOR_ABS,               SMG$SET_CURSOR_REL,
+      SMG$SET_PHYSICAL_CURSOR,          SMG$SCROLL_DISPLAY_AREA,
+      SMG$UNPASTE_VIRTUAL_DISPLAY,
+
+      SMG$CHANGE_VIRTUAL_DISPLAY;
+
+
+TYPE 
+   PasteBoard = CARDINAL;   (* hidden *)
+   Display    = CARDINAL;   (* hidden *)
+
+
+VAR
+   insert_line_clr_flag                       :INTEGER;
+   save_screen_row_begin, save_screen_row_end :INTEGER;
+   pasteboard_initial_erase                   :INTEGER;
+   erase_pasteborard_on_delete                :INTEGER;
+   put_line_wrap_flag                         :CARDINAL;
+   put_line_direction                         :CARDINAL;
+   put_chars_rendition                        :CARDINAL;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE CreateDisplay( VAR  display    :Display;
+                                 rows, cols :CARDINAL;
+                                 border     :BOOLEAN  );
+
+   VAR
+      use_border :INTEGER;
+
+   BEGIN (* CreateDisplay *)
+
+      IF border THEN
+        use_border := SMG$M_BORDER;
+      ELSE
+        use_border := SMG$V_BORDER;
+      END; (* if *)
+
+      action_status := SS$_NORMAL = 
+               SMG$CREATE_VIRTUAL_DISPLAY( rows, cols, display,
+                                    BITSET(use_border), BITSET(SMG$M_NORMAL),
+                                           SMG$C_ASCII );
+
+   END CreateDisplay;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE CreatePasteBoard( VAR  pasteboard :PasteBoard );
+
+   VAR
+     rows, cols :CARDINAL;
+
+   BEGIN (* CreatePasteBoard *)
+
+      action_status := SS$_NORMAL =
+               SMG$CREATE_PASTEBOARD( pasteboard, 'TT:', rows, cols, 
+                       pasteboard_initial_erase );
+
+   END CreatePasteBoard;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE DeleteChars( display  :Display;
+                          n_chars  :CARDINAL;
+                          row, col :CARDINAL );
+
+   BEGIN (* DeleteChars *)
+
+      action_status := SS$_NORMAL =
+               SMG$DELETE_CHARS( display, n_chars, row, col );
+
+   END DeleteChars;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE DeleteDisplay( display :Display );
+
+   BEGIN (* DeleteDisplay *)
+
+      action_status := SS$_NORMAL = SMG$DELETE_VIRTUAL_DISPLAY( display );
+
+   END DeleteDisplay;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE DeleteLine( display    :Display;
+                         start_row  :CARDINAL;
+                         n_rows     :CARDINAL );
+
+   BEGIN (* DeleteLine *)
+
+      action_status := SS$_NORMAL = 
+                       SMG$DELETE_LINE( display, start_row, n_rows );
+
+   END DeleteLine;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE DeletePasteBoard( pasteboard :PasteBoard );
+
+   BEGIN (* DeletePasteBoard *)
+
+      action_status := SS$_NORMAL =
+                 SMG$DELETE_PASTEBOARD( pasteboard, 
+                       BITSET(erase_pasteborard_on_delete) );
+
+   END DeletePasteBoard;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE DrawLine( display     :Display;
+                       start_row, start_col :CARDINAL;
+                       end_row  , end_col   :CARDINAL );
+
+   BEGIN (* DrawLine *)
+
+      action_status := SS$_NORMAL =
+                SMG$DRAW_LINE( display, start_row, start_col, end_row, end_col,
+                        BITSET(SMG$M_NORMAL), BITSET(SMG$M_NORMAL) );
+
+   END DrawLine;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE DrawRectangle( display       :Display;
+                            top_left_row  :CARDINAL;
+                            top_left_col  :CARDINAL;
+                            bot_right_row :CARDINAL;
+                            bot_right_col :CARDINAL );
+
+   BEGIN (* DrawRectangle *)
+
+      action_status := SS$_NORMAL =
+                    SMG$DRAW_RECTANGLE( display, top_left_row, top_left_col,
+                          bot_right_row, bot_right_col,
+                          BITSET(SMG$M_NORMAL), BITSET(SMG$M_NORMAL) ); 
+
+   END DrawRectangle;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE EraseChars( display  :Display;
+                         n_chars  :CARDINAL;
+                         row, col :CARDINAL );
+
+   BEGIN (* EraseChars *)
+
+      action_status := SS$_NORMAL = 
+                       SMG$ERASE_CHARS( display, n_chars, row, col );
+
+   END EraseChars;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE EraseDisplay( display     :Display;
+                           start_row, start_col :CARDINAL;
+                           end_row  , end_col   :CARDINAL );
+
+   BEGIN (* EraseDisplay *)
+
+      action_status := SS$_NORMAL =
+                SMG$ERASE_DISPLAY( display, start_row, start_col,
+                                   end_row, end_col );
+
+   END EraseDisplay;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE EraseLine( display  :Display;
+                        row, col :CARDINAL );
+
+   BEGIN (* EraseLine *)
+
+      action_status := SS$_NORMAL = SMG$ERASE_LINE( display, row, col );
+
+   END EraseLine;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE InsertChars( display  :Display;
+                          text     :ARRAY OF CHAR;
+                          row, col :CARDINAL );
+
+   BEGIN (* InsertChars *)
+
+      action_status := SS$_NORMAL =
+               SMG$INSERT_CHARS( display, text, row, col, 
+                          BITSET(SMG$M_NORMAL),
+                          BITSET(SMG$M_NORMAL),
+                                 SMG$C_ASCII );
+
+   END InsertChars;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE InsertLine( display  :Display;
+                         row      :CARDINAL;
+                         text     :ARRAY OF CHAR );
+
+   BEGIN (* InsertLine *)
+
+      action_status := SS$_NORMAL =
+                SMG$INSERT_LINE( display, row, text, SMG$M_UP,
+                          BITSET(SMG$M_NORMAL), BITSET(SMG$M_NORMAL),
+                                 insert_line_clr_flag, SMG$C_ASCII );
+
+   END InsertLine;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE LabelBorder( display :Display;
+                          text    :ARRAY OF CHAR );
+
+   VAR
+       display_attr,
+       video_attr, char_set :CARDINAL;
+       units, height, width :CARDINAL;
+
+   BEGIN (* LabelBorder *)
+
+      action_status := SS$_NORMAL =
+               SMG$GET_DISPLAY_ATTR( display, height, width,
+                  BITSET(display_attr), BITSET(video_attr), char_set );
+
+      units := ( width - LEN( text ) ) DIV 2;
+
+      action_status := SS$_NORMAL =
+                SMG$LABEL_BORDER( display, text, SMG$K_TOP, units,
+                           BITSET(SMG$M_NORMAL), BITSET(SMG$M_NORMAL),
+                                  SMG$C_ASCII );
+
+   END LabelBorder;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE MoveCursor( display     :Display;
+                         delta_row, delta_col :CARDINAL );
+
+   BEGIN (* MoveCursor *)
+
+      action_status := SS$_NORMAL =
+                  SMG$SET_CURSOR_REL( display, delta_row, delta_col );
+
+   END MoveCursor;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE MoveDisplay( display    :Display;
+                          pasteboard :PasteBoard;
+                          row, col   :CARDINAL );
+
+   BEGIN (* MoveDisplay *)
+
+      action_status := SS$_NORMAL =
+                       SMG$MOVE_VIRTUAL_DISPLAY( display,
+                                                 pasteboard,
+                                                 row, col,
+                                        ADDRESS( display ) );
+
+   END MoveDisplay;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE PasteDisplay( display    :Display;
+                           pasteboard :PasteBoard;
+                           row, col   :CARDINAL );
+
+   BEGIN (* PasteDisplay *)
+
+      action_status := SS$_NORMAL =
+               SMG$PASTE_VIRTUAL_DISPLAY( display,
+                                          pasteboard,
+                                          row, col,
+                                 ADDRESS( display ) );
+
+   END PasteDisplay;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE PopDisplay( display    :Display;
+                         pasteboard :PasteBoard );
+
+   BEGIN (* PopDisplay *)
+
+      action_status := SS$_NORMAL =
+                 SMG$POP_VIRTUAL_DISPLAY( display, pasteboard );
+
+   END PopDisplay;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE PutChars( display   :Display;
+                       text      :ARRAY OF CHAR;
+                       row, col  :CARDINAL );
+
+   BEGIN (* PutChars *)
+
+      action_status := SS$_NORMAL = SMG$PUT_CHARS( display, text,
+                                                   row, col, 1,
+                                            BITSET(put_chars_rendition),
+                                            BITSET(put_chars_rendition),
+                                                   SMG$C_ASCII );
+
+   END PutChars;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE PutLine( display   :Display;
+                      text      :ARRAY OF CHAR;
+                      line_adv  :CARDINAL );
+
+   BEGIN (* PutLine *)
+
+      action_status := SS$_NORMAL = SMG$PUT_LINE( display, text,
+                                         INTEGER( line_adv ),
+                                          BITSET( put_chars_rendition ),
+                                          BITSET( put_chars_rendition ),
+                                          BITSET( put_line_wrap_flag ),
+                                                  SMG$C_ASCII,
+                                                  SMG$M_UP );
+
+   END PutLine;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE PutWithScroll( display :Display;
+                            text    :ARRAY OF CHAR );
+
+   BEGIN (* PutWithScroll *)
+
+      action_status := SS$_NORMAL = SMG$PUT_WITH_SCROLL( display, text,
+                                          BITSET( put_line_direction ),
+                                          BITSET( put_chars_rendition ),
+                                          BITSET( put_chars_rendition ),
+                                                  put_line_wrap_flag,
+                                                  SMG$C_ASCII );
+
+   END PutWithScroll;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE RepaintScreen( pasteboard :PasteBoard );
+
+   BEGIN (* RepaintScreen *)
+
+      action_status := SS$_NORMAL = SMG$REPAINT_SCREEN( pasteboard );
+
+   END RepaintScreen;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE RepasteDisplay( display    :Display;
+                             pasteboard :PasteBoard;
+                             row, col   :CARDINAL );
+
+   BEGIN (* RepasteDisplay *)
+
+      action_status := SS$_NORMAL =
+                SMG$REPASTE_VIRTUAL_DISPLAY( display, pasteboard,
+                                             row, col, display );
+
+   END RepasteDisplay;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE RestoreScreen( pasteboard :PasteBoard;
+                            display    :Display );
+   
+   BEGIN (* RestoreScreen *)
+
+      action_status := SS$_NORMAL =
+                SMG$RESTORE_PHYSICAL_SCREEN( pasteboard, display );
+
+   END RestoreScreen;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE RingBell( display :Display );
+
+   BEGIN (* RingBell *)
+
+      action_status := SS$_NORMAL =
+               SMG$RING_BELL( display, 1 );
+
+   END RingBell;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE SaveScreen( pasteboard   :PasteBoard;
+                         VAR  display :Display );
+
+   BEGIN (* SaveScreen *)
+
+      action_status := SS$_NORMAL =
+               SMG$SAVE_PHYSICAL_SCREEN( pasteboard, display,
+                      save_screen_row_begin, save_screen_row_end );
+
+   END SaveScreen;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE SetCursor( display  :Display;
+                        row, col :CARDINAL );
+
+   BEGIN (* SetCursor *)
+
+      action_status := SS$_NORMAL =
+                 SMG$SET_CURSOR_ABS( display, row, col );
+
+   END SetCursor;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE SetPhysicalCursor( pasteboard :PasteBoard;
+                                row, col   :CARDINAL );
+
+   BEGIN (* SetPhysicalCursor *)
+
+      action_status := SS$_NORMAL =
+               SMG$SET_PHYSICAL_CURSOR( pasteboard, row, col );
+
+   END SetPhysicalCursor;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE ScrollDisplay( display   :Display;
+                            direction :CARDINAL;
+                            count     :CARDINAL );
+
+   VAR
+      display_attr,
+      video_attr, char_set,
+      height, width        :CARDINAL;
+
+   BEGIN (* ScrollDisplay *)
+
+      action_status := SS$_NORMAL =
+                  SMG$GET_DISPLAY_ATTR( display, height, width,
+                                BITSET( display_attr ),
+                                BITSET( video_attr ), char_set );
+
+      action_status := SS$_NORMAL =
+                  SMG$SCROLL_DISPLAY_AREA( display, 1, 1, height, width,
+                                   BITSET( direction ), count );
+
+   END ScrollDisplay;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE UnpasteDisplay( display    :Display;
+                             pasteboard :PasteBoard );
+
+   BEGIN (* UnpasteDisplay *)
+
+      action_status := SS$_NORMAL =
+                 SMG$UNPASTE_VIRTUAL_DISPLAY( display, pasteboard );
+
+   END UnpasteDisplay;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE AddBorder( display :Display );
+
+   VAR
+       display_attributes, video_attributes, char_set :CARDINAL;
+       rows, cols    :CARDINAL;
+
+   BEGIN (* AddBorder *)
+
+      action_status := SS$_NORMAL =
+               SMG$GET_DISPLAY_ATTR( display, rows, cols,
+                             BITSET( display_attributes ),
+                             BITSET( video_attributes ),
+                                     char_set );
+
+      IF action_status THEN
+         action_status := SS$_NORMAL =
+                SMG$CHANGE_VIRTUAL_DISPLAY( display, rows, cols,
+                                    BITSET( SMG$M_BORDER ),
+                                    BITSET( video_attributes ),
+                                            char_set );
+      END; (* if *)
+
+   END AddBorder;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE RemoveBorder( display :Display );
+
+   VAR
+       display_attributes, video_attributes, char_set :CARDINAL;
+       rows, cols    :CARDINAL;
+
+   BEGIN (* RemoveBorder *)
+
+      action_status := SS$_NORMAL =
+               SMG$GET_DISPLAY_ATTR( display, rows, cols,
+                             BITSET( display_attributes ),
+                             BITSET( video_attributes ),
+                                     char_set );
+
+      IF action_status THEN
+         action_status := SS$_NORMAL =
+                SMG$CHANGE_VIRTUAL_DISPLAY( display, rows, cols,
+                                    BITSET( SMG$M_BORDER ),
+                                    BITSET( video_attributes ),
+                                            char_set );
+      END; (* if *)
+
+   END RemoveBorder;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE ChangeDisplayVideo( display   :Display;
+                                 new_video :VideoAttributes );
+
+   VAR
+       display_attributes, video_attributes, char_set :CARDINAL;
+       rows, cols    :CARDINAL;
+
+   BEGIN (* ChangeDisplayVideo *)
+
+      action_status := SS$_NORMAL =
+               SMG$GET_DISPLAY_ATTR( display, rows, cols,
+                             BITSET( display_attributes ),
+                             BITSET( video_attributes ),
+                                     char_set );
+
+      IF action_status THEN
+         (* get the new attributes *)
+         video_attributes := SMG$M_NORMAL;
+         IF video_bold IN new_video THEN
+            video_attributes := video_attributes + SMG$M_BOLD;
+         END;
+         IF video_reverse IN new_video THEN
+            video_attributes := video_attributes + SMG$M_REVERSE;
+         END;
+         IF video_blink IN new_video THEN
+            video_attributes := video_attributes + SMG$M_BLINK;
+         END;
+         IF video_underline IN new_video THEN
+            video_attributes := video_attributes + SMG$M_UNDERLINE;
+         END;
+         action_status := SS$_NORMAL =
+                SMG$CHANGE_VIRTUAL_DISPLAY( display, rows, cols,
+                                    BITSET( display_attributes ),
+                                    BITSET( video_attributes ),
+                                            char_set );
+      END; (* if *)
+
+   END ChangeDisplayVideo;
+
+   (* ------------------------------------------------------------------ *)
+   PROCEDURE ChangeDefaults;
+   BEGIN (* ChangeDefaults *)
+   END ChangeDefaults;
+
+
+BEGIN (* SimpleWindows *)
+
+   action_status := TRUE;
+
+   insert_line_clr_flag := 0;
+
+   save_screen_row_begin := 0;
+   save_screen_row_end   := 0;
+
+   pasteboard_initial_erase := 0;      (* yes *)
+   erase_pasteborard_on_delete := 0;   (* no  *)
+
+   put_line_wrap_flag := 0;
+   put_line_direction := SMG$M_UP;
+
+   put_chars_rendition := SMG$M_NORMAL;
+
+END SimpleWindows.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/systemcon.def b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/systemcon.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/systemcon.def
@@ -0,0 +1,21 @@
+%FOREIGN DEFINITION MODULE SystemConstants;
+
+(* VAX/VMS specific system constants *)
+(* J. Andrea, 1985*)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED
+                 WORDLENGTH, BYTELENGTH, MININT, MAXINT, MINCARD, MAXCARD;
+
+CONST
+
+   WORDLENGTH = 32;
+   BYTELENGTH =  8;
+
+   MININT     = -2147483647;
+
+   MAXINT     = +2147483647;
+   MINCARD    =           0;
+   MAXCARD    =  4294967295;
+
+END SystemConstants.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/veryscree.mod b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/veryscree.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/veryscree.mod
@@ -0,0 +1,274 @@
+IMPLEMENTATION MODULE VeryScreen;
+
+(* line and box drawing added, John Andrea, Sept.25/1991 *)
+(* John Andrea, Feb.1/1991 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM TTIO IMPORT WriteLn, WriteString;
+
+CONST
+   esc = 33C;   (* escape character *)
+
+TYPE
+   Number = ARRAY [0..2] OF CHAR;
+
+VAR
+  home                  :ARRAY [0..2] OF CHAR;
+  erase_screen          :ARRAY [0..2] OF CHAR;
+  erase_line            :ARRAY [0..2] OF CHAR;
+  cursor_on, cursor_off :ARRAY [0..5] OF CHAR;
+  put_cursor            :ARRAY [0..1] OF CHAR;
+
+  cursor_up,   cursor_down  :ARRAY [0..3] OF CHAR;
+  cursor_left, cursor_right :ARRAY [0..3] OF CHAR;
+
+  enter_graphics, exit_graphics :ARRAY [0..2] OF CHAR;
+
+  numbers               :ARRAY [0..132] OF Number;
+
+  row_string, col_string :Number;
+
+  i :CARDINAL;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE Box( row1, col1, row2, col2 :CARDINAL );
+   VAR nr, nc :CARDINAL;
+   BEGIN
+
+      (* flip around the rows and cols to find the minimum *)
+
+      IF col1 > col2 THEN
+        nc := col2;  col2 := col1;  col1 := nc;
+      END;
+      nc := col2 - col1;
+
+      IF nc > 0 THEN
+
+        IF row1 > row2 THEN
+          nr := row2;  row2 := row1;  row1 := nr;
+        END;
+        nr := row2 - row1;
+
+        IF nr > 0 THEN
+
+          PutCursor( row1, col1 );
+
+          WriteString( enter_graphics );
+
+          WriteString( 'l' );  (* first corner *)
+
+          FOR i := 1 TO nc - 1 DO
+             WriteString( 'q' );
+          END;
+
+          WriteString( 'k' );  (* second corner *)
+          WriteString( cursor_left ); WriteString( cursor_down );
+
+          FOR i := 1 TO nr - 1 DO
+             WriteString( 'x' );
+             WriteString( cursor_left ); WriteString( cursor_down );
+          END;
+
+          WriteString( 'j' );  (* third corner *)
+          WriteString( cursor_left );   WriteString( cursor_left );
+
+          FOR i := 1 TO nc - 1 DO
+             WriteString( 'q' );
+             WriteString( cursor_left );  WriteString( cursor_left );
+          END;
+
+          WriteString( 'm' );  (* fourth corner *)
+          WriteString( cursor_left ); WriteString( cursor_up );
+
+          FOR i := 1 TO nr - 1 DO
+             WriteString( 'x' );
+             WriteString( cursor_left ); WriteString( cursor_up );
+          END;
+
+          WriteString( exit_graphics );
+
+        END;
+
+      END;
+
+   END Box;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE Line( row1, col1, row2, col2 :CARDINAL );
+   VAR n :CARDINAL;
+   BEGIN
+
+      (* diagonal lines can't be drawn so simply assume its horizontal if *)
+      (* the columns arn't the same, putting the emphasis on horizontal   *)
+
+      IF col1 # col2 THEN
+
+        IF col1 > col2 THEN
+          PutCursor( row1, col2 );
+          n := col1 - col2;
+        ELSE
+          PutCursor( row1, col1 );
+          n := col2 - col1;
+        END;
+
+        IF n > 0 THEN
+  
+          WriteString( enter_graphics );
+          FOR i := 1 TO n DO
+             WriteString( 'q' );
+          END;
+          WriteString( exit_graphics );
+
+        END;
+
+      ELSE
+
+        IF row1 > row2 THEN
+          PutCursor( row2, col1 );
+          n := row1 - row2;
+        ELSE
+          PutCursor( row1, col1 );
+          n := row2 - row1;
+        END;
+
+        IF n > 0 THEN
+
+          WriteString( enter_graphics );
+          FOR i := 1 TO n DO
+             WriteString( 'x' );
+             WriteString( cursor_left ); WriteString( cursor_down );
+          END;
+          WriteString( exit_graphics );
+
+        END;
+
+      END;
+
+   END Line;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE Home;
+   BEGIN
+      WriteString( home );
+   END Home;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE EraseScreen;
+   BEGIN
+      WriteString( erase_screen );
+   END EraseScreen;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE EraseLine;
+   BEGIN
+      WriteString( erase_line );
+   END EraseLine;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE PutString( text :ARRAY OF CHAR; row, col :CARDINAL );
+   BEGIN
+       PutCursor( row, col );  WriteString( text );
+   END PutString;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE PutCursor( row, col :CARDINAL );
+   BEGIN
+
+      IF ( row < 0 ) OR ( row > 25 ) THEN
+        row_string := numbers[0];
+      ELSE
+        row_string := numbers[ row ];
+      END;
+
+      IF ( col < 0 ) OR ( col > 132 ) THEN
+        col_string := numbers[0];
+      ELSE
+        col_string := numbers[ col ];
+      END;
+
+      WriteString( put_cursor );
+      WriteString( row_string );  WriteString( ';' );
+      WriteString( col_string );  WriteString( 'H' );
+
+   END PutCursor;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE CursorOn( turn_on :BOOLEAN );
+   BEGIN
+
+      IF turn_on THEN
+        WriteString( cursor_on );
+      ELSE
+        WriteString( cursor_off );
+      END;
+
+   END CursorOn;
+ 
+BEGIN (* VeryScreen *)
+
+home         := ' [H';    home[0]         := esc;
+erase_screen := ' [J';    erase_screen[0] := esc;
+erase_line   := ' [K';    erase_line[0]   := esc;
+
+cursor_on  := ' [?25h';  cursor_on[0]  := esc;
+cursor_off := ' [?25l';  cursor_off[0] := esc;
+
+cursor_up    := ' [1A'; cursor_up[0]    := esc;
+cursor_down  := ' [1B'; cursor_down[0]  := esc;
+cursor_right := ' [1C'; cursor_right[0] := esc;
+cursor_left  := ' [1D'; cursor_left[0]  := esc;
+
+put_cursor := ' [';      put_cursor[0] := esc;
+
+enter_graphics := ' (0'; enter_graphics[0] := esc;
+exit_graphics  := ' (B'; exit_graphics[0] := esc;
+
+(* precompute the strings for numbers in range 0 to 132 *)
+
+numbers[0] := '000';  numbers[1] := '001';  numbers[2] := '002';
+numbers[3] := '003';  numbers[4] := '004';  numbers[5] := '005';
+numbers[6] := '006';  numbers[7] := '007';  numbers[8] := '008';
+numbers[9] := '009';  numbers[10] := '010'; numbers[11] := '011';
+numbers[12] := '012'; numbers[13] := '013'; numbers[14] := '014';
+numbers[15] := '015'; numbers[16] := '016'; numbers[17] := '017';
+numbers[18] := '018'; numbers[19] := '019'; numbers[20] := '020';
+numbers[21] := '021'; numbers[22] := '022'; numbers[23] := '023';
+numbers[24] := '024'; numbers[25] := '025'; numbers[26] := '026';
+numbers[27] := '027'; numbers[28] := '028'; numbers[29] := '029';
+numbers[30] := '030'; numbers[31] := '031'; numbers[32] := '032';
+numbers[33] := '033'; numbers[34] := '034'; numbers[35] := '035';
+numbers[36] := '036'; numbers[37] := '037'; numbers[38] := '038'; 
+numbers[39] := '039'; numbers[40] := '040'; numbers[41] := '041';
+numbers[42] := '042'; numbers[43] := '043'; numbers[44] := '044';
+numbers[45] := '045'; numbers[46] := '046'; numbers[47] := '047';
+numbers[48] := '048'; numbers[49] := '049'; numbers[50] := '050';
+numbers[51] := '051'; numbers[52] := '052'; numbers[53] := '053';
+numbers[54] := '054'; numbers[55] := '055'; numbers[56] := '056';
+numbers[57] := '057'; numbers[58] := '058'; numbers[59] := '059';
+numbers[60] := '060'; numbers[61] := '061'; numbers[62] := '062';
+numbers[63] := '063'; numbers[64] := '064'; numbers[65] := '065';
+numbers[66] := '066'; numbers[67] := '067'; numbers[68] := '068';
+numbers[69] := '069'; numbers[70] := '070'; numbers[71] := '071';
+numbers[72] := '072'; numbers[73] := '073'; numbers[74] := '074';
+numbers[75] := '075'; numbers[76] := '076'; numbers[77] := '077'; 
+numbers[78] := '078'; numbers[79] := '079'; numbers[80] := '080';
+numbers[81] := '081'; numbers[82] := '082'; numbers[83] := '083';
+numbers[84] := '084'; numbers[85] := '085'; numbers[86] := '086';
+numbers[87] := '087'; numbers[88] := '088'; numbers[89] := '089';
+numbers[90] := '090'; numbers[91] := '091'; numbers[92] := '092';
+numbers[93] := '093'; numbers[94] := '094'; numbers[95] := '095';
+numbers[96] := '096'; numbers[97] := '097'; numbers[98] := '098';
+numbers[99] := '099'; numbers[100] := '100'; numbers[101] := '101';
+numbers[102] := '102'; numbers[103] := '103'; numbers[104] := '104';
+numbers[105] := '105'; numbers[106] := '106'; numbers[107] := '107';
+numbers[108] := '108'; numbers[109] := '109'; numbers[110] := '110';
+numbers[111] := '111'; numbers[112] := '112'; numbers[113] := '113';
+numbers[114] := '114'; numbers[115] := '115'; numbers[116] := '116';
+numbers[117] := '117'; numbers[118] := '118'; numbers[119] := '119';
+numbers[120] := '120'; numbers[121] := '121'; numbers[122] := '122';
+numbers[123] := '123'; numbers[124] := '124'; numbers[125] := '125';
+numbers[126] := '126'; numbers[127] := '127'; numbers[128] := '128';
+numbers[129] := '129'; numbers[130] := '130'; numbers[131] := '131';
+numbers[132] := '132';
+
+END VeryScreen.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/fst/getchara.def b/examples/Modula-2_Libraries/andrea-m2/lib/fst/getchara.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/fst/getchara.def
@@ -0,0 +1,21 @@
+DEFINITION MODULE GetCharacter;
+
+(* John Andrea, Mar.27/92 *)
+(* This code may NOT be sold, it may be freely used and distributed *)
+
+  PROCEDURE Get(VAR ch: CHAR);
+  (* return a single character, no Carriage-Return needed *)
+
+  PROCEDURE GetNoWait(VAR ch: CHAR);
+  (* return a single character, no Carriage-Return needed *)
+  (* and don't wait till a character occurs, returns null character if there
+   * is no character in the buffer *)
+
+  PROCEDURE StartGet;
+  (* Enter single character mode *)
+
+  PROCEDURE StopGet;
+  (* Exit single character mode *)
+  (* And return to "carriage-return needed for input" mode *)
+
+END GetCharacter.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/fst/getchara.mod b/examples/Modula-2_Libraries/andrea-m2/lib/fst/getchara.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/fst/getchara.mod
@@ -0,0 +1,35 @@
+IMPLEMENTATION MODULE GetCharacter;
+
+(* John Andrea, Mar.27/92 *)
+(* This code may NOT be sold, it may be freely used and distributed *)
+
+FROM TermIO IMPORT Read, KeyPressed;
+
+  (* --------------------------------------------------------------- *)
+  PROCEDURE Get( VAR ch: CHAR) ;
+  BEGIN (* Get *)
+     Read( ch );
+  END Get;
+
+  (* --------------------------------------------------------------- *)
+  PROCEDURE GetNoWait( VAR ch: CHAR );
+  BEGIN
+    IF KeyPressed() THEN
+      Read( ch );
+    ELSE
+      ch := 0C;
+    END;
+  END GetNoWait;
+ 
+  (* --------------------------------------------------------------- *)
+  PROCEDURE StartGet;
+  BEGIN
+  END StartGet;
+
+  (* --------------------------------------------------------------- *)
+  PROCEDURE StopGet;
+  BEGIN
+  END StopGet;
+
+BEGIN
+END GetCharacter.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/fst/moreio.def b/examples/Modula-2_Libraries/andrea-m2/lib/fst/moreio.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/fst/moreio.def
@@ -0,0 +1,8 @@
+DEFINITION MODULE MoreIO;
+
+(* John Andrea, Mar.27/92 *)
+(* This code may NOT be sold, it may be freely used and distributed *)
+
+PROCEDURE ReadString( VAR string :ARRAY OF CHAR );
+
+END MoreIO.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/fst/moreio.mod b/examples/Modula-2_Libraries/andrea-m2/lib/fst/moreio.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/fst/moreio.mod
@@ -0,0 +1,55 @@
+IMPLEMENTATION MODULE MoreIO;
+
+(* John Andrea, Mar.27/92 *)
+(* This code may NOT be sold, it may be freely used and distributed *)
+
+FROM ASCII IMPORT EOL, EOF;
+FROM InOut IMPORT Read, Done;
+
+  (* ----------------------------------------------------- *)
+  PROCEDURE ReadString( VAR string :ARRAY OF CHAR );
+
+  CONST
+     tab = 11C;
+
+  VAR
+     c :CHAR;
+     i, max :CARDINAL;
+
+     (*------------------------------------------*)
+     PROCEDURE Eos( ch :CHAR ) :BOOLEAN;
+     BEGIN
+        RETURN ( ch <= ' ' ) OR ( ch = EOL );
+     END Eos;
+
+  BEGIN
+
+    max := HIGH( string );
+
+    (* skip leading spaces *)
+    Read(c);
+    WHILE ( c # EOF ) & ( ( c = ' ' ) OR ( c = tab ) OR ( c = EOL ) ) DO
+      Read(c);
+    END;
+
+    IF Done THEN
+        i := 0;
+        WHILE Done & NOT Eos(c) & ( i <= max ) DO
+           string[i] := c;
+           Read(c);  i := i + 1;
+        END;
+
+        IF i > max THEN
+          (* the end of the string has been reached *)
+          (* but maybe the input hasn't, keep reading any input string *)
+          WHILE Done & NOT Eos(c) DO
+             Read(c);
+          END;
+        ELSE
+         string[i] := 0C;
+        END;
+    END;
+  END ReadString;
+
+BEGIN
+END MoreIO.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/fst/moremath.def b/examples/Modula-2_Libraries/andrea-m2/lib/fst/moremath.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/fst/moremath.def
@@ -0,0 +1,26 @@
+DEFINITION MODULE MoreMath;
+
+(* John Andrea, Mar.27/92 *)
+(* This code may NOT be sold, it may be freely used and distributed *)
+
+PROCEDURE MinCard( a, b :CARDINAL ) :CARDINAL;
+(* return the smaller of 'a' and 'b' *)
+
+PROCEDURE MaxCard( a, b :CARDINAL ) :CARDINAL;
+(* return the larger of 'a' and 'b' *)
+
+
+PROCEDURE MinInt( a, b :INTEGER ) :INTEGER;
+(* return the smaller of 'a' and 'b' *)
+
+PROCEDURE MaxInt( a, b :INTEGER ) :INTEGER;
+(* return the larger of 'a' and 'b' *)
+
+
+PROCEDURE SizeCard( a :CARDINAL ) :CARDINAL;
+(* return the number of digits in the number *)
+
+PROCEDURE SizeInt( a :INTEGER ) :CARDINAL;
+(* return the number of digits in the number *)
+
+END MoreMath.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/fst/moremath.mod b/examples/Modula-2_Libraries/andrea-m2/lib/fst/moremath.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/fst/moremath.mod
@@ -0,0 +1,77 @@
+IMPLEMENTATION MODULE MoreMath;
+
+(* John Andrea, Mar.27/92 *)
+(* This code may NOT be sold, it may be freely used and distributed *)
+
+    PROCEDURE MinInt( a, b :INTEGER ) :INTEGER;
+    BEGIN
+
+       IF a <= b THEN
+         RETURN a;
+       ELSE
+         RETURN b;
+       END;
+
+    END MinInt;
+
+    PROCEDURE MaxInt( a, b :INTEGER ) :INTEGER;
+    BEGIN
+
+       IF a >= b THEN
+         RETURN a;
+       ELSE
+         RETURN b;
+       END;
+
+    END MaxInt;
+
+    PROCEDURE MinCard( a, b :CARDINAL ) :CARDINAL;
+    BEGIN
+
+       IF a <= b THEN
+         RETURN a;
+       ELSE
+         RETURN b;
+       END;
+
+    END MinCard;
+
+    PROCEDURE MaxCard( a, b :CARDINAL ) :CARDINAL;
+    BEGIN
+
+       IF a >= b THEN
+         RETURN a;
+       ELSE
+         RETURN b;
+       END;
+
+    END MaxCard;
+
+    PROCEDURE SizeCard( a :CARDINAL ) :CARDINAL;
+    BEGIN
+
+       IF a < 10 THEN
+         RETURN 1;
+       ELSE
+         RETURN 1 + SizeCard( a DIV 10 );
+       END;
+
+    END SizeCard;
+
+    PROCEDURE SizeInt( a :INTEGER ) :CARDINAL;
+    BEGIN
+
+       IF ABS( a ) < 10 THEN
+         IF a < 0 THEN
+           RETURN 2;   (* account for the minus sign *)
+         ELSE
+           RETURN 1;
+         END;
+       ELSE
+         RETURN 1 + SizeCard( a DIV 10 );
+       END;
+
+    END SizeInt;
+
+BEGIN (* MoreMath *)
+END MoreMath.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/fst/randomly.def b/examples/Modula-2_Libraries/andrea-m2/lib/fst/randomly.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/fst/randomly.def
@@ -0,0 +1,10 @@
+DEFINITION MODULE Randomly;
+
+(* John Andrea, Mar.27/92 *)
+(* This code may NOT be sold, it may be freely used and distributed *)
+
+PROCEDURE Choose_1_To_N( n :CARDINAL ) :CARDINAL;
+
+PROCEDURE Choose_0_To_N( n :CARDINAL ) :CARDINAL;
+
+END Randomly.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/fst/randomly.mod b/examples/Modula-2_Libraries/andrea-m2/lib/fst/randomly.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/fst/randomly.mod
@@ -0,0 +1,40 @@
+IMPLEMENTATION MODULE Randomly;
+(* for 16 bit computers *)
+(* $S-, $R-, $T- *)
+
+(* John Andrea, Mar.27/92 *)
+(* This code may NOT be sold, it may be freely used and distributed *)
+
+FROM TimeDate IMPORT Time, GetTime;
+
+CONST
+   modulus    = 65535;
+   multiplier = 25173;
+   increment  = 13849;
+
+VAR
+  seed :CARDINAL;
+  now  :Time;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Choose_1_To_N( n :CARDINAL ) :CARDINAL;
+BEGIN
+  seed := ( ( seed * multiplier ) + increment ) MOD modulus;
+
+  IF seed >= n THEN
+    RETURN 1 + ( seed MOD n );
+  ELSE
+    RETURN 1 + seed;
+  END;
+END Choose_1_To_N;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Choose_0_To_N( n :CARDINAL ) :CARDINAL;
+BEGIN
+   RETURN Choose_1_To_N( n + 1 ) - 1;
+END Choose_0_To_N;
+
+BEGIN
+  GetTime( now );   seed := now.millisec;
+  IF NOT ODD( seed ) THEN seed := seed + 1; END;
+END Randomly.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/fst/timer.def b/examples/Modula-2_Libraries/andrea-m2/lib/fst/timer.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/fst/timer.def
@@ -0,0 +1,10 @@
+DEFINITION MODULE Timer;
+
+(* get time stats, FST specific *)
+(* John Andrea, Mar.27/92 *)
+(* This code may NOT be sold, it may be freely used and distributed *)
+
+PROCEDURE StartTimer;
+PROCEDURE ShowTimer;
+
+END Timer.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/fst/timer.mod b/examples/Modula-2_Libraries/andrea-m2/lib/fst/timer.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/fst/timer.mod
@@ -0,0 +1,111 @@
+IMPLEMENTATION MODULE Timer;
+(* $S-, $R-, $T- *)
+(* get time stats *)
+
+(* John Andrea, Mar.27/92 *)
+(* This code may NOT be sold, it may be freely used and distributed *)
+
+FROM InOut IMPORT WriteString, WriteCard, WriteLn;
+FROM TimeDate IMPORT Time, GetTime;
+
+CONST
+  hours_per_day = 24;
+  min_per_day   = hours_per_day * 60;
+
+VAR
+  start, now :Time;
+  started    :BOOLEAN;
+  digits     :ARRAY [0..9] OF CHAR;
+  numbers    :ARRAY [0..99] OF ARRAY [0..1] OF CHAR;
+  i, j, k    :CARDINAL;
+
+(* -------------------------------------------------------- *)
+PROCEDURE StartTimer;
+BEGIN
+  started := TRUE;
+  GetTime( start );
+END StartTimer;
+
+(* -------------------------------------------------------- *)
+PROCEDURE ShowTimer;
+
+VAR
+  dday, dmin, dmil, d, h, m, s, u :CARDINAL;
+
+BEGIN
+  GetTime( now );
+
+  IF started THEN
+
+    (* the time is returned from GetTime in this style *)
+    (* .day is the day since 1900 *)
+    (* .minute is # minutes since midnight *)
+    (* .millisec is # millseconds past the minute *)
+
+    dday := now.day - start.day;
+
+    IF dday = 0 THEN
+      dmin := now.minute - start.minute;
+    ELSE
+      dmin := min_per_day + now.minute - start.minute;
+    END;
+
+    d := dday;
+    h := dmin DIV 60;
+    m := dmin - h * 60;
+
+    IF now.millisec >= start.millisec THEN
+      dmil := now.millisec - start.millisec;
+    ELSE
+
+      (* watch the order of the subtractions, card max is 65534 *)
+      dmil := start.millisec - now.millisec;
+      dmil := 60000 - dmil;
+
+      (* really one minute less than computed, propagate backwards *)
+      IF m > 0 THEN
+        m := m - 1;
+      ELSE
+        IF h > 0 THEN
+          h := h - 1;
+        ELSE
+          d := d - 1;
+        END;
+      END;
+
+    END;
+
+    s := dmil DIV 1000;
+    u := ( dmil - s * 1000 ) DIV 10;
+
+    WriteString( 'elapsed time: ' );
+                        WriteString( numbers[d] );
+    WriteString( ' ' ); WriteString( numbers[h] );
+    WriteString( ':' ); WriteString( numbers[m] );
+    WriteString( ':' ); WriteString( numbers[s] );
+    WriteString( '.' ); WriteString( numbers[u] );
+    WriteLn;
+
+  END;
+END ShowTimer;
+
+BEGIN
+
+  started := FALSE;
+
+  digits[0] := '0'; digits[1] := '1'; digits[2] := '2'; digits[3] := '3';
+  digits[4] := '4'; digits[5] := '5'; digits[6] := '6'; digits[7] := '7';
+  digits[8] := '8'; digits[9] := '9';
+
+  (* generate 2 digit strings for numbers 0 to 99 as a lookup table *)
+
+  k := 0;
+  FOR i := 0 TO 9 DO
+    FOR j := 0 TO 9 DO
+      numbers[k][0] := digits[i];
+      numbers[k][1] := digits[j];
+       k := k + 1;
+    END;
+  END;
+
+END Timer.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/fst/veryscre.def b/examples/Modula-2_Libraries/andrea-m2/lib/fst/veryscre.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/fst/veryscre.def
@@ -0,0 +1,26 @@
+DEFINITION MODULE VeryScreen;
+
+(* John Andrea, Mar.27/92 *)
+(* This code may NOT be sold, it may be freely used and distributed *)
+
+PROCEDURE Home;
+  (* move the cursor to top of screen *)
+
+PROCEDURE EraseScreen;
+  (* erase the screen from the cursor down *)
+
+PROCEDURE EraseLine;
+  (* erase from the cursor to then end of the current line *)
+
+PROCEDURE PutString( text :ARRAY OF CHAR; row, col :CARDINAL );
+  (* put some text at the given location *)
+
+PROCEDURE PutCursor( row, col :CARDINAL );
+  (* move the cursor to the given location *)
+
+PROCEDURE CursorOn( turn_on :BOOLEAN );
+  (* turn cursor on or off, true=on, false=off *)
+  (* if you forget to turn it back on at the end of your program *)
+  (* use the editor, it will force the cursor back on *)
+
+END VeryScreen.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/fst/veryscre.mod b/examples/Modula-2_Libraries/andrea-m2/lib/fst/veryscre.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/fst/veryscre.mod
@@ -0,0 +1,57 @@
+IMPLEMENTATION MODULE VeryScreen;
+
+(* John Andrea, Mar.27/92 *)
+(* This code may NOT be sold, it may be freely used and distributed *)
+
+FROM Strings IMPORT Length;
+FROM Display IMPORT SetCursorPosition, ClrEOS, ClrEOL, Write;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE Home;
+   BEGIN
+      SetCursorPosition( 1, 1 );
+   END Home;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE EraseScreen;
+   BEGIN
+      Home; ClrEOS;
+   END EraseScreen;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE EraseLine;
+   BEGIN
+      ClrEOL;
+   END EraseLine;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE PutString( text :ARRAY OF CHAR; row, col :CARDINAL );
+   VAR
+     i, max :CARDINAL;
+   BEGIN
+       PutCursor( row, col );
+
+       max := Length( text );
+       IF max > 0 THEN
+         max := max - 1;
+
+         FOR i := 0 TO max DO
+          Write( text[i] );
+         END;
+
+       END;
+   END PutString;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE PutCursor( row, col :CARDINAL );
+   BEGIN
+      SetCursorPosition( row, col );
+   END PutCursor;
+
+   (* ----------------------------------------------------------------- *)
+   PROCEDURE CursorOn( turn_on :BOOLEAN );
+   BEGIN
+   END CursorOn;
+ 
+BEGIN
+END VeryScreen.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/ascii.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/ascii.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/ascii.def
@@ -0,0 +1,46 @@
+DEFINITION MODULE ASCII;
+
+(* J. Andrea, 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED
+   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,  del;
+
+CONST
+   nul = 00C;   (* null  ,           control @ *)
+   soh = 01C;   (*                   control A *)
+   stx = 02C;   (*                   control B *)
+   etx = 03C;   (*                   control C *)
+   eot = 04C;   (*                   control D *)
+   enq = 05C;   (*                   control E *)
+   ack = 06C;   (*                   control F *)
+   bel = 07C;   (* bell ,            control G *)
+   bs  = 10C;   (* backspace ,       control H *)
+   ht  = 11C;   (* tab  ,            control I *)
+   lf  = 12C;   (* line feed ,       control J *)
+   vt  = 13C;   (*                   control K *)
+   ff  = 14C;   (* form feed ,       control L *)
+   cr  = 15C;   (* carriage return , control M *)
+   so  = 16C;   (*           ,       control N *)
+   si  = 17C;   (*                   control O *)
+   dle = 20C;   (*                   control P *)
+   dc1 = 21C;   (*                   control Q *)
+   dc2 = 22C;   (*                   control R *)
+   dc3 = 23C;   (*                   control S *)
+   dc4 = 24C;   (*                   control T *)
+   nak = 25C;   (*                   control U *)
+   syn = 26C;   (*                   control V *)
+   etb = 27C;   (*                   control W *)
+   can = 30C;   (*                   control X *)
+   em  = 31C;   (*                   control Y *)
+   sub = 32C;   (*                   control Z *)
+   esc = 33C;   (* escape ,          control [ *)
+   fs  = 34C;   (*                   control \ *)
+   gs  = 35C;   (*                   control ] *)
+   rs  = 36C;   (*                   control ^ *)
+   us  = 37C;   (*                   control _ *)
+   del = 177C;  (* del                         *)
+
+END ASCII.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/base2.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/base2.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/base2.def
@@ -0,0 +1,24 @@
+DEFINITION MODULE Base2;
+
+(*
+ Convert a base 10 value to/from base 2,
+ the base 2 value is specified as a character string containing "0" and "1"s
+*)
+(* John Andrea, Nov.18/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED Max10, HowMany2, ToBase2, FromBase2;
+
+PROCEDURE Max10() :CARDINAL;
+(* what is the largest base 10 number handled by this module *)
+
+PROCEDURE HowMany2( base10 :CARDINAL ) :CARDINAL;
+(* return the number of base2 digits used to represent the given base10 value *)
+
+PROCEDURE ToBase2( base10 :CARDINAL; VAR base2 :ARRAY OF CHAR;
+                   VAR ok :BOOLEAN );
+
+PROCEDURE FromBase2( base2 :ARRAY OF CHAR; VAR base10 :CARDINAL;
+                     VAR ok :BOOLEAN );
+
+END Base2.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/base2.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/base2.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/base2.mod
@@ -0,0 +1,131 @@
+IMPLEMENTATION MODULE Base2;
+
+(* for 16 bit machines use max_power = 15 *)
+(* for 32 bit machines use max_power = 31 *)
+(* John Andrea, Nov.18/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM StringOperations IMPORT Length;
+
+CONST
+  max_power = 31;
+
+VAR
+  power2 :ARRAY [0..max_power] OF CARDINAL;
+  max_value, i :CARDINAL;
+
+  (* --------------------------------------------------------- *)
+  PROCEDURE Max10() :CARDINAL;
+  BEGIN
+     RETURN max_value;
+  END Max10;
+
+  (* --------------------------------------------------------- *)
+  PROCEDURE HowMany2( base10 :CARDINAL ) :CARDINAL;
+  (* return the number of base 2 digits needed to represent 'base10' *)
+  VAR n :CARDINAL;
+  BEGIN
+
+     IF base10 < 2 THEN
+       n := 1;
+     ELSE
+
+       (* find the largest position in the power list *)
+       n := 0;
+       WHILE base10 >= power2[n] DO
+         n := n + 1;
+       END;
+
+     END;
+
+     RETURN n;
+
+  END HowMany2;
+
+  (* --------------------------------------------------------- *)
+  PROCEDURE ToBase2( base10 :CARDINAL; VAR base2 :ARRAY OF CHAR; VAR ok :BOOLEAN );
+  VAR
+    n, i, j :CARDINAL;
+    high    :CARDINAL;
+
+  BEGIN
+
+    high := HIGH( base2 );
+
+    IF base10 = 0 THEN
+      ok := TRUE;
+
+      base2[0] := '0';
+      IF high > 0 THEN base2[1] := 0C; END;
+
+    ELSE
+
+      IF base10 > max_value THEN
+        ok := FALSE;
+        base2[0] := 0C;
+      ELSE
+
+        n := HowMany2( base10 ) - 1;
+        IF n > high THEN
+          ok := FALSE;
+          base2[0] := 0C;
+        ELSE
+
+          (* for each of the powers of 2, count their numbers *)
+          FOR i := 0 TO n DO
+             j := n - i;
+             IF base10 >= power2[j] THEN
+               base10   := base10 - power2[j];
+               base2[i] := '1';
+             ELSE
+               base2[i] := '0';
+             END;
+          END;
+
+          IF high > n THEN base2[n+1] := 0C; END;
+       END;
+      END;
+    END;
+
+  END ToBase2;
+
+  (* --------------------------------------------------------- *)
+  PROCEDURE FromBase2( base2 :ARRAY OF CHAR; VAR base10 :CARDINAL; VAR ok :BOOLEAN );
+  VAR
+    i, n, d :CARDINAL;
+    c       :CHAR;
+  BEGIN
+     ok     := TRUE;
+     base10 := 0;
+
+     n := Length( base2 );
+
+     i := 0;
+     WHILE ( i < n ) & ok DO
+
+       c := base2[i];
+       IF c = '0' THEN
+         d := 0;
+       ELSIF c = '1' THEN
+         d := 1;
+       ELSE
+         ok := FALSE;  d := 0;
+       END;
+
+       base10 := base10 * 2 + d;
+       i := i + 1;
+     END;
+
+  END FromBase2;
+
+BEGIN
+
+  (* precompute the powers of 2 *)
+  power2[0] := 1;
+  FOR i := 1 TO max_power DO
+     power2[i] := 2 * power2[i-1];
+  END;
+
+  max_value := power2[max_power];
+
+END Base2.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/base3.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/base3.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/base3.def
@@ -0,0 +1,24 @@
+DEFINITION MODULE Base3;
+
+(*
+ Convert a base 10 number to base 3,
+ the base 3 value is represented as a string of characters "0", "1", "2".
+*)
+(* John Andrea, Nov.18/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED Max10, HowMany3, ToBase3, FromBase3;
+
+PROCEDURE Max10() :CARDINAL;
+(* what is the largest base 10 number handled by this module *)
+
+PROCEDURE HowMany3( base10 :CARDINAL ) :CARDINAL;
+(* return the number of base3 digits used to represent the given base10 value *)
+
+PROCEDURE ToBase3( base10 :CARDINAL; VAR base3 :ARRAY OF CHAR;
+                   VAR ok :BOOLEAN );
+
+PROCEDURE FromBase3( base3 :ARRAY OF CHAR; VAR base10 :CARDINAL;
+                     VAR ok :BOOLEAN );
+
+END Base3.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/base3.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/base3.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/base3.mod
@@ -0,0 +1,138 @@
+IMPLEMENTATION MODULE Base3;
+
+(* John Andrea, Nov.18/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+(* for 16 bit machines use max_power of 11 *)
+(* for 32 bit machines use max_power of 20 *)
+
+FROM StringOperations IMPORT Length;
+
+CONST
+  max_power = 20;
+
+VAR
+  power3 :ARRAY [0..max_power] OF CARDINAL;
+  max_value, i :CARDINAL;
+
+  (* --------------------------------------------------------- *)
+  PROCEDURE Max10() :CARDINAL;
+  BEGIN
+     RETURN max_value;
+  END Max10;
+
+  (* --------------------------------------------------------- *)
+  PROCEDURE HowMany3( base10 :CARDINAL ) :CARDINAL;
+  (* return the number of base 3 digits needed to represent 'x' *)
+  VAR n :CARDINAL;
+  BEGIN
+
+     IF base10 < 3 THEN
+       n := 1;
+     ELSE
+
+       (* find the largest position in the power list *)
+       n := 0;
+       WHILE base10 >= power3[n] DO
+         n := n + 1;
+       END;
+
+     END;
+
+     RETURN n;
+
+  END HowMany3;
+
+  (* --------------------------------------------------------- *)
+  PROCEDURE ToBase3( base10 :CARDINAL; VAR base3 :ARRAY OF CHAR; VAR ok :BOOLEAN );
+  VAR
+    n, i, j, k, high :CARDINAL;
+
+  BEGIN
+
+    high := HIGH( base3 );
+
+    IF base10 = 0 THEN
+      ok := TRUE;
+      base3[0] := '0';
+      IF high > 0 THEN base3[1] := 0C; END;
+    ELSE
+
+      IF base10 > max_value THEN
+        ok := FALSE;
+        base3[0] := 0C;
+      ELSE
+
+        n := HowMany3( base10 ) - 1;
+
+        IF n > HIGH( base3 ) THEN
+          ok := FALSE;
+          base3[0] := 0C;
+        ELSE
+
+          (* for each of the powers of 3, count their numbers *)
+          FOR i := 0 TO n DO
+             j := n - i;
+             k := 0;
+             WHILE base10 >= power3[j] DO
+               k      := k + 1;
+               base10 := base10 - power3[j];
+             END;
+             IF k = 0 THEN
+               base3[i] := '0';
+             ELSIF k = 1 THEN
+               base3[i] := '1';
+             ELSE
+               base3[i] := '2';
+             END;
+          END;
+
+          IF high > n THEN base3[n+1] := 0C; END;
+       END;
+      END;
+    END;
+
+  END ToBase3;
+
+  (* --------------------------------------------------------- *)
+  PROCEDURE FromBase3( base3 :ARRAY OF CHAR; VAR base10 :CARDINAL; VAR ok :BOOLEAN );
+  VAR
+    i, n, d :CARDINAL;
+    c       :CHAR;
+  BEGIN
+     ok     := TRUE;
+     base10 := 0;
+
+     n := Length( base3 );
+
+     i := 0;
+     WHILE ( i < n ) & ok DO
+
+       c := base3[i];
+       IF c = '0' THEN
+         d := 0;
+       ELSIF c = '1' THEN
+         d := 1;
+       ELSIF c = '2' THEN
+         d := 2;
+       ELSE
+         ok := FALSE;  d := 0;
+       END;
+
+       base10 := base10 * 3 + d;
+       i := i + 1;
+     END;
+
+  END FromBase3;
+
+BEGIN
+
+  (* precompute the powers of 3 *)
+  power3[0] := 1;
+  FOR i := 1 TO max_power DO
+     power3[i] := 3 * power3[i-1];
+  END;
+
+  max_value := power3[max_power];
+
+END Base3.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/bitmapope.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/bitmapope.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/bitmapope.def
@@ -0,0 +1,79 @@
+DEFINITION MODULE BitmapOperations;
+
+(* Bitmap operations using dynamic memory *)
+
+(* V1.1, J. Andrea, Jun.22/93 -add Duplicate *)
+(* V1.0, J. Andrea, Mar.18/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+(*
+* For those operations which return a status in the boolean 'ok',
+* the value of 'ok' should be checked before attempting to use the
+* resultant bitmap.
+* If 'ok' is FALSE, then the resultant bitmap will not exist.
+*)
+
+EXPORT QUALIFIED Bitmap,                           (* the type *)
+                 Build, Destroy,                   (* matrix creation/deletion*)
+                 Put, Get,                         (* element access *)
+                 Size, Compare,                    (* status *)
+                 Clear, Copy, Duplicate,           (* new copy *)
+                 Not, And, Or, Xor,                (* advanced operations *)
+                 Line,                             (* advanced operations *)
+                 PrintText, PrintSixel, PrintPS;   (* output to a file *)
+
+TYPE Bitmap;   (* opaque *)
+
+PROCEDURE Build( VAR a :Bitmap; rows, columns :CARDINAL );
+(* create a bitmap of the specified size *)
+
+PROCEDURE Destroy( VAR a :Bitmap );
+(* get rid of the specified bitmap *)
+
+PROCEDURE Put( a :Bitmap; row, col :CARDINAL; set :CARDINAL );
+(* 'set'=0 means turn off, =1 is turn on, =2 is flip, bit at 'row,col' *)
+
+PROCEDURE Get( a :Bitmap; row, col :CARDINAL ) :BOOLEAN;
+(* return the value at 'row,col' *)
+
+PROCEDURE Size( a :Bitmap; VAR rows, cols :CARDINAL );
+(* return the size of a bitmap *)
+
+PROCEDURE Compare( a, b :Bitmap ) :BOOLEAN;
+(* compare two bitmaps, return TRUE if they are the same *)
+
+PROCEDURE Clear( a :Bitmap );
+(* set the whole bitmap to off *)
+
+PROCEDURE Copy( a, b :Bitmap );
+(* copy 'a' into a 'b', iff sizes are the same *)
+
+PROCEDURE Duplicate( a :Bitmap; VAR b :Bitmap );
+(* copy bitmap 'a' into a new bitmap 'b' *)
+
+PROCEDURE Not( a :Bitmap; VAR b :Bitmap );
+(* invert every dot in 'a' into new bitmap 'b' *)
+
+PROCEDURE And( a, b :Bitmap; VAR c :Bitmap; VAR ok :BOOLEAN );
+(* perform AND on all elements in 'a' with 'b', giving 'c' *)
+
+PROCEDURE Or( a, b :Bitmap; VAR c :Bitmap; VAR ok :BOOLEAN );
+(* perform OR on all elements in 'a' with 'b', giving 'c' *)
+
+PROCEDURE Xor( a, b :Bitmap; VAR c :Bitmap; VAR ok :BOOLEAN );
+(* perform XOR on all elements in 'a' with 'b', giving 'c' *)
+
+PROCEDURE Line( a :Bitmap; row1, col1, row2, col2 :CARDINAL; set :CARDINAL );
+(* draw a line from position 1 to position 2, same option as Put *)
+
+PROCEDURE PrintText( a :Bitmap; file_name :ARRAY OF CHAR; VAR ok :BOOLEAN );
+(* print the bitmap into a simple text file using simple characters *)
+
+PROCEDURE PrintSixel( a :Bitmap; file_name :ARRAY OF CHAR; VAR ok :BOOLEAN );
+(* print the bitmap into Sixel graphics file, for DEC line printers *)
+
+PROCEDURE PrintPS( a :Bitmap; file_name :ARRAY OF CHAR; size :CARDINAL;
+                   VAR ok :BOOLEAN );
+(* print the bitmap into graphic PostScript file, each dot being 'size' points *)
+
+END BitmapOperations.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/bitmapope.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/bitmapope.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/bitmapope.mod
@@ -0,0 +1,671 @@
+IMPLEMENTATION MODULE BitmapOperations;
+
+(* Known bug - on the compare, all of the last set should not be compared *)
+
+(* Bitmap operations using dynamic memory, see the corresponding definition *)
+(* V2.1, J. Andrea, Jun.22/93 - add Duplicate *)
+(* V2.0, J. Andrea, Jun.17/93 - get bitmap size at runtime *)
+(* V1.0, J. Andrea, Mar.18/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+(*
+* A bitmap is implemented as a collection of BITSETS, each bit in the set is
+* accessed as required by calculating the memory offset to the bitset containing
+* the requested bit, then the offset into that bitset to get the specific bit.
+* The global operations (Clear, And, Or, etc.) are performed not one bit at a
+* time, but on one BITSETS a time.
+* The single bit operations, Put and Get, must be performed on one bit.
+*)
+
+FROM SYSTEM IMPORT TSIZE, ADDRESS;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+FROM FileSystem IMPORT Done, Create, Close, WriteChar, File, EOL;
+FROM StringOperations IMPORT Length;
+
+TYPE
+  Bitmap = POINTER TO RECORD
+             rows, cols :CARDINAL;   (* dimensions of the bitmap *)
+             start      :ADDRESS;    (* memory address of the first item *)
+             size       :CARDINAL;   (* actual size of the bitmap in bytes *)
+             in_last    :CARDINAL;   (* number of bits used in last bitset *)
+             sets       :CARDINAL;   (* number of bitsets *)
+           END;
+
+  DataType = BITSET;
+
+VAR
+  bset_bits, bset_bytes :CARDINAL;
+  empty, full           :BITSET;
+  digits                :ARRAY [0..9] OF CHAR;
+  outf                  :File;
+  i                     :CARDINAL;
+
+
+(* ---------------------------------------------------- *)
+PROCEDURE WriteLn;
+BEGIN
+  WriteChar( outf, EOL );
+END WriteLn;
+
+(* ---------------------------------------------------- *)
+PROCEDURE WriteString( s :ARRAY OF CHAR );
+VAR
+  i, n :CARDINAL;
+BEGIN
+  n := Length( s );
+  IF n > 0 THEN
+    n := n - 1;
+    FOR i := 0 TO n DO
+      WriteChar( outf, s[i] );
+    END;
+  END;
+END WriteString;
+
+(* ---------------------------------------------------- *)
+PROCEDURE WriteCard( x :CARDINAL );
+VAR
+  y :CARDINAL;
+BEGIN
+  IF x < 10 THEN
+    WriteChar( outf, digits[x] );
+  ELSE
+    y := x DIV 10;
+    WriteCard( y );
+    WriteCard( x - y * 10 );
+  END;
+END WriteCard;
+
+(* -------------------------------------------------------- *)
+PROCEDURE InRange( a :Bitmap; row, col :CARDINAL ) :BOOLEAN;
+(* is the specified row/col item in this bitmap *)
+BEGIN
+  RETURN ( row >= 1 ) & ( row <= a^.rows ) & ( col >= 1 ) & ( col <= a^.cols );
+END InRange;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Offset( a :Bitmap; row, col :CARDINAL; VAR set, bit :CARDINAL );
+(* calculate the memory offset to the row/col item from the first item *)
+VAR
+  which_dot :CARDINAL;
+BEGIN
+
+  (* the bitmap is treated as a long string of bits *)
+  (* with one row laid after another                *)
+  (* calculate the position of this dot             *)
+  (* subtract the extra 1 here rather than twice later *)
+
+  which_dot := ( row - 1 ) * a^.cols + col - 1;
+
+  (* the bits are grouped into sets of 32 (imp. dep.) each *)
+  (* calculate which set this dot belongs to   *)
+  (* - this is an offset from the first, so it should be zero based *)
+
+  set := which_dot DIV bset_bits;
+
+  (* and how far into this set is the dot that we need *)
+
+  bit := which_dot - set * bset_bits;
+
+END Offset;
+
+(* -------------------------------------------------------- *)
+PROCEDURE ReverseOffset( a :Bitmap; set, bit :CARDINAL; VAR row, col :CARDINAL );
+(* given item position, calculate row and column *)
+VAR
+  which_dot :CARDINAL;
+BEGIN
+  which_dot := ( set - 1 ) * bset_bits + bit;
+  row       := 1 + ( which_dot DIV a^.cols );
+  col       := which_dot - ( ( row - 1 ) * a^.cols );
+END ReverseOffset;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Build( VAR a :Bitmap; n_rows, n_columns :CARDINAL );
+VAR
+  n_bits :CARDINAL;
+BEGIN
+  NEW( a );
+
+  (* protect users from themselves *)
+  IF n_rows    = 0 THEN n_rows    := 1 END;
+  IF n_columns = 0 THEN n_columns := 1 END;
+
+
+  a^.rows := n_rows;
+  a^.cols := n_columns;
+
+  n_bits  := n_rows * n_columns;
+
+  a^.in_last := n_bits MOD bset_bits;
+
+  IF a^.in_last = 0 THEN
+    a^.in_last := bset_bits;       (* last one is filed *)
+  ELSE
+    (* must be a multiple of bits in a bitset *)
+    n_bits := n_bits + bset_bits - a^.in_last;
+  END;
+
+  a^.sets := n_bits DIV bset_bits;   (* convert to bitsets *)
+  a^.size := a^.sets * bset_bytes;   (* convert to bytes *)
+
+  ALLOCATE( a^.start, a^.size );     (* grab that number of bytes from memory *)
+
+END Build;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Destroy( VAR a :Bitmap );
+BEGIN
+  DEALLOCATE( a^.start, a^.size );
+  DISPOSE( a );
+END Destroy;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Put( a :Bitmap; row, col :CARDINAL; set :CARDINAL );
+VAR
+  adra                 :POINTER TO DataType;
+  which_set, which_bit :CARDINAL;
+BEGIN
+
+  IF InRange( a, row, col ) THEN
+    Offset( a, row, col, which_set, which_bit );
+    adra  := a^.start + which_set * bset_bytes;
+
+    IF set = 0 THEN
+      EXCL( adra^, which_bit );
+    ELSIF set = 2 THEN
+      IF which_bit IN adra^ THEN
+        EXCL( adra^, which_bit );
+      ELSE
+        INCL( adra^, which_bit );
+      END;
+    ELSE
+      INCL( adra^, which_bit );    (* everything else means turn on *)
+    END;
+  END;
+END Put;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Get( a :Bitmap; row, col :CARDINAL ) :BOOLEAN;
+VAR
+  result :BOOLEAN;
+  adra   :POINTER TO DataType;
+  which_set, which_bit :CARDINAL;
+BEGIN
+  IF InRange( a, row, col ) THEN
+    Offset( a, row, col, which_set, which_bit );
+    adra   := a^.start + which_set * bset_bytes;
+    result := which_bit IN adra^;
+  ELSE
+    result := FALSE;
+  END;
+  RETURN result;
+END Get;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Size( a :Bitmap; VAR n_rows, n_cols :CARDINAL );
+BEGIN
+  n_rows := a^.rows;
+  n_cols := a^.cols;
+END Size;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Compare( a, b :Bitmap ) :BOOLEAN;
+VAR
+  result     :BOOLEAN;
+  adra, adrb :POINTER TO DataType;
+  i, k       :CARDINAL;
+BEGIN
+
+  result := TRUE;
+
+  IF ( a^.rows = b^.rows ) & ( a^.cols = b^.cols ) THEN
+
+    i := 1;
+    k := 0;
+    WHILE result & ( i <= a^.sets ) DO
+       adra   := a^.start + k;
+       adrb   := b^.start + k;
+       result := adra^ = adrb^;
+       i      := i + 1;
+       k      := k + bset_bytes;
+    END;
+
+  ELSE
+    result := FALSE;
+  END;
+
+  RETURN result;
+
+END Compare;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Clear( a :Bitmap );
+VAR
+  adra :POINTER TO DataType;
+  i, k :CARDINAL;
+BEGIN
+
+  k := 0;
+  FOR i := 1 TO a^.sets DO
+     adra  := a^.start + k;
+     adra^ := empty;
+     k     := k + bset_bytes;
+  END;
+
+END Clear;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Copy( a, b :Bitmap );
+VAR
+  adra, adrb :POINTER TO DataType;
+  i, k       :CARDINAL;
+BEGIN
+  IF ( a^.rows = b^.rows ) & ( a^.cols = b^.cols ) THEN
+
+    k := 0;
+    FOR i := 1 TO a^.sets DO
+       adra  := a^.start + k;
+       adrb  := b^.start + k;
+       adrb^ := adra^;
+       k     := k + bset_bytes;
+    END;
+
+  END;
+END Copy;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Duplicate( a :Bitmap; VAR b :Bitmap );
+BEGIN
+  Build( b, a^.rows, a^.cols );
+  Copy( a, b );
+END Duplicate;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Not( a :Bitmap; VAR b :Bitmap );
+VAR
+  adra, adrb :POINTER TO DataType;
+  i, k       :CARDINAL;
+BEGIN
+
+  Build( b, a^.rows, a^.cols );
+
+  k := 0;
+  FOR i := 1 TO a^.sets DO
+     adra  := a^.start + k;
+     adrb  := b^.start + k;
+     adrb^ := adra^ / full;        (* a Xor with <all bits> *)
+     k     := k + bset_bytes;
+  END;
+
+END Not;
+
+(* -------------------------------------------------------- *)
+PROCEDURE And( a, b :Bitmap; VAR c :Bitmap; VAR ok :BOOLEAN );
+VAR
+  adra, adrb, adrc :POINTER TO DataType;
+  i, k       :CARDINAL;
+BEGIN
+
+  IF ( a^.rows # b^.rows ) OR ( a^.cols # b^.cols ) THEN
+    ok := FALSE;
+  ELSE
+    ok := TRUE;
+
+    Build( c, a^.rows, a^.cols );
+
+    k := 0;
+    FOR i := 1 TO a^.sets DO
+       adra  := a^.start + k;
+       adrb  := b^.start + k;
+       adrc  := c^.start + k;
+       adrc^ := adra^ * adrb^;       (* set intersection *)
+       k     := k + bset_bytes;
+    END;
+
+  END;
+
+END And;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Or( a, b :Bitmap; VAR c :Bitmap; VAR ok :BOOLEAN );
+VAR
+  adra, adrb, adrc :POINTER TO DataType;
+  i, k             :CARDINAL;
+BEGIN
+
+  IF ( a^.rows # b^.rows ) OR ( a^.cols # b^.cols ) THEN
+    ok := FALSE;
+  ELSE
+    ok := TRUE;
+
+    Build( c, a^.rows, a^.cols );
+
+    k := 0;
+    FOR i := 1 TO a^.sets DO
+       adra  := a^.start + k;
+       adrb  := b^.start + k;
+       adrc  := c^.start + k;
+       adrc^ := adra^ + adrb^;    (* set union *)
+       k     := k + bset_bytes;
+    END;
+
+  END;
+
+END Or;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Xor( a, b :Bitmap; VAR c :Bitmap; VAR ok :BOOLEAN );
+VAR
+  adra, adrb, adrc :POINTER TO DataType;
+  i, k             :CARDINAL;
+BEGIN
+
+  IF ( a^.rows # b^.rows ) OR ( a^.cols # b^.cols ) THEN
+    ok := FALSE;
+  ELSE
+    ok := TRUE;
+
+    Build( c, a^.rows, a^.cols );
+
+    k := 0;
+    FOR i := 1 TO a^.sets DO
+       adra  := a^.start + k;
+       adrb  := b^.start + k;
+       adrc  := c^.start + k;
+       adrc^ := adra^ / adrb^;   (* symmetric set difference *)
+       k     := k + bset_bytes;
+    END;
+
+  END;
+
+END Xor;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Line( a :Bitmap; row1, col1, row2, col2 :CARDINAL; set :CARDINAL );
+
+VAR
+  dr, dc, length, x, y :REAL;
+  i, n                 :CARDINAL;
+
+BEGIN
+   IF InRange( a, row1, col1 ) & InRange( a, row2, col2 ) THEN
+
+     dr := FLOAT( row2 ) - FLOAT( row1 );
+     dc := FLOAT( col2 ) - FLOAT( col1 );
+
+     IF ABS( dr ) > ABS( dc ) THEN
+       length := ABS( dr );
+     ELSE
+       length := ABS( dc );
+     END;
+
+     n := TRUNC( length );
+     IF n > 0 THEN
+
+       dr := dr / length;
+       dc := dc / length;
+
+       x := FLOAT( col1 ) + 0.5;
+       y := FLOAT( row1 ) + 0.5;
+       
+       FOR i := 1 TO n DO
+          Put( a, TRUNC( y ), TRUNC( x ), set );
+          x := x + dc;
+          y := y + dr;
+       END;
+
+     END;
+
+   END;
+END Line;
+
+(* -------------------------------------------------------- *)
+PROCEDURE PrintText( a :Bitmap; filename :ARRAY OF CHAR; VAR ok :BOOLEAN );
+VAR
+   r, c, i, j, n :CARDINAL;
+   adra          :POINTER TO DataType;
+BEGIN
+
+  Create( outf, filename, TRUE, TRUE );
+
+  IF Done() THEN
+    ok := TRUE;
+
+    n := a^.cols;
+    IF n > 132 THEN n := 132 END;      (* no wider than 132 characters *)
+
+    i := 0;
+    j := bset_bits;
+
+    r := 1;
+    WHILE r <= a^.rows DO
+
+       c := 1;
+       WHILE c <= a^.cols DO
+
+          IF j >= bset_bits THEN
+            (* jump to the next bitset *)
+            i := i + 1;  j := 0;
+            adra := a^.start + ( i - 1 ) * bset_bytes;
+          END;
+
+          IF c <= n THEN
+
+            IF j IN adra^ THEN
+              WriteChar( outf, '*' );
+            ELSE
+              WriteChar( outf, '.' );
+            END;
+
+          END;
+
+          c := c + 1;
+          j := j + 1;
+       END;
+       WriteLn;
+
+       r := r + 1;
+    END;
+
+    Close( outf );
+
+  ELSE
+    ok := FALSE;
+  END;
+
+END PrintText;
+
+(* -------------------------------------------------------- *)
+PROCEDURE PrintSixel( a :Bitmap; filename :ARRAY OF CHAR; VAR ok :BOOLEAN );
+
+CONST
+   esc     = 33C;
+   max_out = 800;
+   blank   = 63;
+
+VAR
+   out_line           :ARRAY [1..max_out] OF CARDINAL;
+   r1, r2, r, c, f, x :CARDINAL;
+   i, j, k, n         :CARDINAL;
+
+BEGIN
+  Create( outf, filename, TRUE, FALSE );
+
+  IF Done() THEN
+    ok := TRUE;
+
+    n  := a^.cols;
+    IF n > max_out THEN n := max_out; END;
+
+    WriteChar( outf, esc ); WriteString( 'P0q' ); (* into Sixel graphics mode *)
+
+    r1 := 1;
+    WHILE r1 <= a^.rows DO
+
+      (* work in sets of 6 rows at a time *)
+      r2 := r1 + 5;        IF r2 > a^.rows THEN r2 := a^.rows; END;
+
+      FOR c := 1 TO n DO
+         k := blank;
+         f := 1;
+         FOR r := r1 TO r2 DO
+            IF Get( a, r, c ) THEN
+              k := k + f;
+            END;
+            f := f * 2;
+         END;
+         out_line[c] := k;
+      END;
+
+      (* truncate trailing blanks *)
+      j := n;
+      WHILE ( j > 1 ) & ( out_line[j] = blank ) DO
+        j := j - 1;
+      END;
+
+      WriteString( '??' );  (* spaces *)
+
+      (* try to use repeat counts to reduce file space and print time *)
+
+      c := 1;
+      WHILE c <= j DO
+
+         k := 0;
+         x := out_line[c];
+         i := c + 1;
+
+         WHILE ( i <= j ) & ( x = out_line[i] ) DO
+            k := k + 1;
+            i := i + 1;
+         END;
+
+         k := k + 1;   (* first + number of repeats *)
+
+         (* determine if its repeated enough *)
+
+         IF k > 3 THEN
+           WriteChar( outf, '!' );
+           WriteCard( k );
+           WriteChar( outf, CHR( x ) );
+         ELSE
+           FOR i := 1 TO k DO
+             WriteChar( outf, CHR( x ) );
+           END;
+         END;
+
+         c := c + k;   (* jump ahead *)
+      END;
+
+      WriteString( '-' );  (* new graphics line *)
+
+      r1 := r2 + 1;
+    END;
+
+
+    WriteChar( outf, esc ); WriteString( '\' );   (* out of Sixel mode *)
+
+    Close( outf );
+  ELSE
+    ok := FALSE;
+  END;
+
+END PrintSixel;
+
+(* -------------------------------------------------------- *)
+PROCEDURE PrintPS( a :Bitmap; filename :ARRAY OF CHAR; size :CARDINAL;
+                   VAR ok :BOOLEAN );
+
+CONST
+   max_rows = 750;
+   max_cols = 560;
+   side     = 25;
+
+VAR
+   r, c    :CARDINAL;
+   i, j, k :CARDINAL;
+   adra    :POINTER TO DataType;
+
+   (* ------------- *)
+   PROCEDURE WriteDot;
+   BEGIN
+      IF ( r * size < max_rows ) & ( c * size < max_cols ) THEN
+        WriteCard( c ); WriteString( ' ' );
+        WriteCard( r ); WriteString( ' D' ); WriteLn;
+      END;
+   END WriteDot;
+
+BEGIN
+
+  Create( outf, filename, TRUE, TRUE );
+
+  IF Done() THEN
+    ok := TRUE;
+
+    IF size < 1 THEN
+      size := 1;
+    ELSE
+      IF size > 100 THEN
+        size := 100;
+      END;
+    END;
+
+    WriteString( '%!PS-Adobe' ); WriteLn;
+    WriteString( '/D { moveto ' );
+    WriteString( ' 1 0 rlineto 0 1 rlineto -1 0 rlineto closepath fill' );
+    WriteString( ' } bind def' ); WriteLn;
+
+    WriteCard( side ); WriteString( ' ' ); WriteCard( max_rows );
+    WriteString( ' translate 0 0 moveto' ); WriteLn;
+    WriteString( '.2 setgray' ); WriteLn;
+    WriteCard( size ); WriteString( ' dup neg scale' ); WriteLn;
+
+    k := 0;
+    FOR i := 1 TO a^.sets - 1 DO
+       adra := a^.start + k;
+       IF adra^ # empty THEN
+         FOR j := 0 TO bset_bits DO
+            IF j IN adra^ THEN
+              ReverseOffset( a, i, j, r, c );
+              WriteDot;
+            END;
+         END;
+       END;
+       k := k + bset_bytes;
+    END;
+
+    adra := a^.start + k;
+    ReverseOffset( a, a^.sets, 0, r, c );
+    FOR j := 0 TO a^.in_last - 1 DO
+       IF j IN adra^ THEN
+         WriteDot;
+       END;
+       c := c + 1;
+    END;
+
+    WriteString( 'showpage' ); WriteLn;
+    WriteString( '%eof' );
+
+    Close( outf );
+  ELSE
+    ok := FALSE;
+  END;
+
+END PrintPS;
+
+BEGIN
+
+  bset_bytes := TSIZE( DataType );
+  bset_bits  := bset_bytes * 8;
+
+  empty := {};
+
+  full := {};
+  FOR i := 0 TO bset_bits - 1 DO
+     INCL( full, i );
+  END;
+
+  FOR i := 0 TO 9 DO
+     digits[i] := CHR( i + 48 );
+  END;
+
+END BitmapOperations.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/bitsetfun.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/bitsetfun.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/bitsetfun.def
@@ -0,0 +1,31 @@
+DEFINITION MODULE BitsetFunctions;
+
+(* logical operations on BITSETS *)
+(* J. Andrea, 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED 
+       Or, Nor, Xor, And, Nand, Xand, Not, ShiftLeft, ShiftRight;
+
+   PROCEDURE Or( a, b :BITSET ) :BITSET;
+
+   PROCEDURE Nor( a, b :BITSET ) :BITSET;
+
+   PROCEDURE Xor( a, b :BITSET ) :BITSET;
+
+   PROCEDURE And( a, b :BITSET ) :BITSET;
+
+   PROCEDURE Nand( a, b :BITSET ) :BITSET;
+
+   PROCEDURE Xand( a, b :BITSET ) :BITSET;
+   (* set difference *)
+
+   PROCEDURE Not( a :BITSET ) :BITSET;
+ 
+   PROCEDURE ShiftLeft( a :BITSET; n :CARDINAL ) :BITSET;
+   (* perform a circular shift left, n times *)
+
+   PROCEDURE ShiftRight( a :BITSET; n :CARDINAL ) :BITSET;
+   (* perform a circular shift right, n times *)
+
+END BitsetFunctions.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/bitsetfun.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/bitsetfun.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/bitsetfun.mod
@@ -0,0 +1,115 @@
+IMPLEMENTATION MODULE BitsetFunctions;
+
+(* logical operations on BITSETS *)
+
+(* V2.0, J. Andrea, Jun.17/93 - determine word size at runtime *)
+(* V1.0, J. Andrea, 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SYSTEM IMPORT TSIZE;
+
+VAR
+  empty, full    :BITSET;
+  i, bits_in_set :CARDINAL;
+
+   (* --------------------------------------------------------- *)
+   PROCEDURE Or( a, b :BITSET ) :BITSET;
+   BEGIN
+     RETURN ( a + b );                (* set union *)
+   END Or;
+
+   (* --------------------------------------------------------- *)
+   PROCEDURE Nor( a, b :BITSET ) :BITSET;
+   BEGIN
+     RETURN Not(Or(a,b));
+   END Nor;
+
+   (* --------------------------------------------------------- *)
+   PROCEDURE Xor( a, b :BITSET ) :BITSET;
+   BEGIN
+     RETURN ( a / b );          (* symmetric set difference *)
+   END Xor;
+
+   (* --------------------------------------------------------- *)
+   PROCEDURE And( a, b :BITSET ) :BITSET;
+   BEGIN
+     RETURN ( a * b );        (* set intersection *)
+   END And;
+
+   (* --------------------------------------------------------- *)
+   PROCEDURE Nand( a, b :BITSET ) :BITSET;
+   BEGIN
+     RETURN Not(And(a,b));
+   END Nand;
+
+   (* --------------------------------------------------------- *)
+   PROCEDURE Xand( a, b :BITSET ) :BITSET;
+   BEGIN
+     RETURN (a - b);          (* set difference *)
+   END Xand;
+
+   (* --------------------------------------------------------- *)
+   PROCEDURE Not( a :BITSET ) :BITSET;
+   BEGIN
+     RETURN Xor( a, full );           (* a Xor with <all bits> *)
+   END Not;
+
+   (* --------------------------------------------------------- *)
+   PROCEDURE ShiftLeft( a :BITSET; n :CARDINAL ) :BITSET;
+   (* perform a circular shift left, n times *)
+
+   VAR
+     i, last :CARDINAL;
+     save    :BOOLEAN;
+
+   BEGIN
+
+      last := bits_in_set - 1;
+
+      FOR i := 1 TO n DO
+
+         save := last IN a;             (* is the 31st bit set ? *)
+         EXCL( a, last );               (* remove it in any case *)
+         a := BITSET( CARDINAL(a) * 2 );(* shift = multiply by 2 *)
+         EXCL( a, 0 );                  (* remove the 0th bit    *)
+         IF save THEN INCL( a, 0 ) END; (* shift the last bit around *)
+
+      END;
+      RETURN a;
+   END ShiftLeft;
+
+   (* --------------------------------------------------------- *)
+   PROCEDURE ShiftRight( a :BITSET; n :CARDINAL ) :BITSET;
+   (* perform a circular shift right, n times *)
+
+   VAR
+     i, last :CARDINAL;
+     save    :BOOLEAN;
+
+   BEGIN
+      last := bits_in_set - 1;
+
+      FOR i := 1 TO n DO
+
+         save :=  0 IN a;                  (* is the  0th bit set ? *)
+         EXCL( a, 0 );                     (* remove it in any case *)
+         a := BITSET( CARDINAL(a) DIV 2 ); (* shift = divide by 2   *)
+         EXCL( a, last );                  (* remove the last bit   *)
+         IF save THEN INCL( a, last ) END; (* shift the  0th around *)
+
+      END;
+      RETURN a;
+   END ShiftRight;
+
+BEGIN
+
+  bits_in_set := TSIZE( BITSET ) * 8;
+
+  empty := {};
+
+  full := empty;
+  FOR i := 1 TO bits_in_set DO
+     INCL( full, i-1 );
+  END;
+
+END BitsetFunctions.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/cardarray.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/cardarray.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/cardarray.def
@@ -0,0 +1,66 @@
+DEFINITION MODULE CardArrays;
+
+(* Operations on a dynamic array of cardinals *)
+
+(* V1.1, J, Andrea, JUn.22/93 -add Duplicate *)
+(* V1.0, J, Andrea, May.18/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+(*
+* For those operations which return a status in the boolean 'ok',
+* the value of 'ok' should be checked before attempting to use the
+* resultant matrix.
+* If 'ok' is FALSE, then the resultant matrix will not exist.
+*)
+
+EXPORT QUALIFIED CardArray,                        (* the type *)
+                 Build, Destroy,                   (* matrix creation/deletion*)
+                 Put, Get,                         (* element access *)
+                 Size, Compare,                    (* status *)
+                 Assign,                           (* set elements *) 
+                 Copy, Duplicate,                  (* new copy *)
+                 Min, Max,                         (* basic operations *)
+                 Add, Multiply;                    (* basic operations *)
+
+TYPE CardArray;   (* opaque *)
+
+PROCEDURE Build( VAR a :CardArray; min_index, max_index :CARDINAL );
+(* create a new array of the specified size *)
+
+PROCEDURE Destroy( VAR a :CardArray );
+(* get rid for the specified CardArray *)
+
+PROCEDURE Put( a :CardArray; index :CARDINAL; value :CARDINAL );
+(* put the specified value into the CardArray at the index *)
+
+PROCEDURE Get( a :CardArray; index :CARDINAL ) :CARDINAL;
+(* return the value at 'index' *)
+
+PROCEDURE Size( a :CardArray; VAR min_index, max_index :CARDINAL );
+(* return the size of the array *)
+
+PROCEDURE Min( a :CardArray ) :CARDINAL;
+(* return the minimum value in the array *)
+
+PROCEDURE Max( a :CardArray ) :CARDINAL;
+(* return the maximum value in the array *)
+
+PROCEDURE Compare( a, b :CardArray ) :BOOLEAN;
+(* compare two arrays, return TRUE if they are the same in size and contents *)
+
+PROCEDURE Assign( a :CardArray; x :CARDINAL );
+(* set all elements in the array to 'x' *)
+
+PROCEDURE Copy( a, b :CardArray );
+(* copy all of 'a' into 'b', iff sizes are same *)
+
+PROCEDURE Duplicate( a :CardArray; VAR b :CardArray );
+(* copy 'a' into a new 'b' *)
+
+PROCEDURE Add( a :CardArray; x :CARDINAL );
+(* add 'x' to all elements of 'a' *)
+
+PROCEDURE Multiply(  a :CardArray; x :CARDINAL );
+(* multiply 'x' by all elements of 'a' *)
+
+END CardArrays.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/cardarray.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/cardarray.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/cardarray.mod
@@ -0,0 +1,225 @@
+IMPLEMENTATION MODULE CardArrays;
+
+(* Operations on a dynamic array of cardinals *)
+
+(* V1.1, J. Andrea, Jun.22/93 -add Duplicate *)
+(* V1.0, J. Andrea, May.18/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM SYSTEM  IMPORT ADDRESS, TSIZE;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+
+TYPE
+  CardArray = POINTER TO RECORD
+             min, max :CARDINAL;      (* dimemsions of the matrix *)
+             start    :ADDRESS;       (* memory address of the first item *)
+             size     :CARDINAL;      (* actual size in bytes *)
+           END;
+
+  ArrayType = CARDINAL;
+
+VAR
+  type_size  :CARDINAL;             (* #bytes in a single item *)
+
+(* -------------------------------------------------------------- *)
+PROCEDURE Build( VAR a :CardArray; min_index, max_index :CARDINAL );
+VAR
+  i :CARDINAL;
+BEGIN
+  NEW( a );
+
+  IF min_index > max_index THEN
+    i         := min_index;
+    min_index := max_index;
+    max_index := i;
+  END;
+
+  a^.min := min_index;
+  a^.max := max_index;
+
+  a^.size := ( max_index - min_index + 1 ) * type_size;
+
+  ALLOCATE( a^.start, a^.size );
+END Build;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Destroy( VAR a :CardArray );
+BEGIN
+  DEALLOCATE( a^.start, a^.size );
+  DISPOSE( a );
+END Destroy;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Put( a :CardArray; index :CARDINAL; value :ArrayType );
+VAR
+  adra :POINTER TO ArrayType;
+BEGIN
+  IF ( a^.min <= index ) & ( index <= a^.max ) THEN
+    adra  := a^.start + ( index - a^.min ) * type_size;
+    adra^ := value;
+  END;
+END Put;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Get( a :CardArray; index :CARDINAL ) :ArrayType;
+VAR
+  adra :POINTER TO ArrayType;
+BEGIN
+  IF ( a^.min <= index ) & ( index <= a^.max ) THEN
+    adra := a^.start + ( index - a^.min ) * type_size;
+    RETURN adra^;
+  ELSE
+    RETURN 0;
+  END;
+END Get;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Size( a :CardArray; VAR min_index, max_index :CARDINAL );
+BEGIN
+  min_index := a^.min;
+  max_index := a^.max;
+END Size;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Min( a :CardArray ) :ArrayType;
+VAR
+  adra   :POINTER TO ArrayType;
+  result :ArrayType;
+  i, k   :CARDINAL;
+BEGIN
+
+  k := 0;
+
+  adra   := a^.start;
+  result := adra^;
+
+  FOR i := a^.min+1 TO a^.max DO
+     k     := k + type_size;
+     adra  := a^.start + k;
+     IF adra^ < result THEN result := adra^ END;
+  END;
+
+  RETURN result;
+END Min;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Max( a :CardArray ) :ArrayType;
+VAR
+  adra   :POINTER TO ArrayType;
+  result :ArrayType;
+  i, k   :CARDINAL;
+BEGIN
+
+  k := 0;
+
+  adra   := a^.start;
+  result := adra^;
+
+  FOR i := a^.min+1 TO a^.max DO
+     k     := k + type_size;
+     adra  := a^.start + k;
+     IF adra^ > result THEN result := adra^ END;
+  END;
+
+  RETURN result;
+END Max;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Compare( a, b :CardArray ) :BOOLEAN;
+VAR
+  ok         :BOOLEAN;
+  adra, adrb :POINTER TO ArrayType;
+  i, k       :CARDINAL;
+BEGIN
+  IF ( a^.min = b^.min ) & ( a^.max = b^.max ) THEN
+
+    ok := TRUE;
+
+    k := 0;
+    i := a^.min;
+    WHILE ok & ( i <= a^.max ) DO
+       adra  := a^.start + k;
+       adrb  := b^.start + k;
+       ok    := adra^ = adrb^;
+       k     := k + type_size;
+       i     := i + 1;
+    END;
+
+  ELSE
+    ok := FALSE;
+  END;
+
+  RETURN ok;
+END Compare;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Assign( a :CardArray; x :ArrayType );
+VAR
+  adra :POINTER TO ArrayType;
+  i, k :CARDINAL;
+BEGIN
+  k := 0;
+  FOR i := a^.min TO a^.max DO
+     adra  := a^.start + k;
+     adra^ := x;
+     k     := k + type_size;
+  END;
+END Assign;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Copy( a, b :CardArray );
+VAR
+  adra, adrb :POINTER TO ArrayType;
+  i, k       :CARDINAL;
+BEGIN
+  IF ( a^.min = b^.min ) & ( a^.max = b^.max ) THEN
+
+    k := 0;
+    FOR i := a^.min TO a^.max DO
+       adra  := a^.start + k;
+       adrb  := b^.start + k;
+       adrb^ := adra^;
+       k     := k + type_size;
+    END;
+
+  END;
+END Copy;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Duplicate( a :CardArray; VAR b :CardArray );
+BEGIN
+  Build( b, a^.min, a^.max );
+  Copy( a, b );
+END Duplicate;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Add( a :CardArray; x :ArrayType );
+VAR
+  adra :POINTER TO ArrayType;
+  i, k :CARDINAL;
+BEGIN
+  k := 0;
+  FOR i := a^.min TO a^.max DO
+     adra  := a^.start + k;
+     adra^ := adra^ + x;
+     k     := k + type_size;
+  END;
+END Add;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Multiply(  a :CardArray; x :ArrayType );
+VAR
+  adra :POINTER TO ArrayType;
+  i, k :CARDINAL;
+BEGIN
+  k := 0;
+  FOR i := a^.min TO a^.max DO
+     adra  := a^.start + k;
+     adra^ := adra^ * x;
+     k     := k + type_size;
+  END;
+END Multiply;
+
+BEGIN
+  type_size := TSIZE( ArrayType );
+END CardArrays.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/cmdline.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/cmdline.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/cmdline.def
@@ -0,0 +1,18 @@
+DEFINITION MODULE CmdLine;
+
+(* Return the command line (less program name) *)
+(* J. Andrea, Jun.28/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+EXPORT QUALIFIED WholeCommandLine, Nargs, GetArg;
+
+  PROCEDURE WholeCommandLine( VAR line :ARRAY OF CHAR );
+  (* Return the whole command line *)
+
+  PROCEDURE Nargs() :CARDINAL;
+  (* Return the number of arguments in the command line *)
+
+  PROCEDURE GetArg( n :CARDINAL; VAR arg :ARRAY OF CHAR );
+  (* Return the n'th argument on the command line *)
+
+END CmdLine.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/dateopera.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/dateopera.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/dateopera.def
@@ -0,0 +1,59 @@
+DEFINITION MODULE DateOperations;
+
+(* Date and calendar procedures *)
+(* J. Andrea, Aug.16/92 *)
+(* Date calculations, dates valid only for 1-jan-1901 to 31-dec-2099 *)
+
+EXPORT QUALIFIED Date,
+                 Today,
+                 StringToDate, DateToString, MakeDate,
+                 LeapYear,
+                 DayOfYear, DayOfWeek,
+                 DaysBetween, AddDays, SubtractDays, Compare,
+                 PhaseOfMoon;
+                 
+TYPE
+   Date = RECORD
+            day, month, year :CARDINAL;
+            number :INTEGER;
+            true   :BOOLEAN;
+          END;
+   
+   PROCEDURE Today( VAR date :Date );
+   (* return the current time as a date *)
+   
+   PROCEDURE StringToDate( string :ARRAY OF CHAR; VAR date :Date );
+   PROCEDURE DateToString( date :Date; VAR string :ARRAY OF CHAR );
+   (* Convert to and from strings in VMS format dd-mmm-yyyy *)
+   
+   PROCEDURE MakeDate( day, month, year :CARDINAL; VAR date :Date );
+   (* create a date from only numeric info *)
+   
+   PROCEDURE LeapYear( year :CARDINAL ) :BOOLEAN;
+   (* is the given year a leap year *)
+                       
+   PROCEDURE DayOfYear( date :Date ) :CARDINAL;
+   (* return the day of the year 1 to 365 (or 366) *)
+   (* a zero is returned for invalid dates *)
+
+   PROCEDURE DayOfWeek( date :Date; VAR name :ARRAY OF CHAR );
+   (* return the day of the week, Sunday, Monday, etc. *)
+   (* an empty string is returned for invalid dates *)
+   
+   PROCEDURE DaysBetween( date1, date2 :Date ) :INTEGER;
+   (* return the number of days between the two given days *)
+   
+   PROCEDURE AddDays( in_date :Date; days :CARDINAL; VAR out_date :Date );
+   (* add the specified number of days to the given date *)
+   
+   PROCEDURE SubtractDays( in_date :Date; days :CARDINAL; VAR out_date :Date );
+   (* subtract the specified number of days from the given date *)
+                          
+   PROCEDURE Compare( date1, date2 :Date ) :CHAR;
+   (* return one of "=", ">", "<", or null (if one date is invalid) *)
+
+   PROCEDURE PhaseOfMoon( date :Date; VAR phase :ARRAY OF CHAR );
+   (* return the phase of the moon as a string *)
+   (* an empty string is returned for invalid dates *)
+
+END DateOperations.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/largenumb.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/largenumb.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/largenumb.def
@@ -0,0 +1,51 @@
+DEFINITION MODULE LargeNumbers;
+
+(* Handle very large numbers *)
+(* V3.0, J. Andrea, Nov.14/92 *)
+
+EXPORT QUALIFIED NumType, zero, one,
+                 StatusType, status,
+                 SetDigits, Add, Subtract, Multiply, Divide,
+                 Abs, ChangeSign,
+                 Times10, Divide10,
+                 StringToNum, NumToString;
+
+CONST
+   max_precision = 200;
+   min_exp = -16000;
+   max_exp =  16000;
+   
+TYPE
+   SignType = (positive,negative);
+   NumType  = RECORD
+               man  :ARRAY [-1..max_precision] OF CHAR;   (* mantissa *)
+               sign :SignType;  (* sign of mantissa *)
+               exp  :INTEGER;   (* exponent, may be positive or negative *)
+               an   :CARDINAL;  (* a number, set when each number is initialized *)
+              END;
+   StatusType = ( ok, overflow, underflow, divide_by_zero,
+                  too_few_digits, too_many_digits, invalid_digit,
+                  nan );  (* Not A Number *)
+                  
+VAR
+  status :StatusType;
+  zero, one :NumType;
+
+PROCEDURE SetDigits( d :INTEGER );
+
+PROCEDURE Add( a, b :NumType; VAR c :NumType );
+PROCEDURE Subtract( a, b :NumType; VAR c :NumType );
+PROCEDURE Multiply( a, b :NumType; VAR c :NumType );
+PROCEDURE Divide( a, b :NumType; VAR c :NumType );
+
+PROCEDURE Abs( VAR a :NumType );
+PROCEDURE ChangeSign( VAR a :NumType );
+
+PROCEDURE Times10( VAR a :NumType );
+PROCEDURE Divide10( VAR a :NumType );
+(* Times10 and Divide10 are fast operators *)
+ 
+PROCEDURE StringToNum( s :ARRAY OF CHAR; VAR a :NumType );
+PROCEDURE NumToString( a :NumType; VAR s :ARRAY OF CHAR );
+
+END LargeNumbers.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/largenumb.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/largenumb.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/largenumb.mod
@@ -0,0 +1,750 @@
+IMPLEMENTATION MODULE LargeNumbers;
+
+(* based on ExNumLib in "Modula-2 Library Modules: A Programmers Reference"
+   by Robert D. Walker, Tab Books Inc, 1988 *)
+(* V3.0, J.Andrea, Nov.14/92 - character operations working *)
+(* V2.1, J.Andrea, Nov.13/92 - use lookup table for character operations *)
+(* V2.0, J.Andrea, Nov.13/92 - store mantissa as characters not integers *)
+(* V1.0, J.Andrea, Nov.13/92 - add tests for non-initialized numbers *)
+(* V0.0, implemented and some fixes by J.Andrea, Nov.12/92 *)
+
+FROM StringOperations IMPORT Length, Append;
+FROM Conversions IMPORT IntToString;
+
+CONST
+   exp_max_len = 7;     (* how many digits could an exponent hold *)
+   max_real_digits = 7; (* precision of a REAL type floating point number *)
+   an_value = 12321;    (* an unlikely value in garbage memory space *)
+
+VAR
+  max_digits :INTEGER;
+  i          :INTEGER;
+  c, d       :CHAR;
+
+ digit_to_int  :ARRAY [0C..11C] OF INTEGER;  (* range chr(0) to chr(9) *)
+ int_to_digit  :ARRAY [0..9] OF CHAR;
+ char_to_digit :ARRAY ['0'..'9'] OF CHAR;
+ digit_to_char :ARRAY [0C..11C] OF CHAR;
+ char_to_int   :ARRAY ['0'..'9'] OF INTEGER;
+ mul_digits    :ARRAY [0C..11C] OF ARRAY [0C..11C] OF INTEGER;
+ 
+(* ----------------- *)
+PROCEDURE IsAN( a :NumType ) :BOOLEAN;
+(* is the large number A Number, has it been initialized ? *)
+BEGIN
+  RETURN a.an = an_value;
+END IsAN;
+
+(* ----------------- *)
+PROCEDURE xtoi( x :REAL; k :INTEGER ) :REAL;
+(* raise a real number to an integer power *)
+VAR
+  y :REAL;
+  i :INTEGER;
+BEGIN
+  y := 1.0;  (* initialize, and default for k=0 *)
+  IF k > 0 THEN
+    FOR i := 1 TO k DO
+      y := y * x;
+    END;
+  ELSE
+    IF k < 0 THEN
+      FOR i := 1 TO k DO
+        y := y / x;
+      END;
+    END;
+  END;
+  RETURN y;
+END xtoi;
+
+(* -------------------------------------------- *)
+PROCEDURE SetDigits( d :INTEGER );
+BEGIN
+  IF d < 2 THEN
+    max_digits := 2;
+    status := too_few_digits;
+  ELSIF d > max_precision THEN
+    max_digits := max_precision;
+    status := too_many_digits;
+  ELSE
+    max_digits := d;
+    status := ok;
+  END;
+END SetDigits;
+
+(* -------------------------------------------- *)
+PROCEDURE Add( a, b :NumType; VAR c :NumType );
+BEGIN
+  IF IsAN( a ) & IsAN( b ) THEN
+    IF a.sign = b.sign THEN
+      AddUtility( a, b, c );
+      IF a.sign = negative THEN
+        ChangeSign( c );
+      END;
+    ELSE
+      IF a.sign = positive THEN
+        SubtractUtility( a, b, c );
+      ELSE
+        SubtractUtility( b, a, c );
+      END;
+    END;
+  ELSE
+    c := zero;
+    status := nan;
+  END;
+END Add;
+
+(* -------------------------------------------- *)
+PROCEDURE Subtract( a, b :NumType; VAR c :NumType );
+BEGIN
+  IF IsAN( a ) & IsAN( b ) THEN
+    IF a.sign = b.sign THEN
+      IF a.sign = positive THEN
+        SubtractUtility( a, b, c );
+      ELSE
+        SubtractUtility( b, a, c );
+      END;
+    ELSE
+      AddUtility( a, b, c );
+      IF a.sign = negative THEN
+        ChangeSign( c );
+      END;
+    END;
+  ELSE
+    c := zero;
+    status := nan;
+  END;
+END Subtract;
+
+(* -------------------------------------------- *)
+PROCEDURE Multiply( a, b :NumType; VAR c :NumType );
+VAR
+  i, j, product, carry :INTEGER;
+  ex1 :NumType;
+BEGIN
+
+  IF IsAN( a ) & IsAN( b ) THEN
+    IF ( Compare( a, zero ) = 0 ) OR ( Compare( b, zero ) = 0 ) THEN
+      (* multiplication by zero *)
+      c := zero;
+      status := ok;
+    ELSIF Compare( a, one ) = 0 THEN
+      (* multiplication by one *)
+      c := b;
+      status := ok;
+    ELSIF Compare( b, one ) = 0 THEN
+      (* multiplication by one *)
+      c := a;
+      status := ok;
+    ELSE (* regular multiplication *)
+
+      status := ok;
+      c := zero;
+
+      FOR i := max_digits - 1 TO 0 BY -1 DO
+
+         ex1 := zero;
+         ex1.exp := a.exp + b.exp - i;
+         carry := 0;
+
+         FOR j := max_digits - 1 TO 0 BY -1 DO
+            product := mul_digits[a.man[j],b.man[i]] + carry;
+            ex1.man[j] := int_to_digit[product MOD 10];
+            carry := product DIV 10;
+         END;
+
+         (* check for a final carry *)
+         IF carry > 0 THEN
+           ShiftRight( ex1 );
+           ex1.man[0] := int_to_digit[carry];
+           Times10( ex1 );
+         END;
+
+         (* add up what we've got so far *)
+         AddUtility( c, ex1, c );
+
+       END;
+
+       (* adjust product sign *)
+       IF a.sign # b.sign THEN
+         ChangeSign( c );
+       END;
+
+      END;
+  ELSE
+    c := zero;
+    status := nan;
+  END;
+
+END Multiply;
+
+(* -------------------------------------------- *)
+PROCEDURE Divide( a, b :NumType; VAR c :NumType );
+VAR
+   i, quotient :INTEGER;
+   ex1, ex2 :NumType;
+BEGIN
+
+  IF IsAN( a ) & IsAN( b ) THEN
+    status := ok;
+
+    IF Compare( b, zero ) = 0 THEN
+      status := divide_by_zero;
+    ELSIF Compare( a, zero ) = 0 THEN
+      (* dividend is zero *)
+      c := zero;
+    ELSIF Compare( b, one ) = 0 THEN
+      (* divide by one *)
+      c := a;
+    ELSE (* regular division *)
+
+      c := zero;
+      c.exp := a.exp - b.exp;
+
+      ex1 := a;        (* let ex1 = ABS( a ) / magnitude( a ) *)
+      Abs( ex1 );
+      ex1.exp := 0;
+      ex2 := b;        (* let ex2 = ABS( b ) / magnitude( b ) *)
+      Abs( ex2 );
+      ex2.exp := 0;
+
+      FOR i := 0 TO max_digits-1 DO
+         quotient := 0;
+         WHILE Compare( ex1, ex2 ) = 1 DO     (* while ex1 > ex2 *)
+           quotient := quotient + 1;
+           SubtractUtility( ex1, ex2, ex1 );
+         END;
+         c.man[i] := int_to_digit[quotient];
+         Divide10( ex2 );
+      END;
+
+      (* normalize quotient *)
+      Norm( c );
+
+      (* adjust quotient sign *)
+      IF a.sign # b.sign THEN
+        ChangeSign( c );
+      END;
+
+    END;
+
+  ELSE
+    c := zero;
+    status := nan;
+  END;
+
+END Divide;
+
+(* -------------------------------------------- *)
+PROCEDURE Abs( VAR a :NumType );
+BEGIN
+  a.sign := positive;
+END Abs;
+
+(* -------------------------------------------- *)
+PROCEDURE ChangeSign( VAR a :NumType );
+BEGIN
+  IF a.sign = positive THEN
+    a.sign := negative;
+  ELSE
+    a.sign := positive;
+  END;
+END ChangeSign;
+
+(* -------------------------------------------- *)
+PROCEDURE Times10( VAR a :NumType );
+BEGIN
+  IF IsAN( a ) THEN
+    a.exp := a.exp + 1;
+    IF a.exp > max_exp THEN
+      status := overflow;
+    ELSE
+      status := ok;
+    END;
+  ELSE
+    a := zero;
+    status := nan;
+  END;
+END Times10;
+
+(* -------------------------------------------- *)
+PROCEDURE Divide10( VAR a :NumType );
+BEGIN
+  IF IsAN( a ) THEN
+    a.exp := a.exp - 1;
+    IF a.exp < min_exp THEN
+      status := underflow;
+    ELSE
+      status := ok;
+    END;
+  ELSE
+    a := zero;
+    status := nan;
+  END;
+END Divide10;
+
+(* -------------------------------------------- *)
+PROCEDURE Compare( a, b :NumType ) :INTEGER;
+VAR
+  done :BOOLEAN;
+  i    :INTEGER;
+BEGIN
+  IF IsAN( a ) & IsAN( b ) THEN
+    IF a.sign # b.sign THEN
+      IF a.sign = positive THEN
+        RETURN 1;      (* a is +, b is -, so a > b *)
+      ELSE
+        RETURN -1;     (* a is -, b is +, so a < b *)
+      END;
+    ELSE
+
+      (* a and b have the same sign *)
+
+      IF a.exp # b.exp THEN
+
+        IF a.exp > b.exp THEN
+          IF a.sign = positive THEN
+            RETURN 1; (* a > b *)
+          ELSE
+            RETURN -1; (* a < b *)
+          END;
+        ELSE
+
+          (* a and b have same sign, and a exponent <= b exponent *)
+          IF a.sign = positive THEN
+            RETURN -1;
+          ELSE
+            RETURN 1;
+          END;
+
+        END;
+
+      ELSE
+
+        (* a and b have the same sign, and the same exponent *)
+
+        done := FALSE;
+        i    := 0;
+
+        (* compare each digit till a difference is found, or the end *)
+        WHILE ( i <= max_digits - 1 ) & NOT done DO
+          IF a.man[i] # b.man[i] THEN
+            done := TRUE;
+          ELSE
+            i := i + 1;
+          END;
+        END;
+
+        IF i > max_digits - 1 THEN
+          (* end reached, so all digits match *)
+          RETURN 0;
+        ELSE
+
+          (* compare those last digits which are different *)
+          IF a.man[i] < b.man[i] THEN
+            IF a.sign = positive THEN
+              RETURN -1; (* a<b *)
+            ELSE
+              RETURN 1; (* a>b *)
+            END;
+          ELSE
+            IF a.sign = positive THEN
+              RETURN 1; (* a>b *)
+            ELSE
+              RETURN -1;
+            END;
+          END;
+        END;
+      END;
+
+    END;
+  ELSE
+    RETURN -1; (* this is questionable *)
+  END;
+  
+END Compare;
+
+(* -------------------------------------------- *)
+PROCEDURE Norm( VAR a :NumType );
+VAR
+  value_zero :BOOLEAN;
+  i          :INTEGER;
+BEGIN
+  IF IsAN( a ) THEN
+    (* check for a zero *)
+    i := 0;
+    value_zero := TRUE;
+    WHILE ( i <= max_digits - 1 ) & value_zero DO
+      IF a.man[i] # int_to_digit[0] THEN
+        value_zero := FALSE;
+      END;
+      i := i + 1;
+    END;
+
+    IF value_zero THEN
+      (* normalize zero *)
+      a.sign := positive;
+      a.exp  := 0;
+    ELSE
+      (* shift mantissa to left until most signifigant digit is non-zero,
+         increment exponent with each shift *)
+      WHILE a.man[0] = int_to_digit[0] DO
+        ShiftLeft( a );
+        Divide10( a )
+      END;
+    END;
+  ELSE
+    a := zero;
+    status := nan;
+  END;
+END Norm;
+
+(* -------------------------------------------- *)
+PROCEDURE StringToNum( s :ARRAY OF CHAR; VAR a :NumType );
+VAR
+  done, neg_exp :BOOLEAN;
+  i, len        :CARDINAL;
+  j, exponent   :INTEGER;
+  second_digit  :BOOLEAN;
+
+  (* ---------------- *)
+  PROCEDURE Numeral( c :CHAR ) :BOOLEAN;
+  (* is the character a number *)
+  BEGIN
+     RETURN ( c >= '0' ) & ( c <= '9' );
+  END Numeral;
+
+BEGIN
+  status := ok;
+  done   := TRUE;
+
+  a := zero;
+
+  exponent := 0;
+  neg_exp  := FALSE;
+
+  len := Length( s );
+
+  IF len > 0 THEN
+    i := 0;
+    (* chek for a negative mantissa *)
+    IF s[i] = '-' THEN
+      a.sign := negative;
+      i := i + 1;
+    END;
+
+    (* skip leading zeros *)
+    WHILE ( i < len ) & ( s[i] = '0' ) DO
+      i := i + 1;
+    END;
+
+    IF i < len THEN
+      (* more than just zeros in this string *)
+
+      j := 0;
+
+      second_digit := FALSE;
+      
+      (* handle digits to the left of the decimal point *)
+      WHILE ( i < len ) & done DO
+        IF Numeral( s[i] ) THEN
+          a.man[j] := char_to_digit[s[i]];
+          IF second_digit THEN
+            Times10( a );
+          ELSE
+            second_digit := TRUE;
+          END;
+          j := j + 1;
+          i := i + 1;
+        ELSE
+          done := FALSE;
+        END;
+      END;      
+
+      IF NOT done THEN
+        (* non-numeric was found, could it be something that we want *)
+        IF ( s[i] = '.' ) OR ( CAP(s[i]) = 'E' ) THEN
+
+          IF s[i] = '.' THEN
+            i := i + 1;
+            done := TRUE;
+            (* get all the digits to the right of the decimal point *)
+            WHILE ( i < len ) & done DO
+              IF Numeral( s[i] ) THEN
+                a.man[j] := char_to_digit[s[i]];
+                j := j + 1;
+                i := i + 1;
+              ELSE
+                done := FALSE;
+              END;
+            END;
+          END;
+
+          IF NOT done THEN
+            IF CAP( s[i] ) = 'E' THEN
+              i := i + 1;
+              neg_exp := s[i] = '-';
+              IF ( s[i] = '+' ) OR neg_exp THEN
+                i := i + 1; (* skip the sign *)
+              END;
+              (* handle the exponent *)
+              exponent := 0;
+              done := TRUE;
+              WHILE ( i < len ) & done DO
+                IF Numeral( s[i] ) THEN
+                  exponent := exponent * 10 + char_to_int[s[i]];
+                ELSE
+                  done := FALSE;
+                END;
+              END;
+
+              IF NOT done THEN
+                status := invalid_digit;
+              ELSE
+                IF neg_exp THEN
+                  a.exp := a.exp - exponent;
+                ELSE
+                  a.exp := a.exp + exponent;
+                END;
+              END;
+
+            ELSE
+              status := invalid_digit;
+            END;
+          END;
+
+        ELSE
+          status := invalid_digit;
+        END;
+        
+      END;
+
+    END;
+  END;
+
+END StringToNum;
+
+(* -------------------------------------------- *)
+PROCEDURE NumToString( a :NumType; VAR s :ARRAY OF CHAR );
+VAR
+  i, last :INTEGER;
+  s_exp :ARRAY [0..exp_max_len] OF CHAR;
+
+BEGIN
+  (* create a null string *)
+  s[0] := 0C;
+
+  IF IsAN( a ) THEN
+
+    (* the sign *)
+    IF a.sign = negative THEN
+      Append( '-', s );
+    END;
+
+    Append( digit_to_char[a.man[0]], s );
+
+    Append( '.', s );
+
+    (* find the last non-zero digit *)
+    last := max_digits - 1;
+    WHILE ( last >= 1 ) & ( a.man[last] = 0C ) DO
+      last := last - 1;
+    END;
+
+    FOR i := 1 TO last DO
+      Append( digit_to_char[a.man[i]], s );
+    END;
+
+    (* the exponent *)
+    Append( 'E', s );
+
+    IntToString( a.exp, 0, s_exp );
+
+    Append( s_exp, s );
+
+  ELSE
+    Append( '0', s );
+    status := nan;
+  END;
+
+END NumToString;
+
+(* -------------------------------------------- *)
+PROCEDURE AddUtility( a, b :NumType; VAR c :NumType );
+VAR
+  i, j, carry, digit, result :INTEGER;
+  ex1, ex2 :NumType;
+BEGIN
+  IF a.exp > b.exp THEN
+    ex1 := a;
+    ex2 := b;
+  ELSE
+    ex1 := b;
+    ex2 := a;
+  END;
+
+  c     := zero;
+  c.exp := ex1.exp;
+
+  carry := 0;
+  FOR i := max_digits-1 TO 0 BY -1 DO
+
+    j := i + ex2.exp - ex1.exp;        (* j = index to ex2 *)
+    (* check that j falls within bounds *)
+    IF ( j >= 0 ) & ( j <= max_digits -1 ) THEN
+      digit := digit_to_int[ex2.man[j]]; (* get digit from ex2 *)
+    ELSE
+      digit := 0; (* j is outside, use zero *);
+    END;
+
+    (* perform addition with carry *)
+    result := digit_to_int[ex1.man[i]] + digit + carry;
+    (* check for next carry *)
+    IF result >= 10 THEN
+      result := result MOD 10;
+      carry := 1;
+    ELSE
+      carry := 0;
+    END;
+    c.man[i] := int_to_digit[result];
+
+  END;
+
+  (* handle final carry *)
+  IF carry > 0 THEN
+    ShiftRight( c );        (* shift mantissa to right *)
+    c.man[0] := 1C;         (* make first digit = 1 *)
+    Times10( c );           (* update exponent *)
+  END;
+
+  (* set status *)
+  IF c.exp > max_exp THEN
+    status := overflow;
+  ELSE
+    status := ok;
+  END;
+
+END AddUtility;
+
+(* -------------------------------------------- *)
+PROCEDURE SubtractUtility( a, b:NumType; VAR c :NumType );
+VAR
+  i, j, borrow, digit, result :INTEGER;
+  ex1, ex2  :NumType;
+  positive_result :BOOLEAN;
+BEGIN
+  Abs( a );  Abs( b );
+  IF a.exp > b.exp THEN
+    ex1 := a;
+    ex2 := b;
+  ELSE
+    ex1 := b;
+    ex2 := a;
+  END;
+
+  positive_result := Compare( ex1, ex2 ) = 1;
+
+  c := zero;
+  c.exp := ex1.exp;
+
+  borrow := 0;
+
+  FOR i := max_digits-1 TO 0 BY -1 DO
+
+     j := i + ex2.exp - ex1.exp;      (* j is index into ex2 *)
+     (* check that j falls within bounds *)
+     IF ( j >= 0 ) & ( j <= max_digits -1 ) THEN
+       digit := digit_to_int[ex2.man[j]]; (* get digit from ex2 *)
+     ELSE
+       digit := 0; (* j outside array, user zero *)
+     END;
+
+     (* perform subtraction with borrowing *)
+
+     result := digit_to_int[ex1.man[i]];
+     IF positive_result THEN
+       result := result - digit;
+     ELSE
+       result := digit - result;
+     END;
+     result := result - borrow;
+
+     (* check for borrow *)
+     IF result < 0 THEN
+       result := result + 10;
+       borrow := 1;
+     ELSE
+       borrow := 0;
+     END;
+     c.man[i] := int_to_digit[result];
+
+   END;
+
+   (* normalize *)
+   Norm( c );
+   
+   (* adjust sign *)
+   IF Compare( a, b ) = -1 THEN
+     ChangeSign( c );
+   END;
+
+END SubtractUtility;
+
+(* -------------------------------------------- *)
+PROCEDURE ShiftRight( VAR a :NumType );
+VAR
+  i :INTEGER;
+BEGIN
+  FOR i := max_digits TO 1 BY -1 DO
+    a.man[i] := a.man[i-1];
+  END;
+  a.man[0] := int_to_digit[0];   (* put zero in most signifigant position *)
+END ShiftRight;
+
+(* -------------------------------------------- *)
+PROCEDURE ShiftLeft( VAR a :NumType );
+VAR
+  i :INTEGER;
+BEGIN
+  FOR i := -1 TO max_digits - 2 DO
+    a.man[i] := a.man[i+1];
+  END;
+  a.man[max_digits-1] := int_to_digit[0];   (* put zero in least signifigant position *)
+END ShiftLeft;
+
+BEGIN
+
+  (* precompute conversions *)
+  FOR i := 0 TO 9 DO
+    digit_to_int[ CHR(i) ] := i;
+    int_to_digit[ i ]      := CHR(i);
+  END;
+  i := 0;
+  FOR c := '0' TO '9' DO
+    char_to_digit[ c ] := CHR( i );
+    digit_to_char[ CHR(i) ] := c;
+    char_to_int[ c ] := i;
+    i := i + 1;
+  END;
+
+  (* precompute tables of adding and multiplying together character digits *)
+  FOR c := 0C TO 11C DO
+    FOR d := 0C TO 11C DO
+       mul_digits[c,d] := digit_to_int[c] * digit_to_int[d];
+    END;
+  END;
+
+  (* set default for number size *)
+  SetDigits( max_precision );
+
+  zero.sign := positive;
+  zero.exp  := 0;
+  FOR i := -1 TO max_precision DO
+    zero.man[i] := int_to_digit[0];
+  END;
+  zero.an := an_value;
+
+  one := zero;
+  one.man[0] := int_to_digit[1];
+  
+END LargeNumbers.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/largesets.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/largesets.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/largesets.def
@@ -0,0 +1,55 @@
+DEFINITION MODULE LargeSets;
+
+(*
+ Some implementations limit sizes of sets to 32 elements, others to 65535
+ elements. This module allows sets of numbers limited only by available memory.
+ Use of this module for objects other than numbers requires another layer
+ to map object indicies into numbers.
+*)
+(* V1.1, J. Andrea, Jun.22/93 -add Duplicate *)
+(* V1.0, J. Andrea, Apr.5/92 *)
+(* This code may be freely used and distributed, it may bot be sold *)
+
+EXPORT QUALIFIED LargeSet, 
+                 Build, Destroy, Empty, Fill,
+                 Incl,  Excl,    In,
+                 Not,   Equal,
+                 Copy,  Duplicate;
+
+TYPE LargeSet;   (* opaque *)
+
+PROCEDURE Build( VAR s :LargeSet; min, max :CARDINAL );
+(* create a set of numbers in the range [min,max] *)
+
+PROCEDURE Destroy( VAR s :LargeSet );
+(* get rid of the specified set *)
+
+PROCEDURE Empty( s :LargeSet );
+(* turn off all elements *)
+
+PROCEDURE Fill( s :LargeSet );
+(* turn on all elements *)
+
+PROCEDURE Incl( s :LargeSet; x :CARDINAL );
+(* put the specified number into the set *)
+
+PROCEDURE Excl( s :LargeSet; x :CARDINAL );
+(* take the specified number out of the set *)
+
+PROCEDURE In( s :LargeSet; x :CARDINAL ) :BOOLEAN;
+(* determine if the number is in the set *)
+
+PROCEDURE Not( s :LargeSet );
+(* invert the set *)
+
+PROCEDURE Equal( s, t :LargeSet ) :BOOLEAN;
+(* compare two sets, return TRUE if they have the same ranges, and same
+   element are on *)
+
+PROCEDURE Copy( s, t :LargeSet );
+(* make 't' the same as 's' *)
+
+PROCEDURE Duplicate( s :LargeSet; VAR t :LargeSet );
+(* copy set 's' into a new set 't' *)
+
+END LargeSets.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/largesets.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/largesets.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/largesets.mod
@@ -0,0 +1,245 @@
+IMPLEMENTATION MODULE LargeSets;
+
+(* V2.1, John Andrea, Jun.22/93 -add Copy and Duplicate *)
+(* V2.0, John Andrea, Jun.17/93 -determine bitset size ar runtime *)
+(* V1.0, John Andrea, Apr.5/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM SYSTEM IMPORT TSIZE, ADDRESS;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+
+TYPE
+   LargeSet = POINTER TO RECORD
+                  start    :ADDRESS;    (* memory address of the first item *)
+                  min, max :CARDINAL;   (* size of the set *)
+                  sets     :CARDINAL;   (* number of bitsets used *)
+                  in_last  :CARDINAL;   (* number of bits in the last set *)
+               END;
+   DataType  = BITSET;
+   DataPoint = POINTER TO DataType;
+
+VAR
+  bset_bits, bset_bytes :CARDINAL;
+  empty, full           :BITSET;
+  i                     :CARDINAL;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Offset( a :LargeSet; x :CARDINAL; VAR set, bit :CARDINAL );
+(* calculate the memory offset to the item from the first item *)
+VAR
+  count_bit :CARDINAL;
+BEGIN
+  count_bit := x - a^.min;
+  set       := count_bit DIV bset_bits;
+  (* and how far into this set is the dot that we need *)
+  bit       := count_bit - set * bset_bits;
+END Offset;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Build( VAR a :LargeSet; min, max :CARDINAL );
+VAR
+  i, n :CARDINAL;
+BEGIN
+  NEW( a );
+
+  IF min > max THEN
+   i   := min;
+   min := max;
+   max := i;
+  END;
+
+  a^.min := min;   a^.max := max;
+
+  n := max - min + 1;
+
+  a^.in_last := n MOD bset_bits;
+
+  IF a^.in_last = 0 THEN
+    a^.in_last := bset_bits;   (* already a multiple of bset_bits *)
+  ELSE
+    n := n + bset_bits - a^.in_last;    (* bump up to a multiple of bset_bits *)
+  END;
+
+  a^.sets := n DIV bset_bits;
+
+  ALLOCATE( a^.start, a^.sets * bset_bytes );       (* grab bytes from memory *)
+  Empty( a );
+END Build;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Destroy( VAR a :LargeSet );
+BEGIN
+  DEALLOCATE( a^.start, a^.sets * bset_bytes );
+  DISPOSE( a );
+END Destroy;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Empty( a :LargeSet );
+VAR
+  adra :DataPoint;
+  i, k :CARDINAL;
+BEGIN
+  k := 0;
+  FOR i := 1 TO a^.sets DO
+     adra  := a^.start + k;
+     adra^ := empty;
+     k     := k + bset_bytes;
+  END;
+END Empty;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Fill( a :LargeSet );
+VAR
+  adra :DataPoint;
+  i, k :CARDINAL;
+BEGIN
+  k := 0;
+  FOR i := 1 TO a^.sets DO
+     adra  := a^.start + k;
+     adra^ := full;
+     k     := k + bset_bytes;
+  END;
+END Fill;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Incl( a :LargeSet; x :CARDINAL );
+VAR
+  adra                 :DataPoint;
+  which_set, which_bit :CARDINAL;
+BEGIN
+  IF ( a^.min <= x ) & ( x <= a^.max ) THEN
+
+    Offset( a, x, which_set, which_bit );
+    adra := a^.start + which_set * bset_bytes;
+    INCL( adra^, which_bit );
+
+  END;
+END Incl;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Excl( a :LargeSet; x :CARDINAL );
+VAR
+  adra                 :DataPoint;
+  which_set, which_bit :CARDINAL;
+BEGIN
+  IF ( a^.min <= x ) & ( x <= a^.max ) THEN
+
+    Offset( a, x, which_set, which_bit );
+    adra := a^.start + which_set * bset_bytes;
+    EXCL( adra^, which_bit );
+
+  END;
+END Excl;
+
+(* -------------------------------------------------------- *)
+PROCEDURE In( a :LargeSet; x :CARDINAL ) :BOOLEAN;
+VAR
+  adra                 :DataPoint;
+  which_set, which_bit :CARDINAL;
+  result               :BOOLEAN;
+BEGIN
+  IF ( a^.min <= x ) & ( x <= a^.max ) THEN
+
+    Offset( a, x, which_set, which_bit );
+    adra   := a^.start + which_set * bset_bytes;
+    result := which_bit IN adra^;
+
+  ELSE
+    result := FALSE;
+  END;
+  RETURN result;
+END In;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Not( a :LargeSet );
+VAR
+  adra :DataPoint;
+  i, k :CARDINAL;
+BEGIN
+  k := 0;
+  FOR i := 1 TO a^.sets DO
+     adra  := a^.start + k;
+     adra^ := adra^ / full;    (* Xor with <all bits> *)
+     k     := k + bset_bytes;
+  END;
+END Not;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Equal( a, b :LargeSet ) :BOOLEAN;
+VAR
+  adra, adrb :DataPoint;
+  i, k       :CARDINAL;
+  ok         :BOOLEAN;
+BEGIN
+
+   IF ( a^.min = b^.min ) & ( a^.max = b^.max ) THEN
+     ok := TRUE;
+
+     k  := 0;
+     i  := 1;
+     WHILE ( i <= a^.sets - 1 ) & ok DO
+       adra := a^.start + k;
+       adrb := b^.start + k;
+       ok   := adra^ = adrb^;
+       i    := i + 1;
+       k    := k + bset_bytes;
+     END;
+
+     (* only the used portion of the last set should be compared *)
+     IF ok THEN
+       adra := a^.start + k;
+       adrb := b^.start + k;
+
+       i := 0;
+       WHILE ( i < a^.in_last ) & ok DO
+         ok := ( i IN adra^ ) = ( i IN adrb^ );
+         i  := i + 1;
+       END;
+
+     END;
+
+   ELSE
+     ok := FALSE;
+   END;
+
+   RETURN ok;
+END Equal;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Copy( a, b :LargeSet );
+VAR
+  adra, adrb :DataPoint;
+  i, k :CARDINAL;
+BEGIN
+  IF ( a^.min = b^.min ) & ( a^.max = b^.max ) THEN
+
+    k := 0;
+    FOR i := 1 TO a^.sets DO
+       adra  := a^.start + k;
+       adrb  := b^.start + k;
+       adrb^ := adra^;
+       k     := k + bset_bytes;
+    END;
+
+  END;
+END Copy;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Duplicate( a :LargeSet; VAR b :LargeSet );
+BEGIN
+   Build( b, a^.min, a^.max );
+   Copy( a, b );
+END Duplicate;
+
+BEGIN
+   bset_bytes := TSIZE( DataType );
+   bset_bits  := bset_bytes * 8;
+
+   empty := {};
+
+   full  := {};
+   FOR i := 0 TO bset_bits - 1 DO
+     INCL( full, i );
+   END;
+
+END LargeSets.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/lewertssc.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/lewertssc.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/lewertssc.def
@@ -0,0 +1,21 @@
+DEFINITION MODULE LewertsScale;
+
+EXPORT QUALIFIED Scale;
+
+      PROCEDURE Scale( data_min, data_max :REAL; approx_inc :CARDINAL;
+                       VAR scale_min, scale_max, scale_inc :REAL );
+(*
+*     From the known data minimum and maximum, and an approximate
+*     number of increments wanted, use this algorithm to find the
+*     scaling numbers for a graph that will be nicely scaled number
+*     around the data range.
+*
+*     Taken from an algorithm given in:
+*            Computer Language magazine
+*            September 1989, Vol. 6, No. 9
+*            "Composing Well Tempered Linear Scales"
+*            by Tom Steppe
+*            pp. 49 - 65
+*)
+
+END LewertsScale.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/lewertssc.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/lewertssc.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/lewertssc.mod
@@ -0,0 +1,187 @@
+IMPLEMENTATION MODULE LewertsScale;
+
+(* Modula-2 implementation by John Andrea, Oct.8/92 *)
+
+FROM MathLib0 IMPORT sqrt, power;
+FROM MoreMath IMPORT Log10;
+
+VAR
+  n_set    :CARDINAL;
+  nice_set :ARRAY [1..4] OF REAL;
+ 
+      (* ---------------------------------------------------------- *)
+       PROCEDURE Scale( data_min, data_max :REAL; approx_inc :CARDINAL;
+                       VAR scale_min, scale_max, scale_inc :REAL );
+      (* Implementation notes:
+       * 1) should n_set be large enough to include the 10 or not.
+       *    The book is confusing as it is given in C and there is some
+       *    comment about including the 10 for a special purpose.
+       * 2) there seems to be a problem with the given algorithm in
+       *    computing the scale-max, so do a hack here to fix it
+       * 3) there seems to be a problem with the given algorithm in
+       *    computing the scale-min, so do a hack here to fix it
+      *)
+
+      VAR
+        actual_inc :INTEGER;
+
+        interval_size :REAL;
+
+        set_index :CARDINAL;
+        power_of_ten :REAL;
+
+        nice_num, geo_mean :REAL;
+
+        n_low_mul, n_hi_mul  :INTEGER;
+
+      BEGIN
+
+        IF approx_inc < 2 THEN
+          actual_inc := 2;
+        ELSE
+          actual_inc := INTEGER( approx_inc );
+        END;
+
+        IF data_min > data_max THEN
+          nice_num := data_min;
+          data_min := data_max;
+          data_max := nice_num;
+        ELSE    
+        
+          (* compute the smallest potential interval *)
+          interval_size := ( data_max - data_min ) / FLOAT( actual_inc );
+
+          (* compute the nice number closest to the approximate potential interval *)
+          FirstNiceNum( interval_size, set_index, power_of_ten, nice_num );
+ 
+          geo_mean := sqrt( nice_set[set_index] * nice_set[set_index+1] );
+
+          WHILE geo_mean * power_of_ten < interval_size DO
+
+             NextNiceNum( set_index, power_of_ten, nice_num );
+
+             geo_mean := sqrt( nice_set[set_index] * nice_set[set_index+1] );
+          END;
+
+          (* produce the scale using the computed nice number *)
+          CalcExtLabel( data_min, data_max, nice_num, n_low_mul, n_hi_mul );
+
+          (* and the scale limits *)
+          scale_min  := FLOAT( n_low_mul ) * nice_num;
+          scale_max  := FLOAT( n_hi_mul  ) * nice_num;
+          actual_inc := n_hi_mul - n_low_mul;
+
+          (* heres the hack to fix the scale_max *)
+          scale_inc := ( scale_max - scale_min ) / FLOAT( actual_inc );
+
+          WHILE scale_max < data_max DO
+             scale_max := scale_max + nice_num;
+          END;
+
+          (* and fix scale_min too *)
+          WHILE scale_min > data_min DO
+             scale_min := scale_min - nice_num;
+          END;
+
+      END;
+   END Scale;
+
+       (* ---------------------------------------------------------- *)
+      PROCEDURE CalcExtLabel( data_min, data_max, nice_num :REAL;
+                              VAR n_low, n_high :INTEGER);
+      (* calculate an externally labeled scale *)
+      VAR
+        check :REAL;
+      BEGIN
+      
+        (* calculate the low multiple *)
+        n_low := TRUNC( data_min / nice_num );
+
+        (* double check it *)
+        (* make sure that we've got the largest possible minimum *)
+        check := FLOAT( n_low + 1 ) * nice_num;
+        IF check <= data_min THEN
+          n_low := n_low + 1;
+        END;
+
+        (* calculate the high multiple *)
+        n_high := TRUNC( ( data_max / nice_num ) + 0.5 );
+
+        (* double check it *)
+        (* make sure that we've got the smallest possible maximum *)
+        check := FLOAT( n_high - 1 ) * nice_num;
+        IF check >= data_max THEN
+          n_high := n_high - 1;
+        END;
+
+    END CalcExtLabel;
+
+       (* ---------------------------------------------------------- *)
+    PROCEDURE FirstNiceNum( interval_size :REAL; 
+                            VAR set_index :CARDINAL;
+                            VAR power_of_ten, nice_num :REAL );
+
+    (* calculate an initial value for the nice-number *)
+    (* Implementation notes: *)
+    (*   1) can a real be raised to a negative integer power ? *)
+
+    VAR
+      exponent :INTEGER;
+       
+    BEGIN
+    
+      (* calculate an initial power of ten *)
+      exponent := TRUNC( Log10( interval_size ) );
+      power_of_ten := power( 10.0, FLOAT( exponent ) );
+
+      (* double check it *)
+      IF power_of_ten * 10.0 <= interval_size THEN
+        power_of_ten := power_of_ten * 10.0;
+      END;
+
+      (* and the index into the set of number is initialy the first number *)
+      set_index := 1;
+
+      (* and return the first nice-number *)
+      nice_num := power_of_ten;
+
+    END FirstNiceNum;
+
+      (* ---------------------------------------------------------- *)
+      PROCEDURE NextNiceNum( VAR set_index :CARDINAL;
+                             VAR power_of_ten, nice_num :REAL );
+
+      (* calculate the next value for the nice-number *)
+      (* Implementation notes: *)
+      (*  1) should the check for the exceeded set size *)
+      (*     be ".ge." as it is in the book, or ".gt." *)
+      (*     since FORTRAN starts indicies at one rather *)
+      (*     than starting at zero as in the book. *)
+
+      BEGIN
+      
+        (* increment the index *)
+        set_index := set_index + 1;
+
+        (* if the maximum has been passed, then reset index to first *)
+        (* position, and increase the power of ten *)
+
+        IF set_index > n_set THEN
+          set_index    := 1;
+          power_of_ten := power_of_ten * 10.0;
+        END;
+
+        (* and return the next nice number *)
+
+        nice_num := nice_set[set_index] * power_of_ten;
+
+      END NextNiceNum;
+
+BEGIN
+
+ n_set := 3; (* actual length less one *)
+
+ nice_set[1] := 1.0;  nice_set[2] := 2.0;
+ nice_set[3] := 5.0;  nice_set[4] := 10.0;
+
+END LewertsScale.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/matrixope.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/matrixope.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/matrixope.def
@@ -0,0 +1,81 @@
+DEFINITION MODULE MatrixOperations;
+
+(* Matrix operations using dynamic memory *)
+
+(* V1.1, J. Andrea, Jun.22/93 -add Duplicate *)
+(* V1.0, J. Andrea, Mar.16/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+(*
+* For those operations which return a status in the boolean 'ok',
+* the value of 'ok' should be checked before attempting to use the
+* resultant matrix.
+* If 'ok' is FALSE, then the resultant matrix will not exist.
+*)
+
+EXPORT QUALIFIED Matrix,                           (* the type *)
+                 Build, Destroy,                   (* matrix creation/deletion*)
+                 Put, Get,                         (* element access *)
+                 Size, Min, Max, Compare,          (* status *)
+                 Ident, Assign,                    (* modify all elements *)
+                 Copy, Duplicate,                  (* new copy *)
+                 Scale, Add, Multiply,             (* basic operations *)
+                 Transpose, Invert, Determinant;   (* advanced operations *)
+
+TYPE Matrix;   (* opaque *)
+
+PROCEDURE Build( VAR a :Matrix; rows, columns :CARDINAL );
+(* create a matrix of the specified size *)
+
+PROCEDURE Destroy( VAR a :Matrix );
+(* get rid for the specified matrix *)
+
+PROCEDURE Put( a :Matrix; row, col :CARDINAL; value :REAL );
+(* put the specified value into the matrix at 'row,col' *)
+
+PROCEDURE Get( a :Matrix; row, col :CARDINAL ) :REAL;
+(* return the value at 'row,col' *)
+
+PROCEDURE Size( a :Matrix; VAR rows, cols :CARDINAL );
+(* return the size of a matrix *)
+
+PROCEDURE Min( a :Matrix ) :REAL;
+(* return the minimum value in the matrix *)
+
+PROCEDURE Max( a :Matrix ) :REAL;
+(* return the maximum value in the matrix *)
+
+PROCEDURE Compare( a, b :Matrix ) :BOOLEAN;
+(* compare two matricies, return TRUE if they are the same *)
+
+PROCEDURE Ident( a :Matrix );
+(* set the matrix to the identity matrix *)
+
+PROCEDURE Assign( a :Matrix; x :REAL );
+(* set all elements in the matrix to 'x' *)
+
+PROCEDURE Copy( a, b :Matrix );
+(* copy 'a' into 'b', iff sizes are the same *)
+
+PROCEDURE Duplicate( a :Matrix; VAR b :Matrix );
+(* copy 'a' into a new 'b' *)
+
+PROCEDURE Scale( a :Matrix; scale :REAL );
+(* multiply all elements of matrix 'a' by the scalar 'scale' *)
+
+PROCEDURE Add( a, b :Matrix; VAR c :Matrix; VAR ok :BOOLEAN );
+(* add matrix 'a' to 'b', and return 'ok' as TRUE if done *)
+
+PROCEDURE Multiply( a, b :Matrix; VAR c :Matrix; VAR ok :BOOLEAN );
+(* multiply matrix 'a' by 'b', and return 'ok' as TRUE if done *)
+
+PROCEDURE Transpose( a :Matrix; VAR b :Matrix );
+(* transpose matrix 'a' into a new matrix 'b' *)
+
+PROCEDURE Invert( a :Matrix; VAR b :Matrix; VAR ok :BOOLEAN );
+(* invert matrix 'a' into a new matrix 'b', and return 'ok' as TRUE if done *)
+
+PROCEDURE Determinant( a :Matrix; VAR d :REAL; VAR ok :BOOLEAN );
+(* return the determinant of 'a' in the value 'd' *)
+
+END MatrixOperations.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/matrixope.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/matrixope.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/matrixope.mod
@@ -0,0 +1,507 @@
+IMPLEMENTATION MODULE MatrixOperations;
+
+(* matrix operations using dynamic memory, see the corresponding definition *)
+
+(* V1.2, J. Andrea, Jun.22/93 -add Duplicate *)
+(* V1.1, J. Andrea, Jun.11/92 - recursive determinant for any size matrix *)
+(* V1.0, J. Andrea, Mar.16/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SYSTEM  IMPORT ADDRESS, TSIZE;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+
+TYPE
+  Matrix = POINTER TO RECORD
+             rows, cols :CARDINAL;   (* dimemsions of the matrix *)
+             start      :ADDRESS;    (* memory address of the first item *)
+             size       :CARDINAL;   (* actual size in bytes *)
+           END;
+
+  DataType  = REAL;
+  DataPoint = POINTER TO DataType;
+
+VAR
+  type_size :CARDINAL;             (* #bytes in a single item *)
+  delta     :DataType;             (* small number for some operations *)
+
+(* -------------------------------------------------------- *)
+PROCEDURE InRange( a :Matrix; row, col :CARDINAL ) :BOOLEAN;
+(* is the specified row/col item in this matrix ? *)
+BEGIN
+  RETURN ( row >= 1 ) & ( row <= a^.rows ) & ( col >= 1 ) & ( col <= a^.cols );
+END InRange;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Offset( a :Matrix; row, col :CARDINAL ) :CARDINAL;
+(* calculate the memory offset to the row/col item from the first item *)
+BEGIN
+  RETURN type_size * ( ( row - 1 ) * a^.cols + ( col - 1 ) );
+END Offset;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Build( VAR a :Matrix; n_rows, n_columns :CARDINAL );
+BEGIN
+  NEW( a );
+
+  (* get something *)
+  IF n_rows    = 0 THEN n_rows    := 1 END;
+  IF n_columns = 0 THEN n_columns := 1 END;
+
+  a^.rows := n_rows;
+  a^.cols := n_columns;
+
+  a^.size := n_rows * n_columns * type_size;
+  ALLOCATE( a^.start, a^.size );
+END Build;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Destroy( VAR a :Matrix );
+BEGIN
+  DEALLOCATE( a^.start, a^.size );
+  DISPOSE( a );
+END Destroy;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Put( a :Matrix; row, col :CARDINAL; x :DataType );
+VAR
+  adra :DataPoint;
+BEGIN
+  IF InRange( a, row, col ) THEN
+    adra  := a^.start + Offset( a, row, col );
+    adra^ := x;
+  END;
+END Put;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Get( a :Matrix; row, col :CARDINAL ) :DataType;
+VAR
+  adra   :DataPoint;
+  result :DataType;
+BEGIN
+  IF InRange( a, row, col ) THEN
+    adra   := a^.start + Offset( a, row, col );
+    result := adra^;
+  ELSE
+    result := 0.0;
+  END;
+  RETURN result;
+END Get;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Size( a :Matrix; VAR n_rows, n_cols :CARDINAL );
+BEGIN
+  n_rows := a^.rows;
+  n_cols := a^.cols;
+END Size;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Min( a :Matrix ) :DataType;
+VAR
+  result  :DataType;
+  adra    :DataPoint;
+  i, k, n :CARDINAL;
+BEGIN
+
+  n := a^.rows * a^.cols;
+
+  adra   := a^.start;
+  result := adra^;
+
+  k := type_size;
+  FOR i := 2 TO n DO
+     adra  := a^.start + k;
+     k     := k + type_size;
+     IF adra^ < result THEN result := adra^ END;
+  END;
+
+  RETURN result;
+END Min;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Max( a :Matrix ) :DataType;
+VAR
+  result  :DataType;
+  adra    :DataPoint;
+  i, k, n :CARDINAL;
+BEGIN
+
+  n := a^.rows * a^.cols;
+
+  adra   := a^.start;
+  result := adra^;
+
+  k := type_size;
+  FOR i := 2 TO n DO
+     adra  := a^.start + k;
+     k     := k + type_size;
+     IF adra^ > result THEN result := adra^ END;
+  END;
+
+  RETURN result;
+END Max;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Compare( a, b :Matrix ) :BOOLEAN;
+VAR
+  ok         :BOOLEAN;
+  adra, adrb :DataPoint;
+  i, k, n    :CARDINAL;
+BEGIN
+
+  IF ( a^.rows = b^.rows ) & ( a^.cols = b^.cols ) THEN
+
+    ok := TRUE;
+
+    n := a^.rows * a^.cols;
+
+    i := 1;
+    k := 0;
+    WHILE ok & ( i <= n ) DO
+       adra := a^.start + k;
+       adrb := b^.start + k;
+       k    := k + type_size;
+       ok   := ABS( adra^ - adrb^ ) <= delta;
+       i    := i + 1;
+    END;
+
+  ELSE
+    ok := FALSE;
+  END;
+
+  RETURN ok;
+
+END Compare;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Assign( a :Matrix; x :DataType );
+VAR
+  adra    :DataPoint;
+  i, k, n :CARDINAL;
+BEGIN
+  n := a^.rows * a^.cols;
+  k := 0;
+  FOR i := 1 TO n DO
+     adra  := a^.start + k;
+     adra^ := x;
+     k     := k + type_size;
+  END;
+END Assign;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Ident( a :Matrix );
+VAR
+  adra       :DataPoint;
+  i, j, k, n :CARDINAL;
+BEGIN
+
+  n   := a^.rows * a^.cols;
+  j   := 1;                  (* item number of first '1' *)
+  k   := 0;
+  FOR i := 1 TO n DO
+     adra := a^.start + k;
+
+     IF i = j THEN
+       adra^ := 1.0;
+       j     := j + a^.cols + 1;   (* next item number which will be a '1' *)
+     ELSE
+       adra^ := 0.0;
+     END;
+
+     k := k + type_size;
+  END;
+
+END Ident;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Copy( a, b :Matrix );
+VAR
+  adra, adrb :DataPoint;
+  i, k, n    :CARDINAL;
+BEGIN
+  IF ( a^.rows = b^.rows ) & ( a^.cols = b^.cols ) THEN
+
+    n := a^.rows * a^.cols;
+
+    k := 0;
+    FOR i := 1 TO n DO
+       adra  := a^.start + k;
+       adrb  := b^.start + k;
+       adrb^ := adra^;
+       k     := k + type_size;
+    END;
+
+  END;
+END Copy;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Duplicate( a :Matrix; VAR b :Matrix );
+BEGIN
+  Build( b, a^.rows, a^.cols );
+  Copy( a, b );
+END Duplicate;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Scale( a :Matrix; x :DataType );
+VAR
+  adra    :DataPoint;
+  i, k, n :CARDINAL;
+BEGIN
+
+  n := a^.rows * a^.cols;
+
+  k := 0;
+  FOR i := 1 TO n DO
+     adra  := a^.start + k;
+     adra^ := adra^ * x;
+     k     := k + type_size;
+  END;
+
+END Scale;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Add( a, b :Matrix; VAR c :Matrix; VAR ok :BOOLEAN );
+VAR
+  adra, adrb, adrc :DataPoint;
+  i, k, n          :CARDINAL;
+BEGIN
+
+  IF ( a^.rows # b^.rows ) OR ( a^.cols # b^.cols ) THEN
+    ok := FALSE;
+  ELSE
+
+    ok := TRUE;
+    Build( c, a^.rows, a^.cols );
+
+    n := a^.rows * a^.cols;
+
+    k := 0;
+    FOR i := 1 TO n DO
+       adra  := a^.start + k;
+       adrb  := b^.start + k;
+       adrc  := c^.start + k;
+       adrc^ := adra^ + adrb^;
+       k     := k + type_size;
+    END;
+
+  END;
+
+END Add;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Multiply( a, b :Matrix; VAR c :Matrix; VAR ok :BOOLEAN );
+VAR
+  sum              :DataType;
+  adra, adrb, adrc :DataPoint;
+  i, j, k          :CARDINAL;
+BEGIN
+
+  IF a^.cols # b^.rows THEN
+    ok := FALSE;
+  ELSE
+    ok := TRUE;
+
+    Build( c, a^.rows, b^.cols );
+
+    FOR i := 1 TO a^.rows DO
+      FOR j := 1 TO b^.cols DO
+
+        sum := 0.0;
+
+        FOR k := 1 TO a^.cols DO
+           adra := a^.start + Offset( a, i, k );
+           adrb := b^.start + Offset( b, k, j );
+           sum  := sum + adra^ * adrb^;
+        END;
+
+        adrc  := c^.start + Offset( c, i, j );
+        adrc^ := sum;
+
+      END;
+    END;
+
+  END;
+
+END Multiply;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Transpose( a :Matrix; VAR b :Matrix );
+VAR
+  adra, adrb :DataPoint;
+  i, j       :CARDINAL;
+BEGIN
+
+  Build( b, a^.cols, a^.rows );  (* flip dimensions *)
+
+  FOR i := 1 TO a^.rows DO
+    FOR j := 1 TO a^.cols DO
+       adra  := a^.start + Offset( a, i, j );
+       adrb  := b^.start + Offset( b, j, i );
+       adrb^ := adra^;
+    END;
+  END;
+
+END Transpose;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Invert( b :Matrix; VAR a :Matrix; VAR ok :BOOLEAN ); (* note a <-> b *)
+VAR
+  r, p             :DataType;
+  adra, adrb, adrc :DataPoint;
+  i, j, k, n       :CARDINAL;
+BEGIN
+
+  ok := TRUE;
+
+  IF ( b^.rows # b^.cols ) OR ( b^.rows < 2 ) THEN
+    ok := FALSE;       (* not square, forget it *)
+  ELSE
+
+    Copy( b, a );
+
+    n := a^.rows;
+
+    k := 1;
+    WHILE ok & ( k <= n ) DO
+
+      adra := a^.start + Offset( a, k, 1 );         (* pivot := mat(k,1) *)
+      p    := adra^;
+
+      IF p <= 1.E-10 THEN
+        ok := FALSE;  (* zero pivot point *)
+      ELSE
+
+        FOR j := 1 TO n - 1 DO
+           adra  := a^.start + Offset( a, k, j+1 );
+           adrb  := a^.start + Offset( a, k, j );
+           adrb^ := adra^ / p;                    (* mat(k,j) := mat(k,j+1)/p *)
+        END;
+
+        adra  := a^.start + Offset( a, k, n );
+        adra^ := 1.0 / p;                          (* mat(k,n) := 1/p *)
+
+        FOR i := 1 TO n DO
+           IF i # k THEN
+
+             adra := a^.start + Offset( a, i, 1 );
+             r    := adra^;                         (* r := mat(i,1) *)
+
+             FOR j := 1 TO n - 1 DO
+                adra  := a^.start + Offset( a, k, j );
+                adrb  := a^.start + Offset( a, i, j+1 );
+                adrc  := a^.start + Offset( a, i, j );
+                adrc^ := adrb^ - r * adra^; 
+                                     (* mat(i,j) := mat(i,j+1) - r * mat(k,j) *)
+             END;
+
+             adra  := a^.start + Offset( a, k, n );
+             adrb  := a^.start + Offset( a, i, n );
+             adrb^ := - r * adra^;              (* mat(i,n) := - r * mat(k,n) *)
+           END;
+        END;
+
+      END;
+
+      k := k + 1;
+    END;
+
+    IF NOT ok THEN
+      Destroy( b );
+    END;
+
+  END;
+
+END Invert;
+
+
+(* -------------------------------------------------------- *)
+PROCEDURE Determinant( a :Matrix; VAR d :DataType; VAR ok :BOOLEAN ); 
+VAR
+  n, i, j, p, q, k :CARDINAL;
+  b             :Matrix;
+  f, x, y, z    :DataType;
+  adra, adrb    :DataPoint;
+BEGIN
+ 
+   ok := TRUE;
+   n  := a^.rows;
+
+   IF n # a^.cols THEN
+     ok := FALSE;
+     d  := 0.0;
+   ELSE
+   
+     IF n = 1 THEN
+
+       adra := a^.start;
+       d    := adra^;
+
+     ELSIF n = 2 THEN
+
+       adra := a^.start;
+       adrb := a^.start + Offset( a, 2, 2 );
+       d    := adra^ * adrb^;
+       adra := a^.start + Offset( a, 2, 1 );
+       adrb := a^.start + Offset( a, 1, 2 );
+       d    := d - adra^ * adrb^;
+
+     ELSE
+     
+       z := 0.0;
+       f := 1.0;
+              
+       (* create sub matricies, and found their determinants *)
+       
+       Build( b, n-1, n-1 );
+
+       (* run across all the columns in the input matrix *)
+       FOR k := 1 TO n DO
+       
+          adra := a^.start + Offset( a, 1, k );
+          x    := adra^;
+       
+          (* skip any zero element *)
+          IF x # 0.0 THEN
+          
+            q := 1;
+            FOR j := 1 TO n DO
+            
+               (* skip the column that matches the top selected column *)
+               IF k # j THEN
+               
+                 (* pick up all the rows in this whole column *)
+                 FOR i := 2 TO n DO
+                    p := i - 1;
+                     
+                    adra  := a^.start + Offset( a, i, j );
+                    adrb  := b^.start + Offset( b, p, q );
+                    adrb^ := adra^;
+
+                 END;
+                 q := q + 1;
+                 
+             END;
+           END;
+           
+           Determinant( b, y, ok );
+           
+           z := z + f * x * y;  (* add in the result from that submatrix *)
+           
+         END;
+         f := - f; (* +-+-+-+-... is how the summing goes *)
+       END;
+       
+       Destroy( b );
+       
+       d := z; (* return the final result *)
+     END;
+
+   END;
+END Determinant;
+
+
+BEGIN
+
+  delta     := 1.E-6;
+  type_size := TSIZE( DataType );
+
+END MatrixOperations.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/moreio.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/moreio.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/moreio.def
@@ -0,0 +1,29 @@
+DEFINITION MODULE MoreIO;
+
+(* misc. extra i/o functions *)
+(* J. Andrea, Feb.18/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED ReadLine, WriteLeftString, WriteRightString;
+
+
+PROCEDURE ReadLine( VAR line :ARRAY OF CHAR );
+(*
+ Read a line from standard input into the given string.
+*)
+
+PROCEDURE WriteLeftString( string :ARRAY OF CHAR; width :CARDINAL );
+(*
+ Write a string to standard output, left justified into a fixed width field,
+ if the string is longer then the specified width then truncate the string,
+ if the string is shorter then the width, append spaces to fill the width.
+*)
+
+PROCEDURE WriteRightString( string :ARRAY OF CHAR; width :CARDINAL );
+(*
+ Write a string to standard output, right justified into a fixed width field,
+ if the string is longer then the specified width then truncate the string,
+ if the string is shorter then the width, prepend spaces to fill the width.
+*)
+
+END MoreIO.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/moreio.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/moreio.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/moreio.mod
@@ -0,0 +1,82 @@
+IMPLEMENTATION MODULE MoreIO;
+
+(* misc. extra i/o functions *)
+(* J. Andrea, Feb.18/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT Read, ReadLn, EOL, WriteString;
+FROM StringOperations IMPORT Length;
+
+VAR
+   i, n :CARDINAL;
+
+
+   (* ---------------------------------------------------- *)
+   PROCEDURE WriteLeftString( string :ARRAY OF CHAR; width :CARDINAL );
+   BEGIN
+      WriteFixString( string, width, TRUE );
+   END WriteLeftString;
+
+
+   (* ---------------------------------------------------- *)
+   PROCEDURE WriteRightString( string :ARRAY OF CHAR; width :CARDINAL );
+   BEGIN
+      WriteFixString( string, width, FALSE );
+   END WriteRightString;
+
+
+   (* ---------------------------------------------------- *)
+   PROCEDURE ReadLine( VAR line :ARRAY OF CHAR );
+
+   VAR
+      c :CHAR;
+
+   BEGIN (* ReadLine *)
+
+      n := HIGH( line ) + 1;
+
+      i := 0;
+      Read( c );
+
+      WHILE ( c # EOL ) & ( i < n ) DO
+         line[i] := c;  i := i + 1;
+         Read( c );
+      END;
+      ReadLn;
+
+      IF i < n THEN line[i] := 0C; END;
+
+   END ReadLine;
+
+
+   (* ---------------------------------------------------- *)
+   PROCEDURE WriteFixString( string :ARRAY OF CHAR; width :CARDINAL;
+                             left_justify :BOOLEAN );
+   BEGIN (* WriteFixString *)
+      IF width > 0 THEN
+
+        n := Length( string );
+
+        IF n <= width THEN
+
+          IF left_justify THEN WriteString( string ); END;
+
+          FOR i := n + 1 TO width DO
+             WriteString( ' ' );
+          END;
+
+          IF NOT left_justify THEN WriteString( string ); END;
+
+        ELSE
+
+          FOR i := 0 TO width - 1 DO
+             WriteString( string[i] );
+          END;
+
+        END;
+
+      END;
+   END WriteFixString;
+
+BEGIN
+END MoreIO.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/moremath.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/moremath.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/moremath.def
@@ -0,0 +1,72 @@
+DEFINITION MODULE MoreMath;
+
+(* misc. extra math functions *)
+(* more functions added, J. Andrea, Aug.13/91 *)
+(* J. Andrea, 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED   IModulus, CardPower, RealPower, IntPower, entier,
+                   MinReal, MaxReal, MinCard, MaxCard, MinInt, MaxInt,
+                   SizeCard, SizeInt, CalcPi, Log10, Log2;
+
+
+    PROCEDURE IModulus( a, b :INTEGER ) :INTEGER;
+    (* return the integer modulus of two numbers
+       handles a negative 'a' value (unlike the languages built in MOD) *)
+
+
+    PROCEDURE CardPower( base, exponent :CARDINAL ) :CARDINAL;
+    (* raise a cardinal to a cardinal power *)
+
+    PROCEDURE RealPower( base :REAL; exponent :CARDINAL ) :REAL;
+    (* raise a real to a cardinal power *)
+
+    PROCEDURE IntPower( base, exponent :INTEGER ) :INTEGER;
+    (* raise an integer to an integer power *)
+
+
+    PROCEDURE entier( a :REAL ) :INTEGER;
+    (* returns an INTEGER; as per definition in Seafarer's Guide pp. 36 *)
+
+
+    PROCEDURE MinReal( a, b :REAL ) :REAL;
+    (* return the smaller of 'a' and 'b' *)
+
+    PROCEDURE MaxReal( a, b :REAL ) :REAL;
+    (* return the larger of 'a' and 'b' *)
+
+
+    PROCEDURE MinCard( a, b :CARDINAL ) :CARDINAL;
+    (* return the smaller of 'a' and 'b' *)
+
+    PROCEDURE MaxCard( a, b :CARDINAL ) :CARDINAL;
+    (* return the larger of 'a' and 'b' *)
+
+
+    PROCEDURE MinInt( a, b :INTEGER ) :INTEGER;
+    (* return the smaller of 'a' and 'b' *)
+
+    PROCEDURE MaxInt( a, b :INTEGER ) :INTEGER;
+    (* return the larger of 'a' and 'b' *)
+
+
+    PROCEDURE SizeCard( a :CARDINAL ) :CARDINAL;
+    (* return the number of digits in 'a' *)
+
+    PROCEDURE SizeInt( a :INTEGER ) :CARDINAL;
+    (* return the number of digits in 'a', including a minus sign *)
+
+
+    PROCEDURE CalcPi() :REAL;
+    (* Return the value of Pi at maximum precision.
+       From a method by  J. Borwein and P. Borwein,
+       see:  "Ramanujan and Pi", Scientific American, Feb. 1988 *)
+
+
+    PROCEDURE Log10( x :REAL ) :REAL;
+    (* Return log base 10 of x *)
+    
+    PROCEDURE Log2( x :REAL ) :REAL;
+    (* Return log base 2 of x *)
+
+END MoreMath.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/morestrin.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/morestrin.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/morestrin.def
@@ -0,0 +1,42 @@
+DEFINITION MODULE MoreStrings;
+
+(* misc. extra string functions *)
+
+(* V3.0, J. Andrea, Jun.17/93 -move some extended functions to ExtendStrings *)
+(* V2.0, J. Andrea, Jun.26/92 -add Contains *)
+(* revitalized - J. Andrea, Aug.12/91 *)
+(* V1.0, J. Andrea, Apr 1986 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+
+EXPORT QUALIFIED EqualSubString,
+                 Locate, Contains;
+
+PROCEDURE EqualSubString( a, b :ARRAY OF CHAR;
+                          start, len :CARDINAL ) :BOOLEAN;
+(*
+ Compare similar substrings of two strings 'a' and 'b'.
+
+ If the specified position of the substring is not completely
+ contained in both 'a' and 'b' then FALSE is returned.
+*)
+
+
+PROCEDURE Locate( string, pattern :ARRAY OF CHAR;
+                  start :CARDINAL ) :CARDINAL;
+(*
+ Find the first occurance of 'pattern' in 'source' starting at the
+ 'start'TH character.
+ If the substring isn't found then a zero is returned.
+ If the substring is found then the relative position in 'source'
+   is returned. Relative positions start at 1, meaning first character.
+*)
+
+
+PROCEDURE Contains( string, pattern :ARRAY OF CHAR ) :BOOLEAN;
+(*
+ Does the 'pattern' occur in 'source', yes or no.
+ The case of characters is not signifigant.
+*)
+
+END MoreStrings.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/morestrin.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/morestrin.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/morestrin.mod
@@ -0,0 +1,169 @@
+IMPLEMENTATION MODULE MoreStrings;
+
+(* misc. extra string functions *)
+(* see definition module for algorithm notes *)
+(* V2.0, J. Andrea, Jun.17/93 -do only generic things here, move some VMS
+                               specific functions to a new ExtendStrings *)
+(* V1.0, J. Andrea, 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM StringOperations IMPORT Length;
+
+    (* -------------------------------------------------------- *)
+    PROCEDURE Contains( source, pattern :ARRAY OF CHAR ) :BOOLEAN;
+    VAR
+       len_s, len_p, s, p :CARDINAL;
+       done, found :BOOLEAN;
+    BEGIN
+
+       len_s := Length( source );
+
+       IF len_s = 0 THEN
+         RETURN FALSE;
+       ELSE
+
+         len_p := Length( pattern );
+
+         IF ( len_p = 0 ) OR ( len_p > len_s ) THEN
+           RETURN FALSE;
+         ELSE
+
+           found := FALSE;
+           done  := FALSE;
+
+           s := 0;
+
+           WHILE ( NOT done ) & ( NOT found ) DO
+
+             (* find the next occurance of the first char of the pattern *)
+             WHILE ( s < len_s ) & ( CAP(source[s]) # CAP(pattern[0]) ) DO
+                s := s + 1;
+             END;
+
+             IF s = len_s THEN
+               (* didn't find another first character match *)
+               done := TRUE;
+             ELSE
+
+               (* try to determine if the pattern fits here *)
+
+               IF len_s - s + 1 < len_p THEN
+                 (* the pattern won't fit in the remainder if the source *)
+                 done := TRUE;
+               ELSE
+
+                 (* ok, try to make a match *)
+
+                 p := 0;
+                 WHILE ( p < len_p ) & ( CAP(source[s+p]) = CAP(pattern[p]) ) DO
+                    p := p + 1;
+                 END;
+
+                 found := p = len_p;
+
+               END;
+
+             END;
+
+             s := s + 1;
+
+           END; (* while *)
+
+           RETURN found;
+
+         END;
+       END;
+
+    END Contains;
+
+
+    (* -------------------------------------------- *)
+    PROCEDURE Locate( source, pattern :ARRAY OF CHAR;
+                      start :CARDINAL ) :CARDINAL;
+    VAR
+      len_s, len_p, s, p :CARDINAL;
+     
+    BEGIN
+
+       (* start is not zero offset, its the start'th character *)
+       IF start = 0 THEN start := 1; END;
+
+       len_s := Length( source );
+
+       IF ( len_s = 0 ) OR ( start > len_s ) THEN
+         RETURN 0;
+       ELSE
+
+         len_p := Length( pattern );
+
+         IF ( len_p = 0 ) OR ( len_p > len_s ) THEN
+           RETURN 0;
+         ELSE
+
+           (* convert start back to zero offset for the open arrays *)
+           start := start - 1;
+           
+           (* keep trying to make comparisons till the pattern
+              will no longer fit at the end of the source *)
+
+           s := start;
+           WHILE len_s - s + 1 >= len_p DO
+
+             (* are the strings equal from this position to the end *)
+
+             p := 0;
+             WHILE ( p < len_p ) & ( source[s+p] = pattern[p] ) DO
+                  p := p + 1;
+             END;
+
+             IF p = len_p THEN   (* they are equal *)
+                RETURN s + 1;
+             END;
+
+             s := s + 1;
+           END;
+
+           RETURN 0;   (* if outside the loop, then not found *)
+
+         END;
+       END;
+    END Locate;
+
+
+    (* -------------------------------------------- *)
+    PROCEDURE EqualSubString( a, b :ARRAY OF CHAR;
+                              start, len :CARDINAL ) :BOOLEAN;
+    VAR
+      i, n :CARDINAL;
+    BEGIN
+
+       IF len = 0 THEN
+         RETURN FALSE;
+       ELSE
+
+         n := start + len - 1;
+
+         IF n > Length( a ) THEN
+           RETURN FALSE;
+         ELSE
+
+           IF n > Length( b ) THEN
+             RETURN FALSE;
+           ELSE
+
+             i := start - 1;
+             WHILE ( i < n ) & ( a[i] = b[i] ) DO
+               i := i + 1;
+             END;
+
+             RETURN i = n;
+
+           END;
+         END;
+       END;
+
+    END EqualSubString;
+
+
+BEGIN
+END MoreStrings.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/packarray.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/packarray.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/packarray.def
@@ -0,0 +1,83 @@
+DEFINITION MODULE PackArray;
+
+(* Operations on arrays of cardinals using dynamic memory,
+   the cardinals should be small so that they can be effectively packed into
+   word items in order to save memory space. *)
+(* V1.1, J. Andrea, Jun.22/93 -add Duplicate *)
+(* V1.0, J. Andrea, Jun.15/93 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+(*
+* For those operations which return a status in the boolean 'ok',
+* the value of 'ok' should be checked before attempting to use the
+* resultant array.
+* If 'ok' is FALSE, then the resultant will not exist.
+*)
+
+EXPORT QUALIFIED Array,                            (* the type *)
+                 Build, Destroy,                   (* creation/deletion *)
+                 Put, Get,                         (* element access *)
+                 Size, Min, Max, Compare,          (* status *)
+                 Assign,                           (* modify all elements *)
+                 Copy,                             (* copy every element *)
+                 Duplicate;                        (* new copy *)
+
+TYPE Array;   (* opaque *)
+
+PROCEDURE Build( VAR a :Array; minimum, maximum :CARDINAL;
+                 number_elements :CARDINAL );
+(*
+ Create an array of the specified number of elements,
+ also supply the minimum and maximum values for the data items.
+   This is intended to be used for small values ( say 0 to 8 or so ) so that
+ those values (taking 3 or 4 bits to represent) could be packed together into
+ larger data items in order to save memory space. Large values can be used
+ but if course the space saving efficiency will be lessened.
+   It's not really the absolute values that are wanted, but the difference
+ between them. For instance picking 100, 107 as the values is a difference of
+ 8 which will fit in 4 bits.
+*)
+
+PROCEDURE Destroy( VAR a :Array );
+(* Get rid for the specified object *)
+
+PROCEDURE Put( a :Array; element :CARDINAL; value :CARDINAL );
+(*
+ Put the specified value into the array at 'element'.
+ Trying to putting a value outside the specified range will cause the value
+ to be set to the range end (minimum or maximum).
+*)
+
+PROCEDURE Get( a :Array; element :CARDINAL ) :CARDINAL;
+(*
+ Return the value at 'element'.
+ Trying to get an element outside the array will result in a zero returned.
+*)
+
+PROCEDURE Size( a :Array; VAR bits, bytes, elements :CARDINAL );
+(*
+ Return the specifics about how the array is implemented.
+ bits  = number of bits used to implement the packed value,
+ bytes = number of bytes in the whole array (overhead excluded),
+ elements = number of elements in the array.
+*)
+
+PROCEDURE Min( a :Array ) :CARDINAL;
+(* Return the minimum value *)
+
+PROCEDURE Max( a :Array ) :CARDINAL;
+(* Return the maximum value *)
+
+PROCEDURE Compare( a, b :Array ) :BOOLEAN;
+(* Compare two, return TRUE if they are the same *)
+
+PROCEDURE Assign( a :Array; x :CARDINAL );
+(* Set all elements to 'x' *)
+
+PROCEDURE Copy( a, b :Array );
+(* Copy 'a' into 'b', if the sizes, etc. are exactly the same *)
+
+PROCEDURE Duplicate( a :Array; VAR b :Array );
+(* Make a duplicate of 'a' into a new 'b' *)
+
+END PackArray.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/packarray.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/packarray.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/packarray.mod
@@ -0,0 +1,395 @@
+IMPLEMENTATION MODULE PackArray;
+
+(* Array of small cardinal values packed into bit items,
+   see the corresponding definition *)
+(* V1.1, J. Andrea, Jun.22/93 -add Duplicate *)
+(* V1.0, J. Andrea, Jun.15/93 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SYSTEM  IMPORT ADDRESS, TSIZE;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+
+TYPE
+  ImplementationType = BITSET;
+  DataType           = CARDINAL;
+
+  Array = POINTER TO RECORD
+             length   :CARDINAL;   (* dimensions of the array *)
+             start    :ADDRESS;    (* memory address of the first item *)
+             min, max :DataType;   (* range of data items *)
+             bytes    :CARDINAL;   (* number of bytes in whole array *)
+             bits     :CARDINAL;   (* how many bits used to implement values *)
+             aligned  :BOOLEAN;    (* bits fit exactly in a word *)
+           END;
+
+VAR
+  bytes_per_word :CARDINAL;               (* #bytes in a single item *)
+  bits_per_word  :CARDINAL;               (* # bits *)
+  adra, adrb     :POINTER TO ImplementationType;  (* generic pointers *)
+
+(* -------------------------------------------------------- *)
+PROCEDURE InRange( a :Array; element :CARDINAL ) :BOOLEAN;
+(* is the specified row/col item in this array ? *)
+BEGIN
+  RETURN ( element >= 1 ) & ( element <= a^.length );
+END InRange;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Offsets( a :Array; element :CARDINAL;
+                   VAR word, word_bit,
+                       bits_in_first, bits_in_second :CARDINAL );
+(* The element should be known to be valid at this point. *)
+(* Calculate the memory offset to the element item from the first item *)
+
+VAR
+  element_first, element_last, word_first, word_last :CARDINAL;
+BEGIN
+
+       (* In absolute counts, find the end points of this element *)
+       (* These are not zero based *)
+
+  element_last  := a^.bits * element;
+  element_first := element_last - a^.bits + 1;
+
+       (* In which word does the current element begin *)
+       (* This one is zero based, so the "-1" is needed *)
+
+  word := ( element_first - 1 ) DIV bits_per_word;
+
+       (* In absolute counts, where does the current word begin *)
+       (* This is not zero based *)
+
+  word_first := 1 + word * bits_per_word;
+
+       (* The current element's first bit begins somewhere in the word *)
+       (* This is also zero based, so no +1 *)
+
+  word_bit := element_first - word_first;
+
+  IF a^.aligned THEN
+    bits_in_first  := a^.bits;
+    bits_in_second := 0;
+  ELSE
+
+    (* Otherwise figure out how much of this element is spread across the
+       two contiguous words, if at all *)
+
+       (* In absolute counts, the last bit in the word is *)
+
+    word_last := word_first + bits_per_word - 1;
+
+    IF element_last > word_last THEN
+
+      (* Find the distance from the beginning of the element to the end
+         of the word *)
+
+      bits_in_first  := word_last - element_first + 1;
+      bits_in_second := a^.bits - bits_in_first;
+
+    ELSE
+      bits_in_first  := a^.bits;
+      bits_in_second := 0;
+    END;
+  END;
+END Offsets;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Build( VAR a :Array; minimum, maximum, n_elements :CARDINAL );
+VAR
+  total_bits, total_words :CARDINAL;
+  i, k, n :CARDINAL;
+  temp    :DataType;
+BEGIN
+  NEW( a );
+
+  IF n_elements = 0 THEN n_elements := 1 END;
+
+  IF minimum > maximum THEN
+    temp    := maximum;
+    maximum := minimum;
+    minimum := temp;
+  END;
+
+  a^.min := minimum;
+  a^.max := maximum;
+
+  a^.length := n_elements;
+
+  (* here is the range *)
+  n := maximum - minimum + 1;
+
+  (* compute the number of bits needed to implement a number of that size *)
+  i := 0;
+  k := 1;
+  WHILE k < n DO
+    i := i + 1;
+    k := k * 2;
+  END;
+
+  a^.bits := i;
+  
+  a^.aligned := bits_per_word MOD a^.bits = 0;
+  
+  (* so the total number of bits for the whole array *)
+  total_bits := a^.bits * n_elements;
+
+  (* round total number of bits up to fill a whole word *)
+  k := total_bits MOD bits_per_word;
+  IF k # 0 THEN
+    total_bits := total_bits + bits_per_word - k;
+  END;
+
+  (* number of words to use *)
+  total_words := total_bits DIV bits_per_word;
+
+  (* and how many bytes in total *)
+  a^.bytes := total_words * bytes_per_word;
+
+  ALLOCATE( a^.start, a^.bytes );
+
+  (* zero out that piece of memory *)
+  k := 0;
+  FOR i := 1 TO total_words DO
+     adra  := a^.start + k;
+     adra^ := {};
+     k     := k + bytes_per_word;
+  END;
+
+END Build;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Destroy( VAR a :Array );
+BEGIN
+  DEALLOCATE( a^.start, a^.bytes );
+  DISPOSE( a );
+END Destroy;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Put( a :Array; element :CARDINAL; x :DataType );
+VAR
+  result                :ImplementationType;
+  which_word            :CARDINAL;
+  element_bit, word_bit :CARDINAL;
+  first_set, second_set :CARDINAL;
+  location              :CARDINAL;
+    
+  (* ------------------------------ *)
+  PROCEDURE Bits( n :CARDINAL );
+  VAR
+    i :CARDINAL;
+  BEGIN
+    FOR i := 1 TO n DO
+       IF element_bit IN result THEN
+         INCL( adra^, word_bit );
+       ELSE
+         EXCL( adra^, word_bit );
+       END;
+       INC( word_bit );
+       INC( element_bit );
+    END;
+   END Bits;
+   
+BEGIN
+  IF InRange( a, element ) THEN
+
+    IF x < a^.min THEN
+      x := a^.min;
+    ELSIF x > a^.max THEN
+      x := a^.max;
+    END;
+    result := BITSET( x - a^.min );
+
+    Offsets( a, element, which_word, word_bit, first_set, second_set );
+    location := which_word * bytes_per_word;
+    adra := a^.start + location;
+
+    element_bit := 0;
+    Bits( first_set );
+
+    IF second_set # 0 THEN
+      (* move to the second word and get the rest of the bits from it *)
+      adra     := a^.start + ( location + bytes_per_word );
+      word_bit := 0;
+      Bits( second_set );
+   END;
+
+  END;
+END Put;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Get( a :Array; element :CARDINAL ) :DataType;
+VAR
+  result                :ImplementationType;
+  which_word            :CARDINAL;
+  element_bit, word_bit :CARDINAL;
+  first_set, second_set :CARDINAL;
+  location              :CARDINAL;
+  
+  (* ----------------------- *)
+  PROCEDURE Bits( n :CARDINAL );
+  VAR
+    i :CARDINAL;
+  BEGIN
+    FOR i := 1 TO n DO
+      IF word_bit IN adra^ THEN
+        INCL( result, element_bit );
+      END;
+      INC( element_bit );
+      INC( word_bit );
+    END; 
+  END Bits;
+  
+BEGIN
+
+  IF NOT InRange( a, element ) THEN
+    RETURN 0;
+  ELSE
+
+    Offsets( a, element, which_word, word_bit, first_set, second_set );
+    location := which_word * bytes_per_word;
+    adra     := a^.start + location;
+
+    result := {};
+
+    element_bit := 0;
+    Bits( first_set );
+
+    IF second_set # 0 THEN
+      (* move to the second word and get the rest of the bits from it *)
+      adra := a^.start + ( location + bytes_per_word );
+      word_bit := 0;
+      Bits( second_set );
+    END;
+
+    RETURN CARDINAL( result ) + a^.min;
+  END;
+
+END Get;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Size( a :Array; VAR bits, bytes, elements :CARDINAL );
+BEGIN
+  bytes    := a^.bytes;
+  bits     := a^.bits;
+  elements := a^.length;
+END Size;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Min( a :Array ) :DataType;
+VAR
+  i         :CARDINAL;
+  x, result :DataType;
+BEGIN
+
+  result := Get( a, 1 );
+
+  (* Since the absolute minimum is predefined then might as well stop
+     if that minimum is reached *)
+
+  i := 2;
+  WHILE ( i <= a^.length ) & ( result > a^.min ) DO
+    x := Get( a, i );
+    IF x < result THEN result := x END;
+    i := i + 1;
+  END;
+
+  RETURN result;
+END Min;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Max( a :Array ) :DataType;
+VAR
+  i         :CARDINAL;
+  x, result :DataType;
+BEGIN
+
+  result := Get( a, 1 );
+
+  (* Since the absolute maximum is predefined then might as well stop
+     if that minimum is reached *)
+
+  i := 2;
+  WHILE ( i <= a^.length ) & ( result < a^.min ) DO
+    x := Get( a, i );
+    IF x > result THEN result := x END;
+    i := i + 1;
+  END;
+
+  RETURN result;
+END Max;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Compare( a, b :Array ) :BOOLEAN;
+VAR
+  same :BOOLEAN;
+  i, k :CARDINAL;
+  total_words :CARDINAL;
+BEGIN
+
+  IF a^.length # b^.length THEN
+    same := FALSE;
+  ELSE
+
+    same := TRUE;
+
+    total_words := a^.bytes DIV bytes_per_word;
+    i := 1;
+    k := 0;
+    WHILE same & ( i <= total_words ) DO
+      adra := a^.start + k;
+      adrb := b^.start + k;
+      same := adra^ = adrb^;
+      i    := i + 1;
+      k    := k + bytes_per_word;
+    END;
+
+  END;
+
+  RETURN same;
+
+END Compare;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Assign( a :Array; x :DataType );
+VAR
+  i :CARDINAL;
+BEGIN
+  FOR i := 1 TO a^.length DO
+     Put( a, i, x );
+  END;
+END Assign;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Copy( a, b :Array );
+VAR
+  i, k, total_words :CARDINAL;
+BEGIN
+  IF ( a^.min = b^.min ) & ( a^.max = b^.max ) & ( a^.length = b^.length ) THEN
+
+    total_words := a^.bytes DIV bytes_per_word;
+
+    k := 0;
+    FOR i := 1 TO total_words DO
+       adra  := a^.start + k;
+       adrb  := b^.start + k;
+       adrb^ := adra^;
+       k     := k + bytes_per_word;
+    END;
+
+  END;
+END Copy;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Duplicate( a :Array; VAR b :Array );
+BEGIN
+  Build( b, a^.min, a^.max, a^.length );
+  Copy( a, b );
+END Duplicate;
+
+
+BEGIN
+
+  bytes_per_word := TSIZE( ImplementationType );
+  bits_per_word  := bytes_per_word * 8;
+
+END PackArray.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/packmatri.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/packmatri.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/packmatri.def
@@ -0,0 +1,83 @@
+DEFINITION MODULE PackMatrix;
+
+(* Operations on matrices of cardinals using dynamic memory,
+   the cardinals should be small so that they can be effectively packed into
+   word items in order to save memory space. *)
+(* V1.1, J. Andrea, Jun.22/93 -add Duplicate *)
+(* V1.0, J. Andrea, Jun.15/93 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+(*
+* For those operations which return a status in the boolean 'ok',
+* the value of 'ok' should be checked before attempting to use the
+* resultant array.
+* If 'ok' is FALSE, then the resultant will not exist.
+*)
+
+EXPORT QUALIFIED Matrix,                           (* the type *)
+                 Build, Destroy,                   (* matrix creation/deletion *)
+                 Put, Get,                         (* element access *)
+                 Size, Min, Max, Compare,          (* status *)
+                 Assign,                           (* modify all elements *)
+                 Copy,                             (* copy every element *)
+                 Duplicate;                        (* new copy *)
+
+TYPE Matrix;   (* opaque *)
+
+PROCEDURE Build( VAR a :Matrix; minimum, maximum :CARDINAL;
+                 rows, cols :CARDINAL );
+(*
+ Create a matrix of the specified size,
+ also supply the minimum and maximum values for the data items.
+   This is intended to be used for small values ( say 0 to 8 or so ) so that
+ those values (taking 3 or 4 bits to represent) could be packed together into
+ larger data items in order to save memory space. Large values can be used
+ but if course the space saving efficiency will be lessened.
+   It's not really the absolute values that are wanted, but the difference
+ between them. For instance picking 100, 107 as the values is a difference of
+ 8 which will fit in 4 bits.
+*)
+
+PROCEDURE Destroy( VAR a :Matrix );
+(* Get rid for the specified object *)
+
+PROCEDURE Put( a :Matrix; row, col :CARDINAL; value :CARDINAL );
+(*
+ Put the specified value into the array at 'row, col'.
+ Trying to putting a value outside the specified range will cause the value
+ to be set to the range end (minimum or maximum).
+*)
+
+PROCEDURE Get( a :Matrix; row, col :CARDINAL ) :CARDINAL;
+(*
+ Return the value at 'element'.
+ Trying to get an element outside the matrix will result in a zero returned.
+*)
+
+PROCEDURE Size( a :Matrix; VAR bits, bytes, rows, cols :CARDINAL );
+(*
+ Return the specifics about how the matrix is implemented.
+ bits  = number of bits used to implement the packed value,
+ bytes = number of bytes in the whole array (overhead excluded),
+ rows,cols = size of matrix.
+*)
+
+PROCEDURE Min( a :Matrix ) :CARDINAL;
+(* Return the minimum value *)
+
+PROCEDURE Max( a :Matrix ) :CARDINAL;
+(* Return the maximum value *)
+
+PROCEDURE Compare( a, b :Matrix ) :BOOLEAN;
+(* Compare two, return TRUE if they are the same *)
+
+PROCEDURE Assign( a :Matrix; x :CARDINAL );
+(* Set all elements to 'x' *)
+
+PROCEDURE Copy( a, b :Matrix );
+(* Copy all of 'a' into 'b', iff the sizes, etc. are exactly the same *)
+
+PROCEDURE Duplicate( a :Matrix; VAR b :Matrix );
+(* Copy 'a' into a new 'b' *)
+
+END PackMatrix.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/packmatri.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/packmatri.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/packmatri.mod
@@ -0,0 +1,142 @@
+IMPLEMENTATION MODULE PackMatrix;
+
+(* Matrix of small cardinal values packed into bit items,
+   see the corresponding definition *)
+(* V1.1, J. Andrea, Jun.22/93 -add Duplictate, fix bug in Offset *)
+(* V1.0, J. Andrea, Jun.15/93 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+IMPORT PackArray;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+
+TYPE
+  DataType = CARDINAL;
+
+  Matrix = POINTER TO RECORD
+             rows, cols :CARDINAL;
+             min,  max  :DataType;
+             data       :PackArray.Array;
+           END;
+
+(* -------------------------------------------------------- *)
+PROCEDURE InRange( a :Matrix; row, col :CARDINAL ) :BOOLEAN;
+(* Is the specified row/col item in this matrix ? *)
+BEGIN
+  RETURN ( row >= 1 ) & ( row <= a^.rows ) & ( col >= 1 ) & ( col <= a^.cols );
+END InRange;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Offset( a :Matrix; row, col :CARDINAL ) :CARDINAL;
+(* Calculate the memory offset to the row/col item from the first item *)
+(* This is not zero based, so no "-1" *)
+BEGIN
+  RETURN ( row - 1 ) * a^.cols + col;
+END Offset;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Build( VAR a :Matrix; minimum, maximum, rows, cols :CARDINAL );
+VAR
+  temp :DataType;
+BEGIN
+  NEW( a );
+
+  IF rows = 0 THEN rows := 1 END;
+  IF cols = 0 THEN cols := 1 END;
+
+  a^.rows := rows;
+  a^.cols := cols;
+
+  IF minimum > maximum THEN
+    temp    := maximum;
+    maximum := minimum;
+    minimum := temp;
+  END;
+
+  a^.min := minimum;
+  a^.max := maximum;
+
+  PackArray.Build( a^.data, minimum, maximum, rows * cols );
+
+END Build;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Destroy( VAR a :Matrix );
+BEGIN
+  PackArray.Destroy( a^.data );
+  DISPOSE( a );
+END Destroy;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Put( a :Matrix; row, col :CARDINAL; x :DataType );
+BEGIN
+  IF InRange( a, row, col ) THEN
+    PackArray.Put( a^.data, Offset( a, row, col ), x );
+  END;
+END Put;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Get( a :Matrix; row, col :CARDINAL ) :DataType;
+BEGIN
+  IF NOT InRange( a, row, col ) THEN
+    RETURN 0;
+  ELSE
+    RETURN PackArray.Get( a^.data, Offset( a, row, col ) );
+  END;
+END Get;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Size( a :Matrix; VAR bits, bytes, rows, cols :CARDINAL );
+VAR
+  length :CARDINAL;
+BEGIN
+  rows := a^.rows;
+  cols := a^.cols;
+  PackArray.Size( a^.data, bits, bytes, length );
+END Size;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Min( a :Matrix ) :DataType;
+BEGIN
+  RETURN PackArray.Min( a^.data );
+END Min;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Max( a :Matrix ) :DataType;
+BEGIN
+  RETURN PackArray.Max( a^.data );
+END Max;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Compare( a, b :Matrix ) :BOOLEAN;
+BEGIN
+  IF ( a^.rows # b^.rows ) OR ( a^.cols # b^.cols ) THEN
+    RETURN FALSE;
+  ELSE
+    RETURN PackArray.Compare( a^.data, b^.data );
+  END;
+END Compare;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Assign( a :Matrix; x :DataType );
+BEGIN
+  PackArray.Assign( a^.data, x );
+END Assign;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Copy( a, b :Matrix );
+BEGIN
+  IF ( a^.min  = b^.min )  & ( a^.max  = b^.max  ) &
+     ( a^.rows = b^.rows ) & ( a^.cols = b^.cols ) THEN
+    PackArray.Copy( a^.data, b^.data );
+  END;
+END Copy;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Duplicate( a :Matrix; VAR b :Matrix );
+BEGIN
+  Build( b, a^.min, a^.max, a^.rows, a^.cols );
+  Copy( a, b );
+END Duplicate;
+
+BEGIN
+END PackMatrix.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/psdots.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/psdots.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/psdots.def
@@ -0,0 +1,28 @@
+DEFINITION MODULE PSDots;
+
+(* Put some dots on a PostScript page *)
+(* J. Andrea, Nov.13/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED
+   BeginPS, EndPS, GetDimensions, Dot, Title;
+
+PROCEDURE BeginPS( filename :ARRAY OF CHAR );
+(* define the output file to hold the graphics commands *)
+
+PROCEDURE EndPS;
+(* close the current output file *)
+
+PROCEDURE GetDimensions( VAR x, y :CARDINAL );
+(* return the maximum possible dimensions of the display *)
+
+PROCEDURE Dot( x, y :CARDINAL );
+(* draw a dot at the location *)
+(* columns are in the x direction, rows are in the y direction *)
+(* columns are in the width direction, rows are in the height direction *)
+
+PROCEDURE Title( string :ARRAY OF CHAR );
+(* put up a title *)
+(* this procedure is optional *)
+
+END PSDots.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/psdots.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/psdots.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/psdots.mod
@@ -0,0 +1,217 @@
+IMPLEMENTATION MODULE PSDots;
+
+(* J. Andrea, Nov.13/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM FileSystem IMPORT Done, Create, Close, WriteChar, File, EOL;
+
+CONST
+   absolute_rows = 776;
+   absolute_cols = 575;
+
+   margin        = 18;
+
+   max_rows      = absolute_rows - margin - margin;
+   max_cols      = absolute_cols - margin - margin;
+
+   max_buff      = 80;
+
+VAR
+  page          :ARRAY [1..max_rows] OF ARRAY [1..max_cols] OF BOOLEAN;
+
+  output_open   :BOOLEAN;
+
+  digits  :ARRAY [0..9] OF CHAR;
+  i       :CARDINAL;
+
+  outf    :File;
+
+  buffer  :ARRAY [1..max_buff] OF CHAR;
+  n_buff  :CARDINAL;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Flush;
+VAR i :CARDINAL;
+BEGIN
+
+  IF n_buff > 0 THEN
+    FOR i := 1 TO n_buff DO
+      WriteChar( outf, buffer[i] );
+    END;
+    WriteChar( outf, EOL );
+    n_buff := 0;
+  END;
+
+END Flush;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Output( string :ARRAY OF CHAR );
+(* write the given string to the output file *)
+VAR i, L :CARDINAL;
+BEGIN
+
+  L := LEN( string );
+  IF L + n_buff > max_buff THEN Flush; END;
+
+  L := L - 1;
+  FOR i := 0 TO L DO
+    n_buff := n_buff + 1;
+    buffer[n_buff] := string[i];
+  END;
+
+END Output;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE OutputNumber( x :CARDINAL );
+(* assumption that x is less than 1000 *)
+VAR num :ARRAY [0..2] OF CHAR;
+BEGIN
+
+  IF x > 99 THEN
+
+    (* 3 digits *)
+
+    i := x DIV 100;
+    num[0] := digits[i];
+    x := x - 100 * i;
+    i := x DIV 10;
+    num[1] := digits[i];
+    x := x - 10 * i;
+    num[2] := digits[x];
+
+  ELSE
+    IF x > 9 THEN
+
+      (* 2 digits *)
+
+      i := x DIV 10;
+      num[0] := digits[i];
+      x := x - 10 * i;
+      num[1] := digits[x];
+      num[2] := 0C;
+
+    ELSE
+
+      (* 1 digit *)
+      num[0] := digits[x];
+      num[1] := 0C;
+
+    END;
+  END;
+
+  Output( num );
+
+END OutputNumber;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE BeginPS( filename :ARRAY OF CHAR );
+(* define the output file to hold the graphics commands *)
+BEGIN
+  IF output_open THEN  EndPS;  END;
+
+  Create( outf, filename, TRUE, TRUE );
+
+  IF Done() THEN
+    output_open := TRUE;
+
+    n_buff := 0;
+
+    Output( '%!PS-Adobe' ); Flush;
+    Output( '/D { moveto 0 1 rlineto stroke } bind def' ); Flush;
+    Output( '18 18 translate 0 setlinewidth' ); Flush;
+
+  END;
+END BeginPS;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE EndPS;
+
+VAR
+  row, col :CARDINAL;
+
+BEGIN
+  IF output_open THEN
+
+    FOR row := 1 TO max_rows DO
+      FOR col := 1 TO max_cols DO
+         IF page[row][col] THEN
+           OutputNumber( col );
+           Output( ' ' );
+           OutputNumber( row );
+           Output( ' D ' );
+         END;
+      END;
+    END;
+
+    Output( ' showpage' ); Flush;
+    Output( 4C );
+    Flush;
+    Close( outf );
+    output_open := FALSE;
+  END;
+END EndPS;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE GetDimensions( VAR columns, rows :CARDINAL );
+(* return the dimensions of the display *)
+BEGIN
+  columns := max_cols;
+  rows    := max_rows;
+END GetDimensions;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Dot( col, row :CARDINAL );
+(* move to the new location, make a dot *)
+(* columns are in the x direction, rows are in the y direction *)
+(* columns are in the width direction, rows are in the height direction *)
+
+BEGIN
+  IF output_open THEN
+
+    IF col = 0 THEN
+      col := 1;
+    ELSE
+      IF col > max_cols THEN
+        col := max_cols;
+      END;
+    END;
+
+    IF row = 0 THEN
+      row := 1;
+    ELSE
+      IF row > max_rows THEN
+        row := max_rows;
+      END;
+    END;
+
+    page[row][col] := TRUE;
+
+  END;
+END Dot;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Title( string :ARRAY OF CHAR );
+BEGIN
+   Output( '2 2 moveto ' );
+   Output( '/Times-Roman findfont 10 scalefont setfont' );
+   Flush;
+
+   WriteChar( outf, '(' );
+   FOR i := 0 TO LEN( string ) - 1 DO
+     WriteChar( outf, string[i] );
+   END;
+   WriteChar( outf, ')' );
+   WriteChar( outf, EOL );
+
+   Output( 'show ' );
+END Title;
+
+BEGIN (* PSDots *)
+
+   output_open := FALSE;
+
+   FOR i := 0 TO 9 DO
+      digits[i] := CHAR( i + 48 );
+   END;
+
+END PSDots.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/psgraphic.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/psgraphic.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/psgraphic.def
@@ -0,0 +1,64 @@
+DEFINITION MODULE PSGraphics;
+
+(* simple PostScript Graphics routines *)
+(* J. Andrea, May.16/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+
+EXPORT QUALIFIED
+   BeginPS, EndPS,
+   GetDimensions,  GetPosition,
+   Border, Move, Dot, Line, Circle, Rectangle, VectorMove, VectorLine, Text,
+   Command;
+
+
+PROCEDURE BeginPS( filename :ARRAY OF CHAR );
+(* define the output file to hold the graphics commands *)
+
+PROCEDURE EndPS;
+(* close the current output file *)
+
+
+PROCEDURE GetDimensions( VAR x, y :CARDINAL );
+(* return the maximum possible dimensions of the display *)
+
+PROCEDURE GetPosition( VAR x, y :CARDINAL );
+(* return the current location of the cursor *)
+
+
+PROCEDURE Border;
+(* draw a border around the largest dimensions *)
+
+PROCEDURE Move( x, y :CARDINAL );
+(* move to the new location, make it the current point *)
+
+PROCEDURE Dot;
+(* draw a dot at the current location *)
+
+PROCEDURE Line( x, y :CARDINAL );
+(* draw a line from the current point to the new point,
+   and the new point will become the current point *)
+
+PROCEDURE Circle( radius :CARDINAL; filled :BOOLEAN );
+(* draw a circle of the given radius from the current point *)
+
+PROCEDURE Rectangle( width, height :CARDINAL; filled :BOOLEAN );
+(* draw a rectangle, one corner at current point,
+   opposite corner at current+width,current+height *)
+
+PROCEDURE VectorMove( length :CARDINAL; angle :REAL );
+(* move from the current location given a length and angle *)
+
+PROCEDURE VectorLine( length :CARDINAL; angle :REAL );
+(* draw a line from the current location given a length and angle,
+   and the new point will become the current point *)
+
+PROCEDURE Text( string :ARRAY OF CHAR; size :CARDINAL );
+(* put some text at the current location *)
+
+
+PROCEDURE Command( string :ARRAY OF CHAR );
+(* put some other PostScript command into the output stream *)
+
+
+END PSGraphics.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/psgraphic.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/psgraphic.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/psgraphic.mod
@@ -0,0 +1,542 @@
+IMPLEMENTATION MODULE PSGraphics;
+
+(* simple PostScript Graphics routines *)
+(* J. Andrea, May.16/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM FileSystem IMPORT Done, Create, Close, WriteChar, File, EOL;
+FROM MathLib0   IMPORT sin, cos;
+
+CONST
+   absolute_rows = 776;
+   absolute_cols = 575;
+
+   row_offset    = 20;
+   col_offset    = 20;
+
+   max_rows      = absolute_rows - row_offset;
+   max_cols      = absolute_cols - col_offset;
+
+VAR
+  current_row, current_col :CARDINAL;
+  true_row,    true_col    :CARDINAL;
+
+  output_open              :BOOLEAN;
+
+  biggest :CARDINAL;
+
+  digits  :ARRAY [0..9] OF CHAR;
+  i       :CARDINAL;
+
+  outf    :File;
+
+  font_chosen  :CARDINAL;
+
+  unstroked_lines :CARDINAL;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE CheckLocation( row, col :CARDINAL; VAR new_row, new_col :CARDINAL );
+(* don't allow new position to be out of bounds *)
+BEGIN
+   IF row > max_rows THEN row := max_rows; END;
+   IF col > max_cols THEN col := max_cols; END;
+   new_row := row;   new_col := col;
+END CheckLocation;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE TrueLocation;
+(* and invert positions so that y (rows) run bottom to top,
+   and apply offsets as required *)
+BEGIN
+   true_row := current_row + row_offset;
+   true_col := current_col + col_offset;
+END TrueLocation;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Output( string :ARRAY OF CHAR );
+(* write the given string to the output file *)
+VAR i, L :CARDINAL;
+BEGIN
+
+  L := LEN( string ) - 1;
+  FOR i := 0 TO L DO
+    WriteChar( outf, string[i] );
+  END;
+END Output;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE OutputNumber( x :CARDINAL );
+(* assumption that x is less than 1000 *)
+
+BEGIN
+
+  IF x > 99 THEN
+
+    (* 3 digits *)
+
+    i := x DIV 100;
+    WriteChar( outf, digits[i] );
+    x := x - 100 * i;
+    i := x DIV 10;
+    WriteChar( outf, digits[i] );
+    x := x - 10 * i;
+    WriteChar( outf, digits[x] );
+
+  ELSE
+    IF x > 9 THEN
+
+      (* 2 digits *)
+
+      i := x DIV 10;
+      WriteChar( outf, digits[i] );
+      x := x - 10 * i;
+      WriteChar( outf, digits[x] );
+
+    ELSE
+
+      (* 1 digit *)
+
+      WriteChar( outf, digits[x] );
+
+    END;
+  END;
+
+END OutputNumber;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE NewLine;
+BEGIN
+  WriteChar( outf, EOL );
+END NewLine;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE DoingALine( yes :BOOLEAN );
+(* define the output file to hold the graphics commands *)
+
+  (* ----------------------------------------------- *)
+  PROCEDURE DoStroke;
+  BEGIN
+     Output( 'stroke' ); NewLine;
+     unstroked_lines := 0;
+
+     (* but where did the current point go, it disappeared with
+        to stroke, so get a new current point *)
+     Move( current_col, current_row );
+  END DoStroke;
+
+BEGIN
+
+  IF yes THEN
+
+    IF unstroked_lines = 0 THEN
+
+      (* if there arn't any lines already done, then there probably isn't
+         a PostScript current point, make one *)
+      Move( current_col, current_row );
+
+    ELSE
+
+      (* every 1000 lines do a stroke because of a possible PostScript limit *)
+      IF unstroked_lines > 1000 THEN
+        DoStroke;
+      END;
+
+    END;
+
+    unstroked_lines := unstroked_lines + 1;
+
+  ELSE
+
+    (* this next operation won't be a line, so if there are lines
+       left over, we better paint them *)
+
+    IF unstroked_lines > 0 THEN
+      DoStroke;
+    END;
+
+  END;
+
+END DoingALine;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE BeginPS( filename :ARRAY OF CHAR );
+(* define the output file to hold the graphics commands *)
+BEGIN
+  IF output_open THEN  EndPS;  END;
+
+  Create( outf, filename, TRUE, TRUE );
+
+  IF Done() THEN
+    output_open := TRUE;
+
+    Output( '%!' ); NewLine;
+    Output( '/L { lineto } bind def' ); NewLine;
+    Output( '/M { moveto } bind def' ); NewLine;
+
+    current_row := 0; current_col := 0;
+    font_chosen := 0;
+    unstroked_lines := 0;
+
+  END;
+END BeginPS;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE EndPS;
+(* close the current output file *)
+BEGIN
+  IF output_open THEN
+    IF unstroked_lines > 0 THEN Output( 'stroke ' ); END;
+    Output( 'showpage' ); NewLine;
+    Close( outf );
+    output_open := FALSE;
+  END;
+END EndPS;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE GetDimensions( VAR columns, rows :CARDINAL );
+(* return the dimensions of the display *)
+BEGIN
+  columns := max_cols;
+  rows    := max_rows;
+END GetDimensions;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE GetPosition( VAR column, row :CARDINAL );
+(* return the current location of the cursor *)
+BEGIN
+  column := current_col;
+  row    := current_row;
+END GetPosition;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Border;
+(* draw a border *)
+BEGIN
+  IF output_open THEN
+    DoingALine( FALSE );
+
+    (* move to the corner *)
+    Move( col_offset, row_offset );
+
+    (* output the lines to draw the border, using relative motion *)
+    OutputNumber( max_cols );
+    Output( ' ' );
+    OutputNumber( 0 );
+    Output( ' rlineto' );
+
+    Output( ' ' );
+    OutputNumber( max_rows );
+    Output( ' ' );
+    OutputNumber( 0 );
+    Output( ' rlineto' );
+
+    Output( ' ' );
+    OutputNumber( max_cols );
+    Output( ' neg ' );
+    OutputNumber( 0 );
+    Output( ' rlineto' );
+
+    Output( ' closepath stroke' ); NewLine;
+
+    (* return to the current location *)
+    Move( current_col, current_row );
+
+  END;
+END Border;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Move( column, row :CARDINAL );
+(* move to the new location, make it the current point *)
+BEGIN
+  IF output_open THEN
+    DoingALine( FALSE );
+
+    CheckLocation( row, column, current_row, current_col );
+    TrueLocation;
+
+    OutputNumber( true_col );
+    Output( ' ' );
+    OutputNumber( true_row );
+    Output( ' M' );
+    NewLine;
+  END;
+END Move;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Dot;
+(* draw a dot at the current location *)
+BEGIN
+  IF output_open THEN
+    TrueLocation;
+    Line( true_col, true_row+1 );
+  END;
+END Dot;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Line( column, row :CARDINAL );
+(* draw a line from the current point to the new point *)
+BEGIN
+  IF output_open THEN
+
+    DoingALine( TRUE );
+
+    CheckLocation( row, column, current_row, current_col );
+    TrueLocation;
+
+    OutputNumber( true_col );
+    Output( ' ' );
+    OutputNumber( true_row );
+    Output( ' L' );
+    NewLine;
+  END;
+END Line;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Circle( radius :CARDINAL; filled :BOOLEAN );
+(* draw a circle of the given radius from the current point *)
+BEGIN
+  IF output_open THEN
+    IF radius > biggest THEN radius := biggest; END;
+
+    TrueLocation;
+
+    DoingALine( FALSE );
+
+    OutputNumber( true_col );
+    Output( ' ' );
+    OutputNumber( true_row );
+
+    Output( ' ' );
+    OutputNumber( radius );
+    Output( ' 0 360 arc ' );
+
+    Output( ' closepath' );
+
+    IF filled THEN
+      Output( ' fill' );
+    ELSE
+      Output( ' stroke' );
+    END;
+    NewLine;
+
+    (* return to the current location *)
+    Move( current_col, current_row );
+  END;
+END Circle;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Rectangle( width, height :CARDINAL; filled :BOOLEAN );
+(* draw a rectangle, one corner at current point,
+   opposite corner at current+width,current+height *)
+BEGIN
+  IF output_open THEN
+    IF width  + current_col > max_cols THEN
+      width  := max_cols - current_col; END;
+    IF height + current_row > max_rows THEN
+      height := max_rows - current_row; END;
+
+    DoingALine( FALSE );
+
+    OutputNumber( width );
+    Output( ' ' );
+    OutputNumber( 0 );
+    Output( ' rlineto' );
+
+    Output( ' ' );
+    OutputNumber( height );
+    Output( ' ' );
+    OutputNumber( 0 );
+    Output( ' rlineto' );
+
+    Output( ' ' );
+    OutputNumber( width );
+    Output( ' neg ' );
+    OutputNumber( 0 );
+    Output( ' rlineto' );
+
+    Output( ' closepath' );
+
+    IF filled THEN
+      Output( ' fill' );
+    ELSE
+      Output( ' stroke' );
+    END;
+    NewLine;
+
+    (* return to the current location *)
+    Move( current_col, current_row );
+  END;
+END Rectangle;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Vector( length :CARDINAL; angle :REAL;
+                  VAR new_col, new_row :CARDINAL );
+
+VAR
+  a, z  :REAL;
+  delta :CARDINAL;
+
+  (* ------------------------ *)
+  PROCEDURE Delta( length :REAL ) :CARDINAL;
+  BEGIN
+    length := ABS( length );
+    IF length > FLOAT( biggest ) THEN
+      RETURN biggest;
+    ELSE
+      RETURN CARDINAL( TRUNC( length ) );
+    END;
+  END Delta;
+
+BEGIN
+
+   IF length > biggest THEN
+     length := biggest;
+   END;
+
+   a := ABS( angle );
+
+   WHILE a >= 360. DO
+     a := a - 360.
+   END;
+
+   IF angle >= 0. THEN
+     angle := a;
+   ELSE
+     angle := 360. - a;
+   END;
+
+   IF ( angle <= 1. ) OR ( angle >= 359. ) THEN
+     new_col := current_col + length;
+     new_row := current_row;
+   ELSE
+     IF ( angle >= 89. ) AND ( angle <= 91. ) THEN
+       new_row := current_row + length;
+       new_col := current_col;
+     ELSE
+       IF ( angle >= 179. ) AND ( angle <= 181. ) THEN
+         IF length >= current_col THEN
+           new_col := 0;
+         ELSE
+           new_col := current_col - length;
+         END;
+         new_row := current_row;
+       ELSE
+         IF ( angle >= 269. ) AND ( angle <= 271. ) THEN
+           IF length >= current_row THEN
+             new_row := 0;
+           ELSE
+             new_row := current_row - length;
+           END;
+           new_col := current_col;
+         ELSE
+
+           a := angle * 3.141592653 / 180.;
+
+           z := FLOAT( length ) * sin( a );
+
+           IF z >= 0. THEN
+             new_row := current_row + Delta(z);
+           ELSE
+             delta := Delta(z);
+             IF delta >= current_row THEN
+               new_row := 0;
+             ELSE
+               new_row := current_row - delta;
+             END;
+           END;
+
+           z := FLOAT( length ) * cos( a );
+
+           IF z >= 0. THEN
+             new_col := current_col + Delta(z);
+           ELSE
+             delta := Delta(z);
+             IF delta >= current_col THEN
+               new_col := 0;
+             ELSE
+               new_col := current_col - delta;
+             END;
+           END;
+
+         END;
+       END;
+     END;
+   END;
+
+END Vector;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE VectorLine( length :CARDINAL; angle :REAL );
+(* draw a line from the current location given a length and angle *)
+VAR
+  new_row, new_col :CARDINAL;
+
+BEGIN
+  IF output_open THEN
+    Vector( length, angle, new_col, new_row );
+    Line( new_col, new_row );
+  END;
+END VectorLine;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE VectorMove( length :CARDINAL; angle :REAL );
+(* move from the current location given a length and angle *)
+VAR
+  new_row, new_col :CARDINAL;
+
+BEGIN
+  IF output_open THEN
+    Vector( length, angle, new_col, new_row );
+    Move( new_col, new_row );
+  END;
+END VectorMove;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Text( string :ARRAY OF CHAR; size :CARDINAL );
+(* put up some text at the current location *)
+BEGIN
+  IF output_open THEN
+    DoingALine( FALSE );
+
+    IF size > biggest THEN size := biggest END;
+
+    IF font_chosen # size THEN
+      font_chosen := size;
+      Output( '/Times-Roman findfont ' );
+      OutputNumber( size );
+      Output( ' scalefont setfont' );
+      NewLine;
+    END;
+
+    Output( '(' ); Output( string ); Output( ')show' ); NewLine;
+
+    (* return to the current location *)
+    Move( current_col, current_row );
+  END;
+END Text;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Command( string :ARRAY OF CHAR );
+(* put some other PostScript command into the output stream *)
+BEGIN
+  IF output_open THEN
+    DoingALine( FALSE );
+    Output( string ); NewLine;
+  END;
+END Command;
+
+BEGIN (* PSGraphics *)
+
+   output_open := FALSE;
+
+   IF absolute_rows > absolute_cols THEN
+     biggest := absolute_rows;
+   ELSE
+     biggest := absolute_cols;
+   END;
+
+   FOR i := 0 TO 9 DO
+      digits[i] := CHAR( i + 48 );
+   END;
+
+END PSGraphics.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/queues.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/queues.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/queues.def
@@ -0,0 +1,44 @@
+DEFINITION MODULE Queues;
+
+(*
+ This module provides procedures for queue'ing (lifo, fifo, and combinations)
+ objects up to 512 bytes in size.
+ A queue may be made of non-homogeneous objects, but care muse be taken to pop
+ data into the same format as there object which was push'ed.
+ If an item longer than 512 bytes is pushed, then only the first 512 bytes is
+ stored on the queue. And conversely, only as much data is pop'ed as can be
+ stored in the object which will contain the pop'ed item.
+*)
+(* J. Andrea, Oct.11/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SYSTEM IMPORT BYTE;
+
+EXPORT QUALIFIED Queue, Directions, InitQueue, Pop, Push, DelQueue, QueueInfo;
+
+TYPE
+   Queue; (* hidden *)
+
+   Directions = (Top,Bottom);
+
+PROCEDURE InitQueue( VAR a_queue :Queue );
+(* Create a queue, this must be called before the first Push *)
+
+PROCEDURE Push( a_queue :Queue; which_end :Directions; data :ARRAY OF BYTE );
+(* Push an item onto the Queue, any item up to 512 bytes in size *)
+
+PROCEDURE Pop( a_queue :Queue; which_end :Directions;
+               VAR data :ARRAY OF BYTE; VAR nothing_to_pop :BOOLEAN );
+(* Pop the next item from the queue,
+   return 'empty' as TRUE is there is nothing to get popped *)
+
+PROCEDURE DelQueue( VAR a_queue :Queue );
+(* Delete the queue completely *)
+
+PROCEDURE QueueInfo( a_queue :Queue; which_end :Directions;
+                     VAR n_items, size :CARDINAL );
+(* Get some information about the queue
+   'n_items' is the number of items currently on the queue,
+   'size'    is the size of the item at the specified end of the queue *)
+
+END Queues.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/queues.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/queues.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/queues.mod
@@ -0,0 +1,190 @@
+IMPLEMENTATION MODULE Queues;
+
+(* Procedures for non-homogeneous multi-direction queue data structure *)
+(* John Andrea, Oct.11/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SYSTEM IMPORT BYTE;
+FROM MoreMath IMPORT MinCard;
+FROM Storage  IMPORT ALLOCATE, DEALLOCATE;
+
+CONST
+   max_data   = 511;
+
+TYPE
+   DataPtr   = POINTER TO QueueData;
+   QueueData = RECORD
+                 data        :ARRAY [0..max_data] OF BYTE;
+                 size        :CARDINAL;
+                 top, bottom :DataPtr;
+               END;
+
+   Queue     = POINTER TO AQueue;
+   AQueue    = RECORD
+                 top, bottom :DataPtr;
+                 n           :CARDINAL;
+               END;
+
+VAR
+   q      :DataPtr;
+   max, i :CARDINAL;
+
+   (* ------------------------------------------- *)
+   PROCEDURE InitQueue( VAR a_queue :Queue );
+   (* Create a queue, this must be called before the queue is used *)
+   BEGIN
+
+     NEW( a_queue );
+     a_queue^.n      := 0;
+     a_queue^.top    := NIL;
+     a_queue^.bottom := NIL;
+
+   END InitQueue;
+
+   (* ------------------------------------------- *)
+   PROCEDURE Push( a_queue :Queue; which_end :Directions; data :ARRAY OF BYTE );
+   (* Push an item onto the queue *)
+   BEGIN
+
+     NEW( q );
+
+     max     := MinCard( HIGH(data), max_data );
+     q^.size := max;
+
+     FOR i := 0 TO max DO
+        q^.data[i] := data[i];
+     END;
+
+     (* and setup the correct pointers *)
+
+     a_queue^.n := a_queue^.n + 1;
+
+     IF a_queue^.n = 1 THEN
+
+       q^.top          := NIL;
+       q^.bottom       := NIL;
+
+       (* this is the only item on the queue, top and bottom are same place *)
+       a_queue^.top    := q;
+       a_queue^.bottom := q;
+
+     ELSE
+
+       IF which_end = Top THEN
+
+         q^.top    := NIL;
+         q^.bottom := a_queue^.top;
+
+         (* the new item is the top of the old top *)
+         a_queue^.top^.top := q;
+
+         (* the new item is the new top *)
+         a_queue^.top := q;
+
+       ELSE
+
+         q^.top    := a_queue^.bottom;
+         q^.bottom := NIL;
+
+         (* the new item is the bottom of the old bottom *)
+         a_queue^.bottom^.bottom := q;
+
+         (* the new item is the new bottom *)
+         a_queue^.bottom := q;
+
+       END;
+     END;
+
+   END Push;
+
+   (* ------------------------------------------- *)
+   PROCEDURE Pop( a_queue :Queue; which_end :Directions;
+                  VAR data :ARRAY OF BYTE; VAR nothing_to_pop :BOOLEAN );
+   (* Get an item from the queue *)
+   BEGIN
+
+     IF a_queue^.n = 0 THEN
+       nothing_to_pop := TRUE;
+     ELSE
+       nothing_to_pop := FALSE;
+
+       IF which_end = Top THEN
+         q := a_queue^.top;
+       ELSE
+         q := a_queue^.bottom;
+       END;
+
+       (* move the data *)
+
+       max := MinCard( HIGH(data), q^.size );
+       FOR i := 0 TO max DO
+          data[i] := q^.data[i];
+       END;
+
+       (* reset the pointers *)
+
+       a_queue^.n := a_queue^.n - 1;
+
+       IF a_queue^.n = 0 THEN
+         (* nothing left in the queue, set both top and bottom to empty *)
+         a_queue^.top    := NIL;
+         a_queue^.bottom := NIL;
+
+       ELSE
+
+         IF which_end = Top THEN
+           a_queue^.top := q^.bottom;
+         ELSE
+           a_queue^.bottom := q^.top;
+         END;
+
+       END;
+
+       (* get rid of the item which was just pop'ed *)
+
+       DISPOSE( q );
+
+     END;
+
+   END Pop;
+
+   (* ------------------------------------------- *)
+   PROCEDURE DelQueue( VAR a_queue :Queue );
+   (* Complete delete a queue *)
+   BEGIN
+
+      WHILE a_queue^.top # NIL DO
+         q := a_queue^.top^.bottom;
+         DISPOSE( a_queue^.top );
+         a_queue^.top := q;
+      END;
+
+      DISPOSE( a_queue );
+
+   END DelQueue;
+
+   (* ------------------------------------------- *)
+   PROCEDURE QueueInfo( a_queue :Queue; which_end :Directions;
+                        VAR n_items, size :CARDINAL );
+   (* Return some info about a queue *)
+   BEGIN
+
+     n_items := a_queue^.n;
+     IF n_items = 0 THEN
+       size := 0;
+     ELSE
+
+       IF which_end = Top THEN
+         size := a_queue^.top^.size;
+       ELSE
+         size := a_queue^.bottom^.size;
+       END;
+
+       size := size + 1; (* to account for the zero offset *)
+
+     END;
+
+   END QueueInfo;
+
+BEGIN
+END Queues.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/randomly.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/randomly.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/randomly.def
@@ -0,0 +1,54 @@
+DEFINITION MODULE Randomly;
+
+(* procedures for getting random numbers *)
+(* J. Andrea, Jun.2/92 - add NormalRandom *)
+(* J. Andrea, Oct.4/91, add min and max input to RandomReal *)
+(* J. Andrea, Sep.10/91, add "1 to n-1" procedure *)
+(* J. Andrea, 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED
+        RandomReal, NormalRandom,
+        Choose_0_To_N, Choose_0_To_N_Minus_1, 
+        Choose_1_To_N, Choose_1_To_N_Minus_1, 
+        InputSeed, MakeSeed;
+
+
+PROCEDURE RandomReal( min, max :REAL ) :REAL;
+(* return a real number X, such that:  min >= X < max  *)
+
+
+PROCEDURE NormalRandom( mean, sigma :REAL ) :REAL;
+(* return a real number X, as a random value over a normal distribution
+   given the mean and sigma *)
+   
+
+PROCEDURE Choose_0_To_N( n :CARDINAL) :CARDINAL;
+(* return a cardinal A, with given N, such that:  0 >= A <= N *)
+
+
+PROCEDURE Choose_0_To_N_Minus_1( n :CARDINAL) :CARDINAL;
+(* return a cardinal A, with given N, such that:  0 >= A <= N-1 *)
+
+
+PROCEDURE Choose_1_To_N( n :CARDINAL) :CARDINAL;
+(* return a cardinal A, with given N, such that:  1 >= A <= N *)
+
+
+PROCEDURE Choose_1_To_N_Minus_1( n :CARDINAL) :CARDINAL;
+(* return a cardinal A, with given N, such that:  1 >= A <= N-1 *)
+
+
+PROCEDURE InputSeed( seed :INTEGER );
+(* Use this procedure to start the random sequence with you own seed.
+   The seed should be a large odd value.
+   Using the same seed will result in the same sequence. *)
+   
+
+PROCEDURE MakeSeed;
+(* create a seed from the current time of day. *)
+(* This procedure is called as the startup for this module and so
+   there is generally no need to call this procedure *)
+
+
+END Randomly.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/realarray.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/realarray.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/realarray.def
@@ -0,0 +1,66 @@
+DEFINITION MODULE RealArrays;
+
+(* Operations on a dynamic array of reals *)
+
+(* V1.1, J, Andrea, Jun.22/93 -add Duplicate *)
+(* V1.0, J, Andrea, May.18/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+(*
+* For those operations which return a status in the boolean 'ok',
+* the value of 'ok' should be checked before attempting to use the
+* resultant matrix.
+* If 'ok' is FALSE, then the resultant matrix will not exist.
+*)
+
+EXPORT QUALIFIED RealArray,                        (* the type *)
+                 Build, Destroy,                   (* matrix creation/deletion*)
+                 Put, Get,                         (* element access *)
+                 Size, Compare,                    (* status *)
+                 Assign,                           (* per element *)
+                 Copy, Duplicate,                  (* new copy *)
+                 Min, Max,                         (* basic operations *)
+                 Add, Multiply;                    (* basic operations *)
+
+TYPE RealArray;   (* opaque *)
+
+PROCEDURE Build( VAR a :RealArray; min_index, max_index :CARDINAL );
+(* create a new array of the specified size *)
+
+PROCEDURE Destroy( VAR a :RealArray );
+(* get rid for the specified RealArray *)
+
+PROCEDURE Put( a :RealArray; index :CARDINAL; value :REAL );
+(* put the specified value into the RealArray at the index *)
+
+PROCEDURE Get( a :RealArray; index :CARDINAL ) :REAL;
+(* return the value at 'index' *)
+
+PROCEDURE Size( a :RealArray; VAR min_index, max_index :CARDINAL );
+(* return the size of the array *)
+
+PROCEDURE Min( a :RealArray ) :REAL;
+(* return the minimum value in the array *)
+
+PROCEDURE Max( a :RealArray ) :REAL;
+(* return the maximum value in the array *)
+
+PROCEDURE Compare( a, b :RealArray ) :BOOLEAN;
+(* compare two arrays, return TRUE if they are the same in size and contents *)
+
+PROCEDURE Assign( a :RealArray; x :REAL );
+(* set all elements in the array to 'x' *)
+
+PROCEDURE Copy( a, b :RealArray );
+(* copy 'a' into 'b', iff sizes are the same *)
+
+PROCEDURE Duplicate( a :RealArray; VAR b :RealArray );
+(* copy 'a' into a new 'b' *)
+
+PROCEDURE Add( a :RealArray; x :REAL );
+(* add 'x' to all elements of 'a' *)
+
+PROCEDURE Multiply(  a :RealArray; x :REAL );
+(* multiply 'x' by all elements of 'a' *)
+
+END RealArrays.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/realarray.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/realarray.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/realarray.mod
@@ -0,0 +1,228 @@
+IMPLEMENTATION MODULE RealArrays;
+
+(* Operations on a dynamic array of reals *)
+
+(* V1.1, J. Andrea, Jun.22/93 -add Duplicate *)
+(* V1.0, J. Andrea, May.18/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM SYSTEM  IMPORT ADDRESS, TSIZE;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+
+TYPE
+  RealArray = POINTER TO RECORD
+             min, max :CARDINAL;      (* dimemsions of the matrix *)
+             start    :ADDRESS;       (* memory address of the first item *)
+             size     :CARDINAL;      (* actual size in bytes *)
+           END;
+
+
+  ArrayType = REAL;
+
+VAR
+  type_size  :CARDINAL;             (* #bytes in a single item *)
+
+(* -------------------------------------------------------------- *)
+PROCEDURE Build( VAR a :RealArray; min_index, max_index :CARDINAL );
+VAR
+  i :CARDINAL;
+BEGIN
+  NEW( a );
+
+  IF min_index > max_index THEN
+    i         := min_index;
+    min_index := max_index;
+    max_index := i;
+  END;
+
+  a^.min := min_index;
+  a^.max := max_index;
+
+  a^.size := ( max_index - min_index + 1 ) * type_size;
+
+  ALLOCATE( a^.start, a^.size );
+END Build;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Destroy( VAR a :RealArray );
+BEGIN
+  DEALLOCATE( a^.start, a^.size );
+  DISPOSE( a );
+END Destroy;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Put( a :RealArray; index :CARDINAL; value :ArrayType );
+VAR
+  adra :POINTER TO ArrayType;
+BEGIN
+  IF ( a^.min <= index ) & ( index <= a^.max ) THEN
+    adra  := a^.start + ( index - a^.min ) * type_size;
+    adra^ := value;
+  END;
+END Put;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Get( a :RealArray; index :CARDINAL ) :ArrayType;
+VAR
+  adra :POINTER TO ArrayType;
+BEGIN
+  IF ( a^.min <= index ) & ( index <= a^.max ) THEN
+    adra := a^.start + ( index - a^.min ) * type_size;
+    RETURN adra^;
+  ELSE
+    RETURN 0.0;
+  END;
+END Get;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Size( a :RealArray; VAR min_index, max_index :CARDINAL );
+BEGIN
+  min_index := a^.min;
+  max_index := a^.max;
+END Size;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Min( a :RealArray ) :ArrayType;
+VAR
+  adra   :POINTER TO ArrayType;
+  i, k   :CARDINAL;
+  result :ArrayType;
+BEGIN
+
+  k := 0;
+
+  adra   := a^.start;
+  result := adra^;
+
+  FOR i := a^.min+1 TO a^.max DO
+     k     := k + type_size;
+     adra  := a^.start + k;
+     IF adra^ < result THEN result := adra^ END;
+  END;
+
+  RETURN result;
+END Min;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Max( a :RealArray ) :ArrayType;
+VAR
+  adra   :POINTER TO ArrayType;
+  i, k   :CARDINAL;
+  result :ArrayType;
+BEGIN
+
+  k := 0;
+
+  adra   := a^.start;
+  result := adra^;
+
+  FOR i := a^.min+1 TO a^.max DO
+     k     := k + type_size;
+     adra  := a^.start + k;
+     IF adra^ > result THEN result := adra^ END;
+  END;
+
+  RETURN result;
+END Max;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Compare( a, b :RealArray ) :BOOLEAN;
+VAR
+  adra, adrb :POINTER TO ArrayType;
+  i, k :CARDINAL;
+  ok   :BOOLEAN;
+BEGIN
+  IF ( a^.min = b^.min ) & ( a^.max = b^.max ) THEN
+
+    ok := TRUE;
+
+    k := 0;
+    i := a^.min;
+    WHILE ok & ( i <= a^.max ) DO
+       adra  := a^.start + k;
+       adrb  := b^.start + k;
+       ok    := adra^ = adrb^;
+       k     := k + type_size;
+       i     := i + 1;
+    END;
+
+  ELSE
+    ok := FALSE;
+  END;
+
+  RETURN ok;
+END Compare;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Assign( a :RealArray; x :ArrayType );
+VAR
+  adra :POINTER TO ArrayType;
+  i, k :CARDINAL;
+BEGIN
+  k := 0;
+  FOR i := a^.min TO a^.max DO
+     adra  := a^.start + k;
+     adra^ := x;
+     k     := k + type_size;
+  END;
+END Assign;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Copy( a, b :RealArray );
+VAR
+  adra, adrb :POINTER TO ArrayType;
+  i, k :CARDINAL;
+BEGIN
+  IF ( a^.min = b^.min ) & ( a^.max = b^.max ) THEN
+
+    k := 0;
+    FOR i := a^.min TO a^.max DO
+       adra  := a^.start + k;
+       adrb  := b^.start + k;
+       adrb^ := adra^;
+       k     := k + type_size;
+    END;
+
+  END;
+END Copy;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Duplicate( a :RealArray; VAR b :RealArray );
+VAR
+  adra :POINTER TO ArrayType;
+BEGIN
+  Build( b, a^.min, a^.max );
+  Copy( a, b );
+END Duplicate;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Add( a :RealArray; x :ArrayType );
+VAR
+  adra :POINTER TO ArrayType;
+  i, k :CARDINAL;
+BEGIN
+  k := 0;
+  FOR i := a^.min TO a^.max DO
+     adra  := a^.start + k;
+     adra^ := adra^ + x;
+     k     := k + type_size;
+  END;
+END Add;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Multiply(  a :RealArray; x :ArrayType );
+VAR
+  adra :POINTER TO ArrayType;
+  i, k :CARDINAL;
+BEGIN
+  k := 0;
+  FOR i := a^.min TO a^.max DO
+     adra  := a^.start + k;
+     adra^ := adra^ * x;
+     k     := k + type_size;
+  END;
+END Multiply;
+
+BEGIN
+  type_size := TSIZE( ArrayType );
+END RealArrays.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/romannume.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/romannume.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/romannume.def
@@ -0,0 +1,47 @@
+DEFINITION MODULE RomanNumerals;
+
+(* convert to/from strings of Roman Numerals to cardinal values *)
+(* J. Andrea, Sept.5/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+
+EXPORT QUALIFIED FromRoman, ToRoman;
+
+
+PROCEDURE FromRoman( numerals :ARRAY OF CHAR; VAR value :CARDINAL );
+(*
+ Convert from a Roman numeral string to a number.
+ Zero is returned if the given string is an invalid roman numeral,
+ remember that Romans didn't know the concept of zero.
+
+ This routine is fairly robust, it will attempt to convert
+ improper roman numbers, but the result may be strange.
+
+ It is also very forgiving of badly formed roman numerals
+ and will always produce a result, though it may not be what is expected
+ but remember, garbage in -> garbage out.
+
+ Things like this will get translated:
+
+ iv = 4          this is normal, and properly formed
+ vv = 10         not proper, but acceptable
+ iiv = 3         this is improperly formed, but result is as expected
+ iiiiv = 1       same as above
+ iiiiiv = 10     the group of 5 i's is not smaller than V so add rather
+                 than subtract
+ vvx = 20        again, VV is not smaller than X, so add them
+ ivx = 6         think of it as ((iv)x) = 10 - (5-1) = 10-4 = 6
+ viiiiii = 1     5,6 the 5 is smaller so its subtracted from 6
+ ivvx = 1        i(vv)x = 1(10)10 = (9)10 = 1
+*)
+
+
+PROCEDURE ToRoman( value :CARDINAL; VAR numerals :ARRAY OF CHAR );
+(*
+ Convert from a cardinal value to a Roman numeral string.
+ An impossible number returns an empty string or if the output string is
+ not long enough to hold the value then an empty string is also returned.
+*)
+
+
+END RomanNumerals.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/romannume.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/romannume.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/romannume.mod
@@ -0,0 +1,239 @@
+IMPLEMENTATION MODULE RomanNumerals;
+(* convert to/from strings of Roman Numerals to cardinal values *)
+
+(* J. Andrea, Jun.4/92 - more compact numbers, and more correct *)
+(* J. Andrea, Nov.9/91 - better ToRoman *)
+(* J. Andrea, Sept.6/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM StringOperations IMPORT Index, Length;
+
+CONST
+   nul = 0C;
+
+VAR
+   Numerals :ARRAY [1..7] OF CHAR;
+   Values   :ARRAY [1..7] OF CARDINAL;
+   i, k     :CARDINAL;
+   ok       :BOOLEAN;
+   len, max_len :CARDINAL;
+
+   (* -------------------------------------------------------------- *)
+   PROCEDURE FromRoman( roman :ARRAY OF CHAR; VAR value :CARDINAL );
+
+   CONST
+     max_groups = 10;   (* this may not be a valid assumption *)
+
+   VAR
+     c, prev :CHAR;
+     group   :ARRAY [1..max_groups] OF CARDINAL;
+     n_group :CARDINAL;
+     prev_group, curr_group :CARDINAL;
+
+   BEGIN
+
+     len := Length( roman );
+
+     IF len = 0 THEN
+       value := 0;
+     ELSE
+
+       (* in this first section, break the roman numeral into groups *)
+       (* of same values *)
+
+       n_group := 0;   prev := nul;
+
+       i := 0;  ok := TRUE;
+       WHILE ok & ( i < len ) DO
+
+         c := CAP( roman[i] );
+
+         k := Index( Numerals, c );
+
+         IF k = 0 THEN
+           ok := FALSE;
+         ELSE
+
+           IF c = prev THEN
+
+             (* same group *)
+             group[n_group]  := group[n_group] + Values[k];
+
+           ELSE
+
+             (* new group *)
+             n_group := n_group + 1;
+             IF n_group > max_groups THEN
+               (* algorithm error *)
+               ok := FALSE;
+             ELSE
+
+               group[n_group]  := Values[k];
+               prev            := c;
+
+             END;
+
+           END;
+
+           i := i + 1;
+         END;
+       END;
+
+       value := 0;
+
+       IF ok THEN
+
+         IF n_group = 1 THEN
+
+           value := group[1];
+
+         ELSE
+
+           (* force the last group to be zero *)
+           n_group := n_group + 1;
+           group[n_group] := 0;
+
+           (* now add of subtract the groups to form a number *)
+
+           prev_group := group[1];
+           i := 2;
+
+           WHILE i <= n_group DO
+              curr_group := group[i];
+
+              IF prev_group < curr_group THEN
+                prev_group := curr_group - prev_group;
+              ELSE
+                value      := value + prev_group;
+                prev_group := curr_group;
+              END;
+
+              i := i + 1;
+           END;
+
+         END;
+
+       END;
+
+     END;
+
+   END FromRoman;
+
+
+   (* -------------------------------------------------------------- *)
+   PROCEDURE ToRoman( value :CARDINAL; VAR roman :ARRAY OF CHAR );
+
+   VAR
+     s, subtract :CARDINAL;
+
+     (* -------------------------------------------------------------- *)
+     PROCEDURE AddChar( c :CHAR );
+     BEGIN
+       IF len <= max_len THEN
+         roman[len] := c; len := len + 1;
+       ELSE
+         ok := FALSE;
+       END;
+     END AddChar;
+     PROCEDURE InitChar;
+     BEGIN
+       len     := 0;
+       max_len := HIGH( roman );
+       ok      := TRUE;
+     END InitChar;
+     PROCEDURE EndChar;
+     BEGIN
+       IF len <= max_len THEN  roman[len] := nul; END;
+     END EndChar;
+   
+   BEGIN
+
+     InitChar;
+
+     IF value > 0 THEN
+
+       (* remove any large numbers first *)
+       k := 7;
+       WHILE ok & ( value >= Values[k] ) DO
+         AddChar( Numerals[k] );
+         value := value - Values[k];
+       END;
+         
+       (* determine the compound numeral string that represents the value *)
+
+       k := 7;
+       WHILE ok & ( value > 0 ) DO
+
+         (* special case for anything less than five *)
+                
+         IF value < 5 THEN
+           IF value = 4 THEN
+             AddChar( 'I' ); AddChar( 'V' );
+           ELSE
+             FOR i := 1 TO value DO
+                AddChar( 'I' );
+             END;
+           END;
+           value := 0;
+         ELSE
+         
+           (* find numeral which is less than or equal to the current value *)
+           WHILE Values[k] > value DO
+             k := k - 1;
+           END;
+           
+           IF value = Values[k] THEN
+             (* its an exact match *)
+             AddChar( Numerals[k] );
+             value := 0;
+           ELSE
+           
+             (* see if this next value can be made up of a roman subtraction *)
+             (* keeping in mind that only 1, 10, 100, ... can be subtracted  *)
+             (*  from anything, which are the numerals with odd indicies *)
+             (* and you can only subtract one level away, eg. not 1 from 100 *)
+             
+             i := k + 1;  (* the next larger numeral *)
+             IF ODD( i ) THEN
+               s := i - 2;
+             ELSE
+               s := i - 1;
+             END;
+             
+             subtract := Values[i] - Values[s];
+
+             IF subtract > value THEN
+               (* not a numeral subtract (IX, IV, etc.), so just do a subtract *)
+               value := value - Values[k];
+               AddChar( Numerals[k] );
+             ELSE
+               (* it is a subtract, do it *)
+               value := value - subtract;
+               AddChar( Numerals[s] ); AddChar( Numerals[i] );
+             END;
+           END;
+         END;
+       END; (* while *)
+         
+     END;
+
+     IF ok THEN
+       EndChar;
+     ELSE
+       (* something wrong, return an empty string *)
+       roman[0] := nul;
+     END;
+
+   END ToRoman;
+
+BEGIN
+
+  Numerals[1] := 'I';    Values[1] := 1;
+  Numerals[2] := 'V';    Values[2] := 5;
+  Numerals[3] := 'X';    Values[3] := 10;
+  Numerals[4] := 'L';    Values[4] := 50;
+  Numerals[5] := 'C';    Values[5] := 100;
+  Numerals[6] := 'D';    Values[6] := 500;
+  Numerals[7] := 'M';    Values[7] := 1000;
+
+END RomanNumerals.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/saynumber.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/saynumber.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/saynumber.def
@@ -0,0 +1,26 @@
+DEFINITION MODULE SayNumbers;
+
+(* Make a cardinal number into a phrase of words of numbers *)
+(* V1.0, J. Andrea, Oct.11/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+(*
+The output string should be long enough to hold the output,
+the following table lists the lognest output from zero up to:
+10 is 3 at 5 chars, "three"
+100 is 73 at 13 chars, "seventy three"
+1,000 is 373 at 27 chars, "three hundred seventy three"
+10,000 is 3373 at 42 chars, "three thousand three hundred seventy three"
+65535 is 23373 at 49 chars, "twenty three thousand three hundred seventy three"
+100,000 is 73373 at 50 chars, "seventy three thousand three hundred seventy three""
+1,000,000 is 373373 at 64 chars, "three hundred seventy three thousand three hundred seventy three"
+10,000,000 is 3373373 at 78 chars, "three million three hundred seventy three thousand three hundred seventy three"
+*)
+
+EXPORT QUALIFIED SayCard, SayInt;
+
+  PROCEDURE SayCard( x :CARDINAL; VAR word :ARRAY OF CHAR );
+
+  PROCEDURE SayInt( x :INTEGER; VAR word :ARRAY OF CHAR );
+
+END SayNumbers.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/saynumber.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/saynumber.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/saynumber.mod
@@ -0,0 +1,183 @@
+IMPLEMENTATION MODULE SayNumbers;
+
+(* Make a cardinal number into a phrase of words of numbers *)
+(* V1.0, J. Andrea, Oct.11/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+(*
+The term "order" here is used as a power of one thousand, i.e.
+0 to 999 is order 0, 1000 to 999999 is order 1, 1000000 is order 2, etc.
+*)
+
+FROM MoreMath IMPORT SizeCard;
+FROM StringOperations IMPORT Assign, Delete, Append, Insert;
+
+CONST
+  longest = 10; (* number of decimal digits in the longest number *)
+                (* 5 is good for 16 bits, 9 for 32 bits *)
+  max_order = 4; (* the power of 1 thousand for the longest number *)
+                 (* 1 is good for 16 bits, 2 for 32 bits *)
+
+VAR
+  n_order_values :CARDINAL;
+  order_values   :ARRAY [0..max_order] OF CARDINAL;
+
+  size_to_order  :ARRAY [0..longest] OF CARDINAL;
+
+  order_name :ARRAY [0..max_order] OF ARRAY [1..11] OF CHAR;
+
+  digit_name :ARRAY [0..9] OF ARRAY [1..5] OF CHAR;
+  teen_name  :ARRAY [0..9] OF ARRAY [1..9] OF CHAR;
+  tens_name  :ARRAY [1..9] OF ARRAY [1..7] OF CHAR;
+
+  i :CARDINAL;
+
+  (* ---------------------------------------------------- *)
+  PROCEDURE SayInt( x :INTEGER; VAR word :ARRAY OF CHAR );
+  BEGIN
+    IF x = 0 THEN
+      Assign( digit_name[0], word );
+    ELSE
+      SayCard( CARDINAL( ABS( x ) ), word );
+      Insert( 'minus ', 1, word );
+    END;
+  END SayInt;
+
+  (* ---------------------------------------------------- *)
+  PROCEDURE SayCard( x :CARDINAL; VAR word :ARRAY OF CHAR );
+  VAR
+    top, order_size, order_value :CARDINAL;
+
+    (* -------------------------------------------------- *)
+    PROCEDURE Say100( x :CARDINAL );
+    VAR
+      d :CARDINAL;
+    BEGIN
+      IF x > 99 THEN
+        d := x DIV 100;
+        Append( ' ', word );
+        Append( digit_name[d], word );
+        Append( ' hundred', word );
+        x := x - d * 100;
+      END;
+
+      IF ( x >= 10 ) & ( x <= 19 ) THEN
+        Append( ' ', word ); Append( teen_name[x-10], word );
+      ELSE
+
+        IF x > 10 THEN
+          d := x DIV 10;
+          Append( ' ', word ); Append( tens_name[d], word );
+          x := x - d * 10;
+        END;
+
+        IF x > 0 THEN
+          Append( ' ', word ); Append( digit_name[x], word );
+        END;
+      END;
+
+    END Say100;
+
+  BEGIN
+
+     IF x = 0 THEN
+       Assign( digit_name[0], word );
+     ELSE
+
+       word[0] := 0C;
+
+       WHILE x > 0 DO
+         order_size := size_to_order[ SizeCard( x ) ];
+
+
+         WHILE order_size > n_order_values DO
+           order_value := order_values[n_order_values];
+           n_order_values := n_order_values + 1;
+           order_values[n_order_values] := order_value * 1000;
+         END;
+
+         order_value := order_values[ order_size ];
+
+         (* get the value which is less than one thousand *)
+         top := x DIV order_value;
+
+         Say100( top );
+
+         IF order_size > 0 THEN
+           (* and now say order too *)
+           Append( ' ', word ); Append( order_name[order_size], word );
+         END;
+
+         x := x - top * order_value;
+       END;
+
+       WHILE word[0] = ' ' DO
+          Delete( word, 1, 1 );
+       END;
+
+     END;
+
+  END SayCard;
+
+BEGIN
+
+     Assign( "ones",     order_name[0] );
+     Assign( "thousand", order_name[1] );
+     Assign( "million",  order_name[2] );
+     Assign( "billion",  order_name[3] );
+     Assign( "trillion", order_name[4] );
+(*
+     IF max_order > 4 THEN Assign( "quadrillion", order_name[5] ) END;
+     IF max_order > 5 THEN Assign( "quintillion", order_name[6] ) END;
+     IF max_order > 6 THEN Assign( "sextillion", order_name[7] ) END;
+     IF max_order > 7 THEN Assign( "septillion", order_name[8] ) END;
+     IF max_order > 8 THEN Assign( "octillion", order_name[9] ) END;
+*)
+
+     Assign( "zero",  digit_name[0] );
+     Assign( "one",   digit_name[1] );
+     Assign( "two",   digit_name[2] );
+     Assign( "three", digit_name[3] );
+     Assign( "four",  digit_name[4] );
+     Assign( "five",  digit_name[5] );
+     Assign( "six",   digit_name[6] );
+     Assign( "seven", digit_name[7] );
+     Assign( "eight", digit_name[8] );
+     Assign( "nine",  digit_name[9] );
+
+     Assign( "ten",       teen_name[0] );
+     Assign( "eleven",    teen_name[1] );
+     Assign( "twelve",    teen_name[2] );
+     Assign( "thirteen",  teen_name[3] );
+     Assign( "fourteen",  teen_name[4] );
+     Assign( "fifteen",   teen_name[5] );
+     Assign( "sixteen",   teen_name[6] );
+     Assign( "seventeen", teen_name[7] );
+     Assign( "eighteen",  teen_name[8] );
+     Assign( "nineteen",  teen_name[9] );
+
+     Assign( "ten",     tens_name[1] );
+     Assign( "twenty",  tens_name[2] );
+     Assign( "thirty",  tens_name[3] );
+     Assign( "fourty",  tens_name[4] );
+     Assign( "fifty",   tens_name[5] );
+     Assign( "sixty",   tens_name[6] );
+     Assign( "seventy", tens_name[7] );
+     Assign( "eighty",  tens_name[8] );
+     Assign( "ninety",  tens_name[9] );
+
+     (* precompute the order for any length of number *)
+     size_to_order[0] := 0;
+     FOR i := 1 TO longest DO
+        size_to_order[i] := ( i - 1 ) DIV 3;
+     END;
+
+     (* and precompute some values of the orders *)
+     (* if a nigher level value is needed, it will be computed later *)
+     (* only having smal ones here also allows code to be moved *)
+     (* from platform to platform with no changes *)
+     n_order_values := 1;
+     order_values[0] := 1;
+     order_values[1] := 1000;
+
+END SayNumbers.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/setofchar.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/setofchar.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/setofchar.def
@@ -0,0 +1,53 @@
+DEFINITION MODULE SetOfChar;
+
+(*
+ Some implementations cannot handle SETs of CHAR type because that type has
+ too large a range. This module overcomes that limitation, allowing for
+ 256 character values, from zero to 255.
+*)
+(* V1.1, J. Andrea, Jun.22/93 -add Duplicate *)
+(* V1.0, J. Andrea, Apr.5/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+EXPORT QUALIFIED CharSet,
+                 Build, Destroy, Empty, Fill,
+                 Incl,  Excl,    In,
+                 Not,   Equal,
+                 Copy,  Duplicate;
+
+TYPE CharSet;   (* opaque *)
+
+PROCEDURE Build( VAR s :CharSet );
+(* create a set *)
+
+PROCEDURE Destroy( VAR s :CharSet );
+(* get rid of the specified set *)
+
+PROCEDURE Empty( s :CharSet );
+(* turn off all elements *)
+
+PROCEDURE Fill( s :CharSet );
+(* turn on all elements *)
+
+PROCEDURE Incl( s :CharSet; c :CHAR );
+(* put the specified character into the set *)
+
+PROCEDURE Excl( s :CharSet; c :CHAR );
+(* take the specified character out of the set *)
+
+PROCEDURE In( s :CharSet; c :CHAR ) :BOOLEAN;
+(* determine if the character is in the set *)
+
+PROCEDURE Not( s :CharSet );
+(* invert the set *)
+
+PROCEDURE Equal( s, t :CharSet ) :BOOLEAN;
+(* compare two sets, return TRUE if they are the same *)
+
+PROCEDURE Copy( s, t :CharSet );
+(* make 't' equal to 's', iff sizes are the same *)
+
+PROCEDURE Duplicate( s :CharSet; VAR t :CharSet );
+(* copy set 's' into a new set 't' *)
+
+END SetOfChar.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/setofchar.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/setofchar.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/setofchar.mod
@@ -0,0 +1,78 @@
+IMPLEMENTATION MODULE SetOfChar;
+
+(* V1.1, John Andrea, Jun.22/93 -add Duplicate *)
+(* V1.0, John Andrea, Apr.5/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+IMPORT LargeSets;
+
+                                    (* Some compilers don't allow the direct *)
+                                    (* type CharSet = LargeSets.LargeSet     *)
+                                    (* So build a second layer here          *)
+TYPE
+   CharSet  = POINTER TO CharData;
+   CharData = RECORD
+                 set :LargeSets.LargeSet;
+              END;
+
+PROCEDURE Build( VAR a :CharSet );
+BEGIN
+  NEW( a );
+  LargeSets.Build( a^.set, 0, 255 );
+END Build;
+
+PROCEDURE Destroy( VAR a :CharSet );
+BEGIN
+  LargeSets.Destroy( a^.set );
+  DISPOSE( a );
+END Destroy;
+
+PROCEDURE Empty( a :CharSet );
+BEGIN
+  LargeSets.Empty( a^.set );
+END Empty;
+
+PROCEDURE Fill( a :CharSet );
+BEGIN
+  LargeSets.Fill( a^.set );
+END Fill;
+
+PROCEDURE Incl( a :CharSet; c :CHAR );
+BEGIN
+  LargeSets.Incl( a^.set, ORD( c ) );
+END Incl;
+
+PROCEDURE Excl( a :CharSet; c :CHAR );
+BEGIN
+  LargeSets.Excl( a^.set, ORD( c ) );
+END Excl;
+
+PROCEDURE In( a :CharSet; c :CHAR ) :BOOLEAN;
+BEGIN
+  RETURN LargeSets.In( a^.set, ORD( c ) );
+END In;
+
+PROCEDURE Not( a :CharSet );
+BEGIN
+  LargeSets.Not( a^.set );
+END Not;
+
+PROCEDURE Equal( a, b :CharSet ) :BOOLEAN;
+BEGIN
+   RETURN LargeSets.Equal( a^.set, b^.set );
+END Equal;
+
+PROCEDURE Copy( a, b :CharSet );
+BEGIN
+   LargeSets.Copy( a^.set, b^.set );
+END Copy;
+
+PROCEDURE Duplicate( a :CharSet; VAR b :CharSet );
+BEGIN
+   Build( b );
+   Copy( a, b );
+END Duplicate;
+
+BEGIN
+END SetOfChar.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/shuffle.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/shuffle.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/shuffle.def
@@ -0,0 +1,36 @@
+DEFINITION MODULE Shuffle;
+
+(*
+ These routines are for randomly picking numbers from a sequential list
+ so that no number is picked more than once.
+ Applications are card shuffling type operations where a set of objects
+ need to be rearranged/picked randomly.
+
+ First call Create to build a list with the specified range, then use Next
+ to get numbers within that range, randomly without repeating a number.
+ Call Reset to reset the list to have all 'size' numbers available again.
+ If Next is called more than 'size' times, a Reset will be forced.
+*)
+
+(* V1.1, John Andrea, Jun.22/93 -add Copy and Duplicate *)
+(* V1.0, John Andrea, Apr.5/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+EXPORT QUALIFIED Deck, Create, Reset, Next;
+
+TYPE
+    Deck;   (* opaque *)
+
+PROCEDURE Create( VAR d :Deck; min, max :CARDINAL );
+
+PROCEDURE Reset( d :Deck );
+
+PROCEDURE Next( d :Deck ) :CARDINAL;
+
+PROCEDURE Copy( d, e :Deck );
+(* copy the settings of 'd' into 'e', iff min and max are the same *)
+
+PROCEDURE Duplicate( d :Deck; VAR e :Deck );
+(* make a new duplicate of 'd' in new 'e' *)
+
+END Shuffle.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/shuffle.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/shuffle.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/shuffle.mod
@@ -0,0 +1,91 @@
+IMPLEMENTATION MODULE Shuffle;
+
+(* See the definition module for details *)
+
+(* V1.1, John Andrea, Jun.22/93 -add Copy and Duplicate *)
+(* V1.0, John Andrea, Apr.5/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+IMPORT LargeSets;
+FROM Storage IMPORT ALLOCATE;
+FROM Randomly IMPORT Choose_1_To_N;
+
+TYPE
+    Deck = POINTER TO RECORD
+             min, max :CARDINAL;
+             size     :CARDINAL;
+             n_left   :CARDINAL;
+             set      :LargeSets.LargeSet;
+           END;
+
+(* ------------------------------------------- *)
+PROCEDURE Create( VAR d :Deck; min, max :CARDINAL );
+VAR
+  i :CARDINAL;
+BEGIN
+  NEW( d );
+
+  IF min > max THEN
+    i   := min;
+    min := max;
+    max := i;
+  END;
+
+  d^.min  := min;
+  d^.max  := max;
+  d^.size := max - min + 1;
+
+  LargeSets.Build( d^.set, min, max );
+
+  Reset( d );
+END Create;
+
+(* ------------------------------------------- *)
+PROCEDURE Reset( d :Deck );
+BEGIN
+  d^.n_left := d^.size;
+  LargeSets.Fill( d^.set );
+END Reset;
+
+(* ------------------------------------------- *)
+PROCEDURE Next( d :Deck ) :CARDINAL;
+VAR
+  i, n, count :CARDINAL;
+BEGIN
+ IF d^.n_left = 0 THEN Reset( d ); END;
+
+ n := Choose_1_To_N( d^.n_left );
+
+ (* find the n'th non-zero number in the list *)
+ i     := d^.min;
+ count := 0;
+ WHILE count # n DO
+   IF LargeSets.In( d^.set, i ) THEN count := count + 1 END;
+   i := i + 1;
+ END;
+ i := i - 1;
+
+ LargeSets.Excl( d^.set, i );   (* make this number un-available *)
+ d^.n_left := d^.n_left - 1;    (* now the list is smaller by one *)
+
+ RETURN i;
+END Next;
+
+(* ------------------------------------------- *)
+PROCEDURE Copy( d, e :Deck );
+BEGIN
+  IF ( d^.min = e^.min ) & ( d^.max = e^.max ) THEN
+    LargeSets.Copy( d^.set, e^.set );
+    e^.n_left := d^.n_left;
+  END;
+END Copy;
+
+(* ------------------------------------------- *)
+PROCEDURE Duplicate( d :Deck; VAR e :Deck );
+BEGIN
+  Create( e, d^.min, d^.max );
+  Copy( d, e );
+END Duplicate;
+
+BEGIN
+END Shuffle.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/shufflefa.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/shufflefa.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/shufflefa.def
@@ -0,0 +1,30 @@
+DEFINITION MODULE ShuffleFast;
+
+(*
+ These routines are for randomly picking numbers from a sequential list
+ so that no number is picked more than once.
+ Applications are card shuffling type operations where a set of objects
+ need to be rearranged/picked randomly.
+
+ First call Create to build a list, then use Next to get numbers randomly.
+ Call Reset to reset the list to have all 'size' numbers available again.
+ If Next is called more than 'size' times, a Reset will be forced.
+*)
+
+(* John Andrea, Apr.2/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+
+EXPORT QUALIFIED Deck, Create, Reset, Next;
+
+
+TYPE
+    Deck;   (* opaque *)
+
+PROCEDURE Create( VAR d :Deck; size :CARDINAL );
+
+PROCEDURE Reset( d :Deck );
+
+PROCEDURE Next( d :Deck ) :CARDINAL;
+
+END ShuffleFast.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/shufflefa.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/shufflefa.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/shufflefa.mod
@@ -0,0 +1,130 @@
+IMPLEMENTATION MODULE ShuffleFast;
+
+(* See the definition module for details *)
+(* V3.0, John Andrea, Jun.1793 - determine bitmap size at runtime *)
+(* V2.0, John Andrea, Apr.3/92 - use bitmaps to further reduce memory size *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM SYSTEM IMPORT TSIZE, ADDRESS;
+FROM Storage IMPORT ALLOCATE;
+FROM Randomly IMPORT Choose_1_To_N;
+
+TYPE
+    Deck = POINTER TO RECORD
+             length  :CARDINAL;   (* number of numbers *)
+             n_left  :CARDINAL;   (* number of numbers not yet picked *)
+             start   :ADDRESS;    (* first element in memory *)
+             size    :CARDINAL;   (* actual size of the bitmap in bytes *)
+             sets    :CARDINAL;   (* number of bitsets *)
+           END;
+
+VAR
+   adr         :POINTER TO BITSET;
+   i, k        :CARDINAL;
+   empty, full :BITSET;
+
+   bset_bits, bset_bytes :CARDINAL;
+
+(* ------------------------------------------- *)
+PROCEDURE Create( VAR d :Deck; n :CARDINAL );
+VAR n_bits, in_last :CARDINAL;
+BEGIN
+
+  (* protect users from themselves *)
+  IF n = 0 THEN n := 1 END;
+
+  NEW( d );
+
+  d^.length := n;
+
+  n_bits    := n;
+
+  in_last := n_bits MOD bset_bits;
+
+  IF in_last = 0 THEN
+    in_last := bset_bits;       (* last one is filed *)
+  ELSE
+    (* must be a multiple of bits in a bitset *)
+    n_bits := n_bits + bset_bits - in_last;
+  END;
+
+  d^.sets := n_bits DIV bset_bits;   (* convert to bitsets *)
+  d^.size := d^.sets * bset_bytes;   (* convert to bytes *)
+
+  ALLOCATE( d^.start, d^.size );
+
+  Reset( d );
+END Create;
+
+(* ------------------------------------------- *)
+PROCEDURE Reset( d :Deck );
+BEGIN
+  d^.n_left := d^.length;
+  k := 0;
+  FOR i := 1 TO d^.length DO
+     adr  := d^.start + k;
+     adr^ := full;
+     k    := k + bset_bytes;
+  END;
+END Reset;
+
+(* ------------------------------------------- *)
+PROCEDURE Next( d :Deck ) :CARDINAL;
+VAR n, count, which_bit :CARDINAL;
+BEGIN
+ IF d^.n_left = 0 THEN Reset( d ); END;
+
+ n := Choose_1_To_N( d^.n_left );
+
+ (* find the n'th available item in the list                *)
+ (* the index of that item will the random number to return *)
+
+ which_bit := bset_bits;   (* force a new value the very first time *)
+
+ i     := 0;
+ k     := 0;
+ count := 0;
+ REPEAT
+
+   which_bit := which_bit + 1;
+
+   IF which_bit >= bset_bits THEN
+     which_bit := 0;
+
+     adr := d^.start + k;        (* get a whole new bitset *)
+     k   := k + bset_bytes;
+
+     (* but skip any bitset which has already been completeley chosen *)
+     WHILE adr^ = empty DO
+       i   := i + bset_bits;   (* jump the index for all of them *)
+       adr := d^.start + k;
+       k   := k + bset_bytes;
+     END;
+
+   END;
+
+   i := i + 1;
+
+   IF which_bit IN adr^ THEN count := count + 1; END;
+
+ UNTIL count = n;
+
+ EXCL( adr^, which_bit );      (* make this number un-available *)
+
+ d^.n_left := d^.n_left - 1;   (* now the list is smaller by one *)
+
+ RETURN i;
+END Next;
+
+BEGIN
+  bset_bytes := TSIZE( BITSET );
+  bset_bits  := bset_bytes * 8;
+
+  empty := {};
+
+  full := {};
+  FOR i := 0 TO bset_bits - 1 DO
+     INCL( full, i );
+  END;
+
+END ShuffleFast.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/sorting.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/sorting.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/sorting.def
@@ -0,0 +1,83 @@
+DEFINITION MODULE Sorting;
+
+(* some sorting routines, BSort's are bubble sorts, QSort's are quicksorts *)
+(* J. Andrea, Dec.16/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+
+EXPORT QUALIFIED CardBSort, RealBSort,
+                 CardQSort, CardQSortIndex, RealQSortIndex,
+                 TopoSort;
+
+(*
+ The bubble sorts used here are based upon the procedure
+ BUBSORT, by L. Slack and J. Andrea, Dec 1981,
+ a theoretically perfect bubble sort.
+ The quicksorts used here are nonrecursive, based upon
+ NonRecursiveQuickSort,
+ "Algorithms and Data Structures"
+ by    Niklaus Wirth, Prentice-Hall Inc., 1986
+ The TopoSort is based on an algorithm given in
+ "Algorithms and Data Structures"
+ by    Niklaus Wirth, Prentice-Hall Inc., 1986
+*)
+
+(*
+ Some routines return an index into the array, this means that the
+ array itself is unchanged and to get access to the array in sorted
+ order you must use the index. This means that it is easy to get the
+ array in 1) original order 2) ascending order and 3) descending order.
+ The index array must be at least as large as the array to be sorted.
+ To use this array, do something like this:
+       sort-procedure( array, n, index );
+       -output in original order-
+       for i = 1 to n
+          print array[i]
+       end
+       -output in ascending order-
+       for i = 1 to n
+          print array[index[i]+1]
+       end
+       -output in descending order-
+       i = n
+       for j = 1 to n
+          print array[index[i]+1]
+          i = i - 1
+       end
+ Remember that the index array will be returned with first element offset
+ of zero, since its treated like an open array.
+*)
+(*
+ The Topological sort routine requires input of two pairs of indices
+ as the 'x' and 'y', where element of index x is less than element of index y,
+ or element of index x comes before element of index y.
+ The returned 'solution' is the ordering of elements based upon the pairs
+ given in x and y, and the number of items in the solution is given in
+ 'n_solution'. 'error' is returned as true if the sorting cannot be performed,
+ 'solution' is returned as false if the indices cannot be ordered.
+*)
+(*
+ Because of the compiler's limit of 65536 bytes in open arrays,
+ these routines can only be used for arrays with 16384 or fewer elements.
+ Otherwise the sorting procedures should be included inline with programs.
+*)
+
+
+      PROCEDURE CardBSort( VAR a :ARRAY OF CARDINAL; array_len :CARDINAL );
+
+      PROCEDURE RealBSort( VAR x :ARRAY OF REAL; array_len :CARDINAL );
+
+      PROCEDURE CardQSort( VAR a :ARRAY OF CARDINAL; array_len :CARDINAL );
+
+      PROCEDURE CardQSortIndex( a :ARRAY OF CARDINAL; array_len :CARDINAL;
+                                VAR index :ARRAY OF CARDINAL );
+
+      PROCEDURE RealQSortIndex( a :ARRAY OF REAL; array_len :CARDINAL;
+                                VAR index :ARRAY OF CARDINAL );
+
+
+      PROCEDURE TopoSort( x, y :ARRAY OF CARDINAL; n_pairs :CARDINAL;
+                VAR solution :ARRAY OF CARDINAL; VAR n_solution :CARDINAL;
+                VAR error, sorted :BOOLEAN );
+
+END Sorting.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/sorting.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/sorting.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/sorting.mod
@@ -0,0 +1,467 @@
+IMPLEMENTATION MODULE Sorting;
+
+(* J. Andrea, Dec.16/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM Storage IMPORT ALLOCATE;
+
+CONST
+   max_stack = 20;
+   n_small   = 6; (* use a simple sort for this size and smaller *)
+
+VAR
+  rtemp :REAL;
+  ctemp :CARDINAL;
+
+  L, R, i, j, n         :INTEGER;
+  top, bottom, lastflip :INTEGER;
+
+  tos            :CARDINAL;
+  Lstack, Rstack :ARRAY [1..max_stack] OF INTEGER;
+
+      (* --------------------------------------------------- *)
+      PROCEDURE CardQSortIndex( x :ARRAY OF CARDINAL; array_len :CARDINAL;
+                                VAR index :ARRAY OF CARDINAL );
+
+      VAR
+        median :CARDINAL;
+
+      BEGIN
+
+        n := INTEGER(array_len) - 1; (* back to zero offset *)
+
+        (* initialize the index *)
+        FOR i := 0 TO n DO
+          index[i] := CARDINAL(i);
+        END;
+
+        tos := 0;
+
+        L := 0;  R := n;
+
+        (* PUSH very first set *)
+        tos := tos + 1;  Lstack[tos] := L;  Rstack[tos] := R;
+
+        REPEAT
+
+          (* POP *)
+          L := Lstack[tos];  R := Rstack[tos];  tos := tos - 1;
+
+          IF R - L + 1 > n_small THEN
+
+            REPEAT
+              i := L;  j := R;    median := x[index[( L + R ) DIV 2]];
+
+              REPEAT
+                WHILE x[index[i]] < median DO
+                  i := i + 1;
+                END;
+                WHILE median < x[index[j]] DO
+                  j := j - 1;
+                END;
+
+                IF i <= j THEN (* swap *)
+                  ctemp := index[i];  index[i] := index[j];  index[j] := ctemp;
+                  i := i + 1;  j := j - 1;
+                END;
+              UNTIL i > j;
+
+              IF j - L < R - i THEN
+                IF i < R THEN (* PUSH *)
+                  tos := tos + 1;  Lstack[tos] := i;  Rstack[tos] := R;
+                END;
+                R := j;
+              ELSE
+                IF L < j THEN (* push *)
+                  tos := tos + 1;  Lstack[tos] := L;  Rstack[tos] := j;
+                END;
+                L := i;
+              END;
+
+            UNTIL L >= R;
+
+         ELSE
+
+           (* small sort for small number of values *)
+           FOR i := L TO R - 1 DO
+             FOR j := i TO R DO
+               IF x[index[i]] > x[index[j]] THEN
+                  ctemp    := index[i];
+                  index[i] := index[j];
+                  index[j] := ctemp
+               END;
+             END;
+           END;
+
+         END; (* check for small *)
+
+       UNTIL tos = 0;
+ 
+      END CardQSortIndex;
+
+      (* --------------------------------------------------- *)
+      PROCEDURE RealQSortIndex( x :ARRAY OF REAL; array_len :CARDINAL;
+                                VAR index :ARRAY OF CARDINAL );
+
+      VAR
+        median :REAL;
+
+      BEGIN
+
+        n := INTEGER(array_len) - 1; (* back to zero offset *)
+
+        (* initialize the index *)
+        FOR i := 0 TO n DO
+          index[i] := CARDINAL(i);
+        END;
+
+        tos := 0;
+
+        L := 0;  R := n;
+
+        (* PUSH very first set *)
+        tos := tos + 1;  Lstack[tos] := L;  Rstack[tos] := R;
+
+        REPEAT
+
+          (* POP *)
+          L := Lstack[tos];  R := Rstack[tos];  tos := tos - 1;
+
+          IF R - L + 1 > n_small THEN
+
+            REPEAT
+              i := L;  j := R;    median := x[index[( L + R ) DIV 2]];
+
+              REPEAT
+                WHILE x[index[i]] < median DO
+                  i := i + 1;
+                END;
+                WHILE median < x[index[j]] DO
+                  j := j - 1;
+                END;
+
+                IF i <= j THEN (* swap *)
+                  ctemp := index[i];  index[i] := index[j];  index[j] := ctemp;
+                  i := i + 1;  j := j - 1;
+                END;
+              UNTIL i > j;
+
+              IF j - L < R - i THEN
+                IF i < R THEN (* PUSH *)
+                  tos := tos + 1;  Lstack[tos] := i;  Rstack[tos] := R;
+                END;
+                R := j;
+              ELSE
+                IF L < j THEN (* push *)
+                  tos := tos + 1;  Lstack[tos] := L;  Rstack[tos] := j;
+                END;
+                L := i;
+              END;
+
+            UNTIL L >= R;
+
+         ELSE
+
+           (* small sort for small number of values *)
+           FOR i := L TO R - 1 DO
+             FOR j := i TO R DO
+               IF x[index[i]] > x[index[j]] THEN
+                  ctemp    := index[i];
+                  index[i] := index[j];
+                  index[j] := ctemp
+               END;
+             END;
+           END;
+
+         END; (* check for small *)
+
+       UNTIL tos = 0;
+ 
+      END RealQSortIndex;
+
+      (* --------------------------------------------------- *)
+      PROCEDURE CardQSort( VAR x :ARRAY OF CARDINAL; array_len :CARDINAL );
+
+      VAR
+        median :CARDINAL;
+
+      BEGIN
+
+        n := INTEGER(array_len) - 1; (* back to zero offset *)
+
+        tos := 0;
+
+        L := 0;  R := n;
+
+        (* PUSH very first set *)
+        tos := tos + 1;  Lstack[tos] := L;  Rstack[tos] := R;
+
+        REPEAT
+
+          (* POP *)
+          L := Lstack[tos];  R := Rstack[tos];  tos := tos - 1;
+
+          IF R - L + 1 > n_small THEN
+
+            REPEAT
+              i := L;  j := R;    median := x[( L + R ) DIV 2];
+
+              REPEAT
+                WHILE x[i] < median DO
+                  i := i + 1;
+                END;
+                WHILE median < x[j] DO
+                  j := j - 1;
+                END;
+
+                IF i <= j THEN (* swap *)
+                  ctemp := x[i];  x[i] := x[j];  x[j] := ctemp;
+                  i := i + 1;  j := j - 1;
+                END;
+              UNTIL i > j;
+
+              IF j - L < R - i THEN
+                IF i < R THEN (* PUSH *)
+                  tos := tos + 1;  Lstack[tos] := i;  Rstack[tos] := R;
+                END;
+                R := j;
+              ELSE
+                IF L < j THEN (* push *)
+                  tos := tos + 1;  Lstack[tos] := L;  Rstack[tos] := j;
+                END;
+                L := i;
+              END;
+
+            UNTIL L >= R;
+
+         ELSE
+
+           (* small sort for small number of values *)
+           FOR i := L TO R - 1 DO
+             FOR j := i TO R DO
+               IF x[i] > x[j] THEN
+                  ctemp := x[i];
+                  x[i]  := x[j];
+                  x[j]  := ctemp
+               END;
+             END;
+           END;
+
+         END; (* check for small *)
+
+       UNTIL tos = 0;
+ 
+      END CardQSort;
+
+      (* ----------------------------------------------------- *)
+      PROCEDURE CardBSort( VAR x :ARRAY OF CARDINAL; array_len :CARDINAL );
+
+      BEGIN
+        top    := 0;      (* open arrays are zero offset *)
+        bottom := INTEGER(array_len) - 1;
+
+        WHILE top < bottom DO
+
+          lastflip := top;
+
+          FOR i := top TO bottom-1 DO
+             IF x[i] > x[i+1] THEN    (* flip *)
+               ctemp  := x[i];
+               x[i]   := x[i+1];
+               x[i+1] := ctemp;
+               lastflip := i;
+             END;
+          END;
+
+          bottom := lastflip;
+
+          IF bottom > top THEN
+
+             i := bottom - 1;
+             FOR j := top TO bottom-1 DO
+               IF x[i] > x[i+1] THEN    (* flip *)
+                 ctemp  := x[i];
+                 x[i]   := x[i+1];
+                 x[i+1] := ctemp;
+                 lastflip := i;
+               END;
+               i := i - 1;
+             END;
+
+             top := lastflip + 1;
+
+          ELSE
+             (* force a loop failure *)
+             top := bottom + 1;
+          END; 
+
+       END;
+
+      END CardBSort;
+
+
+      (* ----------------------------------------------------- *)
+      PROCEDURE RealBSort( VAR x :ARRAY OF REAL; array_len :CARDINAL );
+
+      BEGIN
+        top    := 0;      (* open arrays are zero offset *)
+        bottom := INTEGER(array_len) - 1;
+
+        WHILE top < bottom DO
+
+          lastflip := top;
+
+          FOR i := top TO bottom-1 DO
+             IF x[i] > x[i+1] THEN    (* flip *)
+               rtemp  := x[i];
+               x[i]   := x[i+1];
+               x[i+1] := rtemp;
+               lastflip := i;
+             END;
+          END;
+
+          bottom := lastflip;
+
+          IF bottom > top THEN
+
+             i := bottom - 1;
+             FOR j := top TO bottom-1 DO
+               IF x[i] > x[i+1] THEN    (* flip *)
+                 rtemp  := x[i];
+                 x[i]   := x[i+1];
+                 x[i+1] := rtemp;
+                 lastflip := i;
+               END;
+               i := i - 1;
+             END;
+
+             top := lastflip + 1;
+
+          ELSE
+             (* force a loop failure *)
+             top := bottom + 1;
+          END; 
+
+       END;
+
+      END RealBSort;
+
+
+    (* ----------------------------------------------------- *)
+    PROCEDURE TopoSort( x, y :ARRAY OF CARDINAL; n_pairs :CARDINAL;
+                       VAR solution :ARRAY OF CARDINAL; VAR n_solution :CARDINAL;
+                       VAR error, sorted :BOOLEAN );
+    (*
+     This procedure needs some garbage collection added, i've tried but
+     will little success. J. Andrea, Dec.18/91
+    *)
+
+    TYPE
+      LPtr = POINTER TO Leader;
+      TPtr = POINTER TO Trailer;
+
+      Leader = RECORD
+                  key   :CARDINAL;
+                  count :INTEGER;
+                  trail :TPtr;
+                  next  :LPtr;
+               END;
+
+      Trailer = RECORD
+                  id   :LPtr;
+                  next :TPtr;
+                END;
+
+    VAR
+      p, q, head, tail :LPtr;
+      t                :TPtr;
+      i, max_solutions :CARDINAL;
+
+      (* -------------------------------------------- *)
+      PROCEDURE Find( w :CARDINAL ) :LPtr;
+      VAR h :LPtr;
+      BEGIN
+        h := head;   tail^.key := w;  (* sentinel *)
+        WHILE h^.key # w DO
+           h := h^.next;
+        END;
+        IF h = tail THEN
+          NEW( tail );
+          n := n + 1;
+          h^.count := 0;
+          h^.trail := NIL;
+          h^.next  := tail;
+        END;
+        RETURN h;
+      END Find;
+
+    BEGIN
+
+        error      := FALSE;
+        n_solution := 0;
+
+        IF n_pairs < 2 THEN
+          error := TRUE;
+        ELSE
+
+          max_solutions := HIGH( solution ) + 1;
+
+          NEW( head );  tail := head;  n := 0;
+
+          (* add all of the given pairs *)
+
+          FOR i := 0 TO n_pairs - 1 DO
+            p := Find( x[i] );   q := Find( y[i] );
+            NEW(t);
+            t^.id    := q;
+            t^.next  := p^.trail;
+            p^.trail := t;
+            q^.count := q^.count + 1;
+          END;
+
+          (* search for leaders without predecessors *)
+
+           p := head;  head := NIL;
+           WHILE p # tail DO
+            q := p;  p := q^.next;
+            IF q^.count = 0 THEN
+              (* insert q^ in new chain *)
+              q^.next := head;   head := q;
+            END;
+          END;
+
+          (* output phase *)
+
+          q := head;
+          WHILE ( NOT error ) & ( q # NIL ) DO
+            n_solution := n_solution + 1;
+            IF n_solution > max_solutions THEN
+              error := TRUE;
+            ELSE
+
+              solution[n_solution-1] := q^.key;
+              n := n - 1;
+              t := q^.trail;  q := q^.next;
+              WHILE t # NIL DO
+                p := t^.id;  p^.count := p^.count - 1;
+                IF p^.count = 0 THEN
+                  (* insert p^ in leader list *)
+                  p^.next := q;  q := p;
+                END;
+                t := t^.next;
+              END;
+            END;
+          END;
+
+          IF n # 0 THEN
+            sorted := FALSE;
+          ELSE
+            sorted := TRUE;
+          END;
+
+       END;
+
+    END TopoSort;
+
+BEGIN
+END Sorting.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/specialin.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/specialin.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/specialin.def
@@ -0,0 +1,34 @@
+DEFINITION MODULE SpecialInOut;
+
+(* procedures to supplement those in InOut and RealInOut *)
+(*
+  as defined in "Programming and Problem Solving in Modula-2"
+  by S. Leestma and L. Nyhoff, MacMillian Publishing Company, 1989
+*)
+(* some slight modifications by J. Andrea, Aug.28/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+
+EXPORT QUALIFIED FWriteReal, ReadBoole, WriteBoole, ReadAString;
+
+
+PROCEDURE FWriteReal( real_number :REAL;
+                      field_width, decimal_places :CARDINAL );
+(* output a real number in decimal format using 'field_width' spaces
+   and rounded to 'decimal_places' *)
+
+
+PROCEDURE ReadBoole( VAR boolean_value :BOOLEAN );
+(* read the string 'TRUE' or 'FALSE' from standard input *)
+(* the value must be followed by white space or an end-of-line *)
+
+
+PROCEDURE WriteBoole( boolean_value :BOOLEAN );
+(* output 'TRUE' or 'FALSE' to standard output *)
+(* the output string will be followed by a space character *)
+
+
+PROCEDURE ReadAString( VAR string :ARRAY OF CHAR );
+(* read a whole line from standard input into 'string' *)
+
+END SpecialInOut.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/specialin.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/specialin.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/specialin.mod
@@ -0,0 +1,166 @@
+IMPLEMENTATION MODULE SpecialInOut;
+
+(* procedures to supplement those in InOut and RealInOut *)
+(*
+  as defined in "Programming and Problem Solving in Modula-2"
+  by S. Leestma and L. Nyhoff, MacMillian Publishing Company, 1989
+*)
+(* some modifications by J. Andrea, Aug.28/91 *)
+(* the FWriteReal procedure isn't very good *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT Read, ReadString, Write, WriteString, WriteLn, WriteCard, EOL;
+FROM RealInOut IMPORT WriteReal;
+
+CONST
+   nul = 0C;
+
+VAR
+   digits :ARRAY [0..9] OF CHAR;
+
+(* ------------------------------------------------------------------ *)
+PROCEDURE FWriteReal( real_number :REAL;
+                      field_width, decimal_places :CARDINAL );
+CONST
+   significant_digits = 10;
+
+VAR
+   r_num, rounding_increment  :REAL;
+   left_digits, digit         :CARDINAL;
+   num_positions, sign, i     :CARDINAL;
+
+BEGIN
+
+   IF real_number >= 0.0 THEN
+     sign := 0;
+     r_num := real_number;
+   ELSE
+     sign := 1;
+     r_num := - real_number;
+   END;
+
+   (* round the value to 'decimal_places' *)
+   rounding_increment := 0.5;
+   FOR i := 1 TO decimal_places DO
+      rounding_increment := rounding_increment / 10.0;
+   END;
+   r_num := r_num + rounding_increment;
+
+   (* normalize the number *)
+   left_digits := 1;
+   WHILE r_num >= 10.0 DO
+     left_digits := left_digits + 1;
+     r_num       := r_num / 10.0;
+   END;
+
+   (* if too many digits, display a message and output the number *)
+   num_positions := left_digits + decimal_places;
+   IF num_positions > significant_digits THEN
+     WriteString( '*** Too many places specified for ' );
+     WriteReal( real_number, significant_digits );
+   ELSE
+
+     (* print leading blanks so value is right justified *)
+     num_positions := num_positions + sign + 1;
+     FOR i := num_positions + 1 TO field_width DO
+        WriteString( ' ' );
+     END;
+
+     IF sign = 1 THEN
+       Write( '-' );
+     END;
+
+     FOR i := 1 TO left_digits DO
+        digit := TRUNC( r_num );
+        Write( digits[digit] );
+        r_num := 10.0 * ( r_num - FLOAT(digit) );
+     END;
+
+     (* decimal point *)
+
+     Write( '.' );
+
+     (* digits to the right of the decimal point *)
+     FOR i := 1 TO decimal_places DO
+        digit := TRUNC( r_num );
+        Write( digits[digit] );
+        r_num := 10.0 * ( r_num - FLOAT(digit) );
+     END;
+
+   END;
+END FWriteReal;
+
+
+(* ------------------------------------------------------------------ *)
+PROCEDURE ReadBoole( VAR boolean_value :BOOLEAN );
+
+VAR
+  string :ARRAY [0..5] OF CHAR;
+  i      :CARDINAL;
+
+BEGIN
+
+  ReadString( string );
+
+  FOR i := 0 TO 4 DO
+     string[i] := CAP( string[i] );
+  END;
+
+  IF ( string[0] = 'T' ) & ( string[1] = 'R' ) &
+     ( string[2] = 'U' ) & ( string[3] = 'E' ) &
+     ( string[4] = nul ) THEN
+     boolean_value := TRUE;
+  ELSE
+     IF ( string[0] = 'F' ) & ( string[1] = 'A' ) &
+        ( string[2] = 'L' ) & ( string[3] = 'S' ) &
+        ( string[4] = 'E' ) & ( string[5] = nul ) THEN
+        boolean_value := FALSE;
+     ELSE
+       WriteString( "***Bad Input -- not 'TRUE' or 'FALSE' ***" ); WriteLn;
+     END;
+  END;
+
+END ReadBoole;
+
+(* ------------------------------------------------------------------ *)
+PROCEDURE WriteBoole( boolean_value :BOOLEAN );
+BEGIN
+  IF boolean_value THEN
+    WriteString( 'TRUE ' );
+  ELSE
+    WriteString( 'FALSE ' );
+  END;
+END WriteBoole;
+
+(* ------------------------------------------------------------------ *)
+PROCEDURE ReadAString( VAR string :ARRAY OF CHAR );
+VAR
+  max_index, i :CARDINAL;
+  ch           :CHAR;
+BEGIN
+
+  max_index := HIGH( string );
+
+  i := 0;
+  Read( ch );
+  WHILE ch # EOL DO
+    IF i <= max_index THEN
+      string[i] := ch;
+      i := i + 1;
+    END;
+    Read( ch );
+  END;
+
+  IF i < max_index THEN string[i] := nul; END;
+
+END ReadAString;
+
+
+BEGIN
+
+  digits[0] := '0';   digits[1] := '1';   digits[2] := '2';
+  digits[3] := '3';   digits[4] := '4';   digits[5] := '5';
+  digits[6] := '6';   digits[7] := '7';   digits[8] := '8';
+  digits[9] := '9';
+
+END SpecialInOut.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/stacks.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/stacks.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/stacks.def
@@ -0,0 +1,40 @@
+DEFINITION MODULE Stacks;
+
+(*
+ This module provides procedures for stack'ing objects up to 512 bytes in size.
+ A stack may be made of non-homogeneous objects, but care muse be taken to pop
+ data into the same format as there object which was push'ed.
+ If an item longer than 512 bytes is pushed, then only the first 512 bytes is
+ stored on the stack. And conversely, only as much data is pop'ed as can be
+ stored in the object which will contain the pop'ed item.
+*)
+(* J. Andrea, Oct.3/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM SYSTEM IMPORT BYTE;
+
+EXPORT QUALIFIED InitStack, Stack, Pop, Push, DelStack, StackInfo;
+
+TYPE
+   Stack; (* hidden *)
+
+PROCEDURE InitStack( VAR a_stack :Stack );
+(* Create a stack, this must be called before the first Push *)
+
+PROCEDURE Push( a_stack :Stack; data :ARRAY OF BYTE );
+(* Push an item onto the stack, any item up to 512 bytes in size *)
+
+PROCEDURE Pop( a_stack :Stack; VAR data :ARRAY OF BYTE;
+               VAR nothing_to_pop :BOOLEAN );
+(* Pop the next item from the stack,
+   return 'empty' as TRUE is there is nothing to get popped *)
+
+PROCEDURE DelStack( VAR a_stack :Stack );
+(* Delete the stack completely *)
+
+PROCEDURE StackInfo( a_stack :Stack; VAR n_items, size :CARDINAL );
+(* Get some information about the stack
+   'n_items' is the number of items currently on the stack,
+   'size'    is the size of the item at the top of the stack *)
+
+END Stacks.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/stacks.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/stacks.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/stacks.mod
@@ -0,0 +1,71 @@
+IMPLEMENTATION MODULE Stacks;
+
+(* Procedures for non-homogeneous stack data structure *)
+(* V1.2, J.Andrea, Jun.22/93 -more compiler generic *)
+(* V1.1, John Andrea, Oct.11/91 - modified to use the generic Queue module *)
+(* V1.0, John Andrea, Oct.3/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+FROM SYSTEM IMPORT BYTE;
+IMPORT Queues;
+
+                                              (* Some compilers don't allow  *)
+                                              (* type  Stack  = Queues.Queue *)
+                                              (* So build in a second layer  *)
+TYPE
+   Stack     = POINTER TO StackData;
+   StackData = RECORD
+                 queue :Queues.Queue;
+               END;
+
+   (* ------------------------------------------- *)
+   PROCEDURE InitStack( VAR a :Stack );
+   (* Create a stack, this must be called before the stack is used *)
+   BEGIN
+
+     NEW( a );
+     Queues.InitQueue( a^.queue );
+
+   END InitStack;
+
+   (* ------------------------------------------- *)
+   PROCEDURE Push( a :Stack; data :ARRAY OF BYTE );
+   (* Push an item onto the stack *)
+   BEGIN
+
+     Queues.Push( a^.queue, Queues.Top, data );
+
+   END Push;
+
+   (* ------------------------------------------- *)
+   PROCEDURE Pop( a :Stack; VAR data :ARRAY OF BYTE;
+                  VAR nothing_to_pop :BOOLEAN );
+   (* Get an item from the stack *)
+   BEGIN
+
+     Queues.Pop( a^.queue, Queues.Top, data, nothing_to_pop );
+
+   END Pop;
+
+   (* ------------------------------------------- *)
+   PROCEDURE DelStack( VAR a :Stack );
+   (* Complete delete a stack *)
+   BEGIN
+
+      Queues.DelQueue( a^.queue );
+      DISPOSE( a );
+
+   END DelStack;
+
+   (* ------------------------------------------- *)
+   PROCEDURE StackInfo( a :Stack; VAR n_items, size :CARDINAL );
+   (* Return some info about a stack *)
+   BEGIN
+
+     Queues.QueueInfo( a^.queue, Queues.Top, n_items, size );
+
+   END StackInfo;
+
+BEGIN
+END Stacks.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/stringope.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/stringope.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/stringope.def
@@ -0,0 +1,154 @@
+DEFINITION MODULE StringOperations;
+
+(* Some procedures for string manipulation *)
+
+(* J. Andrea, Sep.5/91 - add Compare - algorithm from Digital Western Labs. *)
+(* J. Andrea, Aug.19/91 - add NextBlank and NextNonBlank *)
+(* revitalized - J. Andrea, Aug.12/91 *)
+(* J. Andrea, Apr 1986 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+
+EXPORT QUALIFIED Equal,  Compare, Assign,    Index,  
+                 Append, Concat,  SubString, Insert, Replace, Delete,
+                 Upper,  Lower,  
+                 NextBlank, NextNonBlank,
+                 Empty,  Trim, Length;
+
+
+
+PROCEDURE Equal( a, b :ARRAY OF CHAR ) :BOOLEAN;
+(*
+ Return TRUE if the two strings 'a' and 'b' are equal.
+ This is a very simple string comparison, the strings must be of
+ the same length, and must contain exactly the same characters.
+*)
+
+
+PROCEDURE Compare( a, operation, b :ARRAY OF CHAR ) :BOOLEAN;
+(*
+ Compare the two string 'a' and 'b' and return a match of TRUE of FALSE
+ according to the comparison described in 'operation'.
+ Operation may be one of '=', '#', '<>', '>', '<', '>=', '<=',
+ an invalid operation always returns FALSE.
+ Read the parameters as if it was an expression, "1", ">", "2" is false
+*)
+
+
+PROCEDURE Assign( a :ARRAY OF CHAR; VAR b :ARRAY OF CHAR );
+(*
+ Copy all of 'a' into 'b'.
+ This procedure is provided in order to perform assignments of
+ strings of different lengths.
+*)
+
+
+PROCEDURE Index( source, substring :ARRAY OF CHAR ) :CARDINAL;
+(*
+ Find the first occurance of 'substring' in 'source'.
+ If the substring isn't found then a zero is returned.
+ If the substring is found then the relative position in 'source'
+   is returned. Relative positions start at 1, meaning first character.
+*)
+
+
+PROCEDURE Append( a :ARRAY OF CHAR; VAR b :ARRAY OF CHAR );
+(*
+ Append string 'a' to the end of string 'b'.
+*)
+
+
+PROCEDURE Concat( a, b :ARRAY OF CHAR; VAR c :ARRAY OF CHAR );
+(*
+ Concatenate strings 'a' and 'b' into output string 'c'.
+*)
+
+
+PROCEDURE SubString( a :ARRAY OF CHAR; start, len :CARDINAL;
+                     VAR b :ARRAY OF CHAR );
+(*
+ Copy from string 'a' starting from the 'start'TH character
+ and copying 'len' characters into the string 'b'.
+
+ Specifying 'start' as zero will be taken to mean the 1st character.
+ A 'start' which is beyond the length of 'a' will result in an empty
+   output string.
+ If 'len' specifies too many characters in 'a', then as many as possible
+   will be copied.
+ If 'b' is not large enough to hold all of the substring, then as much
+   as possible will be copied.
+*)
+
+
+PROCEDURE Insert( a :ARRAY OF CHAR;
+                  start :CARDINAL; VAR b :ARRAY OF CHAR );
+(*
+ Insert string 'a' into string 'b' in-front of relative position 'start' in 'b'.
+ The position is relative, 1=first character, etc.
+*)
+
+
+PROCEDURE Replace( a :ARRAY OF CHAR; start :CARDINAL; VAR b :ARRAY OF CHAR );
+(*
+ Replace the characters in 'b' starting at position 'start' with the
+ characters of 'a'. All of 'a' is used, or till the end of 'b' is encountered.
+ The position is relative, 1=first character, etc.
+*)
+
+
+PROCEDURE Delete( VAR a :ARRAY OF CHAR; start, len :CARDINAL );
+(*
+ Delete 'len' characters from 'a' starting at position 'start'.
+ The position is relative, 1=first character, etc.
+*)
+
+
+PROCEDURE Upper( VAR string :ARRAY OF CHAR );
+(*
+ Convert a string to all upper case.
+*)
+
+
+PROCEDURE Lower( VAR string :ARRAY OF CHAR );
+(*
+ Convert a string to all lower case.
+*)
+
+
+PROCEDURE NextBlank( string :ARRAY OF CHAR;
+                     start  :CARDINAL ) :CARDINAL;
+(*
+ Starting at the 'start'TH character, return
+ the position of the next space or tab character.
+ If none found then a zero is returned.
+*)
+
+
+PROCEDURE NextNonBlank( string :ARRAY OF CHAR;
+                     start  :CARDINAL ) :CARDINAL;
+(*
+ Starting at the 'start'TH character, return
+ the position of the next character which is not a
+ space or tab character.
+ If none found then a zero is returned.
+*)
+
+
+PROCEDURE Trim( VAR string :ARRAY OF CHAR );
+(*
+ Remove trailing blanks and tabs from a string.
+*)
+
+
+PROCEDURE Empty( VAR string :ARRAY OF CHAR );
+(*
+ Set the string to completely empty.
+*)
+
+PROCEDURE Length( string :ARRAY OF CHAR ) :CARDINAL;
+(*
+ Return the length of a string.
+*)
+
+
+END StringOperations.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/stringope.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/stringope.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/stringope.mod
@@ -0,0 +1,686 @@
+IMPLEMENTATION MODULE StringOperations;
+
+(* J. Andrea, Jun.17/93 - use internal Length rather than non-standard
+                          built in function LEN, and correct global variables *)
+(* J. Andrea, Jul.2/92 - NextBlank and NextNonBlank use same scan routine *)
+(* J. Andrea, Sep.5/91 - add compare *)
+(* J. Andrea, Aug.12/91 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM MoreMath IMPORT MinCard;
+
+CONST
+   nul   = 0C;
+   space = ' ';
+   tab   = 11C;
+
+TYPE
+   CharScanProc = PROCEDURE( CHAR ) :BOOLEAN;
+
+(* ------------------------------------------------------- *)
+PROCEDURE Blank( c :CHAR ) :BOOLEAN;
+(* is this character a blank or tab *)
+BEGIN
+  RETURN ( c = space ) OR ( c = tab );
+END Blank;
+
+(* ------------------------------------------------------- *)
+PROCEDURE NonBlank( c :CHAR ) :BOOLEAN;
+(* is this character a blank or tab *)
+BEGIN
+  RETURN NOT Blank( c );
+END NonBlank;
+
+    (* -------------------------------------------- *)
+    PROCEDURE Equal( a, b :ARRAY OF CHAR ) :BOOLEAN;
+    VAR
+      i, n :CARDINAL;
+    BEGIN
+
+       n := Length( a );
+
+       IF n # Length( b ) THEN
+         RETURN FALSE;
+       ELSE
+
+         i := 0;
+         WHILE ( i < n ) & ( a[i] = b[i] ) DO
+           i := i + 1;
+         END;
+
+         RETURN i = n;
+
+       END;
+
+    END Equal;
+
+
+
+    (* ---------------------------------------------------------------- *)
+    PROCEDURE Compare( a, operation, b :ARRAY OF CHAR ) :BOOLEAN;
+    (*
+     This nice algorithm comes from:
+                 Western Research Laboratory, Digital Equipment Corp.
+                 100 Hamilton Ave., Palo Alto, CA  94301
+     and is subject to their copyrights: this may be used, copied
+     and modified but may not be sold.
+     Some minor changes and a bug fix by J. Andrea, Sep.5/91
+    *)
+
+    TYPE
+       Operations = ( eq, ne, gt, ge, lt, le, nop );
+
+    VAR
+       compare_op :Operations;
+
+       last_a, last_b :CHAR;
+       len_a,  len_b  :CARDINAL;
+       ok             :BOOLEAN;
+       i, n           :CARDINAL;
+
+    BEGIN (* Compare *)
+
+       n := Length( operation );
+
+       IF n < 1 THEN
+         compare_op := nop;
+
+       ELSIF n = 1 THEN
+
+         IF operation[0] = '=' THEN
+           compare_op := eq;
+         ELSIF operation[0] = '#' THEN
+           compare_op := ne;
+         ELSIF operation[0] = '>' THEN
+           compare_op := gt;
+         ELSIF operation[0] = '<' THEN
+           compare_op := lt;
+         ELSE
+           compare_op := nop;
+         END;
+
+       ELSIF n = 2 THEN
+
+         IF operation[0] = '>' THEN
+
+           IF operation[1] = '=' THEN
+             compare_op := ge;
+           ELSE
+             compare_op := nop;
+           END;
+
+         ELSIF operation[0] = '<' THEN
+
+           IF operation[1] = '=' THEN
+             compare_op := le;
+           ELSIF operation[1] = '>' THEN
+             compare_op := ne;
+           ELSE
+             compare_op := nop;
+           END;
+
+         ELSIF operation[0] = '=' THEN
+
+           IF operation[1] = '<' THEN
+             compare_op := le;
+           ELSIF operation[1] = '>' THEN
+             compare_op := ge;
+           ELSE
+             compare_op := nop;
+           END;
+
+         ELSE
+           compare_op := nop;
+         END;
+
+       ELSE
+         compare_op := nop;
+       END;
+
+       IF compare_op = nop THEN
+         RETURN FALSE;
+       ELSE
+
+         len_a  := Length( a );  len_b  := Length( b );
+         last_a := nul;          last_b := nul;
+
+         IF len_a = len_b THEN
+           n := len_a;
+           IF n # 0 THEN
+             last_a := a[n-1];
+             last_b := b[n-1];
+           END;
+         ELSIF len_a < len_b THEN
+           n      := len_a;
+           last_b := b[n-1];
+         ELSE
+           n      := len_b;
+           last_a := a[n-1];
+         END;
+
+         i := 0; ok := TRUE;
+         WHILE ok & ( i < n ) DO
+           IF a[i] # b[i] THEN
+             ok     := FALSE;
+             last_a := a[i];  last_b := b[i];
+           ELSE
+             i := i + 1;
+           END;
+         END;
+
+         CASE compare_op OF
+
+         eq: RETURN last_a = last_b;
+        |ne: RETURN last_a # last_b;
+        |gt: RETURN last_a > last_b;
+        |lt: RETURN last_a < last_b;
+        |ge: RETURN last_a >= last_b;
+        |le: RETURN last_a <= last_b;
+
+         END;
+
+       END;
+
+    END Compare;
+
+
+
+    (* -------------------------------------------- *)
+    PROCEDURE Index( source, pattern :ARRAY OF CHAR ) :CARDINAL;
+    (*
+       This algorithm is a simple string search.
+       Help from D. MacDonald for a fix to string lengths.
+    *)
+
+    VAR
+       len_s, len_p, s, p :CARDINAL;
+
+    BEGIN (* Index *)
+
+       len_s := Length( source );
+
+       IF len_s = 0 THEN
+         RETURN 0;
+       ELSE
+
+         len_p := Length( pattern );
+
+         IF ( len_p = 0 ) OR ( len_p > len_s ) THEN
+           RETURN 0;
+         ELSE
+
+           (* keep trying to make comparisons till the pattern
+              will no longer fit at the end of the source *)
+
+           s := 0;
+           WHILE len_s - s + 1 >= len_p DO
+
+             (* are the strings equal from this position to the end *)
+
+             p := 0;
+             WHILE ( p < len_p ) & ( source[s+p] = pattern[p] ) DO
+                  p := p + 1;
+             END;
+
+             IF p = len_p THEN   (* they are equal *)
+                RETURN s + 1;
+             END;
+
+             s := s + 1;
+           END;
+
+           RETURN 0;   (* if outside the loop, then not found *)
+
+         END;
+       END;
+
+    END Index;
+
+
+    (* -------------------------------------------- *)
+    PROCEDURE Assign( a :ARRAY OF CHAR; VAR b :ARRAY OF CHAR );
+    VAR
+      i, n, max :CARDINAL;
+    BEGIN
+
+       n := Length( a );
+
+       IF n = 0 THEN
+         b[0] := nul;
+       ELSE
+
+         (* determine how many characters can be copied *)
+
+          max := HIGH( b ) + 1;      (* maximum characters in 'c' *)
+
+          n := MinCard( n, max );    (* minimum required to copy *)
+
+          FOR i := 0 TO n - 1 DO     (* copy those characters *)
+             b[i] := a[i];
+          END;
+
+          IF n < max THEN b[n] := nul; END;
+
+       END;
+
+    END Assign;
+
+
+    (* ---------------------------------------------------------------- *)
+    PROCEDURE Append( a :ARRAY OF CHAR; VAR b :ARRAY OF CHAR );
+    VAR
+       i, n, max, out, remain :CARDINAL;
+    BEGIN
+
+       n := Length( a );
+
+       IF n > 0 THEN
+
+         max := HIGH( b ) + 1;   (* maximum number of characters in 'b' *)
+         out := Length( b );
+
+         (* calculate the minimum number of characters which must be moved *)
+
+         remain := max - out;
+
+         n := MinCard( n, remain );
+
+         FOR i := 0 TO n-1 DO           (* copy those characters *)
+            b[out] := a[i];
+            out    := out + 1;
+         END;
+
+         IF out < max THEN b[out] := nul; END;
+
+       END;
+
+    END Append;
+
+
+    (* ---------------------------------------------------------------- *)
+    PROCEDURE Concat( a, b :ARRAY OF CHAR; VAR c :ARRAY OF CHAR );
+    BEGIN
+
+        Assign( a, c );
+        Append( b, c );
+
+    END Concat;
+
+
+    (* ---------------------------------------------------------------- *)
+    PROCEDURE SubString( a :ARRAY OF CHAR; start, len :CARDINAL;
+                         VAR b :ARRAY OF CHAR );
+    VAR
+      i, n, max :CARDINAL;
+    BEGIN
+
+       IF len = 0 THEN  (* don't copy anything *)
+         b[0] := nul;
+       ELSE
+
+         IF start = 0 THEN start := 1; END;
+
+         n := Length( a );
+
+         IF start > n THEN  (* start off the end, don't copy anything *)
+           b[0] := nul;
+         ELSE
+
+           max := HIGH( b ) + 1;   (* maximum number of characters in 'b' *)
+
+           (* determine how many characters can be copied *)
+
+           (* don't run off the end of the output string *)
+           len := MinCard( len, max );
+
+           (* and don't run off the end of the input string *)
+           IF start + len - 1 > n THEN
+             len := n - start + 1;
+           END;
+
+           (* change 'start' back to zero offset *)
+           start := start - 1;
+
+           FOR i := 0 TO len - 1 DO
+              b[i] := a[start+i];
+           END;
+
+           IF len < max THEN b[len] := nul; END;
+
+        END;
+      END;
+
+    END SubString;
+
+
+
+    (* ---------------------------------------------------------------- *)
+    PROCEDURE Insert( a :ARRAY OF CHAR; start :CARDINAL;
+                      VAR b :ARRAY OF CHAR );
+    VAR
+       i, j, n, m, len_b, max, top, remain :CARDINAL;
+    BEGIN
+
+       n := Length( a );
+
+       IF n > 0 THEN
+
+         len_b := Length( b );
+
+         IF start = 0 THEN start := 1; END;
+
+         IF start <= len_b THEN
+
+           (* this operation must be done in two steps *)
+           (* 1. shift the end section of 'b' back beyond where 'a' will go *)
+           (* 2. move the characters of 'a' into 'b' *)
+
+           max := HIGH( b ) + 1;   (* maximum number of characters in 'b' *)
+
+
+           (* begin part 1 *)
+
+           top := start + n - 1; (* last character of the insert section *)
+
+           (* don't shift anything if the insert will fill the remainder *)
+
+           IF top < max THEN
+
+             (* how many characters should be shifted *)
+             m := len_b - start + 1;
+
+             (* how many places remain after the insert *)
+             remain := max - top;
+
+             (* move only as many characters as will fit at the end *)
+             m := MinCard( remain, m );
+
+             (* the motion must go from the back to the front *)
+             (* or else characters may get written over before they are moved *)
+
+             (* this really reads j := start + m - 1;               *)
+             (* but the strings are zero offset, so the extra -1 is *)
+             (* propagated out of the loop to the initial value     *)
+
+             j := start + m - 2;
+             FOR i := 1 TO m DO
+                b[n+j] := b[j];
+                j := j - 1;
+             END;
+
+           END;
+
+
+           (* begin part 2 *)
+           (* determine how many characters of 'a' can be copied in *)
+
+           m := MinCard( n, max - start + 1 );
+
+           (* convert 'start' back to zero offset *)
+           start := start - 1;
+
+           FOR i := 0 TO m-1 DO           (* copy those characters *)
+              b[start+i] := a[i];
+           END;
+
+           top := len_b + n;
+           IF top < max THEN b[top] := nul; END;
+
+        END;
+      END;
+
+    END Insert;
+
+
+    (* ---------------------------------------------------------------- *)
+    PROCEDURE Replace( a :ARRAY OF CHAR; start :CARDINAL; VAR b :ARRAY OF CHAR );
+    VAR
+      i, n, len_a, len_b :CARDINAL;
+    BEGIN
+
+       len_b := Length( b );
+
+       IF len_b > 0 THEN
+
+         len_a := Length( a );
+
+         IF len_a > 0 THEN
+
+           IF start = 0 THEN start := 1; END;
+
+           IF start <= len_b THEN
+
+             (* find the number of characters which can be replaced *)
+             n := MinCard( len_a, len_b - start + 1 );
+
+             IF n > 0 THEN
+
+               n := n - 1;   start := start - 1;
+
+               FOR i := 0 TO n DO
+                  b[start+i] := a[i];
+               END;
+
+             END;
+           END;
+        END;
+      END;
+
+    END Replace;
+
+
+    (* ---------------------------------------------------------------- *)
+    PROCEDURE Delete( VAR a :ARRAY OF CHAR; start, len :CARDINAL );
+
+    VAR
+       i, n, top, remain :CARDINAL;
+
+    BEGIN
+
+       IF len > 0 THEN
+
+         n := Length( a );
+
+         IF start = 0 THEN start := 1; END;
+
+         IF start <= n THEN
+
+           top := start + len - 1;    (* last character of the delete section *)
+
+           IF top >= n THEN
+             (* all the remaining characters are to be deleted *)
+             (* so just end the string here *)
+
+             a[start-1] := nul;
+
+           ELSE
+
+             (* determine how many characters must be shifted down from *)
+             (* above the delete section *)
+
+             n := n - top;
+
+             (* change 'start' back to zero offset *)
+             start := start - 1;
+
+             FOR i := 0 TO n - 1 DO
+                a[start+i] := a[top+i];
+             END;
+
+             a[start+n] := nul;
+
+           END;
+
+        END;
+      END;
+
+    END Delete;
+
+
+    (* ---------------------------------------------------------------- *)
+    PROCEDURE Upper( VAR string :ARRAY OF CHAR );
+    VAR
+      i, n :CARDINAL;
+      c    :CHAR;
+    BEGIN
+
+       n := Length( string );
+
+       FOR i := 0 TO n-1 DO
+
+          c := string[i];
+
+          IF ( c >= 'a' ) & ( c <= 'z' ) THEN
+            string[i] := CAP( c );
+          END;
+
+       END;
+
+    END Upper;
+
+    (* ---------------------------------------------------------------- *)
+    PROCEDURE Lower( VAR string :ARRAY OF CHAR );
+    VAR
+      i, n :CARDINAL;
+      c    :CHAR;
+    BEGIN
+
+       n := Length( string );
+
+       FOR i := 0 TO n-1 DO
+
+          c := string[i];
+
+          IF ( c >= 'A' ) & ( c <= 'Z' ) THEN
+            string[i] := CHR( ORD( c ) + 32 );
+          END;
+
+       END;
+
+    END Lower;
+
+
+    (* -------------------------------------------- *)
+    PROCEDURE NextScan( source :ARRAY OF CHAR; start :CARDINAL;
+                        ScanFor :CharScanProc ) :CARDINAL;
+    VAR
+      i, n :CARDINAL;
+    BEGIN
+
+       n := Length( source );
+
+       IF n = 0 THEN
+         RETURN 0;
+       ELSE
+
+         IF start = 0 THEN start := 1; END;
+
+         IF start > n THEN
+           RETURN 0;
+         ELSE
+
+           i := start - 1;
+
+           WHILE ( i < n ) & ScanFor( source[i] ) DO
+             i := i + 1;
+           END;
+
+           IF i = n THEN
+             RETURN 0;
+           ELSE
+             RETURN i + 1;
+           END;
+
+         END;
+       END;
+
+    END NextScan;
+
+    (* -------------------------------------------- *)
+    PROCEDURE NextBlank( source :ARRAY OF CHAR;
+                         start  :CARDINAL ) :CARDINAL;
+    BEGIN
+      RETURN NextScan( source, start, NonBlank );
+    END NextBlank;
+
+
+    (* -------------------------------------------- *)
+    PROCEDURE NextNonBlank( source :ARRAY OF CHAR;
+                            start  :CARDINAL ) :CARDINAL;
+    BEGIN
+      RETURN NextScan( source, start, Blank );
+    END NextNonBlank;
+
+
+    (* ---------------------------------------------------------------- *)
+    PROCEDURE Empty( VAR string :ARRAY OF CHAR );
+    VAR
+      i, n :CARDINAL;
+    BEGIN
+
+       n := HIGH( string );
+
+       FOR i := 0 TO n DO
+          string[i] := nul;
+       END;
+
+    END Empty;
+
+
+    (* ---------------------------------------------------------------- *)
+    PROCEDURE Trim( VAR string :ARRAY OF CHAR );
+
+    VAR
+       n, on_input :CARDINAL;
+
+    BEGIN
+
+       on_input := Length( string );
+
+       IF on_input # 0 THEN
+
+         on_input := on_input - 1;
+         n        := on_input;
+
+         (* start at the end and run backwards *)
+
+         WHILE ( n > 0 ) & Blank( string[n] ) DO
+           n := n - 1;
+         END;
+
+         (* has the length of the string actually changed *)
+
+         IF n # on_input THEN
+           (* end the string properly *)
+
+           IF n = 0 THEN
+             IF Blank( string[0] ) THEN string[0] := nul; END;
+           ELSE
+             string[n+1] := nul;
+           END;
+
+         END;
+
+      END;
+
+    END Trim;
+
+    (* ---------------------------------------------------------------- *)
+    PROCEDURE Length( string :ARRAY OF CHAR ) :CARDINAL;
+    VAR
+      i, n :CARDINAL;
+    BEGIN
+
+       n := HIGH( string );
+
+       i := 0;
+       WHILE ( i <= n ) & ( string[i] # nul ) DO
+          i := i + 1;
+       END;
+
+       RETURN i;
+
+    END Length;
+
+BEGIN
+END StringOperations.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/veryscree.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/veryscree.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/veryscree.def
@@ -0,0 +1,49 @@
+DEFINITION MODULE VeryScreen;
+
+(*
+  Very simple screen management procedures.
+  This is the best choice for programmers starting out with screen handling.
+
+  Specific to VT100 and better terminals (VT102, VT220, VT240, VT320, etc.)
+
+  This set of procedures does only a few operations to screens, but
+  does them quickly and simply with little overhead.
+*)
+(* box and line drawing added, John Andrea, Sep.25/1991 *)
+(* John Andrea, Feb.1/1991 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+
+EXPORT QUALIFIED
+   Home,       EraseScreen,  EraseLine,
+   PutString,  PutCursor,    CursorOn,
+   Line,       Box;
+
+
+PROCEDURE Home;
+(* move the cursor to top of screen *)
+
+PROCEDURE EraseScreen;
+(* erase the screen from the cursor down *)
+
+PROCEDURE EraseLine;
+(* erase from the cursor to then end of the current line *)
+
+PROCEDURE PutString( text :ARRAY OF CHAR; row, col :CARDINAL );
+(* put some text at the given location *)
+
+PROCEDURE PutCursor( row, col :CARDINAL );
+(* move the cursor to the given location *)
+
+PROCEDURE CursorOn( turn_on :BOOLEAN );
+(* turn cursor on or off, true=on, false=off *)
+(* if you forget to turn it back on at the end of your program *)
+(* use the editor, it will force the cursor back on *)
+
+PROCEDURE Line( row1, col1, row2, col2 :CARDINAL );
+(* draw a horizontal or vertical line between the two endpoints *)
+
+PROCEDURE Box( row1, col1, row2, col2 :CARDINAL );
+(* draw a box using the given corners *)
+
+END VeryScreen.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/wordhash.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/wordhash.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/wordhash.def
@@ -0,0 +1,80 @@
+DEFINITION MODULE WordHash;
+
+(* Reserved Word Hash Table for Modula-2
+*  coded by J. Andrea, Jan 1986
+*  from
+*        Minimal Perfect Hash Functions for Reserved Word Lists
+*        R.W. Sebeasta and M.A. Taylor
+*        SigPlan Notices, V20, #12, December 1985
+* 
+*  The function HashValue returns a cardinal which can be compared with the
+*    values of the word values, not_a_reserved_word is returned if the input
+*    string is not a Modula-2 reserved word
+*
+*)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED
+       HashValue,
+       not_a_reserved_word,
+       and,     array,     begin,     by,     case,     const,  definition,
+       div,     do,        else,      elsif,  end,      exit,   export,
+       for,     from,      if,        implementation,   import,
+       in,      loop,      mod,       module, not,      of,     or,
+       pointer, procedure, qualified, record, repeat,   return, set,
+       then,    to,        type,      until,  var,      while,  with;
+
+(* sorted by value *)
+CONST 
+       not_a_reserved_word = 32767;
+       else       =  0;
+       exit       =  1;
+       end        =  2;
+       while      =  3;
+       then       =  4;
+       repeat     =  5;
+       elsif      =  6;
+       module     =  7;
+       type       =  8;
+       do         =  9;
+       set        = 10;
+       pointer    = 11;
+       export     = 12;
+       not        = 13;
+       case       = 14;
+       mod        = 15;
+       procedure  = 16;
+       definition = 17;
+       return     = 18;
+       record     = 19;
+       for        = 20;
+       in         = 21;
+       or         = 22;
+       from       = 23;
+       var        = 24;
+       begin      = 25;
+       const      = 26;
+       of         = 27;
+       to         = 28;
+       if         = 29;
+       div        = 30;
+       and        = 31;
+       qualified  = 32;
+       by         = 33;
+       loop       = 34;
+       with       = 35;
+       until      = 36;
+       array      = 37;
+       import     = 38;
+       implementation = 39;
+
+
+CONST (* not exported *)
+     min_hash = 0;   max_hash = 39;
+
+ 
+
+PROCEDURE HashValue( string :ARRAY OF CHAR ) :CARDINAL;
+
+
+END WordHash.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/wordhash.mod b/examples/Modula-2_Libraries/andrea-m2/lib/generic/wordhash.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/wordhash.mod
@@ -0,0 +1,174 @@
+IMPLEMENTATION MODULE WordHash;
+
+(* Reserved Word Hash Table for Modula-2
+*  coded by J. Andrea, Jan 1986
+*  from
+*        Minimal Perfect Hash Functions for Reserved Word Lists
+*        R.W. Sebeasta and M.A. Taylor
+*        SigPlan Notices, V20, #12, December 1985
+* 
+*  The function HashValue returns a cardinal which can be compared with the
+*    values of the word values, not_a_reserved_word is returned if the input
+*    string is not a Modula-2 reserved word
+*
+*)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM StringOperations IMPORT Length;
+
+CONST
+   min_char = 'A';    max_char = 'Z';
+   min_len  =  2;     max_len  = 14;
+
+TYPE
+   LetterInfo = RECORD
+                  value    :INTEGER;
+                  position :INTEGER;
+                END;
+   WordInfo   = RECORD
+                  word_length :CARDINAL;
+                  actual_word :ARRAY [0..max_len] OF CHAR;
+                END;
+
+VAR
+   letters :ARRAY [min_char .. max_char] OF LetterInfo;
+   words   :ARRAY [min_hash .. max_hash] OF WordInfo;
+   
+   (* --------------------------------------------------------- *)
+   PROCEDURE HashValue( string :ARRAY OF CHAR ) :CARDINAL;
+   (* compute and return the hash value of a Modula-2 reserved word *)
+
+   VAR
+      length                   :CARDINAL;
+      first, last, second_last :CHAR;
+      value                    :INTEGER;
+
+      (* ------------------------------------------------------ *)
+      PROCEDURE SecondCheck() :BOOLEAN;
+      (* make sure its the actual word, with a char by char comparison *)
+
+      VAR
+         i, m, l :CARDINAL;
+
+      BEGIN (* SecondCheck *)
+
+         m := CARDINAL( value );   l := words[m].word_length;
+
+         i := 0;
+         WHILE ( i < l ) & ( string[i] = words[m].actual_word[i] ) DO
+            i := i + 1;
+         END; (* while *)
+
+         RETURN ( i >= l );
+
+      END SecondCheck;
+
+   BEGIN (* HashValue *)
+
+      length := Length(string);
+      IF ( length < min_len ) OR ( length > max_len ) THEN
+         RETURN not_a_reserved_word;
+      ELSE
+
+         first := string[0];  last := string[length-1];
+         second_last := string[length-2];
+
+         IF ( first < min_char ) OR ( first > max_char ) OR
+            ( last  < min_char ) OR ( last  > max_char ) OR
+            ( second_last < min_char ) OR ( second_last > max_char ) THEN
+            RETURN not_a_reserved_word;
+         ELSE
+
+            value := letters[first].value + letters[last].value + 
+                     INTEGER( length )    + letters[second_last].position;
+            IF ( value < min_hash ) OR ( value > max_hash ) THEN
+               RETURN not_a_reserved_word;
+            ELSE
+               IF SecondCheck() THEN
+                  RETURN CARDINAL( value );
+               ELSE
+                  RETURN not_a_reserved_word;
+               END; (* if *)
+            END; (* if *)
+
+         END; (* if *)
+
+      END; (* if *)
+
+   END HashValue;
+
+BEGIN (* Wordhash *)
+
+letters['A'].value :=  18;    letters['A'].position :=  0;
+letters['B'].value :=  16;    letters['B'].position :=  1;
+letters['C'].value :=   3;    letters['C'].position :=  2;
+letters['D'].value := - 3;    letters['D'].position :=  3;
+letters['E'].value := -11;    letters['E'].position :=  4;
+letters['F'].value :=   4;    letters['F'].position :=  5;
+letters['G'].value := 100;    letters['G'].position :=  6;
+letters['H'].value :=  14;    letters['H'].position :=  7;
+letters['I'].value :=  15;    letters['I'].position :=  8;
+letters['J'].value := 100;    letters['J'].position :=  9;
+letters['K'].value := 100;    letters['K'].position := 10;
+letters['L'].value :=  15;    letters['L'].position := 11;
+letters['M'].value :=   1;    letters['M'].position := 12;
+letters['N'].value := - 4;    letters['N'].position := 13;
+letters['O'].value :=   7;    letters['O'].position := 14;
+letters['P'].value :=   1;    letters['P'].position := 15;
+letters['Q'].value :=  22;    letters['Q'].position := 16;
+letters['R'].value := - 1;    letters['R'].position := 17;
+letters['S'].value :=   3;    letters['S'].position := 18;
+letters['T'].value :=   0;    letters['T'].position := 19;
+letters['U'].value :=   8;    letters['U'].position := 20;
+letters['V'].value :=  22;    letters['V'].position := 21;
+letters['W'].value := - 2;    letters['W'].position := 22;
+letters['X'].value := 100;    letters['X'].position := 23;
+letters['Y'].value :=  14;    letters['Y'].position := 24;
+letters['Z'].value := 100;    letters['Z'].position := 25;
+
+words[and].word_length     :=  3;    words[and].actual_word     := 'AND';
+words[array].word_length   :=  5;    words[array].actual_word   := 'ARRAY';
+words[begin].word_length   :=  5;    words[begin].actual_word   := 'BEGIN';
+words[by].word_length      :=  2;    words[by].actual_word      := 'BY';
+words[case].word_length    :=  4;    words[case].actual_word    := 'CASE';
+words[const].word_length   :=  5;    words[const].actual_word   := 'CONST';
+words[definition].word_length := 10;
+                           words[definition].actual_word        := 'DEFINITION';
+words[div].word_length     :=  3;    words[div].actual_word     := 'DIV';
+words[do].word_length      :=  2;    words[do].actual_word      := 'DO';
+words[else].word_length    :=  4;    words[else].actual_word    := 'ELSE';
+words[elsif].word_length   :=  5;    words[elsif].actual_word   := 'ELSIF';
+words[end].word_length     :=  3;    words[end].actual_word     := 'END';
+words[exit].word_length    :=  4;    words[exit].actual_word    := 'EXIT';
+words[export].word_length  :=  6;    words[export].actual_word  := 'EXPORT';
+words[for].word_length     :=  3;    words[for].actual_word     := 'FOR';
+words[from].word_length    :=  4;    words[from].actual_word    := 'FROM';
+words[if].word_length      :=  2;    words[if].actual_word      := 'IF';
+words[implementation].word_length := 14;
+                           words[implementation].actual_word    := 'IMPLEMENTATION';
+words[import].word_length  :=  6;    words[import].actual_word  := 'IMPORT';
+words[in].word_length      :=  2;    words[in].actual_word      := 'IN';
+words[loop].word_length    :=  4;    words[loop].actual_word    := 'LOOP';
+words[mod].word_length     :=  3;    words[mod].actual_word     := 'MOD';
+words[module].word_length  :=  6;    words[module].actual_word  := 'MODULE';
+words[not].word_length     :=  3;    words[not].actual_word     := 'NOT';
+words[of].word_length      :=  2;    words[of].actual_word      := 'OF';
+words[or].word_length      :=  2;    words[or].actual_word      := 'OR';
+words[pointer].word_length :=  7;    words[pointer].actual_word := 'POINTER';
+words[procedure].word_length := 9;
+                           words[procedure].actual_word         := 'PROCEDURE';
+words[qualified].word_length := 9;
+                           words[qualified].actual_word         := 'QUALIFIED';
+words[record].word_length  :=  6;    words[record].actual_word  := 'RECORD';
+words[repeat].word_length  :=  6;    words[repeat].actual_word  := 'REPEAT';
+words[return].word_length  :=  6;    words[return].actual_word  := 'RETURN';
+words[set].word_length     :=  3;    words[set].actual_word     := 'SET';
+words[then].word_length    :=  4;    words[then].actual_word    := 'THEN';
+words[to].word_length      :=  2;    words[to].actual_word      := 'TO';
+words[type].word_length    :=  4;    words[type].actual_word    := 'TYPE';
+words[until].word_length   :=  5;    words[until].actual_word   := 'UNTIL';
+words[var].word_length     :=  3;    words[var].actual_word     := 'VAR';
+words[while].word_length   :=  5;    words[while].actual_word   := 'WHILE';
+words[with].word_length    :=  4;    words[with].actual_word    := 'WITH';
+
+END WordHash.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/generic/wordlist.def b/examples/Modula-2_Libraries/andrea-m2/lib/generic/wordlist.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/generic/wordlist.def
@@ -0,0 +1,52 @@
+DEFINITION MODULE WordList;
+
+(* Jaa, Sep.3/92 *)
+(* Build a list of words and make the list quickly and easily searchable *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED  List,
+                  Create, Destroy,
+                  Input, Add, Remove,
+                  In, Get,
+                  Print,
+                  Size;
+
+
+TYPE
+  List;  (* opaque type *)
+
+
+PROCEDURE Create( VAR a_list :List );
+(* initialize a list, this MUST be done *)
+
+PROCEDURE Destroy( VAR a_list :List );
+(* get rid of a list *)
+
+
+PROCEDURE Input( input_file :ARRAY OF CHAR; a_list :List;
+                    VAR done :BOOLEAN );
+(* Give the name of the input file of words to create the list,
+   return done as false if the file can't be opened *)
+
+PROCEDURE Add( word :ARRAY OF CHAR; a_list :List );
+(* add another word to the list *)
+
+PROCEDURE Remove( word :ARRAY OF CHAR; a_list :List );
+(* if the word exists in the list, remove it *)
+
+
+PROCEDURE In( word :ARRAY OF CHAR; a_list :List ) :BOOLEAN;
+(* does this word exist in the list *)
+
+PROCEDURE Get( VAR word :ARRAY OF CHAR; n :CARDINAL; a_list :List );
+(* return the n'th word in the list *)
+
+
+PROCEDURE Print( output_file :ARRAY OF CHAR; a_list :List );
+(* output the whole list into the specified file *)
+
+
+PROCEDURE Size( a_list :List ) :CARDINAL;
+(* return the number of words in the list *)
+
+END WordList.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/bitmapop.mod b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/bitmapop.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/bitmapop.mod
@@ -0,0 +1,626 @@
+IMPLEMENTATION MODULE BitmapOperations;
+
+(* Known bug - on the compare, all of the last set should not be compared *)
+
+(* Bitmap operations using dynamic memory, see the corresponding definition *)
+(* J. Andrea, May.18/92 -dos version *)
+(* V1.0, J. Andrea, Mar.18/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+(*
+* A bitmap is implemented as a collection of BITSETS, each bit in the set is
+* accessed as required by calculating the memory offset to the bitset containing
+* the requested bit, then the offset into that bitset to get the specific bit.
+* The global operations (Clear, And, Or, etc.) are performed not one bit at a
+* time, but on one BITSETS (16 bits) at a time.
+* The single bit operations, Put and Get, must be performed on one bit.
+*)
+
+FROM SYSTEM IMPORT TSIZE, ADDRESS;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+FROM ASCII IMPORT EOL;
+FROM FileSystem IMPORT CreateFile, Close, WriteChar, File, Response;
+FROM StringOperations IMPORT Length;
+
+TYPE
+  Bitmap = POINTER TO RECORD
+             rows, cols :CARDINAL;   (* dimensions of the bitmap *)
+             start      :ADDRESS;    (* memory address of the first item *)
+             size       :CARDINAL;   (* actual size of the bitmap in bytes *)
+             in_last    :CARDINAL;   (* number of bits used in last bitset *)
+             sets       :CARDINAL;   (* number of bitsets *)
+           END;
+
+VAR
+  adra, adrb, adrc     :POINTER TO BITSET;   (* generic pointers *)
+  i, j, k, n           :CARDINAL;            (* generic counters *)
+  which_set, which_bit :CARDINAL;
+  empty, full          :BITSET;
+  outf                 :File;
+  digits               :ARRAY [0..9] OF CHAR;
+
+  bset_bits, bset_bytes :CARDINAL;
+
+(* ---------------------------------------------------- *)
+PROCEDURE WriteLn;
+BEGIN
+  WriteChar( outf, EOL );
+END WriteLn;
+
+(* ---------------------------------------------------- *)
+PROCEDURE WriteString( s :ARRAY OF CHAR );
+VAR i, n :CARDINAL;
+BEGIN
+  n := Length( s );
+  IF n > 0 THEN
+    n := n - 1;
+    FOR i := 0 TO n DO
+      WriteChar( outf, s[i] );
+    END;
+  END;
+END WriteString;
+
+(* ---------------------------------------------------- *)
+PROCEDURE WriteCard( x :CARDINAL );
+VAR y :CARDINAL;
+BEGIN
+  IF x < 10 THEN
+    WriteChar( outf, digits[x] );
+  ELSE
+    y := x DIV 10;
+    WriteCard( y );
+    WriteCard( x - y * 10 );
+  END;
+END WriteCard;
+
+(* -------------------------------------------------------- *)
+PROCEDURE InRange( a :Bitmap; row, col :CARDINAL ) :BOOLEAN;
+(* is the specified row/col item in this bitmap *)
+BEGIN
+  RETURN ( row >= 1 ) & ( row <= a^.rows ) & ( col >= 1 ) & ( col <= a^.cols );
+END InRange;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Offset( a :Bitmap; row, col :CARDINAL; VAR set, bit :CARDINAL );
+(* calculate the memory offset to the row/col item from the first item *)
+VAR which_dot :CARDINAL;
+BEGIN
+
+  (* the bitmap is treated as a long string of bits *)
+  (* with one row laid after another                *)
+  (* calculate the position of this dot             *)
+  (* subtract the extra 1 here rather than twice later *)
+
+  which_dot := ( row - 1 ) * a^.cols + col - 1;
+
+  (* the bits are grouped into sets of 32 (imp. dep.) each *)
+  (* calculate which set this dot belongs to   *)
+  (* - this is an offset from the first, so it should be zero based *)
+
+  set := which_dot DIV bset_bits;
+
+  (* and how far into this set is the dot that we need *)
+
+  bit := which_dot - set * bset_bits;
+
+END Offset;
+
+(* -------------------------------------------------------- *)
+PROCEDURE ReverseOffset( a :Bitmap; set, bit :CARDINAL; VAR row, col :CARDINAL );
+(* given item position, calculate row and column *)
+VAR which_dot :CARDINAL;
+BEGIN
+  which_dot := ( set - 1 ) * bset_bits + bit;
+  row       := 1 + ( which_dot DIV a^.cols );
+  col       := which_dot - ( ( row - 1 ) * a^.cols );
+END ReverseOffset;
+
+(* ------------------------------------------------------- *)
+PROCEDURE Build( VAR a :Bitmap; n_rows, n_columns :CARDINAL );
+VAR n_bits :CARDINAL;
+BEGIN
+  NEW( a );
+
+  (* protect users from themselves *)
+  IF n_rows    = 0 THEN n_rows := 1 END;
+  IF n_columns = 0 THEN n_columns := 1 END;
+
+
+  a^.rows := n_rows;
+  a^.cols := n_columns;
+
+  n_bits  := n_rows * n_columns;
+
+  a^.in_last := n_bits MOD bset_bits;
+
+  IF a^.in_last = 0 THEN
+    a^.in_last := bset_bits;       (* last one is filed *)
+  ELSE
+    (* must be a multiple of bits in a bitset *)
+    n_bits := n_bits + bset_bits - a^.in_last;
+  END;
+
+  a^.sets := n_bits DIV bset_bits;   (* convert to bitsets *)
+  a^.size := a^.sets * bset_bytes;   (* convert to bytes *)
+
+  ALLOCATE( a^.start, a^.size );     (* grab that number of bytes from memory *)
+
+END Build;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Destroy( VAR a :Bitmap );
+BEGIN
+  DEALLOCATE( a^.start, a^.size );
+  DISPOSE( a );
+END Destroy;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Put( a :Bitmap; row, col :CARDINAL; set :CARDINAL );
+BEGIN
+  IF InRange( a, row, col ) THEN
+    Offset( a, row, col, which_set, which_bit );
+    adra  := a^.start + which_set * bset_bytes;
+
+    IF set = 0 THEN
+      EXCL( adra^, which_bit );
+    ELSIF set = 2 THEN
+      IF which_bit IN adra^ THEN
+        EXCL( adra^, which_bit );
+      ELSE
+        INCL( adra^, which_bit );
+      END;
+    ELSE
+      INCL( adra^, which_bit );    (* everything else means turn on *)
+    END;
+  END;
+END Put;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Get( a :Bitmap; row, col :CARDINAL ) :BOOLEAN;
+VAR value :BOOLEAN;
+BEGIN
+  IF InRange( a, row, col ) THEN
+    Offset( a, row, col, which_set, which_bit );
+    adra  := a^.start + which_set * bset_bytes;
+    value := which_bit IN adra^;
+  ELSE
+    value := FALSE;
+  END;
+  RETURN value;
+END Get;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Size( a :Bitmap; VAR n_rows, n_cols :CARDINAL );
+BEGIN
+  n_rows := a^.rows;
+  n_cols := a^.cols;
+END Size;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Compare( a, b :Bitmap ) :BOOLEAN;
+VAR result :BOOLEAN;
+BEGIN
+
+  result := TRUE;
+
+  IF ( a^.rows = b^.rows ) & ( a^.cols = b^.cols ) THEN
+
+    i := 1;
+    k := 0;
+    WHILE result & ( i <= a^.sets ) DO
+       adra   := a^.start + k;
+       adrb   := b^.start + k;
+       result := adra^ = adrb^;
+       i      := i + 1;
+       k      := k + bset_bytes;
+    END;
+
+  ELSE
+    result := FALSE;
+  END;
+
+  RETURN result;
+
+END Compare;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Clear( a :Bitmap );
+BEGIN
+
+  k := 0;
+  FOR i := 1 TO a^.sets DO
+     adra  := a^.start + k;
+     adra^ := empty;
+     k     := k + bset_bytes;
+  END;
+
+END Clear;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Copy( a :Bitmap; VAR b :Bitmap );
+BEGIN
+
+  Build( b, a^.rows, a^.cols );
+
+  k := 0;
+  FOR i := 1 TO a^.sets DO
+     adra  := a^.start + k;
+     adrb  := b^.start + k;
+     adrb^ := adra^;
+     k     := k + bset_bytes;
+  END;
+
+END Copy;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Not( a :Bitmap; VAR b :Bitmap );
+BEGIN
+
+  Build( b, a^.rows, a^.cols );
+
+  k := 0;
+  FOR i := 1 TO a^.sets DO
+     adra  := a^.start + k;
+     adrb  := b^.start + k;
+     adrb^ := adra^ / full;        (* a Xor with <all bits> *)
+     k     := k + bset_bytes;
+  END;
+
+END Not;
+
+(* -------------------------------------------------------- *)
+PROCEDURE And( a, b :Bitmap; VAR c :Bitmap; VAR ok :BOOLEAN );
+BEGIN
+
+  IF ( a^.rows # b^.rows ) OR ( a^.cols # b^.cols ) THEN
+    ok := FALSE;
+  ELSE
+    ok := TRUE;
+
+    Build( c, a^.rows, a^.cols );
+
+    k := 0;
+    FOR i := 1 TO a^.sets DO
+       adra  := a^.start + k;
+       adrb  := b^.start + k;
+       adrc  := c^.start + k;
+       adrc^ := adra^ * adrb^;       (* set intersection *)
+       k     := k + bset_bytes;
+    END;
+
+  END;
+
+END And;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Or( a, b :Bitmap; VAR c :Bitmap; VAR ok :BOOLEAN );
+BEGIN
+
+  IF ( a^.rows # b^.rows ) OR ( a^.cols # b^.cols ) THEN
+    ok := FALSE;
+  ELSE
+    ok := TRUE;
+
+    Build( c, a^.rows, a^.cols );
+
+    k := 0;
+    FOR i := 1 TO a^.sets DO
+       adra  := a^.start + k;
+       adrb  := b^.start + k;
+       adrc  := c^.start + k;
+       adrc^ := adra^ + adrb^;    (* set union *)
+       k     := k + bset_bytes;
+    END;
+
+  END;
+
+END Or;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Xor( a, b :Bitmap; VAR c :Bitmap; VAR ok :BOOLEAN );
+BEGIN
+
+  IF ( a^.rows # b^.rows ) OR ( a^.cols # b^.cols ) THEN
+    ok := FALSE;
+  ELSE
+    ok := TRUE;
+
+    Build( c, a^.rows, a^.cols );
+
+    k := 0;
+    FOR i := 1 TO a^.sets DO
+       adra  := a^.start + k;
+       adrb  := b^.start + k;
+       adrc  := c^.start + k;
+       adrc^ := adra^ / adrb^;   (* symmetric set difference *)
+       k     := k + bset_bytes;
+    END;
+
+  END;
+
+END Xor;
+
+(* -------------------------------------------------------- *)
+PROCEDURE Line( a :Bitmap; row1, col1, row2, col2 :CARDINAL; set :CARDINAL );
+
+VAR
+  dr, dc, length, x, y :REAL;
+  i, n                 :CARDINAL;
+
+BEGIN
+   IF InRange( a, row1, col1 ) & InRange( a, row2, col2 ) THEN
+
+     dr := FLOAT( row2 ) - FLOAT( row1 );
+     dc := FLOAT( col2 ) - FLOAT( col1 );
+
+     IF ABS( dr ) > ABS( dc ) THEN
+       length := ABS( dr );
+     ELSE
+       length := ABS( dc );
+     END;
+
+     n := TRUNC( length );
+     IF n > 0 THEN
+
+       dr := dr / length;
+       dc := dc / length;
+
+       x := FLOAT( col1 ) + 0.5;
+       y := FLOAT( row1 ) + 0.5;
+       
+       FOR i := 1 TO n DO
+          Put( a, TRUNC( y ), TRUNC( x ), set );
+          x := x + dc;
+          y := y + dr;
+       END;
+
+     END;
+
+   END;
+END Line;
+
+(* -------------------------------------------------------- *)
+PROCEDURE PrintText( a :Bitmap; filename :ARRAY OF CHAR; VAR ok :BOOLEAN );
+VAR r, c :CARDINAL;
+BEGIN
+
+  CreateFile( outf, filename, 0 );
+
+  IF outf.res = done THEN
+    ok := TRUE;
+
+    n := a^.cols;
+    IF n > 132 THEN n := 132 END;      (* no wider than 132 characters *)
+
+    i := 0;
+    j := bset_bits;
+
+    r := 1;
+    WHILE r <= a^.rows DO
+
+       c := 1;
+       WHILE c <= a^.cols DO
+
+          IF j >= bset_bits THEN
+            (* jump to the next bitset *)
+            i := i + 1;  j := 0;
+            adra := a^.start + ( i - 1 ) * bset_bytes;
+          END;
+
+          IF c <= n THEN
+
+            IF j IN adra^ THEN
+              WriteChar( outf, '*' );
+            ELSE
+              WriteChar( outf, '.' );
+            END;
+
+          END;
+
+          c := c + 1;
+          j := j + 1;
+       END;
+       WriteLn;
+
+       r := r + 1;
+    END;
+
+    Close( outf );
+
+  ELSE
+    ok := FALSE;
+  END;
+
+END PrintText;
+
+(* -------------------------------------------------------- *)
+PROCEDURE PrintSixel( a :Bitmap; filename :ARRAY OF CHAR; VAR ok :BOOLEAN );
+
+CONST
+   esc     = 33C;
+   max_out = 800;
+   blank   = 63;
+
+VAR
+   out_line           :ARRAY [1..max_out] OF CARDINAL;
+   r1, r2, r, c, f, x :CARDINAL;
+
+BEGIN
+  CreateFile( outf, filename, 0 );
+
+  IF outf.res = done THEN
+    ok := TRUE;
+
+    n  := a^.cols;
+    IF n > max_out THEN n := max_out; END;
+
+    WriteChar( outf, esc ); WriteString( 'P0q' ); (* into Sixel graphics mode *)
+
+    r1 := 1;
+    WHILE r1 <= a^.rows DO
+
+      (* work in sets of 6 rows at a time *)
+      r2 := r1 + 5;        IF r2 > a^.rows THEN r2 := a^.rows; END;
+
+      FOR c := 1 TO n DO
+         k := blank;
+         f := 1;
+         FOR r := r1 TO r2 DO
+            IF Get( a, r, c ) THEN
+              k := k + f;
+            END;
+            f := f * 2;
+         END;
+         out_line[c] := k;
+      END;
+
+      (* truncate trailing blanks *)
+      j := n;
+      WHILE ( j > 1 ) & ( out_line[j] = blank ) DO
+        j := j - 1;
+      END;
+
+      WriteString( '??' );  (* spaces *)
+
+      (* try to use repeat counts to reduce file space and print time *)
+
+      c := 1;
+      WHILE c <= j DO
+
+         k := 0;
+         x := out_line[c];
+         i := c + 1;
+
+         WHILE ( i <= j ) & ( x = out_line[i] ) DO
+            k := k + 1;
+            i := i + 1;
+         END;
+
+         k := k + 1;   (* first + number of repeats *)
+
+         (* determine if its repeated enough *)
+
+         IF k > 3 THEN
+           WriteChar( outf, '!' );
+           WriteCard( k );
+           WriteChar( outf, CHR( x ) );
+         ELSE
+           FOR i := 1 TO k DO
+             WriteChar( outf, CHR( x ) );
+           END;
+         END;
+
+         c := c + k;   (* jump ahead *)
+      END;
+
+      WriteString( '-' );  (* new graphics line *)
+
+      r1 := r2 + 1;
+    END;
+
+
+    WriteChar( outf, esc ); WriteString( '\' );   (* out of Sixel mode *)
+
+    Close( outf );
+  ELSE
+    ok := FALSE;
+  END;
+
+END PrintSixel;
+
+(* -------------------------------------------------------- *)
+PROCEDURE PrintPS( a :Bitmap; filename :ARRAY OF CHAR; size :CARDINAL;
+                   VAR ok :BOOLEAN );
+
+CONST
+   max_rows = 750;
+   max_cols = 560;
+   side     = 25;
+
+VAR
+   r, c :CARDINAL;
+
+   (* ------------- *)
+   PROCEDURE WriteDot;
+   BEGIN
+      IF ( r * size < max_rows ) & ( c * size < max_cols ) THEN
+        WriteCard( c ); WriteString( ' ' );
+        WriteCard( r ); WriteString( ' D' ); WriteLn;
+      END;
+   END WriteDot;
+
+BEGIN
+
+  CreateFile( outf, filename, 0 );
+
+  IF outf.res = done THEN
+    ok := TRUE;
+
+    IF size < 1 THEN
+      size := 1;
+    ELSE
+      IF size > 100 THEN
+        size := 100;
+      END;
+    END;
+
+    WriteString( '%!PS-Adobe' ); WriteLn;
+    WriteString( '/D { moveto ' );
+    WriteString( ' 1 0 rlineto 0 1 rlineto -1 0 rlineto closepath fill' );
+    WriteString( ' } bind def' ); WriteLn;
+
+    WriteCard( side ); WriteString( ' ' ); WriteCard( max_rows );
+    WriteString( ' translate 0 0 moveto' ); WriteLn;
+    WriteString( '.2 setgray' ); WriteLn;
+    WriteCard( size ); WriteString( ' dup neg scale' ); WriteLn;
+
+    k := 0;
+    FOR i := 1 TO a^.sets - 1 DO
+       adra := a^.start + k;
+       IF adra^ # empty THEN
+         FOR j := 0 TO bset_bits DO
+            IF j IN adra^ THEN
+              ReverseOffset( a, i, j, r, c );
+              WriteDot;
+            END;
+         END;
+       END;
+       k := k + bset_bytes;
+    END;
+
+    adra := a^.start + k;
+    ReverseOffset( a, a^.sets, 0, r, c );
+    FOR j := 0 TO a^.in_last - 1 DO
+       IF j IN adra^ THEN
+         WriteDot;
+       END;
+       c := c + 1;
+    END;
+
+    WriteString( 'showpage' ); WriteLn;
+    WriteString( '%eof' );
+
+    Close( outf );
+  ELSE
+    ok := FALSE;
+  END;
+
+END PrintPS;
+
+BEGIN
+
+  bset_bytes := TSIZE( BITSET );
+  bset_bits  := bset_bytes * 8;
+
+  empty := {};
+
+  full := {};
+  FOR i := 0 TO bset_bits - 1 DO
+     INCL( full, i );
+  END;
+
+  FOR i := 0 TO 9 DO
+     digits[i] := CHR( i + 48 );
+  END;
+
+END BitmapOperations.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/cmdline.mod b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/cmdline.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/cmdline.mod
@@ -0,0 +1,105 @@
+IMPLEMENTATION MODULE CmdLine;
+
+(* Implementation by J. Andrea, Jun.28/92 -dos version *)
+(* With help on PSP addresses from Pat Terry *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM RTSMain IMPORT cmdLinePtr;
+FROM StringOperations IMPORT Assign, SubString, NextBlank, NextNonBlank;
+
+CONST
+  max_args = 30;   (* don't expect any more than this many arguments *)
+  max_size = 256;  (* max size of command line *)
+
+VAR
+  cmd_line        :ARRAY [1..max_size] OF CHAR;
+  cmd_len, n_args :CARDINAL;
+  
+  start, stop     :ARRAY [1..max_args] OF CARDINAL;
+  i, j            :CARDINAL;
+  
+  (* ------------------------------------------- *)
+  PROCEDURE WholeCommandLine( VAR line :ARRAY OF CHAR );
+  BEGIN
+     Assign( cmd_line, line );
+  END WholeCommandLine;
+  
+  (* ------------------------------------------- *)
+  PROCEDURE Nargs() :CARDINAL;
+  BEGIN
+    RETURN n_args;
+  END Nargs;
+  
+  (* ------------------------------------------- *)
+  PROCEDURE GetArg( n :CARDINAL; VAR arg :ARRAY OF CHAR );    
+  BEGIN
+    IF ( n < 1 ) OR ( n > n_args ) THEN
+      arg[0] := 0C;
+    ELSE
+    
+      i := stop[n] - start[n] + 1;  (* length of this arg *)
+
+      SubString( cmd_line, start[n], i, arg );
+
+    END;
+  END GetArg;
+  
+  (* ------------------------------------------- *)
+  PROCEDURE SetupArgs;
+  (* at program startup time, precompute the start and end positions *)
+  (* of all the arguments *)
+  BEGIN
+  
+     i := NextNonBlank( cmd_line, 1 );
+     WHILE ( n_args < max_args ) & ( i # 0 ) DO
+        j := NextBlank( cmd_line, i );
+
+        IF j = 0 THEN
+          (* no more blanks, end of arg must be last character *)
+          j := cmd_len + 1;
+        END;
+        
+        n_args := n_args + 1;
+        start[n_args] := i;
+        stop[n_args]  := j - 1;
+
+        i := NextNonBlank( cmd_line, j );
+     END;
+
+  END SetupArgs;
+
+  (* ------------------------------------------- *)
+  PROCEDURE GetCommandLine;
+  (* at program startup time, get the command line from the DOS PSP buffer *)
+  TYPE
+    Psp = POINTER TO ARRAY [0..max_size-1] OF CHAR;
+    
+  VAR
+    psp_ptr :Psp;
+    
+  BEGIN
+  
+     psp_ptr := cmdLinePtr.addr;
+
+     cmd_len := ORD( psp_ptr^[128] );
+       
+     FOR i := 1 TO cmd_len DO
+       cmd_line[i] := psp_ptr^[i+128];
+     END;
+
+     IF cmd_len < max_size THEN
+       cmd_line[cmd_len+1] := 0C;
+     END;
+     
+   END GetCommandLine;
+
+BEGIN
+
+  n_args      := 0;
+  cmd_line[1] := 0C;
+  cmd_len     := 0;
+  
+  GetCommandLine;
+  SetupArgs;
+    
+END CmdLine.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/dateoper.def b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/dateoper.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/dateoper.def
@@ -0,0 +1,59 @@
+DEFINITION MODULE DateOperations;
+
+(* Date and calendar procedures *)
+(* J. Andrea, Aug.16/92 *)
+(* Date calculations, dates valid only for 1-jan-1901 to 31-dec-2099 *)
+
+EXPORT QUALIFIED Date,
+                 Today,
+                 StringToDate, DateToString, MakeDate,
+                 LeapYear,
+                 DayOfYear, DayOfWeek,
+                 DaysBetween, AddDays, SubtractDays, Compare,
+                 PhaseOfMoon;
+                 
+TYPE
+   Date = RECORD
+            day, month, year :CARDINAL;
+            number :LONGINT;
+            true   :BOOLEAN;
+          END;
+   
+   PROCEDURE Today( VAR date :Date );
+   (* return the current time as a date *)
+   
+   PROCEDURE StringToDate( string :ARRAY OF CHAR; VAR date :Date );
+   PROCEDURE DateToString( date :Date; VAR string :ARRAY OF CHAR );
+   (* Convert to and from strings in VMS format dd-mmm-yyyy *)
+   
+   PROCEDURE MakeDate( day, month, year :CARDINAL; VAR date :Date );
+   (* create a date from only numeric info *)
+   
+   PROCEDURE LeapYear( year :CARDINAL ) :BOOLEAN;
+   (* is the given year a leap year *)
+                       
+   PROCEDURE DayOfYear( date :Date ) :CARDINAL;
+   (* return the day of the year 1 to 365 (or 366) *)
+   (* a zero is returned for invalid dates *)
+
+   PROCEDURE DayOfWeek( date :Date; VAR name :ARRAY OF CHAR );
+   (* return the day of the week, Sunday, Monday, etc. *)
+   (* an empty string is returned for invalid dates *)
+   
+   PROCEDURE DaysBetween( date1, date2 :Date ) :LONGINT;
+   (* return the number of days between the two given days *)
+   
+   PROCEDURE AddDays( in_date :Date; days :CARDINAL; VAR out_date :Date );
+   (* add the specified number of days to the given date *)
+   
+   PROCEDURE SubtractDays( in_date :Date; days :CARDINAL; VAR out_date :Date );
+   (* subtract the specified number of days from the given date *)
+                          
+   PROCEDURE Compare( date1, date2 :Date ) :CHAR;
+   (* return one of "=", ">", "<", or null (if one date is invalid *)
+
+   PROCEDURE PhaseOfMoon( date :Date; VAR phase :ARRAY OF CHAR );
+   (* return the phase of the moon as a string *)
+   (* an empty string is returned for invalid dates *)
+
+END DateOperations.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/dateoper.mod b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/dateoper.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/dateoper.mod
@@ -0,0 +1,522 @@
+IMPLEMENTATION MODULE DateOperations;
+(*/NOWARN*)
+(*/CHECK:AIOS*)
+
+(* J. Andrea, Aug.16/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+FROM StringOperations IMPORT Length, Assign;
+FROM TimeDate IMPORT Time, GetTime;
+
+CONST
+  min_day_number =  73355; (* Jan.1/1901  *)
+  max_day_number = 146038; (* Dec.31/2099 *)
+  date_length = 11;    (* size of a vms style date string dd-mmm-yyyy *)
+  
+VAR
+  months :ARRAY [1..12] OF ARRAY [0..2] OF CHAR;
+  days   :ARRAY [1..12] OF CARDINAL;
+  false_date :Date;
+      
+   (* --------------------------------------------------------- *)
+   PROCEDURE Today( VAR date :Date );
+   VAR
+     t :Time;
+     
+     (* ------------------------- *)
+     PROCEDURE GetBitNumber( b :BITSET; start, stop :CARDINAL ) :CARDINAL;
+     VAR
+       i, x, f :CARDINAL;
+     BEGIN
+       x := 0;
+       f := 1;
+       FOR i := start TO stop DO
+         IF i IN b THEN x := x + f; END;
+         f := f * 2;
+       END;
+       RETURN x;
+     END GetBitNumber;
+     
+   BEGIN
+
+     GetTime( t );
+  
+     MakeDate( GetBitNumber( BITSET( t.day ), 0, 4 ),
+               GetBitNumber( BITSET( t.day ), 5, 8 ),
+               GetBitNumber( BITSET( t.day ), 9, 15 ) + 1900, date );
+  
+   END Today;
+   
+   (* --------------------------------------------------------- *)
+   PROCEDURE MakeDate( day, month, year :CARDINAL; VAR date :Date );
+   BEGIN
+   
+     date.true := TRUE;
+     date.day  := day;  date.month := month;  date.year := year;
+      
+     IF ( date.day = 0 ) OR ( date.day > 31 ) THEN
+       date.true := FALSE;
+     ELSE
+         
+       IF date.month > 12 THEN
+         date.true := FALSE;
+       ELSE
+          
+         IF ( date.year < 1901 ) OR ( date.year > 2099 ) THEN
+           date.true := FALSE;
+         ELSE
+            
+           (* test for day in month *)
+           IF date.day > days[date.month] THEN
+             IF date.month # 2 THEN
+               date.true := FALSE;
+             ELSE
+               IF NOT LeapYear( date.year ) THEN
+                 date.true := FALSE;
+               END; 
+             END;
+           END;
+              
+           (* precompute some stuff *)
+           IF date.true THEN
+             date.number := DayNumber( date );
+           END;
+              
+          END;
+        END;
+      END;
+    END MakeDate;
+       
+   (* --------------------------------------------------------- *)
+   PROCEDURE StringToDate( string :ARRAY OF CHAR; VAR date :Date );
+   VAR
+      i, l, p :CARDINAL;
+      mmm     :ARRAY [0..2] OF CHAR;
+      ok      :BOOLEAN;
+      d, m, y :CARDINAL;
+      
+      (* --------------------------- *)
+      PROCEDURE Digit( c :CHAR ) :CARDINAL;
+      BEGIN
+         IF ( c >= '1' ) & ( c <= '9' ) THEN
+           RETURN ORD( c ) - ORD( '0' );
+         ELSE
+           RETURN 0;
+         END;
+      END Digit;
+      
+      (* ------------------------------------- *)
+      PROCEDURE MatchMonth( i :CARDINAL ) :BOOLEAN;
+      BEGIN
+        IF mmm[0] = months[i][0] THEN
+          IF mmm[1] = months[i][1] THEN
+            RETURN mmm[2] = months[i][2];
+          ELSE
+            RETURN FALSE
+          END;
+        ELSE
+          RETURN FALSE
+        END;
+      END MatchMonth;
+      
+   BEGIN
+      
+     date.true := FALSE;
+     
+     l := Length( string );
+     IF l >= date_length - 1 THEN
+       (* its got to be at least 10 chars d-mmm-yyy *)
+     
+       (* parse out the day *)
+       
+       d := 0;  ok := TRUE;
+       p := 0;
+       WHILE ( p < l ) & ok DO
+         IF ( string[p] >= '0' ) & ( string[p] <= '9' ) THEN
+           d := d * 10 + Digit( string[p] );
+           p := p + 1;
+         ELSE
+           ok := FALSE;
+         END;
+       END;
+
+       (* need a dash here *)
+       IF string[p] = '-' THEN
+         
+         p := p + 1;   (* skip the dash *)
+         
+         (* take the next 3 chars as the month *)
+         
+         FOR i := 0 TO 2 DO
+           mmm[i] := CAP(string[p]);  p := p + 1;
+         END;
+        
+         (* need a dash here too *)
+         IF string[p] = '-' THEN
+         
+           (* try to match the month name *)
+      
+           m := 1;
+           WHILE ( m <= 12 ) & NOT MatchMonth( m ) DO
+             m := m + 1;
+           END;
+           
+           IF m < 13 THEN
+           
+             p := p + 1; (* skip the dash *)
+          
+             (* take the rest of the string as a year *)
+             ok := TRUE;
+             y  := 0;
+             WHILE ( p < l ) & ok DO
+               IF ( string[p] >= '0' ) & ( string[p] <= '9' ) THEN
+                 y := y * 10 + Digit( string[p] );
+                 p := p + 1;
+               ELSE
+                 ok := FALSE;
+               END;
+             END;
+            
+             IF ok THEN
+               MakeDate( d, m, y, date );
+             END;
+           END;
+         END;
+        END;
+      END;
+    END StringToDate;
+    
+    (* ------------------------------------------------- *)
+    PROCEDURE DateToString( date :Date; VAR string :ARRAY OF CHAR );
+    VAR
+      d, y :CARDINAL;
+      
+        (* -------------------------------- *)
+        PROCEDURE Digit( x :CARDINAL ) :CHAR;
+        CONST digits = '0123456789';
+        BEGIN
+           IF x < 10 THEN
+             RETURN digits[x];
+           ELSE
+             RETURN ' ';
+           END;
+        END Digit;
+        
+    BEGIN
+      IF date.true THEN
+      
+        (* make sure the string is long enough to hold the date *)
+        IF HIGH( string ) + 1 >= date_length THEN
+        
+          d := date.day DIV 10;
+          string[0] := Digit( d );
+          
+          d := date.day - d * 10;
+          string[1] := Digit( d );
+          
+          string[2] := '-';
+          
+          string[3] := months[date.month][0];
+          string[4] := months[date.month][1];
+          string[5] := months[date.month][2];
+
+          string[6] := '-';
+          
+          y := date.year;
+          d := y DIV 1000;
+          string[7] := Digit( d );
+          y := y - d * 1000;
+          d := y DIV 100;
+          string[8] := Digit( d );
+          y := y - d * 100;
+          d := y DIV 10;
+          string[9] := Digit( d );
+          d := y - d * 10;
+          string[10] := Digit( d );  (* offset by zero, so this is 11th char *)
+          
+          IF HIGH( string ) + 1 > date_length THEN
+            string[11] := 0C;  (* string is offset by zero *)
+          END;
+          
+        ELSE
+          string[0] := 0C;
+        END;
+      ELSE
+        string[0] := 0C;
+      END;
+    END DateToString;
+   
+   (* -------------------------------------------------- *)
+   PROCEDURE LeapYear( year :CARDINAL ) :BOOLEAN;
+   BEGIN
+      IF year MOD 4 = 0 THEN
+        IF year MOD 100 = 0 THEN
+          RETURN FALSE;
+        ELSE
+          RETURN TRUE;
+        END;
+      ELSE
+        RETURN FALSE;
+      END;
+   END LeapYear;
+   
+   (* -------------------------------------------------- *)
+   PROCEDURE DayOfYear( date :Date ) :CARDINAL;
+   VAR i, sum :CARDINAL;
+   BEGIN
+      IF date.true THEN
+      
+        sum := date.day;
+        FOR i := 1 TO date.month - 1 DO
+          sum := sum + days[i];
+        END;
+      
+        IF LeapYear( date.year ) THEN
+          IF ( date.month > 2 ) OR ( ( date.month = 2 ) & ( date.day = 28 ) ) THEN
+            sum := sum + 1;
+          END;
+        END;
+      ELSE
+        sum := 0;
+      END;
+      
+      RETURN sum;
+   END DayOfYear;
+     
+   (* -------------------------------------------------- *)
+   PROCEDURE DayOfWeek( date :Date; VAR day_name :ARRAY OF CHAR );
+   BEGIN
+    
+    IF date.true THEN
+                   
+        CASE date.number MOD 7 OF
+       0 :Assign( 'Sunday', day_name );
+     | 1 :Assign( 'Monday', day_name );
+     | 2 :Assign( 'Tuesday', day_name );
+     | 3 :Assign( 'Wednesday', day_name );
+     | 4 :Assign( 'Thursday', day_name );
+     | 5 :Assign( 'Friday', day_name );
+     | 6 :Assign( 'Saturday', day_name );
+       END; (* case *)
+ 
+     ELSE
+       day_name[0] := 0C;
+     END;
+     
+   END DayOfWeek;
+   
+   (* -------------------------------------------------- *)
+   PROCEDURE DayNumber( date :Date ) :LONGINT;
+   (* algotithm from Hewlett Packard HP-25 Calculator Applications Programs *)
+   (* valid for Mar.1/1700 to Feb.28/2100, but simplified here for
+      1-jan-1901 to 31-dec-2099 *)
+   VAR
+      sum, y, m, d :LONGINT;
+   BEGIN
+    
+    IF date.true THEN
+       
+       IF date.month <= 2 THEN
+         y := date.year - 1;
+         m := date.month + 13;
+       ELSE
+         y := date.year;
+         m := date.month + 1;
+       END;
+       d := date.day;
+       
+       sum := 365 * y + y DIV 4;     (*  365.25 times year  *)
+       
+       sum := sum + 30 * m + ( 6 * m ) DIV 10;  (*  30.6 times month  *)
+       
+       sum := sum + d - 621049;
+
+       RETURN sum;
+     ELSE
+       RETURN 0;
+     END;
+     
+   END DayNumber;
+   
+   (* ------------------------------------------------------ *)
+   PROCEDURE DaysBetween( date1, date2 :Date ) :LONGINT;
+   BEGIN
+     IF date1.true & date2.true THEN
+       RETURN date1.number - date2.number;
+     ELSE
+       RETURN 0;
+     END;
+   END DaysBetween;
+   
+   (* ------------------------------------------------------ *)
+   PROCEDURE AddDays( in_date :Date; delta_days :CARDINAL;
+                      VAR out_date :Date );
+   VAR
+     d, m, y, i :CARDINAL;
+     long_days  :LONGINT;
+   BEGIN
+   
+     IF in_date.true THEN
+       IF delta_days = 0 THEN
+         out_date := in_date;
+       ELSE
+
+         long_days := delta_days;       
+         IF in_date.number + long_days > max_day_number THEN
+           out_date := false_date;
+         ELSE
+         
+           (* do it the hard way, just add a day at a time *)
+           d := in_date.day;   m := in_date.month;   y := in_date.year;
+
+           FOR i := 1 TO delta_days DO
+             d := d + 1;
+             IF d > days[m] THEN
+               IF NOT ( LeapYear( y ) & ( m = 2 ) & ( d = 29 ) ) THEN
+                 d := 1;
+                 m := m + 1;
+                 IF m > 12 THEN
+                   m := 1;
+                   y := y + 1;
+                 END;
+               END;
+             END;
+           END;
+           
+           MakeDate( d, m, y, out_date );
+           
+         END; 
+       END;
+     ELSE
+       out_date := false_date;
+     END;
+   END AddDays;
+   
+   (* ------------------------------------------------------ *)
+   PROCEDURE SubtractDays( in_date :Date; delta_days :CARDINAL;
+                      VAR out_date :Date );
+   VAR
+     d, m, y, i :CARDINAL;
+     long_days  :LONGINT;
+   BEGIN
+     IF in_date.true THEN
+       IF delta_days = 0 THEN
+         out_date := in_date;
+       ELSE
+       
+         long_days := delta_days;
+         IF in_date.number - long_days < min_day_number THEN
+           out_date := false_date;
+         ELSE
+         
+           (* do it the hard way, just subtract a day at a time *)
+           d := in_date.day;   m := in_date.month;   y := in_date.year;
+
+           FOR i := 1 TO delta_days DO
+             d := d - 1;
+             IF d = 0 THEN
+               m := m - 1;
+               IF m = 0 THEN
+                 m := 12;
+                 y := y - 1;
+               END;
+               IF LeapYear( y ) & ( m = 2 ) THEN
+                 d := 29;
+               ELSE
+                 d := days[m];
+               END;
+             END;
+           END;
+           
+           MakeDate( d, m, y, out_date );
+
+         END; 
+       END;
+     ELSE
+       out_date := false_date;
+     END;
+   END SubtractDays;
+   
+   (* -------------------------------------------------- *)
+   PROCEDURE Compare( date1, date2 :Date ) :CHAR;
+   VAR c :CHAR;
+   BEGIN
+      IF date1.true & date2.true THEN
+        IF date1.number = date2.number THEN
+          c := '=';
+        ELSIF date1.number > date2.number THEN
+          c := '>';
+        ELSE
+          c := '<';
+        END;
+      ELSE
+        c := 0C;
+      END;
+      RETURN c;
+   END Compare;
+   
+   
+   (* -------------------------------------------------- *)
+   PROCEDURE PhaseOfMoon( date :Date; VAR phase_name :ARRAY OF CHAR );
+   (* algorithm from TECO, or so says some people on the net *)
+   CONST
+     multiplier = 64;
+   VAR
+     century, golden, epact, period, eighth, sixteenth, phase :CARDINAL;
+   BEGIN
+    
+     IF date.true THEN
+
+       century := date.year DIV 100 + 1;
+       golden  := date.year - ( (date.year DIV 19) * 19 ) + 1;
+       
+       epact   := golden * 11 + 20 + ( (8 * century + 5) DIV 25 - 5) -
+                  (3 * century DIV 4 - 12 );
+       epact   := epact - ( (epact DIV 30) * 30 );
+       IF ( epact = 25 ) & ( golden > 11 ) THEN epact := 26; END;
+       IF epact = 24 THEN epact := 25; END;
+
+       period := 29 * multiplier + multiplier DIV 2;
+       eighth := period DIV 8;
+       sixteenth := eighth DIV 2;
+       
+       phase := ( DayOfYear( date ) + epact - 1 ) * multiplier + sixteenth;
+       phase := phase - ( (phase DIV period) * period);
+       phase := phase DIV eighth;
+       phase := phase MOD 8;
+       
+       CASE phase OF
+       0 :Assign( 'New', phase_name );
+     | 1 :Assign( 'Waxing Crescent', phase_name );
+     | 2 :Assign( 'First Quarter', phase_name );
+     | 3 :Assign( 'Waxing Gibbous', phase_name );
+     | 4 :Assign( 'Full', phase_name );
+     | 5 :Assign( 'Waning Gibbous', phase_name );
+     | 6 :Assign( 'Last Quarter', phase_name );
+     | 7 :Assign( 'Waning Crescent', phase_name );
+       ELSE
+          phase_name[0] := 0C;
+       END; (* case *)
+       
+     ELSE
+       phase_name[0] := 0C;
+     END;
+     
+   END PhaseOfMoon;
+ 
+BEGIN
+ 
+  months[1]  := 'JAN'; months[2]  := 'FEB'; months[3]  := 'MAR';
+  months[4]  := 'APR'; months[5]  := 'MAY'; months[6]  := 'JUN';
+  months[7]  := 'JUL'; months[8]  := 'AUG'; months[9]  := 'SEP';
+  months[10] := 'OCT'; months[11] := 'NOV'; months[12] := 'DEC';
+  days[1]  := 31;      days[2]  := 28;      days[3]  := 31;
+  days[4]  := 30;      days[5]  := 31;      days[6]  := 30;
+  days[7]  := 31;      days[8]  := 31;      days[9]  := 30;
+  days[10] := 31;      days[11] := 30;      days[12] := 31;
+  
+  false_date.true := FALSE;
+  false_date.day  := 0;  false_date.month := 0; false_date.year := 0;
+  false_date.number := 0;
+  
+END DateOperations.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/formedit.def b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/formedit.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/formedit.def
@@ -0,0 +1,46 @@
+DEFINITION MODULE FormEdit;
+
+(* Show lines on the screen for user input/editing. *)
+(* V1.0, J. Andrea, Jun.1/93 *)
+
+FROM ScreenIO IMPORT screen_rows;
+
+EXPORT QUALIFIED max_lines,
+                 SetLine, DoEditing, GetLine, ResetLine,
+                 GetMessage;
+
+CONST
+   max_lines = screen_rows - 1;
+
+PROCEDURE SetLine( line_number :CARDINAL;
+                   prompt, default      :ARRAY OF CHAR;
+                   number_of_chars :CARDINAL;
+                   VAR done :BOOLEAN );
+(* Set the item at the specified line on the screen. *)
+
+PROCEDURE DoEditing( initial_line, display_column :CARDINAL;
+                     first_edit_blank :BOOLEAN );
+(* Do the editing of the current items on the screen. *)
+(* This may be called many times, for instance: one could setup the screen
+   and call this, then remove one or more items with ResetLine, or add new
+   items and then call DoEditing again *)
+(* The 'initial_line' is the line which is set as the current edit line
+   when the editing is started (set to zero to get first one).
+   The prompt is left of the 'display_column', the value is right of
+   that column. Recommended parameters are '0,30' *)
+(* The 'first_edit_blank' option if TRUE will cause an item to be blanked
+   the very first time it is edited. The user can reset to default to get
+   an item back if it shouldn't be blank. *)
+
+PROCEDURE GetLine( line_number :CARDINAL;
+                   VAR answer :ARRAY OF CHAR;
+                   VAR done :BOOLEAN );
+(* Get the result of whatever was edited for that line on the screen. *)
+
+PROCEDURE ResetLine( line_number :CARDINAL );
+(* Turn off the given line on the screen, set line to zero to reset all. *)
+
+PROCEDURE GetMessage( VAR error :BOOLEAN; VAR message :ARRAY OF CHAR );
+(* Return the error message, if any. *)
+
+END FormEdit.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/formedit.mod b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/formedit.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/formedit.mod
@@ -0,0 +1,589 @@
+IMPLEMENTATION MODULE FormEdit;
+
+(* Show lines on the screen for user input/editing. *)
+(* V1.1, J. Andrea, Jun.9/93 -correct a backspace/delete problem
+                             -add first time edit to blank option *)
+(* V1.0, J. Andrea, Jun.3/93 *)
+
+FROM ScreenIO IMPORT screen_rows, screen_cols,
+                     ReadKey, PutString, Bell,
+                     Clear, ClearEOL, Goto,
+                     Normal, Green, Yellow;
+FROM Strings IMPORT Assign, Length;
+
+CONST
+  max_string = 80;
+
+  next = 1;
+  last = 2;
+
+TYPE
+  LineInfo = RECORD
+               on    :BOOLEAN;
+               prompt, default, result :ARRAY [1..max_string+1] OF CHAR;
+               size, len  :CARDINAL;       (* max_size, and current size *)
+               col   :CARDINAL;                 (* prompt column *)
+               point :ARRAY [1..2] OF CARDINAL;
+               first_edit :BOOLEAN;              (* first time touched *)
+             END;
+
+VAR
+  lines :ARRAY [1..max_lines] OF LineInfo;
+  message :ARRAY [0..80] OF CHAR;
+  error   :BOOLEAN;
+
+  ordinary_key, shift_key, control_key, alt_key, function_key, arrow_key,
+  special_key :BOOLEAN;
+  key_value   :CHAR;
+
+  (* ---------------------------------------- *)
+  PROCEDURE Key;
+  BEGIN
+    ReadKey( key_value,
+             shift_key, control_key, alt_key, function_key, arrow_key,
+             special_key );
+    ordinary_key := NOT ( control_key OR alt_key OR function_key OR
+                          arrow_key OR special_key );
+  END Key;
+
+  (* ---------------------------------------- *)
+  PROCEDURE ShowHelp;
+  BEGIN
+     Clear;  Normal;
+     PutString( 'F1   :show this help', 1, 10 );
+     PutString( 'ESC  :redraw editing screen', 2, 10 );
+
+     PutString( 'arrow :move to item to be corrected', 4, 10 );
+     PutString( 'Home  :move to beginning of line', 5, 10 );
+     PutString( 'End   :move to end of line', 6, 10 );
+     PutString( 'Return:same as down arrow', 7, 10 );
+
+     PutString( 'Insert    :open a space', 9, 10 );
+     PutString( 'Delete    :delete current character', 10, 10 );
+     PutString( 'Backspace :delete previous character', 11, 10 );
+
+     PutString( 'F8 :reset line to original value', 13, 10 );
+
+     PutString( 'PageUp      :move to first line', 15, 10 );
+     PutString( 'PageDown    :move to last line', 16, 10 );
+
+     PutString( 'corrections :type to replace current character', 18, 10 );
+     PutString( '             typing is always in overwrite mode', 19, 10 );
+
+     PutString( 'F12         :finished editing', 21, 10 );
+
+     PutString( '-- hit any key to continue --', 25, 20 );
+     Key;
+  END ShowHelp;
+
+  (* ------------------------------------------------------ *)
+  PROCEDURE SetDefault( x :CARDINAL );
+  BEGIN
+    (* save the default as the first value *)
+    Assign( lines[x].default, lines[x].result );
+    lines[x].len := Length( lines[x].result );
+  END SetDefault;
+
+(* ------------------------------------------- *)
+PROCEDURE SetLine( line_number :CARDINAL;
+                   prompt_string, default_string :ARRAY OF CHAR;
+                   number_of_chars :CARDINAL;
+                   VAR done :BOOLEAN );
+BEGIN
+  error := FALSE;
+  done  := TRUE;
+
+  IF ( line_number = 0 ) OR ( line_number > max_lines ) THEN
+    done := FALSE;
+    error := TRUE;
+    message := 'Line number out of range';
+  ELSE
+
+    IF number_of_chars = 0 THEN
+      done    := FALSE;
+      error   := TRUE;
+      message := 'Size of data item cannot be zero';
+    ELSIF number_of_chars >= screen_cols THEN
+      done    := FALSE;
+      error   := TRUE;
+      message := 'Size of data item too large';
+    ELSE
+      lines[line_number].size := number_of_chars;
+    END;
+
+    Assign( prompt_string,  lines[line_number].prompt );
+    Assign( default_string, lines[line_number].default );
+
+    SetDefault( line_number );
+
+    lines[line_number].on         := done;
+    lines[line_number].first_edit := TRUE;
+  END;
+END SetLine;
+
+(* ------------------------------------------- *)
+PROCEDURE DoEditing( initial_edit, display_column :CARDINAL;
+                     first_edit_blank :BOOLEAN );
+VAR
+  very_first, very_last     :CARDINAL;
+  current_line, current_pos :CARDINAL;
+  still_editing             :BOOLEAN;
+  n_on                      :CARDINAL;
+
+  (* ---------------------------------------- *)
+  PROCEDURE Mark( on :BOOLEAN );
+  (* Make the current line green, or not *)
+  VAR
+     x, i, n :CARDINAL;
+  BEGIN
+    x := current_line;
+    IF ( x # 0 ) & lines[x].on THEN
+      Goto( x, display_column ); ClearEOL;
+      IF on THEN
+        Green;
+      ELSE
+        Yellow;
+      END;
+      (* show the item *)
+      PutString( lines[x].result, x, display_column );
+      IF on THEN
+        n := lines[x].len + 1;
+        i := display_column + n - 1;
+        (* and show how big it can be with underlines *)
+        WHILE ( n <= lines[x].size ) & ( i < screen_cols ) DO
+          PutString( '_', x, i );
+          n := n + 1;
+          i := i + 1;
+        END;
+      END;
+      PutCursor;
+    END;
+  END Mark;
+
+  (* -------------------------------------------- *)
+  PROCEDURE PutCursor;
+  BEGIN
+    Goto( current_line, current_pos + display_column - 1 );
+  END PutCursor;
+
+  (* --------------------------------------------- *)
+  PROCEDURE Display;
+  VAR
+    i, j, k :CARDINAL;
+  BEGIN
+    Clear;
+    Green;
+    PutString( 'F1 :help', screen_rows, 72 );
+    Normal;
+
+    FOR i := very_first TO very_last DO
+    IF lines[i].on THEN
+      k := lines[i].col;
+      IF k = 0 THEN
+        (* special case for a prompt that is too long,
+           show only enough as needed *)
+        FOR j := 0 TO display_column - 1 DO
+          PutString( lines[i].prompt[j], i, j+1 );
+        END;
+      ELSE
+        PutString( lines[i].prompt, i, k-1 );
+      END;
+      Yellow;
+      PutString( lines[i].result, i, display_column );
+      Normal;
+    END;
+    END;
+
+    Mark( TRUE );
+    PutCursor;
+  END Display;
+
+  (* ------------------------------------------------------ *)
+  PROCEDURE LineMove( forward :BOOLEAN );
+  (* Move the next line as defined by the arrow keys *)
+  VAR
+    direction, x :CARDINAL;
+  BEGIN
+
+    (* since we plan to move, turn off the pointer on the current item *)
+    Mark( FALSE );
+
+    IF forward THEN
+      direction := next;
+    ELSE
+      direction := last;
+    END;
+
+    x := lines[current_line].point[direction];
+
+    (* so set it and mark it *)
+    current_line := x;
+    Mark( TRUE );
+    EditEnd( TRUE );
+
+  END LineMove;
+  PROCEDURE LineEnd( bottom :BOOLEAN );
+  (* Move to the first or last line *)
+  BEGIN
+    Mark( FALSE );
+    IF bottom THEN
+      current_line := very_last;
+    ELSE
+      current_line := very_first;
+    END;
+    Mark( TRUE );
+    EditEnd( TRUE );
+  END LineEnd;
+
+  (* ----------------------------------------------------------- *)
+  PROCEDURE EditMove( forward :BOOLEAN );
+  (* Move on the current line *)
+  BEGIN
+    IF forward THEN
+      IF current_pos # lines[current_line].size THEN
+        current_pos := current_pos + 1;
+      END;
+    ELSE
+      IF current_pos # 1 THEN
+        current_pos := current_pos - 1;
+      END;
+    END;
+    PutCursor;
+  END EditMove;
+  PROCEDURE EditEnd( forward :BOOLEAN );
+  (* Move to the beginning or end of the current line *)
+  BEGIN
+    IF forward THEN
+      current_pos := lines[current_line].len;
+      IF current_pos = 0 THEN
+        (* if the line is blank, then just go to the first position *)
+        current_pos := 1;
+      END;
+    ELSE
+      current_pos := 1;
+    END;
+    PutCursor;
+  END EditEnd;
+
+  (* ------------------------------------------------ *)
+  PROCEDURE Delete( forward :BOOLEAN );
+  (* Delete the current character (FORWARD), or else delete the previous *)
+  VAR
+    i, k, n, m :CARDINAL;
+
+  BEGIN
+    n := lines[current_line].len;
+    IF n # 0 THEN
+      lines[current_line].first_edit := FALSE;
+      IF forward THEN
+        m := n;
+      ELSE
+        (* for back spacing, cursor may be one past last valid character *)
+        m := n + 1;
+      END;
+      IF current_pos <= m THEN
+        (* otherwise, cursor is past the end of the string, so just move cursor *)
+        IF forward THEN
+          (* delete the current item *)
+          k := current_pos;
+        ELSE
+          k := current_pos - 1;
+        END;
+        IF k # 0 THEN
+          (* shrink the current string *)
+          FOR i := k TO n - 1 DO
+            lines[current_line].result[i] :=
+            lines[current_line].result[i+1];
+          END;
+          lines[current_line].result[n] := 0C;
+          lines[current_line].len       := n - 1;
+        END;
+      END;
+      (* move backwards *)
+      EditMove( FALSE );
+      Mark( TRUE );
+      PutCursor;
+    END;
+  END Delete;
+
+  (* ------------------------------------------------- *)
+  PROCEDURE Replace( ch :CHAR );
+  (* Replace the current character with whats passed in *)
+  VAR
+    n, i :CARDINAL;
+  BEGIN
+    n := lines[current_line].len;
+    lines[current_line].first_edit := FALSE;
+    IF current_pos > n THEN
+
+      (* its been placed beyond the current end, so fill the rest with spaces *)
+      FOR i := n + 1 TO current_pos DO
+         lines[current_line].result[i] := ' ';
+      END;
+
+      (* save this new position as the length *)
+      lines[current_line].len := current_pos;
+      (* put a null char after it *)
+      lines[current_line].result[current_pos+1] := 0C;
+    END;
+
+    (* and put the wanted character there *)
+    lines[current_line].result[current_pos] := ch;
+
+    (* skip on to the next character *)
+    current_pos := current_pos + 1;
+    (* but don't try to go past the end *)
+    IF current_pos > lines[current_line].size THEN
+      current_pos := current_pos - 1
+    END;
+
+    Mark( TRUE );
+  END Replace;
+
+  (* ------------------------------------------------------ *)
+  PROCEDURE Insert( ch :CHAR );
+  (* Insert the given character at the current position, push the other
+     characters down one space. *)
+  VAR
+    i, j, n, x :CARDINAL;
+  BEGIN
+    x := current_line;
+    n := lines[x].len;
+    lines[x].first_edit := FALSE;
+    IF current_pos > n THEN
+      (* can only insert if there's something there *)
+      (* otherwise, just put in a space *)
+      Replace( ' ' );
+      (* but move back to that same position again *)
+      EditMove( FALSE );
+    ELSE
+
+      (* pull the existing characters after this one back one level *)
+      j := n + 1;
+      FOR i := current_pos TO n DO
+        lines[x].result[j] := lines[x].result[j-1];
+        j := j - 1;
+      END;
+
+      (* put a new 'space' at the new location *)
+      lines[x].result[current_pos] := ' ';
+
+      i := lines[x].size;
+      IF n = i THEN
+        (* the line was already at its maximum size *)
+        n := i;
+      ELSE
+        (* otherwise, just count up one more character *)
+        n := n + 1;
+      END;
+      lines[x].len         := n;
+      lines[x].result[n+1] := 0C;
+
+      Mark( TRUE );
+    END;
+  END Insert;
+
+  (* ------------------------------------------------------------ *)
+  PROCEDURE SetupDisplay;
+  (* Determine the loctions of things on the screen, and the pointers
+     from one line to the other for easy arrow motion. *)
+  VAR
+    len, i :CARDINAL;
+  BEGIN
+
+    very_first := 0;
+    very_last  := 0;
+    n_on       := 0;  (* How many are turned on *)
+
+    (* determine the pointers *)
+    FOR i := 1 TO max_lines DO
+      IF lines[i].on THEN
+        n_on := n_on + 1;
+
+        IF very_first = 0 THEN
+          (* this is the first line, so save its value *)
+          very_first := i;
+        END;
+
+        IF very_last # 0 THEN
+          (* the one after the last one is this one *)
+          lines[very_last].point[next] := i;
+        END;
+
+        (* save the value of the previous one, this is ok even if its
+           the first, because the first and last will be reset later *)
+        lines[i].point[last] := very_last;
+
+        (* save this one as the last one, for the next one it will count
+           as the previous one. And it will be the very last at the end of
+           the loop *)
+        very_last := i;
+
+        (* determine where the columns should go *)
+        (* try to show as much as the prompt as possible *)
+        len := Length( lines[i].prompt );
+        IF len >= display_column THEN
+          (* not all of the prompt can be displayed *)
+          (* set a special value for the column *)
+          lines[i].col := 0;
+        ELSE
+          (* determine how far back the start should be *)
+          lines[i].col := display_column - len;
+        END;
+
+      END;
+    END;
+
+    (* and finish up the pointers for the first and last so that they wrap *)
+    lines[very_first].point[last] := very_last;
+    lines[very_last].point[next]  := very_first;
+  END SetupDisplay;
+
+BEGIN
+  error := FALSE;
+
+  IF display_column = 0 THEN display_column := 1 END;
+  IF display_column > screen_cols THEN display_column := screen_cols - 1 END;
+
+  SetupDisplay;
+
+  IF n_on # 0 THEN
+
+    IF initial_edit = 0 THEN initial_edit := very_first END;
+    IF initial_edit > very_last THEN initial_edit := very_last END;
+    IF NOT lines[initial_edit].on THEN initial_edit := very_first END;
+
+    current_line := initial_edit;
+    EditEnd( TRUE );
+
+    Display;
+
+    still_editing := TRUE;
+
+    REPEAT
+       Key;
+
+       IF arrow_key THEN
+         IF key_value = '^' THEN    (* up *)
+           LineMove( FALSE );
+         ELSIF key_value = 'v' THEN  (* down *)
+           LineMove( TRUE );
+         ELSIF key_value = '<' THEN  (* left *)
+           EditMove( FALSE );
+         ELSE                        (* right *)
+           EditMove( TRUE );
+         END;
+
+       ELSIF special_key THEN
+         IF key_value = 'h' THEN    (* home *)
+           EditEnd( FALSE );
+         ELSIF key_value = 'e' THEN (* end *)
+           EditEnd( TRUE );
+         ELSIF key_value = 'd' THEN (* delete *)
+           Delete( TRUE );
+         ELSIF key_value = 'i' THEN (* insert *)
+           Insert( ' ' );
+         ELSIF key_value = '^' THEN (* page up *)
+           LineEnd( FALSE );
+         ELSIF key_value = 'v' THEN (* page down *)
+           LineEnd( TRUE );
+         END;
+
+       ELSIF function_key THEN
+         IF key_value = '<' THEN      (* f12 *)
+           still_editing := FALSE;
+         ELSIF key_value = '8' THEN   (* f8 *)
+           SetDefault( current_line );
+           Mark( TRUE );
+           EditEnd( TRUE );
+         ELSIF key_value = '1' THEN   (* f1 *)
+           ShowHelp;
+           Display;
+         ELSE
+           Bell;
+         END;
+
+       ELSIF control_key THEN
+         IF key_value = '[' THEN       (* esc *)
+           Display;
+         ELSIF key_value = 'h' THEN    (* backspace *)
+           Delete( FALSE );
+         ELSIF key_value = 'm' THEN    (* return *)
+           LineMove( TRUE );
+         ELSE
+           Bell;
+         END;
+
+       ELSIF ordinary_key THEN
+         IF first_edit_blank & lines[current_line].first_edit THEN
+           (* set this item to all blank for this first edit *)
+           lines[current_line].len := 0;
+           current_pos := 1;
+         END;
+         IF shift_key THEN key_value := CAP( key_value ) END;
+         Replace( key_value );
+
+       ELSE
+         Bell;
+       END;
+
+    UNTIL NOT still_editing;
+    Normal; Clear;
+  END;
+END DoEditing;
+
+(* ------------------------------------------- *)
+PROCEDURE GetLine( line_number :CARDINAL;
+                   VAR answer :ARRAY OF CHAR;
+                   VAR done :BOOLEAN );
+(* Return the value for the specified line. *)
+BEGIN
+  error := FALSE;
+  done  := TRUE;
+
+  IF ( line_number = 0 ) OR ( line_number > max_lines ) THEN
+    done    := FALSE;
+    error   := TRUE;
+    message := 'Line number out of range';
+  ELSE
+    IF lines[line_number].on THEN
+      Assign( lines[line_number].result, answer );
+    ELSE
+      done    := FALSE;
+      error   := TRUE;
+      message := 'Line not set';
+    END;
+  END;
+END GetLine;
+
+(* ------------------------------------------- *)
+PROCEDURE ResetLine( line_number :CARDINAL );
+VAR
+  i :CARDINAL;
+BEGIN
+  error := FALSE;
+  IF line_number = 0 THEN
+    FOR i := 1 TO max_lines DO
+       lines[i].on := FALSE;
+    END;
+  ELSE
+    IF ( line_number > 0 ) & ( line_number <= max_lines ) THEN
+      lines[line_number].on := FALSE;
+    END;
+  END;
+END ResetLine;
+
+(* ------------------------------------------- *)
+PROCEDURE GetMessage( VAR problem :BOOLEAN; VAR string :ARRAY OF CHAR );
+BEGIN
+  IF error THEN
+    Assign( message, string );
+  ELSE
+    string[0] := 0C;
+  END;
+END GetMessage;
+
+BEGIN
+  error := FALSE;
+  ResetLine( 0 );
+END FormEdit.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/getchara.def b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/getchara.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/getchara.def
@@ -0,0 +1,35 @@
+DEFINITION MODULE GetCharacter;
+
+(*
+  GET a single character from the terminal,
+  without first setting the proper mode, ordinary non-GET mode is used
+  wherein a RETURN is needed to input data.
+
+  Use StartGet and StopGet to turn on and off single-character-mode.
+*)
+(* J. Andrea, May.18/92 - dos version *)
+(* J. Andrea, 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED StartGet, StopGet, Get, GetNoWait;
+
+
+  PROCEDURE Get( VAR ch :CHAR );
+  (* return a single character, no Carriage-Return needed *)
+
+
+  PROCEDURE GetNoWait( VAR ch :CHAR );
+  (* return a single character, no Carriage-Return needed *)
+  (* and don't wait till a character occurs, returns null character if there
+   * is no character in the buffer *)
+
+
+  PROCEDURE StartGet;
+  (* Enter single character mode *)
+
+
+  PROCEDURE StopGet;
+  (* Exit single character mode *)
+  (* And return to "carriage-return needed for input" mode *)
+
+END GetCharacter.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/getchara.mod b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/getchara.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/getchara.mod
@@ -0,0 +1,37 @@
+IMPLEMENTATION MODULE GetCharacter;
+
+(* GET a single character from the terminal *)
+(* J. Andrea, May.18/92 -dos version *)
+(* bastardization of M. Mall's TTIO from ETH by Jaa, 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+  
+FROM Terminal IMPORT Read, KeyPressed;                
+
+  (* --------------------------------------------------------------- *)
+  PROCEDURE Get( VAR ch: CHAR );
+  BEGIN
+    Read( ch );
+  END Get;
+ 
+  (* --------------------------------------------------------------- *)
+  PROCEDURE GetNoWait( VAR ch: CHAR );
+  BEGIN
+    IF KeyPressed() THEN
+      Read( ch );
+    ELSE
+      ch := 0C;
+    END;
+  END GetNoWait;
+ 
+  (* --------------------------------------------------------------- *)
+  PROCEDURE StartGet;
+  BEGIN
+  END StartGet;
+
+  (* --------------------------------------------------------------- *)
+  PROCEDURE StopGet;
+  BEGIN
+  END StopGet;
+
+BEGIN
+END GetCharacter.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/moreio.mod b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/moreio.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/moreio.mod
@@ -0,0 +1,81 @@
+IMPLEMENTATION MODULE MoreIO;
+
+(* misc. extra i/o functions *)
+(* J. Andrea, May.24/92 -dos version *)
+(* J. Andrea, Feb.18/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM InOut IMPORT Read, EOL, WriteString;
+FROM Strings IMPORT Length;
+
+VAR
+   i, n :CARDINAL;
+
+
+   (* ---------------------------------------------------- *)
+   PROCEDURE WriteLeftString( string :ARRAY OF CHAR; width :CARDINAL );
+   BEGIN
+      WriteFixString( string, width, TRUE );
+   END WriteLeftString;
+
+   (* ---------------------------------------------------- *)
+   PROCEDURE WriteRightString( string :ARRAY OF CHAR; width :CARDINAL );
+   BEGIN
+      WriteFixString( string, width, FALSE );
+   END WriteRightString;
+
+
+   (* ---------------------------------------------------- *)
+   PROCEDURE ReadLine( VAR line :ARRAY OF CHAR );
+
+   VAR
+      c :CHAR;
+
+   BEGIN (* ReadLine *)
+
+      n := HIGH( line ) + 1;
+
+      i := 0;
+      Read( c );
+
+      WHILE ( c # EOL ) & ( i < n ) DO
+         line[i] := c;  i := i + 1;
+         Read( c );
+      END;
+
+      IF i < n THEN line[i] := 0C; END;
+
+   END ReadLine;
+
+
+   (* ---------------------------------------------------- *)
+   PROCEDURE WriteFixString( string :ARRAY OF CHAR; width :CARDINAL;
+                             left_justify :BOOLEAN );
+   BEGIN (* WriteFixString *)
+      IF width > 0 THEN
+
+        n := Length( string );
+
+        IF n <= width THEN
+
+          IF left_justify THEN WriteString( string ); END;
+
+          FOR i := n + 1 TO width DO
+             WriteString( ' ' );
+          END;
+
+          IF NOT left_justify THEN WriteString( string ); END;
+
+        ELSE
+
+          FOR i := 0 TO width - 1 DO
+             WriteString( string[i] );
+          END;
+
+        END;
+
+      END;
+   END WriteFixString;
+
+BEGIN
+END MoreIO.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/moremath.mod b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/moremath.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/moremath.mod
@@ -0,0 +1,282 @@
+IMPLEMENTATION MODULE MoreMath;
+
+(* misc. extra math functions *)
+(* new functions - J. Andrea, Aug.13/91 *)
+(* J. Andrea, May.18/92 -dos version *)
+(* J. Andrea, 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM MathLib0 IMPORT sqrt, pow, ln;
+
+
+    (* -------------------------------------------- *)
+    PROCEDURE IModulus( a, b :INTEGER ) :INTEGER;
+    (* return the integer modulus of two numbers
+       handles a negative 'a' value (unlike the languages built in MOD) *)
+    BEGIN
+
+       IF a < 0 THEN
+         RETURN b - (ABS(a) MOD b);
+       ELSE
+         RETURN a MOD b;
+       END; (* if *)
+
+    END IModulus;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE CardPower( base, exponent :CARDINAL ) :CARDINAL;
+    (* raise a cardinal to a cardinal power *)
+    
+    VAR
+       x, i :CARDINAL;
+       
+    BEGIN
+
+       IF exponent = 0 THEN
+         x := 1;
+       ELSE
+       
+         x := base;
+         
+         FOR i := 2 TO exponent DO
+            x := x * base;
+         END;
+         
+       END;
+
+       RETURN x;
+    END CardPower;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE RealPower( base :REAL; exponent :CARDINAL ) :REAL;
+    (* raise a real value to a cardinal power *)
+    BEGIN
+
+       RETURN pow( base, FLOAT( exponent ) );
+
+    END RealPower;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE IntPower( base, exponent :INTEGER ) :INTEGER;
+    (* raise an integer to an integer power *)
+
+    VAR
+       x, i :INTEGER;
+       
+    BEGIN
+
+       IF exponent = 0 THEN
+         x := 1;
+       ELSE
+       
+         IF exponent < 0 THEN
+           x := 0;
+         ELSE
+         
+           x := base;
+         
+           FOR i := 2 TO exponent DO
+              x := x * base;
+           END;
+         END;
+       END;
+
+       RETURN x;
+    END IntPower;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE entier( a :REAL ) :INTEGER;
+    (* return the nearest integer *)
+    BEGIN
+
+      IF ( a < -32768.0 ) OR ( a > 32767.0 ) THEN
+	RETURN 0
+      ELSE
+        RETURN VAL( INTEGER, TRUNC( a ) )
+      END;
+
+    END entier;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE Float( a :INTEGER ) :REAL;
+    BEGIN
+      RETURN real( a );
+    END Float;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE MinReal( a, b :REAL ) :REAL;
+    BEGIN
+
+       IF a < b THEN
+         RETURN a;
+       ELSE
+         RETURN b;
+       END;
+       
+    END MinReal;
+
+    (* -------------------------------------------------- *)
+    PROCEDURE MaxReal( a, b :REAL ) :REAL;
+    BEGIN
+
+       IF a > b THEN
+         RETURN a;
+       ELSE
+         RETURN b;
+       END;
+
+    END MaxReal;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE MinInt( a, b :INTEGER ) :INTEGER;
+    BEGIN
+
+       IF a < b THEN
+         RETURN a;
+       ELSE
+         RETURN b;
+       END;
+
+    END MinInt;
+
+    (* -------------------------------------------------- *)
+    PROCEDURE MaxInt( a, b :INTEGER ) :INTEGER;
+    BEGIN
+
+       IF a > b THEN
+         RETURN a;
+       ELSE
+         RETURN b;
+       END;
+
+    END MaxInt;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE MinCard( a, b :CARDINAL ) :CARDINAL;
+    BEGIN
+    
+       IF a < b THEN
+         RETURN a;
+       ELSE
+         RETURN b;
+       END;
+
+    END MinCard;
+
+    (* -------------------------------------------------- *)
+    PROCEDURE MaxCard( a, b :CARDINAL ) :CARDINAL;
+    BEGIN
+
+       IF a > b THEN
+         RETURN a;
+       ELSE
+         RETURN b;
+       END;
+
+    END MaxCard;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE SizeCard( a :CARDINAL ) :CARDINAL;
+    BEGIN
+
+       IF a < 10 THEN
+         RETURN 1;
+       ELSE
+         RETURN 1 + SizeCard( a DIV 10 );
+       END;
+
+    END SizeCard;
+
+    (* -------------------------------------------------- *)
+    PROCEDURE SizeInt( a :INTEGER ) :CARDINAL;
+    BEGIN
+
+       IF ABS( a ) < 10 THEN
+         IF a < 0 THEN
+           RETURN 2;
+         ELSE
+           RETURN 1;
+         END;
+       ELSE
+         RETURN 1 + SizeInt( a DIV 10 );
+       END;
+
+    END SizeInt;
+
+
+    (* -------------------------------------------------- *)
+    PROCEDURE CalcPi() :REAL;
+
+    CONST
+      one  = 1.0;
+      two  = 2.0;
+      four = 4.0;
+      six  = 6.0;
+      
+    VAR
+      root_two, last, out, y, a, d, e :REAL;
+      i                               :CARDINAL;
+
+    BEGIN
+
+      root_two := sqrt( two );
+
+      last := 0.0;
+
+      y := root_two - one;
+      a := six - four * root_two;
+
+      out := one / a;
+
+      i := 0;
+      WHILE out # last DO
+        last := out;
+
+        d := one - RealPower( y, 4 );
+        d := sqrt( sqrt( d ) );
+
+        y := ( one - d ) / ( one + d );
+
+        i := i + 1;
+
+        e := RealPower(two, 2*i+1) * y * ( one + y + y * y );
+        a := RealPower(one+y, 4) * a - e;
+
+        out := one / a;
+
+      END;
+      
+      RETURN out;
+
+    END CalcPi;
+
+    (* -------------------------------------------- *)
+    PROCEDURE Log10( x :REAL ) :REAL;
+    BEGIN
+      IF x <= 0.0 THEN
+        RETURN 0.0;
+      ELSE
+        RETURN ln( x ) / ln( 10.0 );
+      END;
+    END Log10;
+      (* -------------------------------------------- *)
+    PROCEDURE Log2( x :REAL ) :REAL;
+    BEGIN
+      IF x <= 0.0 THEN
+        RETURN 0.0;
+      ELSE
+        RETURN ln( x ) / ln( 2.0 );
+      END;
+    END Log2;
+    
+BEGIN
+END MoreMath.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/plotter.def b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/plotter.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/plotter.def
@@ -0,0 +1,12 @@
+DEFINITION MODULE Plotter;
+
+(* VGA plotting *)
+
+(* J. Andrea, Jul.11/92 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+EXPORT QUALIFIED Plot;
+
+  PROCEDURE Plot( title :ARRAY OF CHAR; x, y :ARRAY OF REAL; n :CARDINAL );
+
+END Plotter.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/plotter.mod b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/plotter.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/plotter.mod
@@ -0,0 +1,268 @@
+IMPLEMENTATION MODULE Plotter;
+(*/NOWARN*)
+FROM LewertsScale IMPORT Scale;
+FROM VGAGraphics IMPORT BeginVGA, EndVGA,
+   			EraseScreen, GetDimensions,
+   			Move, LineColor, Text;
+FROM CardArrays IMPORT CardArray, Build, Destroy, Put, Get;
+FROM Terminal IMPORT Read;
+ 
+  (* ---------------------------------------- *)
+  PROCEDURE Plot( title :ARRAY OF CHAR; x, y :ARRAY OF REAL; n :CARDINAL );
+
+  VAR
+    x_min, x_max, y_min, y_max,
+    x_scale_min, x_scale_max,
+    y_scale_min, y_scale_max,
+    x_scale_inc, y_scale_inc :REAL;
+
+    i, j  :CARDINAL;
+    index :CardArray;
+
+    (* ------------------------------------------ *)
+    PROCEDURE SetScale( min, max :REAL;
+                        VAR scale_min, scale_max, scale_inc :REAL );
+    VAR
+      tenth :REAL;
+    BEGIN
+      IF min = max THEN
+        (* its flat, so fake it *)
+        tenth := min / 10.0;
+        min := min - tenth;
+        max := max + tenth; 
+      END;
+
+      (* get nice scaling parameters *)
+      Scale( min, max, 7, scale_min, scale_max, scale_inc );
+    END SetScale;
+    
+  BEGIN
+  
+    Build( index, 0, n-1 ); (* create a temporary array for sorting index *)
+    
+    XYSort( x, y, n, index );
+    
+    x_min := x[Get(index,0)];  x_max := x[Get(index,n-1)];
+    
+    (* but we must run over the array to get y range *)
+    y_min := y[Get(index,0)];  y_max := y[Get(index,0)];
+    FOR i := 1 TO n-1 DO
+      j := Get( index, i );
+      IF y[j] < y_min THEN y_min := y[j] END;
+      IF y[j] > y_max THEN y_max := y[j] END;
+    END;
+    
+    SetScale( x_min, x_max, x_scale_min, x_scale_max, x_scale_inc );
+    SetScale( y_min, y_max, y_scale_min, y_scale_max, y_scale_inc );
+    
+    VGAPlot( title, x, y, n, index,
+             x_scale_min, x_scale_max, y_scale_min, y_scale_max,
+             x_scale_inc, y_scale_inc );
+            
+    Destroy( index ); (* all done, get rid of the temporary index *)
+    
+  END Plot;
+
+  (* ---------------------------------------------------- *)
+  PROCEDURE VGAPlot( title :ARRAY OF CHAR;
+                     x, y :ARRAY OF REAL; n :CARDINAL; index :CardArray;
+                     x_min, x_max, y_min, y_max, x_inc, y_inc :REAL );
+
+  CONST
+     tic_len = 11;
+       
+  VAR
+    x_size, y_size :REAL;
+    i, j           :CARDINAL; 
+    z              :REAL;
+    c		   :CHAR;
+
+    x_range, y_range, x_scale, y_scale :REAL;
+    x_pos, y_pos		       :REAL;
+
+  BEGIN
+
+    EraseScreen;
+        
+    GetDimensions( i, j );
+    x_size := FLOAT( i );
+    y_size := FLOAT( j );
+
+    x_range := x_max - x_min;
+    x_scale := x_size / x_range;
+
+    y_range := y_max - y_min;
+    y_scale := y_size / y_range;
+
+    BeginVGA;
+      
+    (* draw the axis *)
+    Move( 0, 0 ); LineColor( TRUNC( x_size ), 0, 12 );
+    Move( 0, 0 ); LineColor( 0, TRUNC( y_size ), 12 );
+      
+    (* put in the tick marks *)
+      
+    (* run along the x axis, putting in the numbers *)
+    (* run along the y axis, putting in the numbers *)
+    (* now draw the actual data points *)
+
+    (* go to the first data point *)
+
+    i := 0;
+    j := Get( index, i );
+    x_pos := ( x[j] - x_min ) * x_scale;
+    y_pos := ( y[j] - y_min ) * y_scale;
+    Move( TRUNC(x_pos), TRUNC(y_pos) );
+
+    FOR i := 1 TO n-1 DO
+
+       j := Get( index, i );
+       x_pos := ( x[j] - x_min ) * x_scale;
+       y_pos := ( y[j] - y_min ) * y_scale;
+               
+       LineColor( TRUNC(x_pos), TRUNC(y_pos), 14 );
+
+    END;
+
+    Move( 200, 200 ); Text( title );
+
+    Read( c );
+    EndVGA;
+      
+  END VGAPlot;
+    
+  (* ----------------------------------------------------- *)
+  PROCEDURE XYSort( x, y :ARRAY OF REAL; array_len :CARDINAL;
+		    index :CardArray );
+      
+  CONST
+    max_stack = 20;
+    n_small   = 6; (* use a simple sort for this size and smaller *)
+
+  VAR
+    L, R, i, j, k, n :INTEGER;
+
+    tos            :CARDINAL;
+    Lstack, Rstack :ARRAY [1..max_stack] OF INTEGER;
+
+    median :REAL;
+
+    (* -------------------------------- *)
+    PROCEDURE Swap( i, j :CARDINAL );
+    VAR  ctemp :CARDINAL;
+    BEGIN
+      ctemp := Get(index,i);
+      Put( index, i, Get(index,j) );
+      Put( index, j, ctemp );
+    END Swap;
+    
+  BEGIN
+
+    n := INTEGER( array_len ) - 1; (* back to zero offset *)
+
+    (* initialize the index *)
+    FOR i := 0 TO n DO
+       Put( index, i, i );
+    END;
+
+    tos := 0;
+
+    L := 0;  R := n;
+
+    (* PUSH very first set *)
+    tos := tos + 1;  Lstack[tos] := L;  Rstack[tos] := R;
+
+    REPEAT
+
+      (* POP *)
+      L := Lstack[tos];  R := Rstack[tos];  tos := tos - 1;
+
+      IF R - L + 1 > n_small THEN
+
+        REPEAT
+          i := L;  j := R;    median := x[Get(index,( L + R ) DIV 2)];
+
+          REPEAT
+            WHILE x[Get(index,i)] < median DO
+              i := i + 1;
+            END;
+            WHILE median < x[Get(index,j)] DO
+              j := j - 1;
+            END;
+
+            IF i <= j THEN
+              Swap( i, j );
+              i := i + 1;  j := j - 1;
+            END;
+          UNTIL i > j;
+
+          IF j - L < R - i THEN
+            IF i < R THEN (* PUSH *)
+              tos := tos + 1;  Lstack[tos] := i;  Rstack[tos] := R;
+            END;
+            R := j;
+          ELSE
+            IF L < j THEN (* push *)
+              tos := tos + 1;  Lstack[tos] := L;  Rstack[tos] := j;
+            END;
+            L := i;
+          END;
+
+        UNTIL L >= R;
+
+     ELSE
+
+       (* small sort for small number of values *)
+       FOR i := L TO R - 1 DO
+          FOR j := i TO R DO
+             IF x[Get(index,i)] > x[Get(index,j)] THEN
+               Swap( i, j );
+             END;
+          END;
+       END;
+
+     END; (* check for small *)
+
+   UNTIL tos = 0;
+ 
+   (* now look for duplicates of x, and sort those by y *)
+        
+   k := 1; (* start at second element *)
+   WHILE k <= n DO
+
+     IF x[Get(index,k)] = x[Get(index,k-1)] THEN
+
+       L := k - 1;    (* first of the duplicated x's *)
+
+       (* search for more duplictes *)
+       j := k;
+       WHILE ( j <= n ) & ( x[Get(index,L)] = x[Get(index,j)] ) DO
+         j := j + 1;
+       END;
+            
+       R := j - 1;   (* last of the duplicated x's *)
+
+       (* now sort between first and last by Y *)
+       FOR i := L TO R - 1 DO
+          FOR j := i TO R DO
+             IF y[Get(index,i)] > y[Get(index,j)] THEN
+               Swap( i, j );
+             END;
+          END;
+       END;
+
+       (* and advance the current index to the last of the duplicates *)
+       (* because all these values have been examined *)
+
+       k := R;
+            
+     END;
+          
+     k := k + 1;
+   END;
+
+ END XYSort;
+
+
+BEGIN
+END Plotter.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/randomly.mod b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/randomly.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/randomly.mod
@@ -0,0 +1,122 @@
+IMPLEMENTATION MODULE Randomly;
+
+(* procedures for getting random numbers *)
+
+(* J. Andrea, May.18/92 -dos version *)
+(* J. Andrea, Oct.4/91, add min and max to RandomReal *)
+(* reorganized, J. Andrea, Aug.12/91 *)
+(* J. Andrea, 1985 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+IMPORT Random;
+FROM MathLib0 IMPORT sqrt;
+
+    (* --------------------------------------------- *)
+    PROCEDURE RandomReal( min, max :REAL ) :REAL;
+    (* return a real number X, such that min >= X < max *)
+    BEGIN
+
+       RETURN min + ( max - min ) * Random.RandomReal();
+
+    END RandomReal;
+
+    (* --------------------------------------------- *)
+    PROCEDURE NormalRandom( mean, sigma :REAL ) :REAL;
+    (* from CACM Aug.63, algorithm #200 *)
+    CONST
+       n = 13;
+    VAR
+       i   :CARDINAL;
+       sum :REAL;
+    BEGIN
+
+       sum := 0.0;
+       FOR i := 1 TO n DO
+         sum := sum + RandomReal( -1.0, +1.0 );
+       END;
+       RETURN mean + sigma * sum * sqrt( 3.0 / FLOAT( n ) );
+
+    END NormalRandom;
+
+    (* --------------------------------------------- *)
+    PROCEDURE Choose_0_To_N( n :CARDINAL) :CARDINAL;
+    (* return a value in the range  [0..n] *)
+    BEGIN
+
+       RETURN Random.RandomCard( n + 1 );
+
+    END Choose_0_To_N;
+
+    (* --------------------------------------------- *)
+    PROCEDURE Choose_0_To_N_Minus_1( n :CARDINAL) :CARDINAL;
+    (* return a value in the range  [0..n-1] *)
+    BEGIN
+
+       IF n < 2 THEN
+         RETURN 0;
+       ELSE
+
+         RETURN Random.RandomCard( n );
+
+       END;
+
+    END Choose_0_To_N_Minus_1;
+
+
+    (* --------------------------------------------- *)
+    PROCEDURE Choose_1_To_N( n :CARDINAL) :CARDINAL;
+    (* return a value in the range  [1..n] *)
+    BEGIN
+
+       IF n < 2 THEN
+         RETURN 1;
+       ELSE
+
+         RETURN 1 + Random.RandomCard( n );
+
+       END;
+
+    END Choose_1_To_N;
+
+
+    (* --------------------------------------------- *)
+    PROCEDURE Choose_1_To_N_Minus_1( n :CARDINAL) :CARDINAL;
+    (* return a value in the range  [1..n-1] *)
+    BEGIN
+
+       IF n < 2 THEN
+         RETURN 1;
+       ELSE
+
+         RETURN 1 + Random.RandomCard( n - 1 );
+
+       END;
+
+    END Choose_1_To_N_Minus_1;
+
+
+    (* --------------------------------------------- *)
+    PROCEDURE InputSeed( a_seed :INTEGER );
+    (* build a seed from a value from the input value *)
+    
+    VAR x :REAL;
+    
+    BEGIN
+
+      Random.RandomInit( CARDINAL( a_seed ) );
+      
+      (* call random a couple of times to get the seed going *)
+      x := Random.RandomReal( );
+      x := Random.RandomReal();
+      x := Random.RandomReal();
+      
+    END InputSeed;
+
+    (* --------------------------------------------- *)
+    PROCEDURE MakeSeed;
+    BEGIN
+        Random.Randomize;
+    END MakeSeed;
+
+BEGIN
+END Randomly.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/screenio.def b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/screenio.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/screenio.def
@@ -0,0 +1,60 @@
+DEFINITION MODULE ScreenIO;
+
+(* Do screen io, row/column locations, and color on DOS *)
+(* V1.0, J. Andrea, Jun.3/93 *)
+
+EXPORT QUALIFIED screen_rows, screen_cols,
+                 PutString, Clear, ClearEOL,
+                 Goto, GotoRelative,
+                 Red, Green, Blue, Yellow, Magenta, Cyan, White, Normal,
+                 Bold,
+                 Bell,
+                 ReadKey;
+
+CONST
+  screen_rows = 25;
+  screen_cols = 80;
+
+PROCEDURE PutString( string :ARRAY OF CHAR; row, col :CARDINAL );
+
+PROCEDURE Clear;      (* clear the whole screen *)
+PROCEDURE ClearEOL;   (* clear the remainder of the line *)
+
+PROCEDURE Goto( row, col :CARDINAL );  (* set the cursor position *)
+PROCEDURE GotoRelative( direction :CHAR );  (* move one of '<', '>', '^', 'v' *)
+
+PROCEDURE Red; (* set the current color to red, and stays till turned off *)
+PROCEDURE Green;
+PROCEDURE Blue;
+PROCEDURE Yellow;
+PROCEDURE Magenta;
+PROCEDURE Cyan;
+PROCEDURE White;
+PROCEDURE Normal;  (* return color to normal *)
+
+PROCEDURE Bold;
+
+PROCEDURE Bell;  (* ring the bell *)
+
+
+PROCEDURE ReadKey( VAR ch :CHAR;
+                   VAR shift, control, alt, function, arrow, special :BOOLEAN );
+(*
+Return several items about the key that was just pressed.
+An ordinary lower case letter, number, or ascii char is returned with
+  'ch' set to the required value, and all the booleans as false.
+A shifted ascii char, such as "R" is returned with 'shift' as true, and
+  'ch' as "r". And the same for control and alt keys.
+Since even functions keys can have multiple functions (i.e. ALT F1) then
+ the booleans can be returned true in any combination.
+The arrow keys are retuned with 'arrow' as true, and 'ch' as one of ">", "<",
+  "^" or "v" as depictions of the directions.
+The special keys may be returned as "i" for insert, "h" for home,
+  "^" for page up, "v" for page down, "d" for delete, "e" for end
+  and "5" for keypad 5.
+And one note about the function keys. Since the 10..12 characters of f10..f12
+  can't be displayed with one character, then the ascii characters
+  following "9" are used. F10 = ":", F11 = ";", F12 = "<".
+*)
+
+END ScreenIO.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/screenio.mod b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/screenio.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/screenio.mod
@@ -0,0 +1,293 @@
+IMPLEMENTATION MODULE ScreenIO;
+
+(* Do screen io, row/column locations, and color on DOS *)
+(* V1.0, J. Andrea, May.11/93 *)
+
+FROM ASCII IMPORT esc, EOL;
+FROM Strings IMPORT Length;
+FROM Terminal IMPORT Write, Read;
+
+CONST
+  ord1 = 49;  (* ORD('1') *)
+  f11  = ';'; (* two characters past '9' *)
+  f12  = '<'; (* three characters past '9' *)
+
+VAR
+  qwerty_row1, qwerty_row2, qwerty_row3 :ARRAY [0..10] OF CHAR;
+  char :ARRAY [1..screen_cols] OF ARRAY [1..2] OF CHAR;
+  i, k :CARDINAL;
+
+(* -------------- *)
+PROCEDURE Bell;
+BEGIN
+  Write( 7C );
+END Bell;
+
+
+(* ----------------------------------------------------------- *)
+PROCEDURE PutString( string :ARRAY OF CHAR; row, col :CARDINAL );
+VAR
+   i, n :CARDINAL;
+BEGIN
+   n := Length( string );
+   IF n > 0 THEN
+     Goto( row, col );
+     FOR i := 0 TO n - 1 DO
+        Write( string[i] );
+     END;
+   END;
+END PutString;
+
+(* ---------------------------------- *)
+PROCEDURE Goto( row, col :CARDINAL );
+BEGIN
+  IF row = 0 THEN row := 1 END;
+  IF col = 0 THEN col := 1 END;
+  IF row > screen_rows THEN row := 1 END;
+  IF col > screen_cols THEN col := 1 END;
+
+  Write( esc ); Write( '[' );
+  Write( char[row][1] ); Write( char[row][2] );
+  Write( ';' );
+  Write( char[col][1] ); Write( char[col][2] );
+  Write( 'H' );
+END Goto;
+
+(* ------------------------------------- *)
+PROCEDURE GotoRelative( direction :CHAR );
+BEGIN
+  IF direction = '<' THEN
+    Esc; Write( '1' ); Write( 'D' );
+  ELSIF direction = '>' THEN
+    Esc; Write( '1' ); Write( 'C' );
+  ELSIF direction = '^' THEN
+    Esc; Write( '1' ); Write( 'A' );
+  ELSIF direction = 'v' THEN
+    Esc; Write( '1' ); Write( 'B' );
+  END;
+END GotoRelative;
+
+(* ----------------- *)
+PROCEDURE Esc;
+BEGIN
+  Write( esc ); Write( '[' );
+END Esc;
+
+(* -------------------------- *)
+PROCEDURE Clear;
+BEGIN
+  Esc; Write( '2' ); Write( 'J' );
+END Clear;
+PROCEDURE ClearEOL;
+BEGIN
+  Esc; Write( 'K' );
+END ClearEOL;
+
+(* ------------------------------- *)
+PROCEDURE SetColor( c :CHAR );
+BEGIN
+  Esc; Write( '3' ); Write( c ); Write( 'm' );
+END SetColor;
+
+PROCEDURE Red;     BEGIN SetColor( '1' ) END Red;
+PROCEDURE Green;   BEGIN SetColor( '2' ) END Green;
+PROCEDURE Blue;    BEGIN SetColor( '4' ) END Blue;
+PROCEDURE Yellow;  BEGIN SetColor( '3' ) END Yellow;
+PROCEDURE Magenta; BEGIN SetColor( '5' ) END Magenta;
+PROCEDURE Cyan;    BEGIN SetColor( '6' ) END Cyan;
+PROCEDURE White;   BEGIN SetColor( '7' ) END White;
+
+(* ------------------------ *)
+PROCEDURE Normal;
+BEGIN
+  Esc; Write( '0' ); Write( 'm' );
+END Normal;
+PROCEDURE Bold;
+BEGIN
+  Esc; Write( '1' ); Write( 'm' );
+END Bold;
+
+  (* -------------------------------------------------------- *)
+  PROCEDURE ReadKey( VAR ch :CHAR;
+                     VAR shift, control, alt, function, arrow, special :BOOLEAN );
+  BEGIN
+
+    shift    := FALSE;
+    control  := FALSE;
+    alt      := FALSE;
+    function := FALSE;
+    arrow    := FALSE;
+    special  := FALSE;
+
+    Read( ch );
+    IF ch = 0C THEN
+      Read( ch );
+      i := ORD( ch );
+      CASE i OF
+        15 :                                         (* shift tab *)
+               control := TRUE;
+               shift   := TRUE;
+               ch      := 'i';
+      | 16..25 :                                     (* alt q..p *)
+               alt := TRUE;
+               ch  := qwerty_row1[i-16];
+      | 30..38 :                                     (* alt a..l *)
+               alt := TRUE;
+               ch  := qwerty_row2[i-30];
+      | 44..50 :                                     (* alt z..m *)
+               alt := TRUE;
+               ch  := qwerty_row3[i-44];
+      | 59..68,133,134 :
+               function := TRUE;
+               IF i = 133 THEN
+                 ch := f11;                          (* f11 *)
+               ELSIF i = 134 THEN
+                 ch := f12;                          (* f12 *)
+               ELSE
+                 ch := CHR( ord1 + i - 59 );         (* f1..f10 *)
+               END;
+      | 71,73,76,79,81..83 :
+               special := TRUE;
+               CASE i OF
+                71 :ch := 'h';                     (* home *)
+              | 73 :ch := '^';                     (* page up *)
+              | 76 :ch := '5';                     (* keypad 5 *)
+              | 79 :ch := 'e';                     (* end *)
+              | 81 :ch := 'v';                     (* page down *)
+              | 82 :ch := 'i';                     (* insert *)
+              | 83 :ch := 'd';                     (* delete *)
+               END;
+      | 72,75,77,80 :
+               arrow := TRUE;
+               IF i = 72 THEN
+                 ch := '^';                        (* up arrow *)
+               ELSIF i = 75 THEN
+                 ch := '<';                        (* left arrow *)
+               ELSIF i = 77 THEN
+                 ch := '>';                        (* right arrow *)
+               ELSE
+                 ch := 'v';                        (* down arrow *)
+               END;
+      | 84..93,135,136 :
+              shift := TRUE;
+              function := TRUE;
+              IF i = 135 THEN
+                ch := f11;                         (* shift f11 *)
+              ELSIF i = 136 THEN
+                ch := f12;                         (* shift f12 *)
+              ELSE
+                ch := CHR( ord1 + i - 84 );        (* shift f1..f10 *)
+              END;
+      | 94..103,137,138 :
+              control := TRUE;
+              function := TRUE;
+              IF i = 137 THEN
+                ch := f11;                         (* control f11 *)
+              ELSIF i = 138 THEN
+                ch := f12;                         (* control f12 *)
+              ELSE
+                ch := CHR( ord1 + i - 94 );        (* control f1..f10 *)
+              END;
+      | 104..113,139,140 :
+              alt := TRUE;
+              function := TRUE;
+              IF i = 139 THEN
+                ch := f11;                         (* alt f11 *)
+              ELSIF i = 140 THEN
+                ch := f12;                         (* alt f12 *)
+              ELSE
+                ch := CHR( ord1 + i - 104 );       (* alt f1..f10 *)
+              END;
+      | 115,116,141,145 :
+              arrow   := TRUE;
+              control := TRUE;
+              IF i = 115 THEN
+                ch := '<';                          (* contol left arrow *)
+              ELSIF i = 116 THEN
+                ch := '>';                          (* control right arrow *)
+              ELSIF i = 141 THEN
+                ch := '^';                          (* control up arrow *)
+              ELSE
+                ch := 'v';                          (* control down arrow *)
+              END;
+      | 117..119,132,143,146,147 :
+              special := TRUE;
+              control := TRUE;
+              IF i = 117 THEN
+                ch := 'e';                          (* control end *)
+              ELSIF i = 118 THEN
+                ch := 'v';                          (* control page down *)
+              ELSIF i = 119 THEN
+                ch := 'h';                          (* control home *)
+              ELSIF i = 132 THEN
+                ch := '^';                          (* control page up *)
+              ELSIF i = 143 THEN
+                ch := '5';                          (* control keypad 5 *)
+              ELSIF i = 147 THEN
+                ch := 'd';                          (* control delete *)
+              ELSE
+                ch := 'i';                          (* control insert *)
+              END;
+      | 120..131 :
+              alt := TRUE;
+              IF ( i >= 120 ) & ( i <= 128 ) THEN    (* alt 1..9 *)
+                ch := CHR( ord1 + i - 120 );
+              ELSIF i = 129 THEN                     (* alt 0 *)
+                ch := '0';
+              ELSIF i = 130 THEN                     (* alt - *)
+                ch := '-';
+              ELSIF i = 131 THEN                     (* alt = *)
+                ch := '=';
+              END;
+      | 148 :
+          (* this is a control tab, but it would look just like a
+             tab alone, so return it as a shift tab *)
+          control := TRUE;
+          shift   := TRUE;
+          ch := 'i';                           (* control tab, not correct *)
+      | 149 :
+          control := TRUE;
+          alt     := TRUE;
+          ch := 'i';                           (* alt tab *)
+      ELSE
+        ch := 0C;                              (* unknown *)
+      END; (* case *)
+    ELSE
+
+      IF ch < ' ' THEN
+        control := TRUE;
+        (* special case for how the lower module handles return *)
+        IF ch = EOL THEN
+          ch := 'm';
+        ELSIF ( ch >= 33C ) & ( ch <= 37C ) THEN
+          ch := CHR( ORD( ch ) + 64 );       (* esc and next few *)
+        ELSE
+          ch := CHR( ORD( ch ) + 96 );
+        END;
+      ELSIF ( ch >= 'A' ) & ( ch <= 'Z' ) THEN
+        shift := TRUE;
+        ch    := CHR( ORD( ch ) + 32 );
+      END;
+    END;
+
+  END ReadKey;
+
+BEGIN
+
+  qwerty_row1 := 'qwertyuiop';
+  qwerty_row2 := 'asdfghjkl';
+  qwerty_row3 := 'zxcvbnm';
+
+  (* build the table of characters of numbers for lookup *)
+  FOR i := 1 TO 9 DO
+    char[i][1] := '0';
+    char[i][2] := CHR( ORD('0') + i );
+  END;
+  FOR i := 10 TO screen_cols DO
+    k := i DIV 10;
+    char[i][1] := CHR( ORD('0') + k );
+    k := i - k * 10;
+    char[i][2] := CHR( ORD('0') + k );
+  END;
+
+END ScreenIO.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/serial.def b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/serial.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/serial.def
@@ -0,0 +1,26 @@
+DEFINITION MODULE Serial;
+
+(* This is a module to simplify RS232 com port operations. *)
+(* V1.0, J.Andrea, Jun.3/93 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+EXPORT QUALIFIED InitPort, ClosePort, Get, Put, PutString;
+
+PROCEDURE InitPort( VAR done :BOOLEAN );
+(* Initialize the port to the standard settings, COM1, 9600 baud, etc. *)
+(* This must be called before any Gets or Puts, and the device should
+   be turned on. *)
+
+PROCEDURE Get( VAR ch :CHAR );
+(* Get a single character from the serial port. *)
+
+PROCEDURE Put( ch :CHAR );
+(* Write a single character to the serial port. *)
+
+PROCEDURE PutString( s :ARRAY OF CHAR );
+(* Write a string to the serial port. *)
+
+PROCEDURE ClosePort;
+(* Finish using the serial port. *)
+
+END Serial.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/serial.mod b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/serial.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/serial.mod
@@ -0,0 +1,68 @@
+IMPLEMENTATION MODULE Serial;
+
+(* Deal with a serial port. *)
+(* V1.0, J.Andrea, Jun.3/93 *)
+(* This code may be freely used and distributed, it may not be sold *)
+
+IMPORT RS232Code;
+FROM Strings IMPORT Length;
+
+VAR
+  init_done :BOOLEAN;
+
+  (* ------------------------------------ *)
+  PROCEDURE InitPort( VAR done :BOOLEAN );
+  BEGIN
+    RS232Code.Init(     (* com port 1 *)
+         9600,  (* baud *)
+         2,     (* stop bits *)
+         FALSE, (* parity enable *)
+         TRUE,  (* even parity *)
+         7,     (* char size *)
+         done );
+     IF done THEN
+       RS232Code.StartReading;
+       init_done := TRUE;
+     END;
+  END InitPort;
+
+  (* ----------------------------------- *)
+  PROCEDURE ClosePort;
+  BEGIN
+    IF init_done THEN
+      RS232Code.StopReading;
+      init_done := FALSE;
+    END;
+  END ClosePort;
+
+  (* ----------------------------------- *)
+  PROCEDURE Get( VAR ch :CHAR );
+  BEGIN
+    IF init_done THEN
+      RS232Code.Read( ch );
+    ELSE
+      ch := 0C;
+    END;
+  END Get;
+
+  PROCEDURE Put( ch :CHAR );
+  BEGIN
+    IF init_done THEN
+      RS232Code.Write( ch );
+    END;
+  END Put;
+
+  PROCEDURE PutString( s :ARRAY OF CHAR );
+  VAR i, n :CARDINAL;
+  BEGIN
+     n := Length( s );
+     IF n # 0 THEN
+       FOR i := 0 TO n-1 DO
+         Put( s[i] );
+       END;
+     END;
+  END PutString;
+
+BEGIN
+  init_done := FALSE;
+END Serial.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/shortrea.def b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/shortrea.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/shortrea.def
@@ -0,0 +1,55 @@
+DEFINITION MODULE ShortRealInOut;
+(* taken from the Multiscope RealInOut module, but for standard/short reals *)
+
+EXPORT QUALIFIED
+   ReadReal, WriteReal, Done;
+
+
+VAR Done: BOOLEAN;
+
+
+PROCEDURE ReadReal( VAR x :REAL );
+(*
+- Read a REAL from the terminal.
+
+out:    x       the number read.
+
+The range of representable valid real numbers is:
+   1.0E-37 <= ABS(r) < 1.0E38
+
+The syntax accepted for input is:
+
+   realnumber       = fixedpointnumber [exponent].
+   fixedpointnumber = [sign] {digit} [ '.' {digit} ].
+   exponent         =  ('e' | 'E') [sign] digit {digit}.
+   sign             = '+' | '-'.
+   digit            = '0'|'1'|'2'|'3'|'4'|'5'|'6'|'7'|
+                      '8'|'9'.
+
+The following numbers are legal representations of one
+hundred: 100, 10E1, 100E0, 1000E-1, E2, +E2, 1E2, +1E2,
++1E+2, 1E+2 .
+
+At most (about 6) digits are significant, leading zeros not
+counting. Input terminates a control character or space.
+DEL or BS is used for backspacing
+
+The variable 'Done' indicates whether a valid number was
+read.
+*)
+
+
+PROCEDURE WriteReal( x :REAL; 
+                     n :CARDINAL );
+(*
+- Write a REAL to the terminal, right-justified.
+
+in:     x       number to write,
+        n       minimum field width.
+
+If fewer than n characters are needed to represent x,
+leading blanks are output. At least 10 characters are
+needed to write any REAL number.
+*)
+
+END ShortRealInOut.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/shortrea.mod b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/shortrea.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/shortrea.mod
@@ -0,0 +1,22 @@
+(*$T-*)
+(*$R-*)
+IMPLEMENTATION MODULE ShortRealInOut;
+
+IMPORT RealInOut;
+
+VAR
+  x :LONGREAL;
+  
+PROCEDURE ReadReal( VAR r :REAL );
+BEGIN
+  RealInOut.ReadReal( x );   r := SHORT( x );
+  Done := RealInOut.Done;
+END ReadReal;
+
+PROCEDURE WriteReal( r      :REAL; 
+                     length :CARDINAL );
+BEGIN
+  RealInOut.WriteReal( LONG( r ), length );
+END WriteReal;
+
+END ShortRealInOut.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/systemco.def b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/systemco.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/systemco.def
@@ -0,0 +1,23 @@
+DEFINITION MODULE SystemConstants;
+
+(* specific system constants *)
+
+(* J. Andrea, May.18/92 - DOS, Multiscope 4.0 version *)
+(* J. Andrea, 1985*)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+EXPORT QUALIFIED
+                 WORDLENGTH, BYTELENGTH, MININT, MAXINT, MINCARD, MAXCARD;
+
+CONST
+
+   WORDLENGTH = 16;
+   BYTELENGTH =  8;
+
+   MININT     = -32768;
+   MAXINT     = +32767;
+   
+   MINCARD    =      0;
+   MAXCARD    =  65535;
+
+END SystemConstants.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/timer.def b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/timer.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/timer.def
@@ -0,0 +1,17 @@
+DEFINITION MODULE Timer;
+
+(* get time stats *)
+(* J. Andrea, May.18/92 - dos version ? *)
+
+EXPORT QUALIFIED StartTimer, ShowTimer;
+
+PROCEDURE StartTimer;
+(* start up the timer *)
+
+PROCEDURE StopTimer;
+(* stp the timer *)
+
+PROCEDURE ShowTimer;
+(* get the current value of the timer, since the last show *)
+
+END Timer.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/timer.mod b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/timer.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/timer.mod
@@ -0,0 +1,112 @@
+IMPLEMENTATION MODULE Timer;
+(* $S-, $R-, $T- *)
+
+(* get time stats *)
+
+FROM TimeDate IMPORT Time, GetTime;
+
+CONST
+  hours_per_day = 24;
+  min_per_day   = hours_per_day * 60;
+
+VAR
+  start, now :Time;
+  started    :BOOLEAN;
+  digits     :ARRAY [0..9] OF CHAR;
+  numbers    :ARRAY [0..99] OF ARRAY [0..1] OF CHAR;
+  i, j, k    :CARDINAL;
+
+(* -------------------------------------------------------- *)
+PROCEDURE StartTimer;
+BEGIN
+  started := TRUE;
+  GetTime( start );
+END StartTimer;
+
+(* -------------------------------------------------------- *)
+PROCEDURE ShowTimer;
+
+VAR
+  dday, dmin, dmil, d, h, m, s, u :CARDINAL;
+
+BEGIN
+  GetTime( now );
+
+  IF started THEN
+
+    (* the time is returned from GetTime in this style *)
+    (* .day is the day since 1900 *)
+    (* .minute is # minutes since midnight *)
+    (* .millisec is # millseconds past the minute *)
+
+    dday := now.day - start.day;
+
+    IF dday = 0 THEN
+      dmin := now.minute - start.minute;
+    ELSE
+      dmin := min_per_day + now.minute - start.minute;
+    END;
+
+    d := dday;
+    h := dmin DIV 60;
+    m := dmin - h * 60;
+
+    IF now.millisec >= start.millisec THEN
+      dmil := now.millisec - start.millisec;
+    ELSE
+
+      (* watch the order of the subtractions, card max is 65534 *)
+      dmil := start.millisec - now.millisec;
+      dmil := 60000 - dmil;
+
+      (* really one minute less than computed, propagate backwards *)
+      IF m > 0 THEN
+        m := m - 1;
+      ELSE
+        IF h > 0 THEN
+          h := h - 1;
+        ELSE
+          d := d - 1;
+        END;
+      END;
+
+    END;
+
+    s := dmil DIV 1000;
+    u := ( dmil - s * 1000 ) DIV 10;
+
+    WriteString( 'elapsed time: ' );
+                        WriteString( numbers[d] );
+    WriteString( ' ' ); WriteString( numbers[h] );
+    WriteString( ':' ); WriteString( numbers[m] );
+    WriteString( ':' ); WriteString( numbers[s] );
+    WriteString( '.' ); WriteString( numbers[u] );
+    WriteLn;
+
+  END;
+END ShowTimer;
+
+(* -------------------------------------------------------- *)
+PROCEDURE StopTimer;
+BEGIN
+END StopTimer;
+BEGIN
+
+  started := FALSE;
+
+  digits[0] := '0'; digits[1] := '1'; digits[2] := '2'; digits[3] := '3';
+  digits[4] := '4'; digits[5] := '5'; digits[6] := '6'; digits[7] := '7';
+  digits[8] := '8'; digits[9] := '9';
+
+  (* generate 2 digit strings for numbers 0 to 99 as a lookup table *)
+
+  k := 0;
+  FOR i := 0 TO 9 DO
+    FOR j := 0 TO 9 DO
+      numbers[k][0] := digits[i];
+      numbers[k][1] := digits[j];
+       k := k + 1;
+    END;
+  END;
+
+END Timer.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/vgagraph.def b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/vgagraph.def
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/vgagraph.def
@@ -0,0 +1,55 @@
+DEFINITION MODULE VGAGraphics;
+
+(* simple VGA Graphics routines *)
+(* V1.0, J. Andrea, Apr.12/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+(* first try to make PC graphics work like whats on the VAX for REGIS *)
+
+EXPORT QUALIFIED
+   BeginVGA, EndVGA,
+   EraseScreen, GetDimensions,
+   Move,
+   Dot, Line, DotColor, LineColor,
+   Circle, CircleColor,
+   Text, TextColor;
+
+
+PROCEDURE BeginVGA;
+(* start graphics *)
+
+PROCEDURE EndVGA;
+(* reset graphics *)
+
+
+PROCEDURE EraseScreen;
+(* erase the whole display *)
+
+PROCEDURE GetDimensions( VAR x, y :CARDINAL );
+(* return the maximum possible dimensions of the display *)
+
+PROCEDURE Move( x, y :CARDINAL );
+(* move to the new location, make it the current point *)
+
+PROCEDURE Dot;
+(* draw a dot at the current location *)
+
+PROCEDURE DotColor( color :CARDINAL );
+(* draw a dot of the given color *)
+
+PROCEDURE Line( x, y :CARDINAL );
+(* draw a line from the current point to the new point,
+   and the new point will become the current point *)
+
+PROCEDURE LineColor( x, y :CARDINAL; color :CARDINAL );
+(* draw a line of the given color *)
+
+PROCEDURE Circle( x, y, radius :CARDINAL; fill :BOOLEAN );
+PROCEDURE CircleColor( x, y, radius :CARDINAL; color :CARDINAL; fill :BOOLEAN );
+(* draw a circle at center x,y *)
+
+PROCEDURE Text( string :ARRAY OF CHAR );
+PROCEDURE TextColor( string :ARRAY OF CHAR; color :CARDINAL );
+(* put some text at the current location *)
+
+END VGAGraphics.
diff --git a/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/vgagraph.mod b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/vgagraph.mod
new file mode 100644
--- /dev/null
+++ b/examples/Modula-2_Libraries/andrea-m2/lib/multiscope/vgagraph.mod
@@ -0,0 +1,178 @@
+IMPLEMENTATION MODULE VGAGraphics;
+(*/NOWARN*)
+(* simple VGA Graphics routines *)
+(* first try at making pc graphics like regis module on the vax *)
+(* v1.0, J. Andrea, Apr.12/92 *)
+(* This code may be freely used and distributed, it may not be sold. *)
+
+FROM Strings IMPORT Length;
+IMPORT Graphics;
+
+CONST
+   absolute_rows = 480;
+   absolute_cols = 640;
+
+   row_offset    =  4;
+   col_offset    =  4; 
+
+   max_rows      = absolute_rows - 2 * row_offset;
+   max_cols      = absolute_cols - 2 * col_offset;
+
+VAR
+  initial_mode             :INTEGER;
+  current_row, current_col :INTEGER;
+
+  vga_on :BOOLEAN;
+
+  biggest :CARDINAL;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE BeginVGA;
+BEGIN
+   IF NOT vga_on THEN
+     Graphics.GetScreenMode( initial_mode );
+   END;
+   
+   vga_on := TRUE;
+   Graphics.ScreenMode( Graphics.gph16CHiRes );
+   
+END BeginVGA;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE EndVGA;
+BEGIN
+  IF vga_on THEN
+    Graphics.ScreenMode( initial_mode );    
+    vga_on := FALSE;
+    current_row := 0; current_col := 0;
+  END;
+END EndVGA;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE EraseScreen;
+BEGIN
+  IF vga_on THEN
+    Graphics.ScreenMode( -1 );
+  END;
+END EraseScreen;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE GetDimensions( VAR columns, rows :CARDINAL );
+BEGIN
+  columns := CARDINAL( max_cols );
+  rows    := CARDINAL( max_rows );
+END GetDimensions;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Move( col, row :CARDINAL );
+BEGIN
+  IF vga_on THEN
+    IF col >= max_cols THEN col := max_cols END;
+    IF row >= max_rows THEN row := max_rows END;
+    
+    current_row := INTEGER( row );
+    current_col := INTEGER( col );
+
+  END;
+END Move;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Dot;
+BEGIN
+  DotColor( 14 );
+END Dot;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE DotColor( color :CARDINAL );
+BEGIN
+  IF vga_on THEN
+    Graphics.Dot(            col_offset + current_col,
+                  max_rows + row_offset - current_row,
+                  color );
+  END;
+END DotColor;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Line( col, row :CARDINAL );
+BEGIN
+  LineColor( col, row, 14 );
+END Line;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE LineColor( col, row :CARDINAL; color :CARDINAL );
+VAR save_row, save_col :INTEGER;
+BEGIN
+  IF vga_on THEN
+    save_row := current_row;
+    save_col := current_col;
+    
+    IF col >= max_cols THEN col := max_cols END;
+    IF row >= max_rows THEN row := max_rows END;
+    
+    current_row := INTEGER( row );
+    current_col := INTEGER( col );
+    
+    Graphics.Line(            col_offset + save_col,
+                   max_rows + row_offset - save_row,
+                              col_offset + current_col,
+                   max_rows + col_offset - current_row,
+                   color );
+  END;
+END LineColor;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Circle( col, row :CARDINAL; radius :CARDINAL; fill :BOOLEAN );
+BEGIN
+   CircleColor( col, row, radius, 14, fill );
+END Circle;
+
+ (* ----------------------------------------------------------------- *)
+PROCEDURE CircleColor( col, row :CARDINAL; radius :CARDINAL; color :CARDINAL;
+                       fill :BOOLEAN );
+BEGIN
+  IF vga_on THEN
+    IF col >= max_cols THEN col := max_cols END;
+    IF row >= max_rows THEN row := max_rows END;
+    
+    current_row := INTEGER( row );
+    current_col := INTEGER( col );
+    
+    Graphics.Circle(            col_offset + current_col,
+                     max_rows + row_offset - current_row,
+                                col_offset + current_col,
+                     max_rows + row_offset - current_col - INTEGER( radius ),
+                     color, fill );
+    
+  END;
+END CircleColor;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE Text( string :ARRAY OF CHAR );
+BEGIN
+  TextColor( string, 14 );
+END Text;
+
+(* ----------------------------------------------------------------- *)
+PROCEDURE TextColor( string :ARRAY OF CHAR; color :CARDINAL );
+BEGIN
+  IF vga_on THEN
+    Graphics.WriteString( string,
+                                     col_offset + current_col,
+                          max_rows + row_offset - current_row,
+                          color, 0, Length( string ) );
+  END;
+END TextColor;
+
+BEGIN
+
+   current_row := 0; current_col := 0;
+
+   vga_on := FALSE;
+
+   IF absolute_rows > absolute_cols THEN
+     biggest := absolute_rows;
+   ELSE
+     biggest := absolute_cols;
+   END;
+
+END VGAGraphics.
diff --git a/language-Modula2.cabal b/language-Modula2.cabal
new file mode 100644
--- /dev/null
+++ b/language-Modula2.cabal
@@ -0,0 +1,56 @@
+cabal-version:       2.4
+
+name:                language-Modula2
+version:             0.1
+synopsis:            Parser, pretty-printer, and more for the Modula-2 programming language
+description:
+   The library and the executable supports two versions of the Modula-2 programming language: as described by the
+   orginal language report and as standardized by the ISO.
+homepage:            https://github.com/blamario/language-Modula2
+bug-reports:         https://github.com/blamario/language-Modula2/issues
+license:             GPL-3.0-or-later
+license-file:        LICENSE
+author:              Mario Blažević
+maintainer:          blamario@protonmail.com
+copyright:           (c) 2020 Mario Blažević
+category:            Language
+build-type:          Simple
+extra-source-files:  README.md, CHANGELOG.md, examples/**/*.def, examples/**/*.DEF, examples/**/*.mod, examples/**/*.MOD
+
+library
+  exposed-modules:     Language.Modula2,
+                       Language.Modula2.Abstract, Language.Modula2.AST,
+                       Language.Modula2.Grammar, Language.Modula2.Pretty, Language.Modula2.ConstantFolder,
+                       Language.Modula2.ISO.Abstract, Language.Modula2.ISO.AST,
+                       Language.Modula2.ISO.Grammar, Language.Modula2.ISO.Pretty, Language.Modula2.ISO.ConstantFolder
+  -- other-modules:
+  build-depends:       base >= 4.7 && < 5, text < 1.3, containers >= 0.5 && < 1.0, filepath < 1.5, directory < 1.4,
+                       parsers >= 0.12.7 && < 0.13, input-parsers < 0.2, prettyprinter >= 1.2.1 && < 1.7,
+                       rank2classes >= 1.3 && < 1.5, grammatical-parsers >= 0.5 && < 0.6, deep-transformations < 0.2,
+                       template-haskell >= 2.11 && < 2.17,
+                       language-oberon >= 0.3 && < 0.4
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+
+executable parse
+  main-is:             app/Parse.hs
+  -- other-modules:       
+  other-extensions:    RankNTypes, RecordWildCards, ScopedTypeVariables, FlexibleInstances, DeriveDataTypeable
+  build-depends:       base >= 4.7 && < 5, text < 1.3, either == 5.*, containers >= 0.5 && < 1.0,
+                       repr-tree-syb < 0.2, filepath < 1.5, prettyprinter,
+                       rank2classes, grammatical-parsers, deep-transformations < 0.2,
+                       optparse-applicative,
+                       language-oberon >= 0.3 && < 0.4,
+                       language-Modula2
+  default-language:    Haskell2010
+
+test-suite             examples
+  type:                exitcode-stdio-1.0
+  build-depends:       base >= 4.7 && < 5, text < 1.3, grammatical-parsers,
+                       either == 5.*, directory < 2, filepath < 1.5, prettyprinter,
+                       deep-transformations < 0.2,
+                       tasty >= 0.7, tasty-hunit,
+                       language-oberon >= 0.3 && < 0.4,
+                       language-Modula2
+  main-is:             test/Test.hs
+  default-language:    Haskell2010
diff --git a/src/Language/Modula2.hs b/src/Language/Modula2.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Modula2.hs
@@ -0,0 +1,139 @@
+{-# Language FlexibleContexts, GADTs, OverloadedStrings, ScopedTypeVariables, StandaloneDeriving, TypeFamilies #-}
+
+-- | The programming language Modula-2
+
+module Language.Modula2 (parseModule, parseAndSimplifyModule, resolvePosition, resolvePositions,
+                         Placed, Version(..), SomeVersion(..)) where
+
+import qualified Language.Modula2.Abstract as Abstract
+import qualified Language.Modula2.AST as Report (Language)
+import qualified Language.Modula2.ISO.AST as ISO (Language)
+import qualified Language.Modula2.Grammar as Grammar
+import qualified Language.Modula2.ISO.Grammar as ISO.Grammar
+import qualified Language.Modula2.ConstantFolder as ConstantFolder
+import qualified Language.Modula2.ISO.ConstantFolder as ISO.ConstantFolder
+import Language.Modula2.ConstantFolder (Sem, ConstantFold, InhCF, SynCFExp, SynCFMod')
+import Language.Modula2.Pretty ()
+import Language.Modula2.ISO.Pretty ()
+
+import qualified Language.Oberon.Reserializer as Reserializer
+
+import qualified Rank2 as Rank2 (snd)
+import Transformation.AG (Atts, Inherited, Synthesized)
+import Transformation.AG.Generics (Auto)
+import qualified Transformation.Rank2 as Rank2
+import qualified Transformation.Full as Full
+import qualified Transformation.Deep as Deep
+
+import Control.Arrow (first)
+import Control.Monad (when)
+import Data.Functor.Compose (Compose(Compose, getCompose))
+import qualified Data.Map.Lazy as Map
+import Data.Map.Lazy (Map)
+import Data.Monoid ((<>))
+import Data.Text (Text, unpack)
+import Data.Text.IO (readFile)
+import Text.Grampa (Ambiguous, Grammar, ParseResults, parseComplete, failureDescription)
+import qualified Text.Grampa.ContextFree.LeftRecursive as LeftRecursive
+import qualified Text.Parser.Input.Position as Position
+import System.Directory (doesFileExist)
+import System.FilePath (FilePath, addExtension, combine, takeDirectory)
+
+import Prelude hiding (readFile)
+
+-- | Every node in a parsed and resolved AST is wrapped with this functor
+type Placed = (,) (Int, Grammar.ParsedLexemes, Int)
+
+-- | The modes of operation
+data Options = Options{
+   -- | whether to fold the constants in the parsed module
+   foldConstants :: Bool,
+   -- whether to check the types
+   -- checkTypes :: Bool,
+   -- | which version of the Modula-2 language?
+   version :: SomeVersion}
+
+data Version l where
+   -- | the version specified by Niklaus Wirth's ''Report on the Programming Language Modula-2''
+   Report :: Version Report.Language
+   -- | the version specified by the ISO standard
+   ISO    :: Version ISO.Language
+
+-- | The language version in existential container
+data SomeVersion where
+   SomeVersion :: Version l -> SomeVersion
+
+deriving instance Show (Version l)
+deriving instance Show SomeVersion
+
+-- | Replace the stored positions in the entire tree with offsets from the start of the given source text
+resolvePositions :: (p ~ Grammar.NodeWrap, q ~ Placed, Deep.Functor (Rank2.Map p q) g)
+                 => Text -> p (g p p) -> q (g q q)
+resolvePositions src t = resolvePosition src ((resolvePosition src Rank2.<$>) <$> t)
+
+-- | Replace the stored positions of the given node with offset from the start of the given source text
+resolvePosition :: Text -> Grammar.NodeWrap a -> Placed a
+resolvePosition src = \((start, ws, end), a)-> ((Position.offset src start, ws, Position.offset src end), a)
+
+-- | Parse the given text of a single module and fold constants inside it.
+parseAndSimplifyModule :: (Abstract.Modula2 l, Abstract.Nameable l,
+                           Full.Functor (Auto ConstantFold) (Abstract.Expression l l))
+                    => Version l -> Text -> ParseResults Text [Placed (Abstract.Module l l Placed Placed)]
+parseAndSimplifyModule Report source =
+   (Reserializer.adjustPositions . (ConstantFolder.foldConstants (predefined Report) <$>) <$>)
+   <$> parseModule Report source
+parseAndSimplifyModule ISO source =
+   (Reserializer.adjustPositions . (ISO.ConstantFolder.foldConstants (predefined ISO) <$>) <$>)
+   <$> parseModule ISO source
+
+-- | The predefined environment of types, constants, and procedures for the given language version.
+predefined :: (Abstract.Modula2 l, Ord (Abstract.QualIdent l)) => Version l -> ConstantFolder.Environment l
+predefined Report = Map.fromList $ map (first Abstract.nonQualIdent) $
+   [("TRUE", Just Abstract.true),
+    ("FALSE", Just Abstract.false)]
+   ++ map builtin ["BITSET", "BOOLEAN", "CARDINAL", "CHAR", "INTEGER", "PROC", "REAL",
+                   "ABS", "CAP", "CHR", "FLOAT", "HIGH", "MAX", "MIN", "ODD", "ORD", "TRUNC", "VAL"]
+   where builtin name = (name, Just $ Abstract.builtin name)
+predefined ISO = Map.fromList $ map (first Abstract.nonQualIdent) $
+   [("TRUE", Just Abstract.true),
+    ("FALSE", Just Abstract.false)]
+   ++ map builtin ["BITSET", "BOOLEAN", "CARDINAL", "CHAR", "INTEGER", "PROC", "REAL",
+                   "ABS", "CAP", "CHR", "FLOAT", "HIGH", "MAX", "MIN", "ODD", "ORD", "TRUNC", "VAL"]
+   where builtin name = (name, Just $ Abstract.builtin name)
+
+-- | Parse the given text of a single module.
+parseModule :: Version l -> Text -> ParseResults Text [Placed (Abstract.Module l l Placed Placed)]
+parseModule Report source = resolve source (parseComplete Grammar.modula2grammar source)
+parseModule ISO source = resolve source (Rank2.snd $ parseComplete ISO.Grammar.modula2ISOgrammar source)
+
+resolve :: Deep.Functor (Rank2.Map Grammar.NodeWrap Placed) (Abstract.Module l l)
+        => Text
+        -> Grammar.Modula2Grammar l Grammar.NodeWrap (Compose (Compose (ParseResults Text) []) ((,) [[Grammar.Lexeme]]))
+        -> ParseResults Text [Placed (Abstract.Module l l Placed Placed)]
+resolve source results = getCompose (resolvePositions source . snd <$> getCompose (Grammar.compilationUnit results))
+
+{-
+parseNamedModule :: FilePath -> Text -> IO (ParseResults Text [Module Language Language Placed Placed])
+parseNamedModule path name =
+   do let basePath = combine path (unpack name)
+      isDefn <- doesFileExist (addExtension basePath "Def")
+      src <- readFile (addExtension basePath $ if isDefn then "Def" else "Mod")
+      return (getCompose $ resolvePositions src <$> Grammar.compilationUnit (parseComplete Grammar.modula2grammar src))
+
+parseImportsOf :: FilePath -> Map Text (Module Language Language Placed Placed)
+               -> IO (Map Text (Module Language Language Placed Placed))
+parseImportsOf path modules =
+   case filter (`Map.notMember` modules) moduleImports
+   of [] -> return modules
+      newImports -> (((modules <>) . Map.fromList . map assertSuccess) <$>
+                     (traverse . traverse) (parseNamedModule path) [(p, p) | p <- newImports])
+                    >>= parseImportsOf path
+   where moduleImports = foldMap (fmap importedModule . importsOf) modules
+         importedModule (Import _ m) = m
+         importsOf (DefinitionModule _ imports _ _) = imports
+         importsOf (ImplementationModule _ _ imports _) = imports
+         importsOf (ProgramModule _ _ imports _) = imports
+         assertSuccess (m, Left err) = error ("Parse error in module " <> unpack m)
+         assertSuccess (m, Right [p]) = (m, p)
+         assertSuccess (m, Right _) = error ("Ambiguous parses of module " <> unpack m)
+-}
diff --git a/src/Language/Modula2/AST.hs b/src/Language/Modula2/AST.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Modula2/AST.hs
@@ -0,0 +1,421 @@
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GADTs, DataKinds, InstanceSigs, KindSignatures,
+             MultiParamTypeClasses, UndecidableInstances,
+             ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
+
+-- | Concrete data types for Modula-2 constructs that make up its Abstract Syntax Tree. Every data type from this
+-- module is an instance of a type family declared in "Language.Modula2.Abstract". This way it can be replaced by
+-- another data type for another language while leaving other types to be reused.
+
+module Language.Modula2.AST (module Language.Modula2.AST,
+                             Abstract.Ident,
+                             Oberon.Value(..), Oberon.Element(..),
+                             Oberon.FormalParameters(..), Oberon.FPSection(..),
+                             Oberon.Block(..), Oberon.StatementSequence(..),
+                             Oberon.Case(..), Oberon.CaseLabels(..), Oberon.ConditionalBranch(..),
+                             Oberon.RelOp(..)) where
+
+import Control.Applicative (ZipList(ZipList, getZipList))
+import Control.Monad (forM, mapM)
+import Data.Coerce (coerce)
+import Data.Data (Data, Typeable)
+import Data.List.NonEmpty
+import Data.Text (Text)
+
+import qualified Transformation.Shallow.TH
+import qualified Transformation.Deep.TH
+import qualified Rank2 as Rank2
+import qualified Rank2.TH
+
+import qualified Language.Modula2.Abstract as Abstract
+import Language.Modula2.Abstract (Ident)
+import qualified Language.Oberon.AST as Oberon
+
+-- | Data type representing the Modula-2 language, as originally specified by ''Report on the Programming Language
+-- Modula-2''.
+data Language = Language deriving (Data, Typeable)
+
+instance Abstract.Wirthy Language where
+   type Module Language = Module Language
+   type Declaration Language = Declaration True Language
+   type Type Language = Type Language
+   type Statement Language = Statement Language
+   type Expression Language = Expression Language
+   type Value Language = Oberon.Value Language
+   type Designator Language = Designator Language
+
+   type Import Language = Import Language
+   type FieldList Language = FieldList Language
+   type ProcedureHeading Language = ProcedureHeading Language
+   type FormalParameters Language = Oberon.FormalParameters Language
+   type FPSection Language = Oberon.FPSection Language
+   type Block Language = Oberon.Block Language
+   type StatementSequence Language = Oberon.StatementSequence Language
+   type Case Language = Oberon.Case Language
+   type CaseLabels Language = Oberon.CaseLabels Language
+   type ConditionalBranch Language = Oberon.ConditionalBranch Language
+   type Element Language = Oberon.Element Language
+
+   type IdentDef Language = IdentDef Language
+   type QualIdent Language = QualIdent Language
+
+   -- Declaration
+   constantDeclaration = ConstantDeclaration
+   typeDeclaration = TypeDeclaration
+   variableDeclaration = VariableDeclaration
+   procedureDeclaration = ProcedureDeclaration
+
+   formalParameters = Oberon.FormalParameters . ZipList
+   fpSection = Oberon.FPSection
+   block = Oberon.Block . ZipList
+   
+   fieldList = FieldList
+
+   -- Type
+   pointerType = PointerType
+   procedureType = ProcedureType
+   typeReference = TypeReference
+
+   -- Statement
+   assignment = Assignment
+   caseStatement scrutinee cases = CaseStatement scrutinee (ZipList cases)
+   emptyStatement = EmptyStatement
+   exitStatement = Exit
+   ifStatement (branch :| branches) = If branch (ZipList branches)
+   loopStatement = Loop
+   procedureCall proc args = ProcedureCall proc (ZipList <$> args)
+   repeatStatement = Repeat
+   returnStatement = Return
+   whileStatement = While
+
+   conditionalBranch = Oberon.ConditionalBranch
+   caseAlternative (c :| cs) = Oberon.Case c (ZipList cs)
+   labelRange = Oberon.LabelRange
+   singleLabel = Oberon.SingleLabel
+   
+   statementSequence = Oberon.StatementSequence . ZipList
+
+   -- Expression
+   add = Add
+   subtract = Subtract
+   and = And
+   or = Or
+   divide = Divide
+   integerDivide = IntegerDivide
+   literal = Literal
+   modulo = Modulo
+   multiply = Multiply
+   functionCall fun args = FunctionCall fun (ZipList args)
+   negative = Negative
+   positive = Positive
+   not = Not
+   read = Read
+   relation = Relation
+
+   element = Oberon.Element
+   range = Oberon.Range
+
+   -- Value
+   builtin = Oberon.Builtin
+   integer = Oberon.Integer
+   nil = Oberon.Nil
+   real = Oberon.Real
+   string = Oberon.String
+   charCode = Oberon.CharCode
+   false = Oberon.Boolean False
+   true = Oberon.Boolean True
+
+   -- Designator
+   variable = Variable
+   field = Field
+   index array (index :| indexes) = Index array index (ZipList indexes)
+   dereference = Dereference
+
+   -- Identifier
+   identDef = IdentDef
+   nonQualIdent = QualIdent []
+
+instance Abstract.CoWirthy Language where
+   type TargetClass Language = Abstract.Modula2
+   coDeclaration (ConstantDeclaration name value) = Abstract.constantDeclaration name value
+   coDeclaration (TypeDeclaration name ty) = Abstract.typeDeclaration name ty
+   coDeclaration (VariableDeclaration name ty) = Abstract.variableDeclaration name ty
+   coDeclaration (ProcedureDeclaration heading body) = Abstract.procedureDeclaration heading body
+   coDeclaration (ModuleDeclaration name priority imports exports body) =
+      Abstract.moduleDeclaration name priority imports exports body
+
+   coType (ArrayType dimensions itemType) = Abstract.arrayType (getZipList dimensions) itemType
+   coType (EnumerationType names) = Abstract.enumeration names
+   coType (PointerType destination) = Abstract.pointerType destination
+   coType (ProcedureType params) = Abstract.procedureType params
+   coType (RecordType fields) = Abstract.recordType (getZipList fields)
+   coType (SetType itemType) = Abstract.setType itemType
+   coType (SubrangeType base low high) = Abstract.subRange base low high
+   coType (TypeReference q) = Abstract.typeReference q
+
+   coStatement EmptyStatement = Abstract.emptyStatement
+   coStatement (Assignment destination expression) = Abstract.assignment destination expression
+   coStatement (ProcedureCall procedure parameters) = Abstract.procedureCall procedure $ getZipList <$> parameters
+   coStatement (If branch elsifs fallback) = Abstract.ifStatement (branch :| getZipList elsifs) fallback
+   coStatement (CaseStatement scrutinee cases fallback) =
+      Abstract.caseStatement scrutinee (getZipList cases) fallback
+   coStatement (While condition body) = Abstract.whileStatement condition body
+   coStatement (Repeat body condition) = Abstract.repeatStatement body condition
+   coStatement (For index from to by body) = Abstract.forStatement index from to by body
+   coStatement (Loop body) = Abstract.loopStatement body
+   coStatement (With designator body) = Abstract.withStatement designator body
+   coStatement Exit = Abstract.exitStatement
+   coStatement (Return result) = Abstract.returnStatement result
+
+   coExpression (Relation op left right) = Abstract.relation op left right
+   coExpression (Positive e) = Abstract.positive e
+   coExpression (Negative e) = Abstract.negative e
+   coExpression (Add left right) = Abstract.add left right
+   coExpression (Subtract left right) = Abstract.subtract left right
+   coExpression (Or left right) = Abstract.or left right
+   coExpression (Multiply left right) = Abstract.multiply left right
+   coExpression (Divide left right) = Abstract.divide left right
+   coExpression (IntegerDivide left right) = Abstract.integerDivide left right
+   coExpression (Literal value) = Abstract.literal value
+   coExpression (Modulo left right) = Abstract.modulo left right
+   coExpression (And left right) = Abstract.and left right
+   coExpression (Set itemType elements) = Abstract.set itemType (getZipList elements)
+   coExpression (Read var) = Abstract.read var
+   coExpression (FunctionCall function parameters) = Abstract.functionCall function $ getZipList parameters
+   coExpression (Not e) = Abstract.not e
+
+   coValue Oberon.Nil = Abstract.nil
+   coValue (Oberon.Boolean False) = Abstract.false
+   coValue (Oberon.Boolean True) = Abstract.true
+   coValue (Oberon.Builtin name) = Abstract.builtin name
+   coValue (Oberon.Integer n) = Abstract.integer n
+   coValue (Oberon.Real r) = Abstract.real r
+   coValue (Oberon.String s) = Abstract.string s
+   coValue (Oberon.CharCode c) = Abstract.charCode c
+
+   coDesignator (Variable q) = Abstract.variable q
+   coDesignator (Field record name) = Abstract.field record name
+   coDesignator (Index array index indexes) = Abstract.index array (index :| getZipList indexes)
+   coDesignator (Dereference pointer) = Abstract.dereference pointer
+
+instance Abstract.Nameable Language where
+   getProcedureName (ProcedureHeading name _) = name
+   getIdentDefName (IdentDef n) = n
+   getNonQualIdentName (QualIdent [] name) = Just name
+   getNonQualIdentName _ = Nothing
+
+instance Abstract.Modula2 Language where
+   type Export Language = Export Language
+   type Definition Language = Declaration False Language
+   type Variant Language = Variant Language
+
+   -- Module
+   definitionModule name imports exports definitions = DefinitionModule name imports exports (ZipList definitions)
+   implementationModule = ImplementationModule
+   programModule = ProgramModule
+
+   moduleExport = Export
+   moduleImport = Import
+   
+   -- Definition
+   constantDefinition = ConstantDeclaration
+   typeDefinition = \name-> maybe (OpaqueTypeDeclaration name) (TypeDeclaration name)
+   variableDefinition = VariableDeclaration
+   procedureDefinition = ProcedureDefinition
+
+   -- Declaration
+   moduleDeclaration = ModuleDeclaration
+
+   -- Type
+   arrayType = ArrayType . ZipList
+   recordType = RecordType . ZipList
+
+   procedureHeading = ProcedureHeading
+   caseFieldList n t (variant :| variants) fallback = CaseFieldList n t variant (ZipList variants) (ZipList fallback)
+   variant (case1 :| cases) fields = Variant case1 (ZipList cases) (ZipList fields)
+
+   forStatement = For
+   withStatement = With
+
+   enumeration = EnumerationType
+   subRange = SubrangeType
+   setType = SetType
+   
+   set memberType members = Set memberType (ZipList members)
+   qualIdent = QualIdent
+
+newtype IdentDef l = IdentDef Ident deriving (Data, Eq, Ord, Show)
+
+data Module λ l f' f = DefinitionModule Ident
+                          [Abstract.Import l] (Maybe (Abstract.Export l)) (ZipList (f (Abstract.Definition l l f' f')))
+                     | ImplementationModule Ident (Maybe (f (Abstract.Priority l l f' f')))
+                          [Abstract.Import l] (f (Abstract.Block l l f' f'))
+                     | ProgramModule Ident (Maybe (f (Abstract.Priority l l f' f')))
+                          [Abstract.Import l] (f (Abstract.Block l l f' f'))
+
+data Import λ = Import (Maybe Ident) (NonEmpty Ident) deriving (Data, Show)
+data Export λ = Export Bool (NonEmpty Ident) deriving (Data, Show)
+
+deriving instance (Typeable λ, Typeable l, Typeable f, Typeable f', Data (Abstract.Import l), Data (Abstract.Export l),
+                   Data (f (Abstract.Priority l l f' f')),
+                   Data (f (Abstract.Declaration l l f' f')), Data (f (Abstract.Definition l l f' f')),
+                   Data (f (Abstract.Block l l f' f'))) => Data (Module λ l f' f)
+deriving instance (Show (Abstract.Import l), Show (Abstract.Export l), Show (f (Abstract.Priority l l f' f')),
+                   Show (f (Abstract.Declaration l l f' f')), Show (f (Abstract.Definition l l f' f')),
+                   Show (f (Abstract.Block l l f' f'))) => Show (Module λ l f' f)
+
+data Declaration (full :: Bool) λ l (f' :: * -> *) (f :: * -> *) where
+   ConstantDeclaration :: Abstract.IdentDef l -> f (Abstract.ConstExpression l l f' f') -> Declaration x λ l f' f
+   TypeDeclaration :: Abstract.IdentDef l -> f (Abstract.Type l l f' f') -> Declaration x λ l f' f
+   OpaqueTypeDeclaration :: Abstract.IdentDef l -> Declaration False λ l f' f
+   VariableDeclaration :: Abstract.IdentList l -> f (Abstract.Type l l f' f') -> Declaration x λ l f' f
+   ProcedureDeclaration :: f (Abstract.ProcedureHeading l l f' f') -> f (Abstract.Block l l f' f')
+                        -> Declaration True λ l f' f
+   ProcedureDefinition :: f (Abstract.ProcedureHeading l l f' f') -> Declaration False λ l f' f
+   ModuleDeclaration :: Ident -> Maybe (f (Abstract.Priority l l f' f')) -> [Abstract.Import l]
+                     -> Maybe (Abstract.Export l) -> f (Abstract.Block l l f' f') -> Declaration True λ l f' f
+
+{-
+deriving instance (Data l, Typeable x, Typeable f, Typeable f', Show (Abstract.Import l),
+                   Data (Abstract.Import l), Data (f (Abstract.Type l l f' f')), Data (f (Abstract.ConstExpression l l f' f')),
+                   Data (f (Abstract.FormalParameters l l f' f')), Data (f (Abstract.ProcedureHeading l l f' f')),
+                   Data (f (Abstract.Block l l f' f')), Data (Abstract.IdentDef l)) => Data (Declaration x l f' f)
+-}
+deriving instance (Show (Abstract.Export l), Show (Abstract.Import l),
+                   Show (f (Abstract.Type l l f' f')), Show (f (Abstract.ConstExpression l l f' f')),
+                   Show (f (Abstract.FormalParameters l l f' f')), Show (f (Abstract.ProcedureHeading l l f' f')),
+                   Show (f (Abstract.Block l l f' f')), Show (f (Abstract.Block l l f' f')),
+                   Show (Abstract.IdentDef l)) => Show (Declaration λ x l f' f)
+
+data QualIdent l = QualIdent [Ident] Ident 
+   deriving (Data, Eq, Ord, Show)
+
+data Expression λ l f' f = Relation Oberon.RelOp (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | Positive (f (Abstract.Expression l l f' f'))
+                         | Negative (f (Abstract.Expression l l f' f'))
+                         | Add (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | Subtract (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | Or (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | Multiply (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | Divide (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | IntegerDivide (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | Modulo (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | And (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | Set (Maybe (Abstract.QualIdent l)) (ZipList (f (Abstract.Element l l f' f')))
+                         | Read (f (Abstract.Designator l l f' f'))
+                         | FunctionCall (f (Abstract.Designator l l f' f')) (ZipList (f (Abstract.Expression l l f' f')))
+                         | Not (f (Abstract.Expression l l f' f'))
+                         | Literal (f (Abstract.Value l l f' f'))
+
+deriving instance (Typeable λ, Typeable l, Typeable f, Typeable f', Data (Abstract.QualIdent l),
+                   Data (f (Abstract.Designator l l f' f')), Data (f (Abstract.Element l l f' f')),
+                   Data (f (Abstract.Value l l f' f')), Data (f (Abstract.Expression l l f' f'))) =>
+                  Data (Expression λ l f' f)
+deriving instance (Show (Abstract.QualIdent l), Show (f (Abstract.Designator l l f' f')),
+                   Show (f (Abstract.Element l l f' f')), Show (f (Abstract.Value l l f' f')),
+                   Show (f (Abstract.Expression l l f' f'))) =>
+                  Show (Expression λ l f' f)
+deriving instance (Eq (Abstract.QualIdent l), Eq (f (Abstract.Designator l l f' f')),
+                   Eq (f (Abstract.Element l l f' f')), Eq (f (Abstract.Value l l f' f')),
+                   Eq (f (Abstract.Expression l l f' f'))) =>
+                  Eq (Expression λ l f' f)
+
+data Designator λ l f' f = Variable (Abstract.QualIdent l)
+                         | Field (f (Abstract.Designator l l f' f')) Ident 
+                         | Index (f (Abstract.Designator l l f' f'))
+                                 (f (Abstract.Expression l l f' f')) (ZipList (f (Abstract.Expression l l f' f')))
+                         | Dereference (f (Abstract.Designator l l f' f'))
+
+deriving instance (Typeable λ, Typeable l, Typeable f, Typeable f', Data (Abstract.QualIdent l),
+                   Data (f (Abstract.Designator l l f' f')), Data (f (Abstract.Expression l l f' f'))) =>
+                  Data (Designator λ l f' f)
+deriving instance (Show (Abstract.QualIdent l), Show (f (Abstract.Designator l l f' f')),
+                   Show (f (Abstract.Expression l l f' f'))) => Show (Designator λ l f' f)
+deriving instance (Eq (Abstract.QualIdent l), Eq (f (Abstract.Designator l l f' f')),
+                   Eq (f (Abstract.Expression l l f' f'))) => Eq (Designator λ l f' f)
+
+data Type λ l f' f = TypeReference (Abstract.QualIdent l)
+                   | ArrayType (ZipList (f (Abstract.Type l l f' f'))) (f (Abstract.Type l l f' f'))
+                   | EnumerationType (Abstract.IdentList l)
+                   | SubrangeType (Maybe (Abstract.QualIdent l))
+                                  (f (Abstract.ConstExpression l l f' f')) (f (Abstract.ConstExpression l l f' f'))
+                   | SetType (f (Abstract.Type l l f' f'))
+                   | RecordType (ZipList (f (Abstract.FieldList l l f' f')))
+                   | PointerType (f (Abstract.Type l l f' f'))
+                   | ProcedureType (Maybe (f (Abstract.FormalParameters l l f' f')))
+
+deriving instance (Typeable λ, Typeable l, Typeable f, Typeable f',
+                   Data (Abstract.QualIdent l), Data (Abstract.IdentList l),
+                   Data (f (Abstract.Type l l f' f')), Data (f (Abstract.ConstExpression l l f' f')),
+                   Data (f (Abstract.FormalParameters l l f' f')), Data (f (Abstract.FieldList l l f' f'))) =>
+                  Data (Type λ l f' f)
+deriving instance (Show (Abstract.QualIdent l), Show (Abstract.IdentList l), Show (f (Abstract.Type l l f' f')),
+                   Show (f (Abstract.ConstExpression l l f' f')), Show (f (Abstract.FormalParameters l l f' f')),
+                   Show (f (Abstract.FieldList l l f' f'))) =>
+                  Show (Type λ l f' f)
+
+data FieldList λ l f' f = FieldList (Abstract.IdentList l) (f (Abstract.Type l l f' f'))
+                        | CaseFieldList (Maybe Ident) (Abstract.QualIdent l)
+                                        (f (Abstract.Variant l l f' f')) (ZipList (f (Abstract.Variant l l f' f')))
+                                        (ZipList (f (Abstract.FieldList l l f' f')))
+
+data Variant λ l f' f =
+  Variant (f (Abstract.CaseLabels l l f' f')) (ZipList (f (Abstract.CaseLabels l l f' f')))
+          (ZipList (f (Abstract.FieldList l l f' f')))
+
+deriving instance (Typeable λ, Typeable l, Typeable f, Typeable f',
+                   Data (Abstract.QualIdent l), Data (Abstract.IdentList l), Data (f (Abstract.Type l l f' f')),
+                   Data (f (Abstract.Expression l l f' f')), Data (f (Abstract.Variant l l f' f')),
+                   Data (f (Abstract.FieldList l l f' f'))) => Data (FieldList λ l f' f)
+deriving instance (Show (Abstract.QualIdent l), Show (Abstract.IdentList l), Show (f (Abstract.Type l l f' f')),
+                   Show (f (Abstract.Expression l l f' f')), Show (f (Abstract.Variant l l f' f')),
+                   Show (f (Abstract.FieldList l l f' f'))) => Show (FieldList λ l f' f)
+
+deriving instance (Typeable λ, Typeable l, Typeable f, Typeable f', Data (f (Abstract.CaseLabels l l f' f')),
+                   Data (f (Abstract.FieldList l l f' f'))) => Data (Variant λ l f' f)
+deriving instance (Show (f (Abstract.CaseLabels l l f' f')), Show (f (Abstract.FieldList l l f' f')))
+               => Show (Variant λ l f' f)
+
+data ProcedureHeading λ l f' f = ProcedureHeading Ident (Maybe (f (Abstract.FormalParameters l l f' f')))
+
+deriving instance (Typeable λ, Typeable l, Typeable f, Typeable f', Data (f (Abstract.FormalParameters l l f' f'))) =>
+                  Data (ProcedureHeading λ l f' f)
+deriving instance (Show (f (Abstract.FormalParameters l l f' f'))) =>
+                  Show (ProcedureHeading λ l f' f)
+
+data Statement λ l f' f = EmptyStatement
+                        | Assignment (f (Abstract.Designator l l f' f')) (f (Abstract.Expression l l f' f'))
+                        | ProcedureCall (f (Abstract.Designator l l f' f')) (Maybe (ZipList (f (Abstract.Expression l l f' f'))))
+                        | If (f (Abstract.ConditionalBranch l l f' f'))
+                             (ZipList (f (Abstract.ConditionalBranch l l f' f')))
+                             (Maybe (f (Abstract.StatementSequence l l f' f')))
+                        | CaseStatement (f (Abstract.Expression l l f' f')) 
+                                        (ZipList (f (Abstract.Case l l f' f')))
+                                        (Maybe (f (Abstract.StatementSequence l l f' f')))
+                        | While (f (Abstract.Expression l l f' f')) (f (Abstract.StatementSequence l l f' f'))
+                        | Repeat (f (Abstract.StatementSequence l l f' f')) (f (Abstract.Expression l l f' f'))
+                        | For Ident (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f')) 
+                              (Maybe (f (Abstract.Expression l l f' f'))) (f (Abstract.StatementSequence l l f' f'))
+                        | Loop (f (Abstract.StatementSequence l l f' f'))
+                        | With (f (Abstract.Designator l l f' f')) (f (Abstract.StatementSequence l l f' f'))
+                        | Exit
+                        | Return (Maybe (f (Abstract.Expression l l f' f')))
+
+deriving instance (Typeable λ, Typeable l, Typeable f, Typeable f',
+                   Data (f (Abstract.Designator l l f' f')), Data (f (Abstract.Expression l l f' f')),
+                   Data (f (Abstract.Case l l f' f')), Data (f (Abstract.ConditionalBranch l l f' f')),
+                   Data (f (Abstract.StatementSequence l l f' f'))) => Data (Statement λ l f' f)
+deriving instance (Show (f (Abstract.Designator l l f' f')), Show (f (Abstract.Expression l l f' f')),
+                   Show (f (Abstract.Case l l f' f')), Show (f (Abstract.ConditionalBranch l l f' f')),
+                   Show (f (Abstract.StatementSequence l l f' f'))) => Show (Statement λ l f' f)
+
+$(concat <$>
+  (forM [Rank2.TH.deriveFunctor, Rank2.TH.deriveFoldable, Rank2.TH.deriveTraversable,
+         Transformation.Shallow.TH.deriveAll, Transformation.Deep.TH.deriveAll] $
+   \derive-> mconcat <$> mapM derive
+             [''Module, ''Declaration, ''Type, ''Statement, ''Expression,
+              ''Designator, ''FieldList, ''Variant, ''ProcedureHeading]))
+
+$(mconcat <$> mapM Rank2.TH.unsafeDeriveApply
+   [''Module, ''Declaration, ''Type, ''Statement, ''Expression,
+     ''Designator, ''FieldList, ''Variant, ''ProcedureHeading])
diff --git a/src/Language/Modula2/Abstract.hs b/src/Language/Modula2/Abstract.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Modula2/Abstract.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE DeriveDataTypeable, KindSignatures, PolyKinds, ScopedTypeVariables,
+             TypeApplications, TypeFamilies, TypeFamilyDependencies, UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
+
+-- | Finally Tagless Abstract Syntax Tree definitions for the programming language Modula-2
+
+module Language.Modula2.Abstract (Ident, IdentList, BaseType, ConstExpression, Priority,
+                                  Wirthy(..), CoWirthy(..), Nameable(..), Modula2(..),
+                                  RelOp(..), WirthySubsetOf(..), Maybe3(..), just3, maybe3, nothing3) where
+
+import Data.Data (Data, Typeable)
+import Data.List.NonEmpty
+import Data.Text (Text)
+
+import Language.Oberon.Abstract
+
+-- | Module priority
+type Priority l = ConstExpression l
+
+-- | The finally-tagless associated types and methods relevant to the Modula-2 language. Every non-leaf node type has
+-- four type variables:
+--
+-- * type variable @l@ represents the language of the constructs built by the methods,
+-- * @l'@ is the language of the child node constructs,
+-- * @f'@ wraps all descendant nodes, except
+-- * @f@ wraps all direct children of the node.
+class Wirthy l => Modula2 l where
+   type Export l = x | x -> l
+   type Definition l = (d :: * -> (* -> *) -> (* -> *) -> *) | d -> l
+   type Variant l = (v :: * -> (* -> *) -> (* -> *) -> *) | v -> l
+
+   -- Module
+   definitionModule :: Ident -> [Import l'] -> Maybe (Export l') -> [f (Definition l' l' f' f')] -> Module l l' f' f
+   implementationModule,
+      programModule :: Ident -> Maybe (f (Priority l' l' f' f')) -> [Import l'] -> f (Block l' l' f' f')
+                    -> Module l l' f' f
+
+   moduleExport :: Bool -> NonEmpty Ident -> Export l
+   moduleImport :: Maybe Ident -> NonEmpty Ident -> Import l
+
+   -- Definition
+   constantDefinition :: IdentDef l' -> f (ConstExpression l' l' f' f') -> Definition l l' f' f
+   typeDefinition :: IdentDef l' -> Maybe (f (Type l' l' f' f')) -> Definition l l' f' f
+   variableDefinition :: IdentList l' -> f (Type l' l' f' f') -> Definition l l' f' f
+   procedureDefinition :: f (ProcedureHeading l' l' f' f') -> Definition l l' f' f
+
+   -- Declaration
+   moduleDeclaration :: Ident -> Maybe (f (Priority l' l' f' f'))
+                     -> [Import l'] -> Maybe (Export l') -> f (Block l' l' f' f') -> Declaration l l' f' f
+
+   procedureHeading :: Ident -> Maybe (f (FormalParameters l' l' f' f')) -> ProcedureHeading l l' f' f
+   caseFieldList :: Maybe Ident -> QualIdent l' -> NonEmpty (f (Variant l' l' f' f')) -> [f (FieldList l' l' f' f')]
+                 -> FieldList l l' f' f
+   variant :: NonEmpty (f (CaseLabels l' l' f' f')) -> [f (FieldList l' l' f' f')] -> Variant l l' f' f
+
+   -- Type
+   enumeration :: IdentList l' -> Type l l' f' f
+   subRange :: Maybe (QualIdent l') -> f (ConstExpression l' l' f' f') -> f (ConstExpression l' l' f' f')
+            -> Type l l' f' f
+   arrayType :: [f (Type l' l' f' f')] -> f (Type l' l' f' f') -> Type l l' f' f
+   setType :: f (Type l' l' f' f') -> Type l l' f' f
+   recordType :: [f (FieldList l' l' f' f')] -> Type l l' f' f
+
+   -- Statement
+   withStatement :: f (Designator l' l' f' f') -> f (StatementSequence l' l' f' f') -> Statement l l' f' f
+   forStatement :: Ident -> f (Expression l' l' f' f') -> f (Expression l' l' f' f')
+                -> Maybe (f (Expression l' l' f' f')) -> f (StatementSequence l' l' f' f')
+                -> Statement l l' f' f
+
+   -- Expression
+   set :: Maybe (QualIdent l') -> [f (Element l' l' f' f')] -> Expression l l' f' f
+   qualIdent :: [Ident] -> Ident -> QualIdent l
+
+instance Wirthy l => Modula2 (WirthySubsetOf l) where
+   type Export (WirthySubsetOf l) = Maybe (Export l)
+   type Definition (WirthySubsetOf l) = Maybe3 (Definition l)
+   type Variant (WirthySubsetOf l) = Maybe3 (Variant l)
+   definitionModule = const $ const $ const $ const nothing3
+   implementationModule = const $ const $ const $ const nothing3
+   programModule = const $ const $ const $ const nothing3
+
+   moduleExport = const $ const Nothing
+   moduleImport = const $ const Nothing
+
+   -- Definition
+   constantDefinition = const $ const nothing3
+   typeDefinition = const $ const nothing3
+   variableDefinition = const $ const nothing3
+   procedureDefinition = const nothing3
+
+   -- Declaration
+   moduleDeclaration = const $ const $ const $ const $ const nothing3
+
+   procedureHeading = const $ const nothing3
+   caseFieldList = const $ const $ const $ const nothing3
+   variant = const $ const nothing3
+
+   -- Type
+   enumeration = const nothing3
+   subRange = const $ const $ const nothing3
+   arrayType = const $ const nothing3
+   setType = const nothing3
+   recordType = const nothing3
+
+   -- Statement
+   withStatement = const $ const nothing3
+   forStatement = const $ const $ const $ const $ const nothing3
+
+   -- Expression
+   set = const $ const nothing3
+   qualIdent = const $ const Nothing
diff --git a/src/Language/Modula2/ConstantFolder.hs b/src/Language/Modula2/ConstantFolder.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Modula2/ConstantFolder.hs
@@ -0,0 +1,443 @@
+{-# LANGUAGE DataKinds, DeriveGeneric, DuplicateRecordFields, FlexibleContexts, FlexibleInstances,
+             MultiParamTypeClasses, OverloadedStrings, RankNTypes,
+             ScopedTypeVariables, TemplateHaskell, TypeFamilies, UndecidableInstances #-}
+
+-- | The main export of this module is the function 'foldConstants' that folds the constants in a Modula-2 AST using
+-- an attribute grammar. Other exports are helper functions and attribute types that can be reused for other languages
+-- or attribute grammars.
+
+module Language.Modula2.ConstantFolder (foldConstants,
+                                        ConstantFold, Sem, Environment,
+                                        InhCF, SynCF(..), SynCFDesignator(..), SynCFExp(..), SynCFMod(..), SynCFMod',
+                                        foldBinaryArithmetic, foldBinaryBoolean,
+                                        foldBinaryFractional, foldBinaryInteger,
+                                        maxCardinal, maxInteger, minInteger, maxInt32, minInt32, maxSet, minSet,
+                                        doubleSize, floatSize, intSize, int32Size,
+                                        maxReal, minReal) where
+
+import Control.Applicative (liftA2, ZipList(ZipList, getZipList))
+import Control.Arrow (first)
+import Control.Monad (join)
+import Data.Bits (shift)
+import Data.Char (chr, ord, toUpper)
+import Data.Functor.Identity (Identity(..))
+import Data.Int (Int32)
+import Data.Foldable (fold)
+import Data.List.NonEmpty (NonEmpty((:|)), toList)
+import Data.Map.Lazy (Map)
+import qualified Data.Map.Lazy as Map
+import Data.Semigroup (Semigroup(..))
+import qualified Data.Text as Text
+import Foreign.Storable (sizeOf)
+import GHC.Generics (Generic)
+import Language.Haskell.TH (appT, conT, varT, varE, newName)
+import Data.Text.Prettyprint.Doc (Pretty)
+
+import qualified Rank2
+import qualified Transformation
+import qualified Transformation.Deep as Deep
+import qualified Transformation.Full as Full
+import qualified Transformation.Full.TH
+import qualified Transformation.AG as AG
+import Transformation.AG (Attribution(..), Atts, Inherited(..), Synthesized(..), Semantics)
+import Transformation.AG.Generics (Bequether(..), Synthesizer(..), SynthesizedField(..), Auto(Auto), Mapped(..))
+
+import qualified Language.Modula2.Abstract as Abstract
+import qualified Language.Modula2.AST as AST
+import Language.Modula2.Grammar (ParsedLexemes(Trailing), Lexeme(WhiteSpace))
+import qualified Language.Oberon.Abstract as Oberon.Abstract
+import qualified Language.Oberon.AST as Oberon.AST
+import qualified Language.Oberon.ConstantFolder as Oberon
+import Language.Oberon.ConstantFolder (ConstantFold(ConstantFold), Sem, Environment,
+                                       InhCF(..), InhCFRoot(..), SynCF(..), SynCF',
+                                       SynCFRoot(..), SynCFMod(..), SynCFDesignator(..), SynCFMod', SynCFExp(..),
+                                       anyWhitespace, folded', foldedExp, foldedExp')
+
+-- | Fold the constants in the given collection of Modula-2 modules (a 'Map' of modules keyed by module name). It uses
+-- the constant declarations from the modules as well as the given 'Environment' of predefined constants and
+-- functions.
+--
+-- Note that the Modula-2 'AST.Language' satisfies all constraints in the function's type signature.
+foldConstants :: forall l. (Abstract.Modula2 l, Abstract.Nameable l,
+                            Ord (Abstract.QualIdent l), Show (Abstract.QualIdent l),
+                            Atts (Inherited (Auto ConstantFold)) (Abstract.Block l l Sem Sem) ~ InhCF l,
+                            Atts (Inherited (Auto ConstantFold)) (Abstract.Definition l l Sem Sem) ~ InhCF l,
+                            Atts (Inherited (Auto ConstantFold)) (Abstract.Expression l l Sem Sem) ~ InhCF l,
+                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Block l l Sem Sem)
+                            ~ SynCFMod' l (Abstract.Block l l),
+                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Block l l Placed Placed)
+                            ~ SynCFMod' l (Abstract.Block l l),
+                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Definition l l Sem Sem)
+                            ~ SynCFMod' l (Abstract.Definition l l),
+                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Definition l l Placed Placed)
+                            ~ SynCFMod' l (Abstract.Definition l l),
+                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Expression l l Sem Sem) ~ SynCFExp l l,
+                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Expression l l Placed Placed)
+                            ~ SynCFExp l l,
+                            Full.Functor (Auto ConstantFold) (Abstract.Block l l),
+                            Full.Functor (Auto ConstantFold) (Abstract.Definition l l),
+                            Full.Functor (Auto ConstantFold) (Abstract.Expression l l))
+              => Environment l -> AST.Module l l Placed Placed -> AST.Module l l Placed Placed
+foldConstants predef aModule =
+   snd $ getMapped
+   $ folded (syn (Transformation.apply (Auto ConstantFold) ((0, Trailing [], 0), Auto ConstantFold Deep.<$> aModule)
+                  `Rank2.apply`
+                  Inherited (InhCF predef undefined))
+             :: SynCFMod' l (AST.Module l l))
+
+newtype Modules l f' f = Modules {getModules :: Map AST.Ident (f (AST.Module l l f' f'))}
+
+-- * Modules instances, TH candidates
+instance (Transformation.Transformation t, Functor (Transformation.Domain t), Deep.Functor t (AST.Module l l),
+          Transformation.At t (AST.Module l l (Transformation.Codomain t) (Transformation.Codomain t))) =>
+         Deep.Functor t (Modules l) where
+   t <$> ~(Modules ms) = Modules (mapModule <$> ms)
+      where mapModule m = t Transformation.$ ((t Deep.<$>) <$> m)
+
+instance Rank2.Functor (Modules l f') where
+   f <$> ~(Modules ms) = Modules (f <$> ms)
+
+instance Rank2.Apply (Modules l f') where
+   ~(Modules fs) <*> ~(Modules ms) = Modules (Map.intersectionWith Rank2.apply fs ms)
+
+-- * Boring attribute types
+type instance Atts (Synthesized (Auto ConstantFold)) (Modules l _ _) = SynCFRoot (Modules l Placed Identity)
+type instance Atts (Synthesized (Auto ConstantFold)) (AST.Module λ l _ _) = SynCFMod' l (AST.Module λ l)
+type instance Atts (Synthesized (Auto ConstantFold)) (AST.Declaration full λ l _ _) = SynCFMod' l (AST.Declaration full λ l)
+type instance Atts (Synthesized (Auto ConstantFold)) (AST.ProcedureHeading λ l _ _) = SynCF' (AST.ProcedureHeading λ l)
+type instance Atts (Synthesized (Auto ConstantFold)) (AST.Type λ l _ _) = SynCF' (AST.Type λ l)
+type instance Atts (Synthesized (Auto ConstantFold)) (AST.FieldList λ l _ _) = SynCF' (AST.FieldList λ l)
+type instance Atts (Synthesized (Auto ConstantFold)) (AST.Expression λ l _ _) = SynCFExp λ l
+type instance Atts (Synthesized (Auto ConstantFold)) (AST.Designator λ l _ _) = SynCFDesignator l
+type instance Atts (Synthesized (Auto ConstantFold)) (AST.Statement λ l _ _) = SynCF' (AST.Statement λ l)
+type instance Atts (Synthesized (Auto ConstantFold)) (AST.Variant λ l _ _) = SynCF' (AST.Variant λ l)
+
+type instance Atts (Inherited (Auto ConstantFold)) (Modules l _ _) = InhCFRoot l
+type instance Atts (Inherited (Auto ConstantFold)) (AST.Module λ l _ _) = InhCF λ
+type instance Atts (Inherited (Auto ConstantFold)) (AST.Declaration full λ l _ _) = InhCF λ
+type instance Atts (Inherited (Auto ConstantFold)) (AST.ProcedureHeading λ l _ _) = InhCF λ
+type instance Atts (Inherited (Auto ConstantFold)) (AST.Type λ l _ _) = InhCF λ
+type instance Atts (Inherited (Auto ConstantFold)) (AST.FieldList λ l _ _) = InhCF λ
+type instance Atts (Inherited (Auto ConstantFold)) (AST.Expression λ l _ _) = InhCF λ
+type instance Atts (Inherited (Auto ConstantFold)) (AST.Designator λ l _ _) = InhCF λ
+type instance Atts (Inherited (Auto ConstantFold)) (AST.Statement λ l _ _) = InhCF λ
+type instance Atts (Inherited (Auto ConstantFold)) (AST.Variant λ l _ _) = InhCF λ
+
+type Placed = (,) (Int, ParsedLexemes, Int)
+
+wrap :: a -> Mapped Placed a
+wrap = Mapped . (,) (0, Trailing [], 0)
+
+-- * Rules
+
+instance Ord (Abstract.QualIdent l) => Attribution (Auto ConstantFold) (Modules l) Sem Placed where
+   attribution _ (_, Modules self) (Inherited inheritance, Modules ms) =
+     (Synthesized SynCFRoot{modulesFolded= Modules (pure . snd . getMapped . foldedModule . syn <$> ms)},
+      Modules (Map.mapWithKey moduleInheritance self))
+     where moduleInheritance name mod = Inherited InhCF{env= rootEnv inheritance <> foldMap (moduleEnv . syn) ms,
+                                                        currentModule= name}
+           foldedModule :: SynCFMod' l (AST.Module l l) -> Mapped Placed (AST.Module l l Placed Placed)
+           foldedModule = folded
+
+instance (Abstract.Modula2 l, Abstract.Nameable l, k ~ Abstract.QualIdent l, Ord k, Show k,
+          v ~ Abstract.Value l l Placed Placed,
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Block l l Sem Sem) ~ SynCFMod' l (Abstract.Block l l),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Definition l l Sem Sem)
+          ~ SynCFMod' l (Abstract.Definition l l),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Definition l l Placed Placed)
+          ~ SynCFMod' l (Abstract.Definition l l),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Expression l l Sem Sem) ~ SynCFExp l l) =>
+         SynthesizedField "moduleEnv" (Map k (Maybe v)) (Auto ConstantFold) (AST.Module l l) Sem Placed where
+   synthesizedField _ _ (_, mod) inheritance mod' =
+      case (mod, mod') of
+        (AST.DefinitionModule{}, AST.DefinitionModule _ _ _ definitions) -> foldMap (moduleEnv . syn) definitions
+        _ -> mempty
+
+instance (Abstract.Modula2 l, Abstract.Nameable l, k ~ Abstract.QualIdent l, Ord k, v ~ Abstract.Value l l Placed Placed,
+          Abstract.Export l ~ AST.Export l, Abstract.Value l ~ AST.Value l,
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Declaration l l Sem Sem)
+          ~ SynCFMod' l (Abstract.Declaration l l),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Type l l Sem Sem) ~ SynCF' (Abstract.Type l l),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.ProcedureHeading l l Sem Sem)
+          ~ SynCF' (Abstract.ProcedureHeading l l),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.FormalParameters l l Sem Sem)
+          ~ SynCF' (Abstract.FormalParameters l l),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Block l l Sem Sem) ~ SynCFMod' l (Abstract.Block l l),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.ConstExpression l l Sem Sem) ~ SynCFExp l l) =>
+         SynthesizedField "moduleEnv" (Map k (Maybe v)) (Auto ConstantFold) (AST.Declaration full l l) Sem Placed where
+   synthesizedField _ _ (_, AST.ConstantDeclaration namedef _) _ (AST.ConstantDeclaration _ expression) =
+      Map.singleton (Abstract.nonQualIdent $ Abstract.getIdentDefName namedef)
+                    ((snd <$>) . foldedValue $ syn expression)
+   synthesizedField _ _ (pos, AST.ModuleDeclaration moduleName _priority imports exports _body)
+                    _ (AST.ModuleDeclaration _name priority _imports _exports body) =
+      foldMap exportedEnv exports
+      where exportedEnv (AST.Export qualified names) =
+               Map.mapKeysMonotonic qualify (Map.filterWithKey (const . (`elem` exportList)) (moduleEnv $ syn body))
+               where exportList = Abstract.qualIdent [] <$> toList names
+                     qualify qname
+                        | qualified,
+                          Just name <- Abstract.getNonQualIdentName qname = Abstract.qualIdent [moduleName] name
+                        | otherwise = qname
+   synthesizedField _ _ _ _ _ = mempty
+
+instance (Abstract.Nameable l, Ord (Abstract.QualIdent l), Abstract.Modula2 λ,
+          Abstract.Value l ~ AST.Value l, Abstract.QualIdent l ~ AST.QualIdent l,
+          Pretty (AST.Value l l Identity Identity),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Expression l l Sem Sem) ~ SynCFExp l l,
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Element l l Sem Sem) ~ SynCF' (Abstract.Element l l),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Designator l l Sem Sem) ~ SynCFDesignator l) =>
+         Synthesizer (Auto ConstantFold) (AST.Expression λ l) Sem Placed where
+   synthesis _ (pos@(start, ls, end), AST.Relation op _ _) _ (AST.Relation _op left right) =
+      case join (compareValues <$> foldedValue (syn left) <*> foldedValue (syn right))
+      of Just value -> Oberon.literalSynthesis value
+         Nothing -> SynCFExp{folded= Mapped (pos,
+                                             Abstract.relation op (foldedExp' $ syn left) (foldedExp' $ syn right)),
+                             foldedValue= Nothing}
+      where compareValues (_, AST.Boolean l) (ls, AST.Boolean r)   = repos ls <$> relate op (compare l r)
+            compareValues (_, AST.Integer l) (ls, AST.Integer r)   = repos ls <$> relate op (compare l r)
+            compareValues (_, AST.Real l) (ls, AST.Real r)         = repos ls <$> relate op (compare l r)
+            compareValues (_, AST.Integer l) (ls, AST.Real r)      = repos ls <$> relate op (compare (fromIntegral l) r)
+            compareValues (_, AST.Real l) (ls, AST.Integer r)      = repos ls <$> relate op (compare l (fromIntegral r))
+            compareValues (_, AST.CharCode l) (ls, AST.CharCode r) = repos ls <$> relate op (compare l r)
+            compareValues (_, AST.String l) (ls, AST.String r)     = repos ls <$> relate op (compare l r)
+            compareValues (_, AST.CharCode l) (ls, AST.String r) = repos ls
+                                                                   <$> relate op (compare (Text.singleton $ chr l) r)
+            compareValues (_, AST.String l) (ls, AST.CharCode r) = repos ls
+                                                                   <$> relate op (compare l (Text.singleton $ chr r))
+            compareValues _ _                               = Nothing
+            repos (_, ls', _) v = ((start, anyWhitespace ls ls', end), v)
+            relate Abstract.Equal EQ          = Just Abstract.true
+            relate Abstract.Equal _           = Just Abstract.false
+            relate Abstract.Unequal EQ        = Just Abstract.false
+            relate Abstract.Unequal _         = Just Abstract.true
+            relate Abstract.Less LT           = Just Abstract.true
+            relate Abstract.Less _            = Just Abstract.false
+            relate Abstract.LessOrEqual GT    = Just Abstract.false
+            relate Abstract.LessOrEqual _     = Just Abstract.true
+            relate Abstract.Greater GT        = Just Abstract.true
+            relate Abstract.Greater _         = Just Abstract.false
+            relate Abstract.GreaterOrEqual LT = Just Abstract.false
+            relate Abstract.GreaterOrEqual _  = Just Abstract.true
+            relate Abstract.In _              = Nothing
+   synthesis _ (pos@(start, ls, end), _) _ (AST.Positive expr) =
+      case foldedValue (syn expr)
+      of Just ((_, ls', _), AST.Integer n) -> Oberon.literalSynthesis ((start, anyWhitespace ls ls', end),
+                                                                       AST.Integer n)
+         Just ((_, ls', _), AST.Real n) -> Oberon.literalSynthesis ((start, anyWhitespace ls ls', end), AST.Real n)
+         _ -> SynCFExp{folded= Mapped (pos, Abstract.positive $ foldedExp' $ syn expr),
+                       foldedValue= Nothing}
+   synthesis _ (pos@(start, ls, end), _) _ (AST.Negative expr) =
+      case foldedValue (syn expr)
+      of Just ((_, ls', _), AST.Integer n) -> Oberon.literalSynthesis ((start, anyWhitespace ls ls', end),
+                                                                       AST.Integer $ negate n)
+         Just ((_, ls', _), AST.Real n) -> Oberon.literalSynthesis ((start, anyWhitespace ls ls', end),
+                                                                    AST.Real $ negate n)
+         _ -> SynCFExp{folded= Mapped (pos, Abstract.negative $ foldedExp' $ syn expr),
+                       foldedValue= Nothing}
+   synthesis _ (pos, _) _ (AST.Add left right) =
+      foldBinaryArithmetic pos Abstract.add (+) (syn left) (syn right)
+   synthesis _ (pos, _) _ (AST.Subtract left right) =
+      foldBinaryArithmetic pos Abstract.subtract (-) (syn left) (syn right)
+   synthesis _ (pos, _) _ (AST.Or left right) =
+      foldBinaryBoolean pos Abstract.or (||) (syn left) (syn right)
+   synthesis _ (pos, _) _ (AST.Multiply left right) =
+      foldBinaryArithmetic pos Abstract.multiply (*) (syn left) (syn right)
+   synthesis _ (pos, _) _ (AST.Divide left right) =
+      foldBinaryFractional pos Abstract.divide (/) (syn left) (syn right)
+   synthesis _ (pos, _) _ (AST.IntegerDivide left right) =
+      foldBinaryInteger pos Abstract.integerDivide div (syn left) (syn right)
+   synthesis _ (pos, _) _ (AST.Modulo left right) =
+      foldBinaryInteger pos Abstract.modulo mod (syn left) (syn right)
+   synthesis _ (pos, _) _ (AST.And left right) =
+      foldBinaryBoolean pos Abstract.and (&&) (syn left) (syn right)
+   synthesis _ (pos@(start, ls, end), _) _ (AST.Not expr) =
+      case foldedValue (syn expr)
+      of Just ((_, ls', _), AST.Boolean b) -> Oberon.literalSynthesis ((start, anyWhitespace ls ls', end),
+                                                                       if b then Abstract.false else Abstract.true)
+         _ -> SynCFExp{folded= Mapped (pos, Abstract.not $ foldedExp' $ syn expr),
+                       foldedValue= Nothing}
+   synthesis _ (pos, AST.Set t _elements) _ (AST.Set _t elements) =
+      SynCFExp{folded= Mapped (pos, Abstract.set t (getMapped . folded' . syn <$> getZipList elements)),
+               foldedValue= Nothing}
+   synthesis _ (pos, _) _ (AST.Read des) =
+      case (designatorValue (syn des), getMapped $ folded (syn des :: SynCFDesignator l))
+      of (Just val, _) -> Oberon.literalSynthesis val
+         (Nothing, (pos', des')) -> SynCFExp{folded= Mapped (pos, Abstract.read (pos', des')),
+                                             foldedValue= Nothing}
+   synthesis _ (pos, AST.FunctionCall fn1 args1) inheritance (AST.FunctionCall fn args) =
+      case (snd <$> designatorValue (syn fn :: SynCFDesignator l), (snd <$>) . foldedValue . syn <$> getZipList args)
+      of (Just (AST.Builtin "CAP"), [Just (AST.String s)])
+            | Text.length s == 1, capital <- Text.toUpper s -> fromValue (Abstract.string capital)
+         (Just (AST.Builtin "CAP"), [Just (AST.CharCode c)])
+            | capital <- ord (toUpper $ chr c) -> fromValue (Abstract.charCode capital)
+         (Just (AST.Builtin "CHR"), [Just (AST.Integer code)]) -> fromValue (Abstract.charCode $ fromIntegral code)
+         (Just (AST.Builtin "ORD"), [Just (AST.String s)])
+            | Text.length s == 1, code <- ord (Text.head s) -> fromValue (Abstract.integer $ toInteger code)
+         (Just (AST.Builtin "ORD"), [Just (AST.CharCode code)]) -> fromValue (Abstract.integer $ toInteger code)
+         (Just (AST.Builtin "ABS"), [Just (AST.Integer i)]) -> fromValue (Abstract.integer $ abs i)
+         (Just (AST.Builtin "ABS"), [Just (AST.Real r)]) -> fromValue (Abstract.real $ abs r)
+         (Just (AST.Builtin "ASH"), [Just (AST.Integer i), Just (AST.Integer j)])
+            | shifted <- shift i (fromIntegral j) -> fromValue (Abstract.integer shifted)
+         (Just (AST.Builtin "TRUNC"), [Just (AST.Real x)]) -> fromValue (Abstract.integer $ floor x)
+         (Just (AST.Builtin "FLOAT"), [Just (AST.Integer x)]) -> fromValue (Abstract.real $ fromIntegral x)
+         (Just (AST.Builtin "FLOAT"), [Just (AST.Real x)]) -> fromValue (Abstract.real x)
+         (Just (AST.Builtin "LEN"), [Just (AST.String s)]) -> fromValue (Abstract.integer $ toInteger $ Text.length s)
+         (Just (AST.Builtin "LONG"), [Just (AST.Integer x)]) -> fromValue (Abstract.integer x)
+         (Just (AST.Builtin "LONG"), [Just (AST.Real x)]) -> fromValue (Abstract.real x)
+         (Just (AST.Builtin "SHORT"), [Just (AST.Integer x)]) -> fromValue (Abstract.integer x)
+         (Just (AST.Builtin "SHORT"), [Just (AST.Real x)]) -> fromValue (Abstract.real x)
+         (Just (AST.Builtin "ODD"), [Just (AST.Integer x)]) ->
+            fromValue (if x `mod` 2 == 1 then Abstract.true else Abstract.false)
+         (Just (AST.Builtin "SIZE"), [Just (AST.Builtin "INTEGER")]) -> fromValue (Abstract.integer intSize)
+         (Just (AST.Builtin "SIZE"), [Just (AST.Builtin "LONGINT")]) -> fromValue (Abstract.integer intSize)
+         (Just (AST.Builtin "SIZE"), [Just (AST.Builtin "CARDINAL")]) -> fromValue (Abstract.integer intSize)
+         (Just (AST.Builtin "SIZE"), [Just (AST.Builtin "REAL")]) -> fromValue (Abstract.integer doubleSize)
+         (Just (AST.Builtin "SIZE"), [Just (AST.Builtin "LONGREAL")]) -> fromValue (Abstract.integer doubleSize)
+         (Just (AST.Builtin "MAX"), [Just (AST.Builtin "CHAR")]) -> fromValue (Abstract.charCode 0xff)
+         (Just (AST.Builtin "MAX"), [Just (AST.Builtin "INTEGER")]) -> fromValue (Abstract.integer maxInteger)
+         (Just (AST.Builtin "MAX"), [Just (AST.Builtin "LONGINT")]) -> fromValue (Abstract.integer maxInteger)
+         (Just (AST.Builtin "MAX"), [Just (AST.Builtin "CARDINAL")]) -> fromValue (Abstract.integer maxCardinal)
+         (Just (AST.Builtin "MAX"), [Just (AST.Builtin "BITSET")]) -> fromValue (Abstract.integer maxSet)
+         (Just (AST.Builtin "MAX"), [Just (AST.Builtin "REAL")]) -> fromValue (Abstract.real maxReal)
+         (Just (AST.Builtin "MAX"), [Just (AST.Builtin "LONGREAL")]) -> fromValue (Abstract.real maxReal)
+         (Just (AST.Builtin "MIN"), [Just (AST.Builtin "CHAR")]) -> fromValue (Abstract.charCode 0)
+         (Just (AST.Builtin "MIN"), [Just (AST.Builtin "INTEGER")]) -> fromValue (Abstract.integer minInteger)
+         (Just (AST.Builtin "MIN"), [Just (AST.Builtin "LONGINT")]) -> fromValue (Abstract.integer minInteger)
+         (Just (AST.Builtin "MIN"), [Just (AST.Builtin "CARDINAL")]) -> fromValue (Abstract.integer 0)
+         (Just (AST.Builtin "MIN"), [Just (AST.Builtin "BITSET")]) -> fromValue (Abstract.integer minSet)
+         (Just (AST.Builtin "MIN"), [Just (AST.Builtin "REAL")]) -> fromValue (Abstract.real minReal)
+         (Just (AST.Builtin "MIN"), [Just (AST.Builtin "LONGREAL")]) -> fromValue (Abstract.real minReal)
+         _ -> SynCFExp{folded= Mapped (pos, Abstract.functionCall (getMapped $ folded (syn fn :: SynCFDesignator l))
+                                                                  (foldedExp' . syn <$> getZipList args)),
+                       foldedValue= Nothing}
+      where fromValue v = Oberon.literalSynthesis (pos, v)
+   synthesis _ (pos, _) _ (AST.Literal val) =
+      SynCFExp{folded= Mapped (pos, Abstract.literal $ getMapped $ folded' $ syn val),
+               foldedValue= Just (getMapped $ folded' $ syn val)}
+
+maxCardinal, maxInteger, minInteger, maxInt32, minInt32, maxSet, minSet :: Integer
+maxCardinal = 2 * maxInteger + 1
+maxInteger = toInteger (maxBound :: Int)
+minInteger = toInteger (minBound :: Int)
+maxInt32 = toInteger (maxBound :: Int32)
+minInt32 = toInteger (minBound :: Int32)
+maxSet = 63
+minSet = 0
+
+doubleSize, floatSize, intSize, int32Size :: Integer
+doubleSize = toInteger (sizeOf (0 :: Double))
+floatSize = toInteger (sizeOf (0 :: Float))
+intSize = toInteger (sizeOf (0 :: Int))
+int32Size = toInteger (sizeOf (0 :: Int32))
+
+maxReal, minReal :: Double
+maxReal = encodeFloat (floatRadix x - 1) (snd (floatRange x) - 1)
+   where x = 0 :: Double
+minReal = encodeFloat (floatRadix x - 1) (fst (floatRange x))
+   where x = 0 :: Double
+
+foldBinaryArithmetic :: forall λ l f. (f ~ Placed, Abstract.Value l ~ AST.Value l, Abstract.Wirthy λ,
+                                  Pretty (Abstract.Value l l Identity Identity)) =>
+                        (Int, ParsedLexemes, Int)
+                     -> (f (Abstract.Expression l l f f) -> f (Abstract.Expression l l f f) -> Abstract.Expression λ l f f)
+                     -> (forall n. Num n => n -> n -> n)
+                     -> SynCFExp l l -> SynCFExp l l -> SynCFExp λ l
+foldBinaryArithmetic pos@(start, ls, end) node op l r =
+   case join (foldValues <$> foldedValue l <*> foldedValue r)
+   of Just v -> Oberon.literalSynthesis v
+      Nothing -> SynCFExp{folded= Mapped (pos, node (foldedExp' l) (foldedExp' r)),
+                          foldedValue= Nothing}
+   where foldValues :: Placed (AST.Value l l f f) -> Placed (AST.Value l l f f) -> Maybe (Placed (AST.Value l l f f))
+         foldBareValues :: AST.Value l l f f -> AST.Value l l f f -> Maybe (AST.Value l l f f)
+         foldValues (_, l') ((_, ls', _), r') = (,) (start, anyWhitespace ls ls', end) <$> foldBareValues l' r'
+         foldBareValues (AST.Integer l') (AST.Integer r') = Just (AST.Integer $ op l' r')
+         foldBareValues (AST.Real l')    (AST.Real r')    = Just (AST.Real $ op l' r')
+         foldBareValues (AST.Integer l') (AST.Real r')    = Just (AST.Real $ op (fromIntegral l') r')
+         foldBareValues (AST.Real l')    (AST.Integer r') = Just (AST.Real $ op l' (fromIntegral r'))
+         foldBareValues _ _ = Nothing
+
+foldBinaryFractional :: forall λ l f. (f ~ Placed, Abstract.Value l ~ AST.Value l, Abstract.Wirthy λ,
+                                  Pretty (Abstract.Value l l Identity Identity)) =>
+                        (Int, ParsedLexemes, Int)
+                     -> (f (Abstract.Expression l l f f) -> f (Abstract.Expression l l f f) -> Abstract.Expression λ l f f)
+                     -> (forall n. Fractional n => n -> n -> n)
+                     -> SynCFExp l l -> SynCFExp l l -> SynCFExp λ l
+foldBinaryFractional pos@(start, ls, end) node op l r =
+   case join (foldValues <$> foldedValue l <*> foldedValue r)
+   of Just v -> Oberon.literalSynthesis v
+      Nothing -> SynCFExp{folded= Mapped (pos, node (foldedExp' l) (foldedExp' r)),
+                          foldedValue= Nothing}
+   where foldValues :: Placed (AST.Value l l f f) -> Placed (AST.Value l l f f) -> Maybe (Placed (AST.Value l l f f))
+         foldValues (_, AST.Real l') ((_, ls', _), AST.Real r') = Just ((start, anyWhitespace ls ls', end),
+                                                                        AST.Real $ op l' r')
+         foldValues _ _ = Nothing
+
+foldBinaryInteger :: forall λ l f. (f ~ Placed, Abstract.Value l ~ AST.Value l, Abstract.Wirthy λ,
+                               Pretty (Abstract.Value l l Identity Identity)) =>
+                        (Int, ParsedLexemes, Int)
+                     -> (f (Abstract.Expression l l f f) -> f (Abstract.Expression l l f f) -> Abstract.Expression λ l f f)
+                     -> (forall n. Integral n => n -> n -> n)
+                     -> SynCFExp l l -> SynCFExp l l -> SynCFExp λ l
+foldBinaryInteger pos@(start, ls, end) node op l r =
+   case join (foldValues <$> foldedValue l <*> foldedValue r)
+   of Just v -> Oberon.literalSynthesis v
+      Nothing -> SynCFExp{folded= Mapped (pos, node (foldedExp' l) (foldedExp' r)),
+                          foldedValue= Nothing}
+   where foldValues :: Placed (AST.Value l l f f) -> Placed (AST.Value l l f f) -> Maybe (Placed (AST.Value l l f f))
+         foldValues (_, AST.Integer l') ((_, ls', _), AST.Integer r') = Just ((start, anyWhitespace ls ls', end),
+                                                                              AST.Integer $ op l' r')
+         foldValues _ _ = Nothing
+
+foldBinaryBoolean :: forall λ l f. (f ~ Placed, Abstract.Value l ~ AST.Value l, Abstract.Wirthy λ,
+                               Pretty (Abstract.Value l l Identity Identity)) =>
+                     (Int, ParsedLexemes, Int)
+                  -> (f (Abstract.Expression l l f f) -> f (Abstract.Expression l l f f) -> Abstract.Expression λ l f f)
+                  -> (Bool -> Bool -> Bool)
+                  -> SynCFExp l l -> SynCFExp l l -> SynCFExp λ l
+foldBinaryBoolean pos@(start, ls, end) node op l r =
+   case join (foldValues <$> foldedValue l <*> foldedValue r)
+   of Just v -> Oberon.literalSynthesis v
+      Nothing -> SynCFExp{folded= Mapped (pos, node (foldedExp' l) (foldedExp' r)),
+                          foldedValue= Nothing}
+   where foldValues :: Placed (AST.Value l l f f) -> Placed (AST.Value l l f f) -> Maybe (Placed (AST.Value l l f f))
+         foldValues (_, AST.Boolean l') ((_, ls', _), AST.Boolean r') = Just ((start, anyWhitespace ls ls', end),
+                                                                              AST.Boolean $ op l' r')
+         foldValues _ _ = Nothing
+
+instance (Abstract.Modula2 l, Ord (Abstract.QualIdent l), v ~ Abstract.Value l l Placed Placed,
+          Atts (Inherited (Auto ConstantFold)) (Abstract.Expression l l Sem Sem) ~ InhCF l,
+          Atts (Inherited (Auto ConstantFold)) (Abstract.Designator l l Sem Sem) ~ InhCF l,
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Expression l l Sem Sem) ~ SynCFExp λ l,
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Designator l l Sem Sem) ~ SynCFDesignator l) =>
+         SynthesizedField "designatorValue" (Maybe (Placed v)) (Auto ConstantFold) (AST.Designator l l) Sem Placed where
+   synthesizedField _ _ (pos, AST.Variable q) inheritance _ = (,) pos <$> join (Map.lookup q $ env inheritance)
+   synthesizedField _ _ _ _ _ = Nothing
+
+-- * More boring Transformation.Functor instances, TH candidates
+instance Ord (Abstract.QualIdent l) => Transformation.At (Auto ConstantFold) (Modules l Sem Sem) where
+   ($) = AG.applyDefault snd
+
+-- * Unsafe Rank2 AST instances
+
+$(do l <- varT  <$> newName "l"
+     mconcat <$> mapM (\g-> Transformation.Full.TH.deriveUpFunctor (conT ''Auto `appT` conT ''ConstantFold) $ conT g `appT` l `appT` l)
+        [''AST.Type, ''AST.FieldList,
+         ''AST.ProcedureHeading,
+         ''AST.Expression, ''AST.Designator,
+         ''AST.Statement, ''AST.Variant])
+
+$(do let sem = [t|Semantics (Auto ConstantFold)|]
+     let inst g = [d| instance Attribution (Auto ConstantFold) ($g l l) Sem Placed =>
+                               Transformation.At (Auto ConstantFold) ($g l l $sem $sem)
+                         where ($) = AG.applyDefault snd |]
+     mconcat <$> mapM (inst . conT)
+        [''AST.Module, ''AST.ProcedureHeading, ''AST.Type, ''AST.FieldList,
+         ''AST.Statement, ''AST.Expression, ''AST.Designator, ''AST.Variant])
+
+$(do full <- varT  <$> newName "full"
+     l <- varT  <$> newName "l"
+     Transformation.Full.TH.deriveUpFunctor [t| (Auto ConstantFold) |] [t| AST.Declaration $full $l $l |])
+
+instance Attribution (Auto ConstantFold) (AST.Declaration full l l) Sem Placed
+      => Transformation.At (Auto ConstantFold) (AST.Declaration full l l Sem Sem) where
+   ($) = AG.applyDefault snd
diff --git a/src/Language/Modula2/Grammar.hs b/src/Language/Modula2/Grammar.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Modula2/Grammar.hs
@@ -0,0 +1,337 @@
+{-# Language FlexibleContexts, FlexibleInstances, OverloadedStrings, Rank2Types, RecordWildCards, ScopedTypeVariables,
+             TypeFamilies, TypeSynonymInstances, TemplateHaskell #-}
+
+-- | Modula-2 grammar adapted from ''Report on the Programming Language Modula-2''
+
+module Language.Modula2.Grammar (module Language.Modula2.Grammar, Lexeme(..), ParsedLexemes(..)) where
+
+import Control.Applicative
+import Control.Arrow (first)
+import Control.Monad (guard, void)
+import Data.Char (isAlphaNum, isDigit, isHexDigit, isLetter, isOctDigit, isSpace)
+import Data.List.NonEmpty (NonEmpty, toList)
+import Data.Maybe (catMaybes)
+import Data.Monoid ((<>))
+import Data.Text (Text, unpack)
+import Numeric (readOct, readDec, readHex, readFloat)
+import Text.Grampa
+import Text.Grampa.ContextFree.LeftRecursive.Transformer (ParserT, lift, tmap)
+import Text.Parser.Combinators (sepBy, sepBy1, sepByNonEmpty, try)
+import Text.Parser.Token (braces, brackets, parens)
+
+import qualified Rank2.TH
+import Language.Oberon.Grammar (Lexeme(..), TokenType(..), ParsedLexemes(Trailing))
+
+import qualified Language.Modula2.Abstract as Abstract
+import qualified Language.Modula2.AST as AST
+
+type Parser = ParserT ((,) [[Lexeme]])
+
+-- | The names and types of all the Modula-2 grammar productions
+data Modula2Grammar l f p = Modula2Grammar {
+   ident :: p Abstract.Ident,
+   number :: p (Abstract.Value l l f f),
+   integer :: p (Abstract.Value l l f f),
+   real :: p (Abstract.Value l l f f),
+   scaleFactor :: p Text,
+   hexDigit :: p Text,
+   digit :: p Text,
+   octalDigit :: p Text,
+   string_prod :: p Text,
+   qualident :: p (Abstract.QualIdent l),
+   constantDeclaration :: p (Abstract.Declaration l l f f),
+   constantDefinition :: p (Abstract.Definition l l f f),
+   constExpression :: p (NodeWrap (Abstract.ConstExpression l l f f)),
+   relation :: p Abstract.RelOp,
+   addOperator :: p (f (Abstract.Expression l l f f) -> f (Abstract.Expression l l f f) -> Abstract.Expression l l f f),
+   mulOperator :: p (f (Abstract.Expression l l f f) -> f (Abstract.Expression l l f f) -> Abstract.Expression l l f f),
+   set :: p (Abstract.Expression l l f f),
+   element :: p (Abstract.Element l l f f),
+   typeDeclaration :: p (Abstract.Declaration l l f f),
+   typeDefinition :: p (Abstract.Definition l l f f),
+   type_prod :: p (Abstract.Type l l f f),
+   simpleType :: p (Abstract.Type l l f f),
+   enumeration :: p (Abstract.Type l l f f),
+   identList :: p (Abstract.IdentList l),
+   subrangeType :: p (Abstract.Type l l f f),
+   arrayType :: p (Abstract.Type l l f f),
+   recordType :: p (Abstract.Type l l f f),
+   fieldListSequence :: p [f (Abstract.FieldList l l f f)],
+   fieldList :: p (Abstract.FieldList l l f f),
+   variant :: p (Abstract.Variant l l f f),
+   caseLabelList :: p (NonEmpty (f (Abstract.CaseLabels l l f f))),
+   caseLabels :: p (Abstract.CaseLabels l l f f),
+   setType :: p (Abstract.Type l l f f),
+   pointerType :: p (Abstract.Type l l f f),
+   procedureType :: p (Abstract.Type l l f f),
+   formalTypeList :: p (Abstract.FormalParameters l l f f),
+   variableDeclaration :: p (Abstract.Declaration l l f f),
+   variableDefinition :: p (Abstract.Definition l l f f),
+   designator :: p (Abstract.Designator l l f f),
+   expList :: p (NonEmpty (f (Abstract.Expression l l f f))),
+   expression :: p (NodeWrap (Abstract.Expression l l f f)),
+   simpleExpression :: p (NodeWrap (Abstract.Expression l l f f)),
+   term :: p (NodeWrap (Abstract.Expression l l f f)),
+   factor :: p (NodeWrap (Abstract.Expression l l f f)),
+   actualParameters :: p [f (Abstract.Expression l l f f)],
+   statement :: p (Abstract.Statement l l f f),
+   assignment :: p (Abstract.Statement l l f f),
+   procedureCall :: p (Abstract.Statement l l f f),
+   statementSequence :: p (NodeWrap (Abstract.StatementSequence l l f f)),
+   ifStatement :: p (Abstract.Statement l l f f),
+   caseStatement :: p (Abstract.Statement l l f f),
+   case_prod :: p (Abstract.Case l l f f),
+   whileStatement :: p (Abstract.Statement l l f f),
+   repeatStatement :: p (Abstract.Statement l l f f),
+   forStatement :: p (Abstract.Statement l l f f),
+   loopStatement :: p (Abstract.Statement l l f f),
+   withStatement :: p (Abstract.Statement l l f f),
+   procedureDeclaration :: p (Abstract.Declaration l l f f),
+   procedureHeading :: p (Abstract.Ident, Abstract.ProcedureHeading l l f f),
+   block :: p (Abstract.Block l l f f),
+   declarationSequence :: p [f (Abstract.Declaration l l f f)],
+   formalParameters :: p (Abstract.FormalParameters l l f f),
+   fPSection :: p (Abstract.FPSection l l f f),
+   formalType :: p (Abstract.Type l l f f),
+   moduleDeclaration :: p (Abstract.Declaration l l f f),
+   priority :: p (NodeWrap (Abstract.Priority l l f f)),
+   export :: p (Abstract.Export l),
+   import_prod :: p (Abstract.Import l),
+   definitionModule :: p (Abstract.Module l l f f),
+   definitionSequence :: p [f (Abstract.Definition l l f f)],
+   programModule :: p (Abstract.Module l l f f),
+   compilationUnit :: p (NodeWrap (Abstract.Module l l f f))
+   }
+
+type NodeWrap = (,) (Position, ParsedLexemes, Position)
+
+modula2grammar :: Grammar (Modula2Grammar AST.Language NodeWrap) Parser Text
+modula2grammar = fixGrammar grammar
+
+-- | All the productions of Modula-2 grammar
+grammar :: forall l g. (Abstract.Modula2 l, LexicalParsing (Parser g Text))
+        => GrammarBuilder (Modula2Grammar l NodeWrap) g Parser Text
+grammar g@Modula2Grammar{..} = g{
+   ident = identifier,
+   number = integer <|> real <?> "a number",
+   integer = lexicalToken (Abstract.integer . fst . head
+                           <$> (readDec . unpack <$> takeCharsWhile1 isDigit
+                                <|> readOct . unpack <$> takeCharsWhile1 isOctDigit <* string "B"
+                                <|> readHex . unpack <$> (digit <> takeCharsWhile isHexDigit) <* string "H")
+                           <|> Abstract.charCode . fst . head . readOct . unpack
+                               <$> (octalDigit <> takeCharsWhile isOctDigit <* string "C")),
+   real = Abstract.real . fst . head . readFloat . unpack
+          <$> lexicalToken (takeCharsWhile1 isDigit <> string "." <> takeCharsWhile isDigit <> moptional scaleFactor),
+   scaleFactor = string "E" <> moptional (string "+" <|> string "-") <> takeCharsWhile1 isDigit,
+   hexDigit = satisfyCharInput isHexDigit,
+   digit = satisfyCharInput isDigit,
+   octalDigit = satisfyCharInput isOctDigit,
+   string_prod = lexicalToken (char '\'' *> takeCharsWhile (\c-> c /= '\'' && c /= '\n') <* char '\''
+                               <|> char '"' *> takeCharsWhile (\c-> c /= '"' && c /= '\n') <* char '"'),
+   qualident = Abstract.qualIdent <$> many (ident <* delimiter ".") <*> ident,
+   constantDeclaration = Abstract.constantDeclaration <$> (Abstract.identDef <$> ident)
+                         <* delimiter "=" <*> constExpression,
+   constantDefinition = Abstract.constantDefinition <$> (Abstract.identDef <$> ident)
+                        <* delimiter "=" <*> constExpression,
+   constExpression = expression,
+   relation = Abstract.Equal <$ operator "=" <|> Abstract.Unequal <$ (operator "#" <|> operator "<>")
+              <|> Abstract.Less <$ operator "<" <|> Abstract.LessOrEqual <$ operator "<=" 
+              <|> Abstract.Greater <$ operator ">" <|> Abstract.GreaterOrEqual <$ operator ">=" 
+              <|> Abstract.In <$ keyword "IN",
+   addOperator = Abstract.add <$ operator "+" <|> Abstract.subtract <$ operator "-" <|> Abstract.or <$ keyword "OR",
+   mulOperator = Abstract.multiply <$ operator "*" <|> Abstract.divide <$ operator "/"
+                 <|> Abstract.integerDivide <$ keyword "DIV" <|> Abstract.modulo <$ keyword "MOD"
+                 <|> Abstract.and <$ (operator "&" <|> keyword "AND"),
+   set = Abstract.set <$> optional qualident <*> braces (sepBy (wrap element) (delimiter ",")),
+   element = Abstract.element <$> expression
+             <|> Abstract.range <$> expression <* delimiter ".." <*> expression,
+   typeDeclaration = Abstract.typeDeclaration <$> (Abstract.identDef <$> ident) <* delimiter "=" <*> wrap type_prod,
+   typeDefinition = Abstract.typeDefinition <$> (Abstract.identDef <$> ident) <*> optional (delimiter "=" *> wrap type_prod),
+   type_prod = simpleType <|> arrayType <|> recordType <|> setType <|> pointerType <|> procedureType,
+   simpleType = Abstract.typeReference <$> qualident
+                <|> enumeration
+                <|> subrangeType,
+   enumeration = Abstract.enumeration <$> parens identList,
+   identList = sepByNonEmpty (Abstract.identDef <$> ident) (delimiter ","),
+   subrangeType = brackets (Abstract.subRange (Nothing :: Maybe (Abstract.QualIdent l)) <$> constExpression
+                            <* delimiter ".." <*> constExpression),
+   arrayType =
+      Abstract.arrayType <$ keyword "ARRAY" <*> sepBy1 (wrap simpleType) (delimiter ",") <* keyword "OF" <*> wrap type_prod,
+   recordType = Abstract.recordType <$ keyword "RECORD" <*> fieldListSequence <* keyword "END",
+   fieldListSequence = catMaybes <$> sepBy1 (optional $ wrap fieldList) (delimiter ";"),
+   fieldList = (Abstract.fieldList <$> identList <* delimiter ":" <*> wrap type_prod
+                :: Parser g Text (Abstract.FieldList l l NodeWrap NodeWrap))
+               <|> Abstract.caseFieldList <$ keyword "CASE" <*> optional (ident <* delimiter ":") <*> qualident
+                                          <* keyword "OF" <*> sepByNonEmpty (wrap variant) (delimiter "|")
+                                          <*> moptional (keyword "ELSE" *> fieldListSequence) <* keyword "END",
+   variant = Abstract.variant <$> caseLabelList <* delimiter ":" <*> fieldListSequence,
+   caseLabelList = sepByNonEmpty (wrap caseLabels) (delimiter ","),
+   caseLabels = Abstract.singleLabel <$> constExpression
+                <|> Abstract.labelRange <$> constExpression <* delimiter ".." <*> constExpression,
+   setType = Abstract.setType <$ keyword "SET" <* keyword "OF" <*> wrap simpleType,
+   pointerType = Abstract.pointerType <$ keyword "POINTER" <* keyword "TO" <*> wrap type_prod,
+   procedureType = Abstract.procedureType <$ keyword "PROCEDURE" <*> optional (wrap formalTypeList),
+   formalTypeList = Abstract.formalParameters
+                    <$> parens (sepBy (wrap $
+                                       Abstract.fpSection <$> (True <$ keyword "VAR" <|> pure False) <*> pure [] <*> wrap formalType)
+                                      (delimiter ","))
+                    <*> optional (delimiter ":" *> qualident),
+   variableDeclaration = Abstract.variableDeclaration <$> identList <* delimiter ":" <*> wrap type_prod,
+   variableDefinition = Abstract.variableDefinition <$> identList <* delimiter ":" <*> wrap type_prod,
+   designator = Abstract.variable . Abstract.nonQualIdent <$> ident -- qualident
+                <|> Abstract.field <$> wrap designator <* delimiter "." <*> ident
+                <|> Abstract.index <$> wrap designator <*> brackets expList
+                <|> Abstract.dereference <$> wrap designator <* operator "^",
+   expList = sepByNonEmpty expression (delimiter ","),
+   expression = simpleExpression
+                <|> wrap (flip Abstract.relation <$> simpleExpression <*> relation <*> simpleExpression)
+                <?> "expression",
+   simpleExpression =
+      wrap (Abstract.positive <$ operator "+" <*> term
+            <|> Abstract.negative <$ operator "-" <*> term)
+      <|> term
+      <|> wrap (simpleExpression <**> addOperator <*> term),
+   term = factor <|> wrap (term <**> mulOperator <*> factor),
+   factor = wrap (Abstract.literal <$> wrap (number
+                                             <|> Abstract.string <$> string_prod)
+                  <|> set
+                  <|> Abstract.read <$> wrap designator
+                  <|> Abstract.functionCall <$> wrap designator <*> actualParameters
+                  <|> (Abstract.not <$ (operator "~" <|> keyword "NOT") <*> factor
+                       :: Parser g Text (Abstract.Expression l l NodeWrap NodeWrap)))
+            <|> parens expression,
+   actualParameters = parens (sepBy expression (delimiter ",")),
+   statement = assignment <|> procedureCall <|> ifStatement <|> caseStatement 
+               <|> whileStatement <|> repeatStatement <|> loopStatement <|> forStatement <|> withStatement 
+               <|> Abstract.exitStatement <$ keyword "EXIT" 
+               <|> Abstract.returnStatement <$ keyword "RETURN" <*> optional expression
+               <|> pure Abstract.emptyStatement
+               <?> "statement",
+   assignment  =  Abstract.assignment <$> wrap designator <* delimiter ":=" <*> expression,
+   procedureCall = Abstract.procedureCall <$> wrap designator <*> optional actualParameters,
+   statementSequence = wrap (Abstract.statementSequence <$> sepBy1 (wrap statement) (delimiter ";")),
+   ifStatement = Abstract.ifStatement <$ keyword "IF"
+       <*> sepByNonEmpty (wrap $ Abstract.conditionalBranch <$> expression <* keyword "THEN" <*> statementSequence)
+                         (keyword "ELSIF")
+       <*> optional (keyword "ELSE" *> statementSequence) <* keyword "END",
+   caseStatement = Abstract.caseStatement <$ keyword "CASE" <*> expression
+       <*  keyword "OF" <*> sepBy1 (wrap case_prod) (delimiter "|")
+       <*> optional (keyword "ELSE" *> statementSequence) <* keyword "END",
+   case_prod = Abstract.caseAlternative <$> caseLabelList <* delimiter ":" <*> statementSequence,
+   whileStatement = Abstract.whileStatement <$ keyword "WHILE" <*> expression <* keyword "DO"
+                    <*> statementSequence <* keyword "END",
+   repeatStatement = Abstract.repeatStatement <$ keyword "REPEAT"
+                     <*> statementSequence <* keyword "UNTIL" <*> expression,
+   forStatement = 
+      Abstract.forStatement <$ keyword "FOR" <*> ident <* delimiter ":=" <*> expression
+      <* keyword "TO" <*> expression <*> optional (keyword "BY" *> constExpression)
+      <* keyword "DO" <*> statementSequence <* keyword "END",
+   loopStatement = Abstract.loopStatement <$ keyword "LOOP" <*> statementSequence <* keyword "END",
+   withStatement = Abstract.withStatement <$ keyword "WITH" <*> wrap designator <* keyword "DO"
+                   <*> statementSequence <* keyword "END",
+   procedureDeclaration = do (procedureName, heading) <- sequenceA <$> wrap procedureHeading
+                             delimiter ";"
+                             body <- wrap block
+                             lexicalToken (string procedureName)
+                             return (Abstract.procedureDeclaration heading body),
+   procedureHeading = Abstract.procedureHeading <$ keyword "PROCEDURE"
+                      <**> do name <- ident
+                              params <- optional (wrap formalParameters)
+                              return (\proc-> (name, proc name params)),
+   block = Abstract.block <$> declarationSequence <*> optional (keyword "BEGIN" *> statementSequence)
+           <* keyword "END",
+   declarationSequence = concatMany (keyword "CONST" *> many (wrap constantDeclaration <* delimiter ";")
+                                     <|> keyword "TYPE" *> many (wrap typeDeclaration <* delimiter ";")
+                                     <|> keyword "VAR" *> many (wrap variableDeclaration <* delimiter ";")
+                                     <|> (:[]) <$> (wrap procedureDeclaration <* delimiter ";"
+                                                    <|> wrap moduleDeclaration <* delimiter ";"))
+                         <?> "declarations",
+   formalParameters = Abstract.formalParameters <$> parens (sepBy (wrap fPSection) (delimiter ";"))
+                      <*> optional (delimiter ":" *> qualident),
+   fPSection = Abstract.fpSection <$> (True <$ keyword "VAR" <|> pure False) 
+               <*> sepBy1 ident (delimiter ",") <* delimiter ":" <*> wrap formalType,
+   formalType = Abstract.arrayType [] <$ keyword "ARRAY" <* keyword "OF" <*> wrap formalType 
+                <|> Abstract.typeReference <$> qualident,
+   moduleDeclaration = do keyword "MODULE"
+                          name <- ident
+                          Abstract.moduleDeclaration name <$> optional priority <* delimiter ";"
+                             <*> many import_prod <*> optional export <*> wrap block <* lexicalToken (string name),
+   priority = brackets constExpression,
+   export = Abstract.moduleExport <$ keyword "EXPORT" <*> (True <$ keyword "QUALIFIED" <|> pure False)
+            <*> sepByNonEmpty ident (delimiter ",") <* delimiter ";",
+   import_prod = Abstract.moduleImport <$> optional (keyword "FROM" *> ident)
+                 <* keyword "IMPORT" <*> sepByNonEmpty ident (delimiter ",") <* delimiter ";",
+   definitionModule = keyword "DEFINITION" *> keyword "MODULE" *>
+                      do name <- ident
+                         delimiter ";"
+                         Abstract.definitionModule name <$> many import_prod <*> optional export <*> definitionSequence
+                                                   <* keyword "END" <* lexicalToken (string name) <* delimiter ".",
+   definitionSequence =  concatMany (keyword "CONST" *> many (wrap constantDefinition <* delimiter ";")
+                                     <|> keyword "TYPE" *> many (wrap typeDefinition <* delimiter ";")
+                                     <|> keyword "VAR" *> many (wrap variableDefinition <* delimiter ";")
+                                     <|> (:[]) <$> (wrap (Abstract.procedureDefinition <$> wrap (snd <$> procedureHeading))
+                                                    <* delimiter ";"))
+                         <?> "definitions",
+   programModule = do con <- (Abstract.implementationModule <$ keyword "IMPLEMENTATION"
+                              <|> pure Abstract.programModule) <* keyword "MODULE"
+                      name <- ident
+                      con name <$> optional priority <* delimiter ";" <*> many import_prod
+                               <*> wrap block <* lexicalToken (string name) <* delimiter ".",
+   compilationUnit = wrap (lexicalWhiteSpace *> (definitionModule <|> programModule)) <* skipMany (char '\x1a' *> lexicalWhiteSpace)
+   }
+
+instance TokenParsing (Parser (Modula2Grammar l f) Text) where
+   someSpace = someLexicalSpace
+   token = lexicalToken
+
+instance LexicalParsing (Parser (Modula2Grammar l f) Text) where
+   lexicalComment = do c <- comment
+                       lift ([[Comment c]], ())
+   lexicalWhiteSpace = whiteSpace
+   isIdentifierStartChar = isLetter
+   isIdentifierFollowChar = isAlphaNum
+   identifierToken word = lexicalToken (do w <- word
+                                           guard (w `notElem` reservedWords)
+                                           return w)
+   lexicalToken p = snd <$> tmap addOtherToken (match p) <* lexicalWhiteSpace
+      where addOtherToken ([], (i, x)) = ([[Token Other i]], (i, x))
+            addOtherToken (t, (i, x)) = (t, (i, x))
+   keyword s = lexicalToken (string s
+                             *> notSatisfyChar isAlphaNum
+                             <* lift ([[Token Keyword s]], ()))
+               <?> ("keyword " <> show s)
+
+comment :: Parser g Text Text
+comment = try (string "(*"
+               <> concatMany (comment <<|> notFollowedBy (string "*)") *> anyToken <> takeCharsWhile isCommentChar)
+               <> string "*)")
+   where isCommentChar c = c /= '*' && c /= '('
+
+whiteSpace :: LexicalParsing (Parser g Text) => Parser g Text ()
+whiteSpace = spaceChars *> skipMany (lexicalComment *> spaceChars) <?> "whitespace"
+   where spaceChars = (takeCharsWhile1 isSpace >>= \ws-> lift ([[WhiteSpace ws]], ())) <<|> pure ()
+
+wrap :: Parser g Text a -> Parser g Text (NodeWrap a)
+wrap = (\p-> liftA3 surround getSourcePos p getSourcePos) . tmap store . ((,) (Trailing []) <$>)
+   where surround start (lexemes, p) end = ((start, lexemes, end), p)
+         store (wss, (Trailing ws', a)) = (mempty, (Trailing $ ws' <> concat wss, a))
+
+moptional p = p <|> mempty
+
+delimiter, operator :: (LexicalParsing (Parser g Text)) => Text -> Parser g Text ()
+
+delimiter s = void (lexicalToken $ string s) <?> ("delimiter " <> show s)
+operator s = void (lexicalToken $ string s) <?> ("operator " <> show s)
+
+reservedWords :: [Text]
+reservedWords = ["AND", "ARRAY", "BEGIN", "BY",
+                 "CASE", "CONST", "DEFINITION", "DIV", "DO",
+                 "ELSE", "ELSIF", "END", "EXIT", "EXPORT", "FOR", "FROM",
+                 "IF", "IMPLEMENTATION", "IMPORT", "IN", "LOOP",
+                 "MOD", "MODULE", "NOT",
+                 "OF", "OR", "POINTER", "PROCEDURE",
+                 "QUALIFIED", "RECORD", "REPEAT", "RETURN",
+                 "SET", "THEN", "TO", "TYPE",
+                 "UNTIL", "VAR", "WHILE", "WITH"]
+
+$(Rank2.TH.deriveAll ''Modula2Grammar)
diff --git a/src/Language/Modula2/ISO/AST.hs b/src/Language/Modula2/ISO/AST.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Modula2/ISO/AST.hs
@@ -0,0 +1,427 @@
+{-# LANGUAGE DataKinds, DeriveDataTypeable, FlexibleInstances, GADTs, KindSignatures, InstanceSigs,
+             MultiParamTypeClasses, UndecidableInstances,
+             ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
+
+-- | ISO Modula-2 Abstract Syntax Tree definitions
+
+module Language.Modula2.ISO.AST where
+
+import Control.Applicative (ZipList(ZipList, getZipList))
+import Control.Monad (forM, mapM)
+import Data.Coerce (coerce)
+import Data.Data (Data, Typeable)
+import Data.List.NonEmpty
+import Data.Text (Text)
+
+import qualified Transformation.Shallow.TH
+import qualified Transformation.Deep.TH
+import qualified Rank2 as Rank2
+import qualified Rank2.TH
+
+import qualified Language.Modula2.Abstract as Abstract
+import qualified Language.Modula2.ISO.Abstract as ISO.Abstract
+import qualified Language.Modula2.AST as Report
+import Language.Modula2.Abstract (Ident)
+import Language.Modula2.AST hiding (Language, Block(..), Declaration(..), Expression(..), Statement(..),
+                                    Type(..), Variant(..))
+
+-- | Data type representing the Modula-2 language, as specified by the ISO standard.
+data Language = Language deriving (Data, Typeable)
+
+instance Abstract.Wirthy Language where
+   type Module Language = Module Language
+   type Declaration Language = Declaration True Language
+   type Type Language = Type Language
+   type Statement Language = Statement Language
+   type Expression Language = Expression Language
+   type Designator Language = Designator Language
+   type Value Language = Value Language
+
+   type Import Language = Import Language
+   type FieldList Language = FieldList Language
+   type ProcedureHeading Language = ProcedureHeading Language
+   type FormalParameters Language = FormalParameters Language
+   type FPSection Language = FPSection Language
+   type Block Language = Block Language
+   type StatementSequence Language = StatementSequence Language
+   type Case Language = Case Language
+   type CaseLabels Language = CaseLabels Language
+   type ConditionalBranch Language = ConditionalBranch Language
+   type Element Language = Element Language
+
+   type IdentDef Language = Ident
+   type QualIdent Language = QualIdent Language
+
+   -- Declaration
+   constantDeclaration = ConstantDeclaration
+   typeDeclaration = TypeDeclaration
+   variableDeclaration = VariableDeclaration
+   procedureDeclaration = ProcedureDeclaration
+
+   formalParameters = FormalParameters . ZipList
+   fpSection = FPSection
+   block = Block . ZipList
+   
+   fieldList = FieldList
+
+   -- Type
+   pointerType = PointerType
+   procedureType = ProcedureType
+   typeReference = TypeReference
+
+   -- Statement
+   assignment = Assignment
+   caseStatement scrutinee cases = CaseStatement scrutinee (ZipList cases)
+   emptyStatement = EmptyStatement
+   exitStatement = Exit
+   ifStatement (branch :| branches) = If branch (ZipList branches)
+   loopStatement = Loop
+   procedureCall proc args = ProcedureCall proc (ZipList <$> args)
+   repeatStatement = Repeat
+   returnStatement = Return
+   whileStatement = While
+
+   conditionalBranch = ConditionalBranch
+   caseAlternative (c :| cs) = Case c (ZipList cs)
+   labelRange = LabelRange
+   singleLabel = SingleLabel
+   
+   statementSequence = StatementSequence . ZipList
+
+   -- Expression
+   add = Add
+   subtract = Subtract
+   and = And
+   or = Or
+   divide = Divide
+   integerDivide = IntegerDivide
+   literal = Literal
+   modulo = Modulo
+   multiply = Multiply
+   functionCall fun args = FunctionCall fun (ZipList args)
+   negative = Negative
+   positive = Positive
+   not = Not
+   read = Read
+   relation = Relation
+
+   element = Element
+   range = Range
+
+   -- Value
+   builtin = Builtin
+   integer = Integer
+   nil = Nil
+   real = Real
+   string = String
+   charCode = CharCode
+   false = Boolean False
+   true = Boolean True
+
+   -- Designator
+   variable = Variable
+   field = Field
+   index array (index :| indexes) = Index array index (ZipList indexes)
+   dereference = Dereference
+
+   -- Identifier
+   identDef = id
+   nonQualIdent = QualIdent []
+
+instance Abstract.CoWirthy Language where
+   type TargetClass Language = ISO.Abstract.Modula2
+   coDeclaration (ConstantDeclaration name value) = Abstract.constantDeclaration name value
+   coDeclaration (TypeDeclaration name ty) = Abstract.typeDeclaration name ty
+   coDeclaration (VariableDeclaration name ty) = Abstract.variableDeclaration name ty
+   coDeclaration (ProcedureDeclaration heading body) = Abstract.procedureDeclaration heading body
+   coDeclaration (AddressedVariableDeclaration var vars tp) =
+      ISO.Abstract.addressedVariableDeclaration (var :| getZipList vars) tp
+   coDeclaration (ForwardProcedureDeclaration heading) = ISO.Abstract.forwardProcedureDeclaration heading
+   coDeclaration (ModuleDeclaration name priority imports exports body) =
+      Abstract.moduleDeclaration name priority imports exports body
+
+   coType (ArrayType dimensions itemType) = Abstract.arrayType (getZipList dimensions) itemType
+   coType (EnumerationType names) = Abstract.enumeration names
+   coType (PackedSetType base) = ISO.Abstract.packedSetType base
+   coType (PointerType destination) = Abstract.pointerType destination
+   coType (ProcedureType params) = Abstract.procedureType params
+   coType (RecordType fields) = Abstract.recordType (getZipList fields)
+   coType (SetType itemType) = Abstract.setType itemType
+   coType (SubrangeType base low high) = Abstract.subRange base low high
+   coType (TypeReference q) = Abstract.typeReference q
+
+   coStatement EmptyStatement = Abstract.emptyStatement
+   coStatement (Assignment destination expression) = Abstract.assignment destination expression
+   coStatement (ProcedureCall procedure parameters) = Abstract.procedureCall procedure $ getZipList <$> parameters
+   coStatement (If branch elsifs fallback) = Abstract.ifStatement (branch :| getZipList elsifs) fallback
+   coStatement (CaseStatement scrutinee cases fallback) =
+      Abstract.caseStatement scrutinee (getZipList cases) fallback
+   coStatement (While condition body) = Abstract.whileStatement condition body
+   coStatement (Repeat body condition) = Abstract.repeatStatement body condition
+   coStatement (Loop body) = Abstract.loopStatement body
+   coStatement (With designator body) = Abstract.withStatement designator body
+   coStatement Exit = Abstract.exitStatement
+   coStatement (Return result) = Abstract.returnStatement result
+   coStatement (For index from to by body) = Abstract.forStatement index from to by body
+   coStatement RetryStatement = ISO.Abstract.retryStatement
+
+   coExpression (Relation op left right) = Abstract.relation op left right
+   coExpression (Positive e) = Abstract.positive e
+   coExpression (Negative e) = Abstract.negative e
+   coExpression (Add left right) = Abstract.add left right
+   coExpression (Subtract left right) = Abstract.subtract left right
+   coExpression (Or left right) = Abstract.or left right
+   coExpression (Multiply left right) = Abstract.multiply left right
+   coExpression (Divide left right) = Abstract.divide left right
+   coExpression (IntegerDivide left right) = Abstract.integerDivide left right
+   coExpression (Modulo left right) = Abstract.modulo left right
+   coExpression (And left right) = Abstract.and left right
+   coExpression (Literal value) = Abstract.literal value
+   coExpression (Read var) = Abstract.read var
+   coExpression (FunctionCall function parameters) = Abstract.functionCall function $ getZipList parameters
+   coExpression (Not e) = Abstract.not e
+   coExpression (Set itemType elements) = Abstract.set itemType (getZipList elements)
+   coExpression (Remainder left right) = ISO.Abstract.remainder left right
+   coExpression (Array itemType items) = ISO.Abstract.array itemType items
+   coExpression (Record tp fields) = ISO.Abstract.record tp fields
+
+   coValue Nil = Abstract.nil
+   coValue (Boolean False) = Abstract.false
+   coValue (Boolean True) = Abstract.true
+   coValue (Builtin name) = Abstract.builtin name
+   coValue (Integer n) = Abstract.integer n
+   coValue (Real r) = Abstract.real r
+   coValue (String s) = Abstract.string s
+   coValue (CharCode c) = Abstract.charCode c
+
+   coDesignator (Variable q) = Abstract.variable q
+   coDesignator (Field record name) = Abstract.field record name
+   coDesignator (Index array index indexes) = Abstract.index array (index :| getZipList indexes)
+   coDesignator (Dereference pointer) = Abstract.dereference pointer
+
+instance Abstract.Nameable Language where
+   getProcedureName (ProcedureHeading name _) = name
+   getIdentDefName = id
+   getNonQualIdentName (QualIdent [] name) = Just name
+   getNonQualIdentName _ = Nothing
+
+instance Abstract.Modula2 Language where
+   type Export Language = Export Language
+   type Definition Language = Declaration False Language
+   type Variant Language = Variant Language
+
+   -- Module
+   definitionModule name imports exports definitions = DefinitionModule name imports exports (ZipList definitions)
+   implementationModule = ImplementationModule
+   programModule = ProgramModule
+
+   moduleExport = Export
+   moduleImport = Import
+   
+   -- Definition
+   constantDefinition = ConstantDeclaration
+   typeDefinition = \name-> maybe (OpaqueTypeDeclaration name) (TypeDeclaration name)
+   variableDefinition = VariableDeclaration
+   procedureDefinition = ProcedureDefinition
+
+   -- Declaration
+   moduleDeclaration = ModuleDeclaration
+
+   -- Type
+   arrayType = ArrayType . ZipList
+   recordType = RecordType . ZipList
+
+   procedureHeading = ProcedureHeading
+   caseFieldList n t (variant :| variants) fallback = CaseFieldList n t variant (ZipList variants) (ZipList fallback)
+   variant (case1 :| cases) fields = Variant case1 (ZipList cases) (ZipList fields)
+
+   forStatement = For
+   withStatement = With
+
+   enumeration = EnumerationType
+   subRange = SubrangeType
+   setType = SetType
+   
+   -- Expression
+   set memberType members = Set memberType (ZipList members)
+   qualIdent = QualIdent
+
+instance ISO.Abstract.Modula2 Language where
+   type AddressedIdent Language = AddressedIdent Language
+   type Item Language = Item Language
+
+   -- Declaration
+   emptyVariant = EmptyVariant
+   addressedVariableDeclaration (var :| vars) = AddressedVariableDeclaration var (ZipList vars)
+   forwardProcedureDeclaration = ForwardProcedureDeclaration
+   exceptionHandlingBlock = ExceptionHandlingBlock . ZipList
+   addressedIdent = AddressedIdent
+   unaddressedIdent = UnaddressedIdent
+
+   -- Type
+   packedSetType = PackedSetType
+
+   -- Statement
+   retryStatement = RetryStatement
+
+    -- Expression
+   array = Array
+   record = Record
+   remainder = Remainder
+
+   -- Compound expression
+   single = Single
+   repeated = Repeated
+
+data Declaration (full :: Bool) λ l (f' :: * -> *) (f :: * -> *) where
+   ConstantDeclaration :: Abstract.IdentDef l -> f (Abstract.ConstExpression l l f' f') -> Declaration x λ l f' f
+   TypeDeclaration :: Abstract.IdentDef l -> f (Abstract.Type l l f' f') -> Declaration x λ l f' f
+   OpaqueTypeDeclaration :: Abstract.IdentDef l -> Declaration False λ l f' f
+   VariableDeclaration :: Abstract.IdentList l -> f (Abstract.Type l l f' f') -> Declaration x λ l f' f
+   AddressedVariableDeclaration :: f (ISO.Abstract.AddressedIdent l l f' f')
+                                -> ZipList (f (ISO.Abstract.AddressedIdent l l f' f'))
+                                -> f (Abstract.Type l l f' f')
+                                -> Declaration True λ l f' f
+   ProcedureDeclaration :: f (Abstract.ProcedureHeading l l f' f') -> f (Abstract.Block l l f' f')
+                        -> Declaration True λ l f' f
+   ProcedureDefinition :: f (Abstract.ProcedureHeading l l f' f') -> Declaration False λ l f' f
+   ForwardProcedureDeclaration :: f (Abstract.ProcedureHeading l l f' f') -> Declaration True λ l f' f
+   ModuleDeclaration :: Ident -> Maybe (f (Abstract.Priority l l f' f')) -> [Abstract.Import l]
+                     -> Maybe (Abstract.Export l) -> f (Abstract.Block l l f' f') -> Declaration True λ l f' f
+
+deriving instance (Show (Abstract.Export l), Show (Abstract.Import l), Show (f (ISO.Abstract.AddressedIdent l l f' f')),
+                   Show (f (Abstract.Type l l f' f')), Show (f (Abstract.ConstExpression l l f' f')),
+                   Show (f (Abstract.FormalParameters l l f' f')), Show (f (Abstract.ProcedureHeading l l f' f')),
+                   Show (f (Abstract.Block l l f' f')), Show (f (Abstract.Block l l f' f')),
+                   Show (Abstract.IdentDef l)) => Show (Declaration x λ l f' f)
+
+data AddressedIdent λ l f' f = AddressedIdent Ident (f (Abstract.ConstExpression l l f' f'))
+                             | UnaddressedIdent Ident
+
+deriving instance (Typeable λ, Typeable l, Typeable f, Typeable f',
+                   Data (f (Abstract.ConstExpression l l f' f'))) => Data (AddressedIdent λ l f' f)
+deriving instance (Show (f (Abstract.ConstExpression l l f' f'))) => Show (AddressedIdent λ l f' f)
+
+data Type λ l f' f = TypeReference (Abstract.QualIdent l)
+                   | ArrayType (ZipList (f (Abstract.Type l l f' f'))) (f (Abstract.Type l l f' f'))
+                   | EnumerationType (Abstract.IdentList l)
+                   | SubrangeType (Maybe (Abstract.QualIdent l))
+                                  (f (Abstract.ConstExpression l l f' f')) (f (Abstract.ConstExpression l l f' f'))
+                   | SetType (f (Abstract.Type l l f' f'))
+                   | PackedSetType (f (Abstract.Type l l f' f'))
+                   | RecordType (ZipList (f (Abstract.FieldList l l f' f')))
+                   | PointerType (f (Abstract.Type l l f' f'))
+                   | ProcedureType (Maybe (f (Abstract.FormalParameters l l f' f')))
+
+deriving instance (Typeable λ, Typeable l, Typeable f, Typeable f',
+                   Data (Abstract.QualIdent l), Data (Abstract.IdentList l),
+                   Data (f (Abstract.Type l l f' f')), Data (f (Abstract.ConstExpression l l f' f')),
+                   Data (f (Abstract.FormalParameters l l f' f')), Data (f (Abstract.FieldList l l f' f'))) =>
+                  Data (Type λ l f' f)
+deriving instance (Show (Abstract.QualIdent l), Show (Abstract.IdentList l), Show (f (Abstract.Type l l f' f')),
+                   Show (f (Abstract.ConstExpression l l f' f')), Show (f (Abstract.FormalParameters l l f' f')),
+                   Show (f (Abstract.FieldList l l f' f'))) =>
+                  Show (Type λ l f' f)
+
+data Expression λ l f' f = Relation RelOp (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | Positive (f (Abstract.Expression l l f' f'))
+                         | Negative (f (Abstract.Expression l l f' f'))
+                         | Add (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | Subtract (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | Or (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | Multiply (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | Divide (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | IntegerDivide (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | Modulo (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | Remainder (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | And (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f'))
+                         | Array (Maybe (Abstract.QualIdent l)) [f (ISO.Abstract.Item l l f' f')]
+                         | Record (Maybe (Abstract.QualIdent l)) [f (Abstract.Expression l l f' f')]
+                         | Set (Maybe (Abstract.QualIdent l)) (ZipList (f (Abstract.Element l l f' f')))
+                         | Read (f (Abstract.Designator l l f' f'))
+                         | FunctionCall (f (Abstract.Designator l l f' f')) (ZipList (f (Abstract.Expression l l f' f')))
+                         | Not (f (Abstract.Expression l l f' f'))
+                         | Literal (f (Abstract.Value l l f' f'))
+
+data Item λ l f' f = Single (f (Abstract.Expression l l f' f'))
+                   | Repeated (f (Abstract.Expression l l f' f')) (f (Abstract.ConstExpression l l f' f'))
+
+deriving instance (Typeable λ, Typeable l, Typeable f, Typeable f', Data (Abstract.QualIdent l),
+                   Data (f (Abstract.Designator l l f' f')), Data (f (Abstract.Element l l f' f')),
+                   Data (f (ISO.Abstract.Item l l f' f')), Data (f (Abstract.Value l l f' f')),
+                   Data (f (Abstract.Expression l l f' f'))) =>
+                  Data (Expression λ l f' f)
+deriving instance (Show (Abstract.QualIdent l), Show (f (Abstract.Designator l l f' f')),
+                   Show (f (Abstract.Element l l f' f')), Show (f (ISO.Abstract.Item l l f' f')),
+                   Show (f (Abstract.Value l l f' f')), Show (f (Abstract.Expression l l f' f'))) => Show (Expression λ l f' f)
+deriving instance (Eq (Abstract.QualIdent l), Eq (f (Abstract.Designator l l f' f')),
+                   Eq (f (Abstract.Element l l f' f')), Eq (f (ISO.Abstract.Item l l f' f')),
+                   Eq (f (Abstract.Value l l f' f')), Eq (f (Abstract.Expression l l f' f'))) => Eq (Expression λ l f' f)
+deriving instance (Typeable λ, Typeable l, Typeable f, Typeable f', Data (f (Abstract.Expression l l f' f')),
+                   Data (f (Abstract.Expression l l f' f'))) =>
+                  Data (Item λ l f' f)
+deriving instance (Show (f (Abstract.Expression l l f' f'))) => Show (Item λ l f' f)
+deriving instance (Eq (f (Abstract.Expression l l f' f'))) => Eq (Item λ l f' f)
+
+
+data Variant λ l f' f =
+   Variant (f (Abstract.CaseLabels l l f' f')) (ZipList (f (Abstract.CaseLabels l l f' f')))
+           (ZipList (f (Abstract.FieldList l l f' f')))
+   | EmptyVariant
+
+deriving instance (Typeable λ, Typeable l, Typeable f, Typeable f', Data (f (Abstract.CaseLabels l l f' f')),
+                   Data (f (Abstract.FieldList l l f' f'))) => Data (Variant λ l f' f)
+deriving instance (Show (f (Abstract.CaseLabels l l f' f')), Show (f (Abstract.FieldList l l f' f')))
+               => Show (Variant λ l f' f)
+
+
+data Block λ l f' f = Block (ZipList (f (Abstract.Declaration l l f' f'))) (Maybe (f (Abstract.StatementSequence l l f' f')))
+                    | ExceptionHandlingBlock (ZipList (f (Abstract.Declaration l l f' f')))
+                                             (Maybe (f (Abstract.StatementSequence l l f' f')))
+                                             (Maybe (f (Abstract.StatementSequence l l f' f')))
+                                             (Maybe (f (Abstract.StatementSequence l l f' f')))
+
+deriving instance (Typeable λ, Typeable l, Typeable f, Typeable f', Data (f (Abstract.Declaration l l f' f')),
+                   Data (f (Abstract.Designator l l f' f')), Data (f (Abstract.Expression l l f' f')),
+                   Data (f (Abstract.StatementSequence l l f' f'))) =>
+                  Data (Block λ l f' f)
+deriving instance (Show (f (Abstract.Declaration l l f' f')), Show (f (Abstract.Designator l l f' f')),
+                   Show (f (Abstract.Expression l l f' f')), Show (f (Abstract.StatementSequence l l f' f'))) =>
+                  Show (Block λ l f' f)
+
+data Statement λ l f' f = EmptyStatement
+                        | Assignment (f (Abstract.Designator l l f' f')) (f (Abstract.Expression l l f' f'))
+                        | ProcedureCall (f (Abstract.Designator l l f' f')) (Maybe (ZipList (f (Abstract.Expression l l f' f'))))
+                        | If (f (Abstract.ConditionalBranch l l f' f'))
+                             (ZipList (f (Abstract.ConditionalBranch l l f' f')))
+                             (Maybe (f (Abstract.StatementSequence l l f' f')))
+                        | CaseStatement (f (Abstract.Expression l l f' f')) 
+                                        (ZipList (f (Abstract.Case l l f' f')))
+                                        (Maybe (f (Abstract.StatementSequence l l f' f')))
+                        | While (f (Abstract.Expression l l f' f')) (f (Abstract.StatementSequence l l f' f'))
+                        | Repeat (f (Abstract.StatementSequence l l f' f')) (f (Abstract.Expression l l f' f'))
+                        | For Ident (f (Abstract.Expression l l f' f')) (f (Abstract.Expression l l f' f')) 
+                              (Maybe (f (Abstract.Expression l l f' f'))) (f (Abstract.StatementSequence l l f' f'))
+                        | Loop (f (Abstract.StatementSequence l l f' f'))
+                        | With (f (Abstract.Designator l l f' f')) (f (Abstract.StatementSequence l l f' f'))
+                        | Exit
+                        | Return (Maybe (f (Abstract.Expression l l f' f')))
+                        | RetryStatement
+
+deriving instance (Typeable λ, Typeable l, Typeable f, Typeable f',
+                   Data (f (Abstract.Designator l l f' f')), Data (f (Abstract.Expression l l f' f')),
+                   Data (f (Abstract.Case l l f' f')), Data (f (Abstract.ConditionalBranch l l f' f')),
+                   Data (f (Abstract.StatementSequence l l f' f'))) => Data (Statement λ l f' f)
+deriving instance (Show (f (Abstract.Designator l l f' f')), Show (f (Abstract.Expression l l f' f')),
+                   Show (f (Abstract.Case l l f' f')), Show (f (Abstract.ConditionalBranch l l f' f')),
+                   Show (f (Abstract.StatementSequence l l f' f'))) => Show (Statement λ l f' f)
+
+$(concat <$>
+  (forM [Rank2.TH.deriveFunctor, Rank2.TH.deriveFoldable, Rank2.TH.deriveTraversable,
+         Transformation.Shallow.TH.deriveAll, Transformation.Deep.TH.deriveAll] $
+   \derive-> mconcat <$> mapM derive
+             [''AddressedIdent, ''Block, ''Declaration, ''Expression, ''Item, ''Statement, ''Type, ''Variant]))
+
+$(mconcat <$> mapM Rank2.TH.unsafeDeriveApply
+   [''AddressedIdent, ''Block, ''Declaration, ''Type, ''Statement, ''Expression, ''Item, ''Variant])
diff --git a/src/Language/Modula2/ISO/Abstract.hs b/src/Language/Modula2/ISO/Abstract.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Modula2/ISO/Abstract.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE DeriveDataTypeable, KindSignatures, PolyKinds,
+             TypeFamilies, TypeFamilyDependencies, UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
+
+-- | ISO Modula-2 Finally Tagless Abstract Syntax Tree definitions
+
+module Language.Modula2.ISO.Abstract (Modula2(..)) where
+
+import Data.Data (Data, Typeable)
+import Data.List.NonEmpty
+import Data.Text (Text)
+
+import qualified Language.Modula2.Abstract as Report
+import Language.Modula2.Abstract hiding (Modula2)
+
+-- | The additional finally-tagless associated types and methods relevant to the ISO Modula-2 language.
+class Report.Modula2 l => Modula2 l where
+   type AddressedIdent l = (d :: * -> (* -> *) -> (* -> *) -> *) | d -> l
+   type Item l = (i :: * -> (* -> *) -> (* -> *) -> *) | i -> l
+
+   -- Declaration
+   emptyVariant :: Variant l l' f' f
+   addressedVariableDeclaration :: NonEmpty (f (AddressedIdent l' l' f' f')) -> f (Type l' l' f' f')
+                                -> Declaration l l' f' f
+   forwardProcedureDeclaration :: f (ProcedureHeading l' l' f' f') -> Declaration l l' f' f
+   exceptionHandlingBlock :: [f (Declaration l' l' f' f')] -> Maybe (f (StatementSequence l' l' f' f'))
+                          -> Maybe (f (StatementSequence l' l' f' f')) -> Maybe (f (StatementSequence l' l' f' f'))
+                          -> Block l l' f' f
+   addressedIdent :: Ident -> f (ConstExpression l' l' f' f') -> AddressedIdent l l' f' f
+   unaddressedIdent :: Ident -> AddressedIdent l l' f' f
+
+   -- Type
+   packedSetType :: f (Type l' l' f' f') -> Type l l' f' f
+
+   -- Statement
+   retryStatement :: Statement l l' f' f
+
+    -- Expression
+   array :: Maybe (QualIdent l') -> [f (Item l' l' f' f')] -> Expression l l' f' f
+   record :: Maybe (QualIdent l') -> [f (Expression l' l' f' f')] -> Expression l l' f' f
+   remainder :: f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression l l' f' f
+
+   -- Compound expression
+   single :: f (Expression l' l' f' f') -> Item l l' f' f
+   repeated :: f (Expression l' l' f' f') -> f (ConstExpression l' l' f' f') -> Item l l' f' f
+
+instance Wirthy l => Modula2 (WirthySubsetOf l) where
+   type AddressedIdent (WirthySubsetOf l) = Maybe3 (AddressedIdent l)
+   type Item (WirthySubsetOf l) = Maybe3 (Item l)
+   emptyVariant = nothing3
+   addressedVariableDeclaration = const $ const nothing3
+   forwardProcedureDeclaration = const nothing3
+   exceptionHandlingBlock = const $ const $ const $ const nothing3
+   addressedIdent = const $ const nothing3
+   unaddressedIdent = const nothing3
+
+   -- Type
+   packedSetType = const nothing3
+
+   -- Statement
+   retryStatement = nothing3
+
+    -- Expression
+   array = const $ const nothing3
+   record = const $ const nothing3
+   remainder = const $ const nothing3
+
+   -- Compound expression
+   single = const nothing3
+   repeated = const $ const nothing3
diff --git a/src/Language/Modula2/ISO/ConstantFolder.hs b/src/Language/Modula2/ISO/ConstantFolder.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Modula2/ISO/ConstantFolder.hs
@@ -0,0 +1,256 @@
+{-# LANGUAGE DataKinds, DuplicateRecordFields, FlexibleContexts, FlexibleInstances,
+             MultiParamTypeClasses, OverloadedStrings, RankNTypes,
+             ScopedTypeVariables, TemplateHaskell, TypeApplications, TypeFamilies, UndecidableInstances #-}
+
+-- | The main export of this module is the function 'foldConstants' that folds the constants in an ISO Modula-2 AST
+-- using an attribute grammar. Other exports are helper functions and attribute types that can be reused for other
+-- languages or attribute grammars.
+
+module Language.Modula2.ISO.ConstantFolder (foldConstants, InhCF,
+                                            SynCF(..), SynCFDesignator(..), SynCFExp(..), SynCFMod', Environment) where
+
+import Control.Applicative (liftA2, ZipList(ZipList, getZipList))
+import Control.Arrow (first)
+import Control.Monad (join)
+import Data.Bits (shift)
+import Data.Char (chr, ord, toUpper)
+import Data.Coerce (Coercible, coerce)
+import Data.Functor.Identity (Identity(..))
+import Data.Int (Int32)
+import Data.Foldable (fold)
+import Data.List.NonEmpty (toList)
+import Data.Map.Lazy (Map)
+import Data.Maybe (fromMaybe)
+import qualified Data.Map.Lazy as Map
+import Data.Semigroup (Semigroup(..))
+import qualified Data.Text as Text
+import Foreign.Storable (sizeOf)
+import Language.Haskell.TH (appT, conT, varT, varE, newName)
+import Data.Text.Prettyprint.Doc (Pretty)
+
+import qualified Rank2
+import qualified Transformation
+import qualified Transformation.Deep as Deep
+import qualified Transformation.Full as Full
+import qualified Transformation.Full.TH
+import qualified Transformation.AG as AG
+import Transformation.AG (Attribution(..), Atts, Inherited(..), Synthesized(..), Semantics)
+import Transformation.AG.Generics (Bequether(..), Synthesizer(..), SynthesizedField(..), Auto(Auto), Mapped(..))
+
+import qualified Language.Modula2.Abstract as Abstract hiding (Modula2)
+import qualified Language.Modula2.ISO.Abstract as Abstract
+import qualified Language.Modula2.AST as Report
+import qualified Language.Modula2.AST as AST (Ident, QualIdent, Module(..), Export(..),
+                                              ProcedureHeading(..), FieldList(..), Designator(..),
+                                              Element(..), Value(..))
+import qualified Language.Modula2.ISO.AST as AST
+import Language.Modula2.Grammar (ParsedLexemes(Trailing))
+import Language.Oberon.Abstract (coExpression, coValue)
+import qualified Language.Oberon.Abstract as Oberon.Abstract
+import qualified Language.Oberon.AST as Oberon.AST
+import qualified Language.Oberon.ConstantFolder as Oberon.ConstantFolder
+import Language.Oberon.ConstantFolder (ConstantFold(ConstantFold), Placed, Sem, Environment,
+                                       InhCF(..), InhCFRoot(..), SynCF(..), SynCF',
+                                       SynCFRoot(..), SynCFMod(..), SynCFMod', SynCFExp(..), SynCFDesignator(..),
+                                       folded', foldedExp, foldedExp')
+import Language.Modula2.ConstantFolder (foldBinaryArithmetic, foldBinaryBoolean,
+                                        foldBinaryFractional, foldBinaryInteger,
+                                        maxCardinal, maxInteger, minInteger, maxInt32, minInt32, maxSet, minSet,
+                                        doubleSize, floatSize, intSize, int32Size,
+                                        maxReal, minReal)
+
+-- | Fold the constants in the given collection of Modula-2 modules (a 'Map' of modules keyed by module name). It uses
+-- the constant declarations from the modules as well as the given 'Environment' of predefined constants and
+-- functions.
+--
+-- Note that the ISO Modula-2 'AST.Language' satisfies all constraints in the function's type signature.
+foldConstants :: forall l. (Abstract.Modula2 l, Abstract.Nameable l,
+                            Ord (Abstract.QualIdent l), Show (Abstract.QualIdent l),
+                            Atts (Inherited (Auto ConstantFold)) (Abstract.Block l l Sem Sem) ~ InhCF l,
+                            Atts (Inherited (Auto ConstantFold)) (Abstract.Definition l l Sem Sem) ~ InhCF l,
+                            Atts (Inherited (Auto ConstantFold)) (Abstract.Expression l l Sem Sem) ~ InhCF l,
+                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Block l l Sem Sem)
+                            ~ SynCFMod' l (Abstract.Block l l),
+                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Block l l Placed Placed)
+                            ~ SynCFMod' l (Abstract.Block l l),
+                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Definition l l Sem Sem)
+                            ~ SynCFMod' l (Abstract.Definition l l),
+                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Definition l l Placed Placed)
+                            ~ SynCFMod' l (Abstract.Definition l l),
+                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Expression l l Sem Sem) ~ SynCFExp l l,
+                            Atts (Synthesized (Auto ConstantFold)) (Abstract.Expression l l Placed Placed)
+                            ~ SynCFExp l l,
+                            Full.Functor (Auto ConstantFold) (Abstract.Block l l),
+                            Full.Functor (Auto ConstantFold) (Abstract.Definition l l),
+                            Full.Functor (Auto ConstantFold) (Abstract.Expression l l))
+              => Environment l -> AST.Module l l Placed Placed -> AST.Module l l Placed Placed
+foldConstants predef aModule =
+   snd $ getMapped
+   $ folded (syn (Transformation.apply (Auto ConstantFold) ((0, Trailing [], 0), Auto ConstantFold Deep.<$> aModule)
+                  `Rank2.apply`
+                  Inherited (InhCF predef undefined))
+             :: SynCFMod' l (AST.Module l l))
+
+newtype Modules l f' f = Modules {getModules :: Map AST.Ident (f (AST.Module l l f' f'))}
+
+-- * Modules instances, TH candidates
+instance (Transformation.Transformation t, Functor (Transformation.Domain t), Deep.Functor t (AST.Module l l),
+          Transformation.At t (AST.Module l l (Transformation.Codomain t) (Transformation.Codomain t))) =>
+         Deep.Functor t (Modules l) where
+   t <$> ~(Modules ms) = Modules (mapModule <$> ms)
+      where mapModule m = t Transformation.$ ((t Deep.<$>) <$> m)
+
+instance Rank2.Functor (Modules l f') where
+   f <$> ~(Modules ms) = Modules (f <$> ms)
+
+instance Rank2.Apply (Modules l f') where
+   ~(Modules fs) <*> ~(Modules ms) = Modules (Map.intersectionWith Rank2.apply fs ms)
+
+-- * Boring attribute types
+type instance Atts (Synthesized (Auto ConstantFold)) (Modules l _ _) = SynCFRoot (Modules l Placed Identity)
+type instance Atts (Synthesized (Auto ConstantFold)) (AST.Block λ l _ _) = SynCFMod' l (AST.Block l l)
+type instance Atts (Synthesized (Auto ConstantFold)) (AST.Declaration full λ l _ _) = SynCFMod' l (AST.Declaration full l l)
+type instance Atts (Synthesized (Auto ConstantFold)) (AST.AddressedIdent λ l _ _) = SynCF' (AST.AddressedIdent l l)
+type instance Atts (Synthesized (Auto ConstantFold)) (AST.Type λ l _ _) = SynCF' (AST.Type l l)
+type instance Atts (Synthesized (Auto ConstantFold)) (AST.Expression λ l _ _) = SynCFExp λ l
+type instance Atts (Synthesized (Auto ConstantFold)) (AST.Item λ l _ _) = SynCF' (AST.Item l l)
+type instance Atts (Synthesized (Auto ConstantFold)) (AST.Statement λ l _ _) = SynCF' (AST.Statement l l)
+type instance Atts (Synthesized (Auto ConstantFold)) (AST.Variant λ l _ _) = SynCF' (AST.Variant l l)
+
+type instance Atts (Inherited (Auto ConstantFold)) (Modules l _ _) = InhCFRoot l
+type instance Atts (Inherited (Auto ConstantFold)) (AST.Block λ l _ _) = InhCF λ
+type instance Atts (Inherited (Auto ConstantFold)) (AST.Declaration full λ l _ _) = InhCF λ
+type instance Atts (Inherited (Auto ConstantFold)) (AST.AddressedIdent λ l _ _) = InhCF λ
+type instance Atts (Inherited (Auto ConstantFold)) (AST.Type λ l _ _) = InhCF λ
+type instance Atts (Inherited (Auto ConstantFold)) (AST.Item λ l _ _) = InhCF λ
+type instance Atts (Inherited (Auto ConstantFold)) (AST.Expression λ l _ _) = InhCF λ
+type instance Atts (Inherited (Auto ConstantFold)) (AST.Statement λ l _ _) = InhCF λ
+type instance Atts (Inherited (Auto ConstantFold)) (AST.Variant λ l _ _) = InhCF λ
+
+wrap :: a -> Mapped Placed a
+wrap = Mapped . (,) (0, Trailing [], 0)
+
+-- * Rules
+
+instance Ord (Abstract.QualIdent l) => Attribution (Auto ConstantFold) (Modules l) Sem Placed where
+   attribution _ (_, Modules self) (Inherited inheritance, Modules ms) =
+     (Synthesized SynCFRoot{modulesFolded= Modules (pure . snd . getMapped . foldedModule . syn <$> ms)},
+      Modules (Map.mapWithKey moduleInheritance self))
+     where moduleInheritance name mod = Inherited InhCF{env= rootEnv inheritance <> foldMap (moduleEnv . syn) ms,
+                                                        currentModule= name}
+           foldedModule :: SynCFMod' l (AST.Module l l) -> Mapped Placed (AST.Module l l Placed Placed)
+           foldedModule = folded
+
+instance (Abstract.Nameable l, Ord (Abstract.QualIdent l),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Declaration l l Sem Sem) ~ SynCFMod' l (Abstract.Declaration l l),
+          Atts (Inherited (Auto ConstantFold)) (Abstract.StatementSequence l l Sem Sem) ~ InhCF l,
+          Atts (Inherited (Auto ConstantFold)) (Abstract.Declaration l l Sem Sem) ~ InhCF l) =>
+         Bequether (Auto ConstantFold) (AST.Block l l) Sem Placed where
+   bequest _ (pos, AST.Block _decls _stats) inheritance (AST.Block decls stats) =
+      AST.Block (pure $ Inherited localEnv) (pure $ Inherited localEnv)
+      where newEnv = Map.unions (moduleEnv . syn <$> decls)
+            localEnv = InhCF (newEnv `Map.union` env inheritance) (currentModule inheritance)
+   bequest _ (pos, AST.ExceptionHandlingBlock{}) inheritance (AST.ExceptionHandlingBlock decls _stats _catch _always) =
+      AST.ExceptionHandlingBlock (pure $ Inherited localEnv) (pure $ Inherited localEnv) (pure $ Inherited localEnv) (pure $ Inherited localEnv)
+      where newEnv = Map.unions (moduleEnv . syn <$> decls)
+            localEnv = InhCF (newEnv `Map.union` env inheritance) (currentModule inheritance)
+
+instance (Abstract.Nameable l, k ~ Abstract.QualIdent l, v ~ Abstract.Value l l Placed Placed, Ord k,
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Declaration l l Sem Sem)
+          ~ SynCFMod' l (Abstract.Declaration l l)) =>
+         SynthesizedField "moduleEnv" (Map k (Maybe v)) (Auto ConstantFold) (AST.Block l l) Sem Placed where
+   synthesizedField _ _ (pos, AST.Block{}) _ (AST.Block decls _stats) = Map.unions (moduleEnv . syn <$> decls)
+   synthesizedField _ _ (pos, AST.ExceptionHandlingBlock{}) _ (AST.ExceptionHandlingBlock decls _stats _catch _always) =
+      Map.unions (moduleEnv . syn <$> decls)
+
+instance (Abstract.Modula2 l, Abstract.Nameable l, k ~ Abstract.QualIdent l, Ord k, v ~ Abstract.Value l l Placed Placed,
+          Abstract.Export l ~ AST.Export l, Abstract.Value l ~ AST.Value l,
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Declaration l l Sem Sem)
+          ~ SynCFMod' l (Abstract.Declaration l l),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Type l l Sem Sem) ~ SynCF' (Abstract.Type l l),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.ProcedureHeading l l Sem Sem)
+          ~ SynCF' (Abstract.ProcedureHeading l l),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.FormalParameters l l Sem Sem)
+          ~ SynCF' (Abstract.FormalParameters l l),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Block l l Sem Sem) ~ SynCFMod' l (Abstract.Block l l),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.ConstExpression l l Sem Sem) ~ SynCFExp l l) =>
+         SynthesizedField "moduleEnv" (Map k (Maybe v)) (Auto ConstantFold) (AST.Declaration full l l) Sem Placed where
+   synthesizedField _ _ (pos, AST.ConstantDeclaration namedef _) _ (AST.ConstantDeclaration _ expression) =
+      Map.singleton (Abstract.nonQualIdent $ Abstract.getIdentDefName namedef)
+                    ((snd <$>) . foldedValue $ syn expression)
+   synthesizedField _ _ (pos, AST.ModuleDeclaration moduleName _priority imports exports _body)
+                    _ (AST.ModuleDeclaration _name priority _imports _exports body) =
+      foldMap exportedEnv exports
+      where exportedEnv (AST.Export qualified names) =
+               Map.mapKeysMonotonic qualify (Map.filterWithKey (const . (`elem` exportList)) (moduleEnv $ syn body))
+               where exportList = Abstract.qualIdent [] <$> toList names
+                     qualify qname
+                        | qualified,
+                          Just name <- Abstract.getNonQualIdentName qname = Abstract.qualIdent [moduleName] name
+                        | otherwise = qname
+   synthesizedField _ _ _ _ _ = mempty
+
+instance (Abstract.Nameable l, Ord (Abstract.QualIdent l),
+          Abstract.QualIdent l ~ AST.QualIdent l, Abstract.Value l ~ AST.Value l,
+          λ ~ AST.Language,
+--          Abstract.QualIdent Report.Language ~ AST.QualIdent l,
+          Coercible (Abstract.QualIdent Report.Language) (AST.QualIdent l),
+          Coercible (Abstract.Value Report.Language Report.Language) (AST.Value l l),
+          InhCF l ~ InhCF λ,
+          Pretty (AST.Value l l Identity Identity),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Expression l l Sem Sem) ~ SynCFExp l l,
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Element l l Sem Sem) ~ SynCF' (Abstract.Element l l),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Item l l Sem Sem) ~ SynCF' (Abstract.Item l l),
+          Atts (Synthesized (Auto ConstantFold)) (Abstract.Designator l l Sem Sem) ~ SynCFDesignator l) =>
+         Synthesizer (Auto ConstantFold) (AST.Expression λ l) Sem Placed where
+   synthesis _ (pos, _) _ (AST.Remainder left right) = 
+      foldBinaryInteger pos Abstract.remainder div (syn left) (syn right)
+   synthesis _ (pos, _) _ (AST.Array itemType dimensions) =
+      SynCFExp{folded= Mapped (pos, Abstract.array itemType (getMapped . folded' . syn <$> dimensions)),
+               foldedValue= Nothing}
+   synthesis _ (pos, _) _ (AST.Record recordType fields) =
+      SynCFExp{folded= Mapped (pos, Abstract.record recordType (foldedExp' . syn <$> fields)),
+               foldedValue= Nothing}
+   synthesis _ (pos, AST.Set t _elements) _ (AST.Set _t elements) =
+      SynCFExp{folded= Mapped (pos, Abstract.set t (getMapped . folded' . syn <$> getZipList elements)),
+               foldedValue= Nothing}
+   synthesis t (pos, self) (InhCF environment currMod) synthesized =
+      fromReport (synthesis t (pos, toReport self) (InhCF (coerce <$> Map.mapKeysMonotonic coerce environment) currMod)
+                  $ toReport synthesized)
+      where fromJust :: forall f a (b :: * -> *) (c :: * -> *). Oberon.Abstract.Maybe3 f a b c -> f a b c
+            fromJust (Oberon.Abstract.Maybe3 Nothing) =
+               error ("Modula-2 expression cannot be converted from ISO to Report at " ++ show pos)
+            fromJust (Oberon.Abstract.Maybe3 (Just e)) = e
+            fromReport :: SynCFExp Report.Language l -> SynCFExp AST.Language l
+            fromReport SynCFExp{folded= Mapped (pos', reportExpression),
+                                foldedValue= reportValue} =
+               SynCFExp{folded= Mapped (pos', fromJust (coExpression @Report.Language
+                                                        @(Abstract.WirthySubsetOf AST.Language) reportExpression)),
+                        foldedValue= reportValue}
+            toReport :: Abstract.Expression AST.Language l f1 f2 -> Report.Expression Report.Language l f1 f2
+            toReport s = fromJust (coExpression @AST.Language @(Abstract.WirthySubsetOf Report.Language) s)
+
+-- * More boring Transformation.Functor instances, TH candidates
+instance Ord (Abstract.QualIdent l) => Transformation.At (Auto ConstantFold) (Modules l Sem Sem) where
+   ($) = AG.applyDefault snd
+
+-- * Unsafe Rank2 AST instances
+
+$(do l <- varT  <$> newName "l"
+     mconcat <$> mapM (\g-> Transformation.Full.TH.deriveUpFunctor (conT ''Auto `appT` conT ''ConstantFold) $ conT g `appT` l `appT` l)
+        [''AST.Block, ''AST.AddressedIdent, ''AST.Type, ''AST.Expression, ''AST.Statement, ''AST.Item, ''AST.Variant])
+
+$(do let sem = [t|Semantics (Auto ConstantFold)|]
+     let inst g = [d| instance Attribution (Auto ConstantFold) ($g l l) Sem Placed =>
+                               Transformation.At (Auto ConstantFold) ($g l l $sem $sem)
+                         where ($) = AG.applyDefault snd |]
+     mconcat <$> mapM (inst . conT)
+        [''AST.Block, ''AST.AddressedIdent, ''AST.Type, ''AST.Statement, ''AST.Expression, ''AST.Item, ''AST.Variant])
+
+$(do full <- varT  <$> newName "full"
+     l <- varT  <$> newName "l"
+     Transformation.Full.TH.deriveUpFunctor [t| (Auto ConstantFold) |] [t| AST.Declaration $full $l $l |])
+
+instance Attribution (Auto ConstantFold) (AST.Declaration full l l) Sem Placed
+      => Transformation.At (Auto ConstantFold) (AST.Declaration full l l Sem Sem) where
+   ($) = AG.applyDefault snd
diff --git a/src/Language/Modula2/ISO/Grammar.hs b/src/Language/Modula2/ISO/Grammar.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Modula2/ISO/Grammar.hs
@@ -0,0 +1,504 @@
+{-# Language FlexibleContexts, FlexibleInstances, OverloadedStrings, Rank2Types, RecordWildCards, ScopedTypeVariables,
+             TypeFamilies, TypeSynonymInstances, TemplateHaskell #-}
+-- | Modula-2 grammar adapted from the ISO specification of the language.
+
+module Language.Modula2.ISO.Grammar where
+
+import Control.Applicative
+import Control.Monad (guard, void)
+import Data.Char (isAlphaNum, isDigit, isHexDigit, isLetter, isOctDigit, isSpace)
+import Data.List.NonEmpty (NonEmpty, toList)
+import Data.Maybe (catMaybes)
+import Data.Monoid ((<>))
+import Data.Text (Text, unpack)
+import Numeric (readOct, readDec, readHex, readFloat)
+import Text.Grampa
+import Text.Grampa.ContextFree.LeftRecursive.Transformer (lift, tmap)
+import Text.Parser.Combinators (sepBy, sepBy1, sepByNonEmpty, try)
+import Text.Parser.Token (braces, brackets, parens)
+
+import qualified Rank2
+import qualified Rank2.TH
+import Transformation.Deep as Deep (Product(Pair))
+
+import Language.Oberon.Grammar (TokenType(..))
+
+import qualified Language.Modula2.Abstract as Abstract
+import qualified Language.Modula2.ISO.Abstract as ISO.Abstract
+import qualified Language.Modula2.ISO.AST as AST
+import qualified Language.Modula2.Grammar as ReportGrammar
+import           Language.Modula2.Grammar (delimiter, wrap)
+
+type Parser = ReportGrammar.Parser
+
+-- | The names and types of all the new grammar productions in the ISO specification
+data ISOMixin l f p = ISOMixin{
+   machineAddress :: p (f (Abstract.ConstExpression l l f f)),
+   packedSetType :: p (Abstract.Type l l f f),
+   moduleBody :: p (Abstract.Block l l f f),
+   variableIdentifierList :: p (NonEmpty (f (ISO.Abstract.AddressedIdent l l f f))),
+   retryStatement :: p (Abstract.Statement l l f f),
+   arrayConstructor :: p (Abstract.Expression l l f f),
+   recordConstructor :: p (Abstract.Expression l l f f),
+   arrayConstructedValue :: p [f (ISO.Abstract.Item l l f f)],
+   recordConstructedValue :: p [f (Abstract.Expression l l f f)],
+   setConstructedValue :: p [f (Abstract.Element l l f f)],
+   arrayPart :: p (ISO.Abstract.Item l l f f),
+   structureComponent  :: p (f (Abstract.Expression l l f f))}
+
+-- | The new grammar productions in the ISO specification
+isoMixin :: (ISO.Abstract.Modula2 l, LexicalParsing (Parser g Text))
+         => ReportGrammar.Modula2Grammar l ReportGrammar.NodeWrap (Parser g Text)
+         -> ISOMixin l ReportGrammar.NodeWrap (Parser g Text)
+         -> ISOMixin l ReportGrammar.NodeWrap (Parser g Text)
+isoMixin ReportGrammar.Modula2Grammar{..} ISOMixin{..} = ISOMixin{
+   machineAddress = brackets constExpression,
+   variableIdentifierList =
+        sepByNonEmpty (wrap (ISO.Abstract.unaddressedIdent <$> ident
+                             <|> ISO.Abstract.addressedIdent <$> ident <*> brackets constExpression))
+                      (delimiter ","),
+   packedSetType = ISO.Abstract.packedSetType <$ keyword "PACKED" <* keyword "SET" <* keyword "OF" <*> wrap simpleType,
+   moduleBody = ISO.Abstract.exceptionHandlingBlock <$> declarationSequence
+                <*> optional (keyword "BEGIN" *> statementSequence)
+                <*> optional (keyword "EXCEPT" *> statementSequence)
+                <*> optional (keyword "FINALLY" *> statementSequence) <* keyword "END",
+   retryStatement = ISO.Abstract.retryStatement <$ keyword "RETRY",
+   arrayConstructor = ISO.Abstract.array . Just <$> qualident <*> arrayConstructedValue,
+   arrayConstructedValue = braces (sepBy1 (wrap arrayPart) (delimiter ",")),
+   arrayPart = ISO.Abstract.single <$> structureComponent
+               <|> ISO.Abstract.repeated <$> structureComponent <* keyword "BY" <*> constExpression,
+   structureComponent = expression <|> wrap (ISO.Abstract.array Nothing <$> arrayConstructedValue
+                                             <|> ISO.Abstract.record Nothing <$> recordConstructedValue
+                                             <|> Abstract.set Nothing <$> setConstructedValue),
+   recordConstructor = ISO.Abstract.record . Just <$> qualident <*> recordConstructedValue,
+   recordConstructedValue = braces (sepBy structureComponent (delimiter ",")),
+   setConstructedValue = braces (sepBy (wrap element) (delimiter ","))
+   }
+
+type ISOGrammar l = Rank2.Product (ISOMixin l ReportGrammar.NodeWrap) (ReportGrammar.Modula2Grammar l ReportGrammar.NodeWrap)
+
+modula2ISOgrammar :: Grammar (ISOGrammar AST.Language) Parser Text
+modula2ISOgrammar = fixGrammar isoGrammar
+
+-- | All the productions of the ISO Modula-2 grammar
+isoGrammar :: forall l g. (ISO.Abstract.Modula2 l, LexicalParsing (Parser g Text))
+           => GrammarBuilder (ISOGrammar l) g Parser Text
+isoGrammar (Rank2.Pair iso@ISOMixin{..} report@ReportGrammar.Modula2Grammar{..}) =
+   Rank2.Pair (isoMixin report iso) $
+   reportGrammar{
+      ReportGrammar.variableDeclaration =
+           ISO.Abstract.addressedVariableDeclaration <$> variableIdentifierList <* delimiter ":" <*> wrap type_prod,
+      ReportGrammar.procedureDeclaration =
+           ReportGrammar.procedureDeclaration reportGrammar
+           <|> ISO.Abstract.forwardProcedureDeclaration <$> wrap (snd <$> procedureHeading)
+               <* delimiter ";" <* keyword "FORWARD",
+      ReportGrammar.type_prod = ReportGrammar.type_prod reportGrammar <|> packedSetType,
+      ReportGrammar.subrangeType = uncurry <$> (Abstract.subRange <$> optional qualident)
+                                   <*> brackets ((,) <$> constExpression <* delimiter ".." <*> constExpression),
+      ReportGrammar.variant = ReportGrammar.variant reportGrammar <|> pure ISO.Abstract.emptyVariant,
+      ReportGrammar.block = ISO.Abstract.exceptionHandlingBlock <$> declarationSequence
+                            <*> optional (keyword "BEGIN" *> statementSequence)
+                            <*> optional (keyword "EXCEPT" *> statementSequence) <*> pure Nothing <* keyword "END",
+      ReportGrammar.statement = ReportGrammar.statement reportGrammar <|> retryStatement,
+      ReportGrammar.caseStatement = Abstract.caseStatement <$ keyword "CASE" <*> expression
+       <*  keyword "OF" <*> (catMaybes <$> sepBy1 (optional $ wrap case_prod) (delimiter "|"))
+       <*> optional (keyword "ELSE" *> statementSequence) <* keyword "END",
+      ReportGrammar.factor = ReportGrammar.factor reportGrammar <<|> wrap arrayConstructor <<|> wrap recordConstructor,
+      ReportGrammar.set = Abstract.set . Just <$> qualident <*> setConstructedValue,
+      ReportGrammar.mulOperator = ReportGrammar.mulOperator reportGrammar
+                                  <|> ISO.Abstract.remainder <$ keyword "REM"}
+   where reportGrammar = ReportGrammar.grammar report
+
+instance TokenParsing (Parser (ISOGrammar l) Text) where
+   someSpace = someLexicalSpace
+   token = lexicalToken
+
+instance LexicalParsing (Parser (ISOGrammar l) Text) where
+   lexicalComment = do c <- ReportGrammar.comment
+                       lift ([[ReportGrammar.Comment c]], ())
+   lexicalWhiteSpace = ReportGrammar.whiteSpace
+   isIdentifierStartChar = isLetter
+   isIdentifierFollowChar c = isAlphaNum c || c == '_'
+   identifierToken word = lexicalToken (do w <- word
+                                           guard (w `notElem` reservedWords)
+                                           return w)
+   lexicalToken p = snd <$> tmap addOtherToken (match p) <* lexicalWhiteSpace
+      where addOtherToken ([], (i, x)) = ([[ReportGrammar.Token Other i]], (i, x))
+            addOtherToken (t, (i, x)) = (t, (i, x))
+   keyword s = lexicalToken (string s
+                             *> notSatisfyChar isAlphaNum
+                             <* lift ([[ReportGrammar.Token Keyword s]], ()))
+               <?> ("keyword " <> show s)
+
+reservedWords = ReportGrammar.reservedWords <> ["EXCEPT", "FINALLY", "FORWARD", "PACKEDSET", "REM", "RETRY"]
+
+$(Rank2.TH.deriveAll ''ISOMixin)
+
+{-
+compilation module = program module | definition module | implementation module,
+program module =
+   "MODULE", module identifier, [protection], semicolon,
+   import lists, module block, module identifier, period,
+module identifier = identifier,
+protection = left bracket, protection expression, right bracket,
+protection expression = constant expression,
+definition module =
+   "DEFINITION", "MODULE", module identifier, semicolon,
+   import lists, definitions, "END", module identifier, period,
+implementation module =
+   "IMPLEMENTATION", "MODULE", module identifier, [protection], 
+   semicolon, import lists, module block, module identifier, period,
+import lists = {import list},
+import list = simple import | unqualified import,
+simple import = "IMPORT", identifier list, semicolon,
+unqualified import = "FROM", module identifier, "IMPORT", identifier list, semicolon,
+export list = unqualified export | qualified export,
+unqualified export = "EXPORT", identifier list, semicolon,
+qualified export = "EXPORT", "QUALIFIED", identifier list, semicolon,
+qualified identifier = {module identifier, period}, identifier,
+definitions = {definition},
+definition =
+   "CONST", {constant declaration, semicolon} |
+   "TYPE", {type definition, semicolon} |
+   "VAR", {variable declaration, semicolon} |
+   procedure heading, semicolon,
+procedure heading = proper procedure heading | function procedure heading,
+type definition = type declaration | opaque type definition,
+opaque type definition = identifier,
+proper procedure heading = "PROCEDURE", procedure identifier, [formal parameters],
+formal parameters = left parenthesis, [formal parameter list], right parenthesis,
+formal parameter list = formal parameter, {semicolon, formal parameter},
+function procedure heading = "PROCEDURE", procedure identifier, formal parameters,
+   colon, function result type,
+function result type = type identifier,
+formal parameter = value parameter specification | variable parameter specification,
+value parameter specification = identifier list, colon, formal type,
+variable parameter specification = "VAR", identifier list, colon, formal type,
+declarations = {declaration},
+declaration =
+   "CONST", {constant declaration, semicolon} |
+   "TYPE", {type declaration, semicolon} |
+   "VAR", {variable declaration, semicolon} |
+   procedure declaration, semicolon |
+   local module declaration, semicolon,
+constant declaration = identifier, equals, constant expression,
+type declaration = identifier, equals, type denoter,
+variable declaration = variable identifier list, colon, type denoter,
+
+variable identifier list =
+   identifier, [ machine address], {comma, identifier, 
+   [machine address] },
+machine address =
+   left bracket, value of address type, right bracket,
+value of address type =
+   constant expression,
+procedure declaration = proper procedure declaration | function procedure declaration,
+proper procedure declaration =
+   proper procedure heading, semicolon, (proper procedure block, 
+   procedure identifier | "FORWARD"),
+procedure identifier =
+   identifier,
+function procedure declaration =
+   function procedure heading, semicolon, (function procedure block,
+    procedure identifier | "FORWARD"),
+local module declaration =
+   "MODULE", module identifier, [protection], semicolon,
+   import lists, [export list], module block, module identifier,
+type denoter =
+   type identifier |new type,
+ordinal type denoter =
+   ordinal type identifier | new ordinal type,
+type identifier =
+   qualified identifier,
+ordinal type identifier =
+   type identifier,
+new type =
+   new ordinal type | set type | packedset type | pointer type |
+   procedure type | array type | record type,
+new ordinal type =
+   enumeration type | subrange type,
+enumeration type =
+   left parenthesis, identifier list, right parenthesis,
+identifier list =
+   identifier, {comma, identifier},
+subrange type =
+   [range type], left bracket, constant expression, ellipsis,
+   constant expression, right bracket,
+range type =
+   ordinal type identifier,
+set type =
+   "SET", "OF", base type,
+base type =
+   ordinal type denoter,
+packedset type =
+   "PACKEDSET", "OF", base type,
+pointer type =
+   "POINTER", "TO", bound type,
+bound type =
+   type denoter,
+procedure type =
+   proper procedure type | function procedure type,
+proper procedure type =
+   "PROCEDURE", [left parenthesis, [formal parameter type list],
+    right parenthesis],
+function procedure type =
+   "PROCEDURE", left parenthesis, [formal parameter type list],
+    right parenthesis, colon, function result type,
+formal parameter type list =
+   formal parameter type, {comma, formal parameter type},
+formal parameter type =
+   variable formal type | value formal type,
+variable formal type =
+   "VAR", formal type,
+value formal type =
+   formal type,
+formal type =
+   type identifier | open array formal type,
+open array formal type =
+   "ARRAY", "OF", {"ARRAY", "OF"}, type identifier,
+array type =
+   "ARRAY", index type, {comma, index type}, "OF", component type,
+index type =
+   ordinal type denoter,
+component type =
+   type denoter,
+record type =
+   "RECORD", field list, "END",
+field list =
+   fields, {semicolon, fields},
+fields =
+   [fixed fields | variant fields],
+fixed fields =
+   identifier list, colon, field type,
+field type =
+   type denoter,
+variant fields =
+   "CASE", [tag identifier], colon, tag type, "OF",
+   variant list, "END",
+tag identifier =
+   identifier,
+tag type =
+   ordinal type identifier,
+variant list =
+   variant, {case separator, variant}, [variant else part],
+variant else part =
+   "ELSE", field list,
+variant =
+   [variant label list, colon, field list],
+variant label list =
+   variant label, {comma, variant label},
+variant label =
+   constant expression, [ellipsis, constant expression],
+proper procedure block =
+   declarations, [procedure body], "END",
+procedure body =
+   "BEGIN", block body,
+function procedure block =
+   declarations, function body, "END",
+function body =
+   "BEGIN", block body,
+module block =
+   declarations, [module body], "END",
+module body =
+   initialization body, [finalization body],,
+initialization body =
+   "BEGIN", block body,
+finalization body =
+   "FINALLY", block body,
+block body =
+   normal part, ["EXCEPT", exceptional part],
+normal part =
+   statement sequence,
+exceptional part =
+   statement sequence,
+statement =
+   empty statement | assignment statement | procedure call |
+    return statement |retry statement | with statement |
+    if statement | case statement |while statement |
+    repeat statement | loop statement |exit statement |for statement,
+statement sequence =
+   statement, {semicolon, statement},
+empty statement =
+  ,
+assignment statement =
+   variable designator, assignment operator, expression,
+procedure call =
+   procedure designator, [actual parameters],
+procedure designator =
+   value designator,
+return statement =
+   simple return statement | function return statement,
+simple return statement =
+   "RETURN",
+function return statement =
+   "RETURN", expression,
+retry statement =
+   "RETRY",
+with statement =
+   "WITH", record designator, "DO", statement sequence, "END",
+record designator =
+   variable designator | value designator,
+if statement =
+   guarded statements, [if else part], "END",
+guarded statements =
+   "IF", boolean expression, "THEN", statement sequence,
+   {"ELSIF", boolean expression, "THEN", statement sequence},
+if else part =
+   "ELSE", statement sequence,
+boolean expression =
+   expression,
+case statement =
+   "CASE", case selector, "OF", case list, "END",
+case selector =
+   ordinal expression,
+case list =
+   case alternative, {case separator, case alternative},
+   [case else part],
+case else part =
+   "ELSE", statement sequence,
+case alternative =
+   [case label list, colon, statement sequence],
+case label list =
+   case label, {comma, case label},
+case label =
+   constant expression, [ellipsis, constant expression],
+while statement =
+   "WHILE", boolean expression, "DO", statement sequence, "END",
+repeat statement =
+   "REPEAT", statement sequence, "UNTIL", boolean expression,
+loop statement =
+   "LOOP", statement sequence, "END",
+exit statement =
+   "EXIT",
+for statement =
+   "FOR", control variable identifier, assignment operator, 
+   initial value, "TO", final value, ["BY", step size], "DO",
+   statement sequence, "END",
+control variable identifier =
+   identifier,
+initial value =
+   ordinal expression,
+final value =
+   ordinal expression,
+step size =
+   constant expression,
+variable designator =
+   entire designator | indexed designator |
+   selected designator | dereferenced designator,
+entire designator =
+   qualified identifier,
+indexed designator =
+   array variable designator, left bracket, index expression,
+   {comma, index expression}, right bracket,
+array variable designator =
+   variable designator,
+index expression =
+   ordinal expression,
+selected designator =
+   record variable designator, period, field identifier,
+record variable designator =
+   variable designator,
+field identifier =
+   identifier,
+dereferenced designator =
+   pointer variable designator, dereferencing operator,
+pointer variable designator =
+   variable designator,
+expression =
+   simple expression, [relational operator, simple expression],
+simple expression =
+   [sign], term, {term operator, term},
+term =
+   factor, {factor operator, factor},
+factor =
+   left parenthesis, expression, right parenthesis | 
+   logical negation operator, factor |
+   value designator | function call |
+   value constructor | constant literal,
+ordinal expression =
+   expression,
+relational operator =
+   equals operator | inequality operator | less than operator |
+   greater than operator | less than or equal operator |
+   subset operator | greater than or equal operator | 
+   superset operator | set membership operator,
+term operator =
+   plus operator | set union operator | minus operator |
+   set difference operator | logical disjunction operator | 
+   string catenate symbol,
+factor operator =
+   multiplication operator | set intersection operator | 
+   division operator | symmetric set difference operator |
+   rem operator | div operator | mod operator |
+   logical conjunction operator,
+value designator =
+  entire value | indexed value | selected value | dereferenced value,
+entire value =
+   qualified identifier,
+indexed value =
+   array value, left bracket, index expression,
+   {comma, index expression}, right bracket,
+array value =
+   value designator,
+selected value =
+   record value, period, field identifier,
+record value =
+   value designator,
+dereferenced value =
+   pointer value, dereferencing operator,
+pointer value =
+   value designator,
+function call =
+   function designator, actual parameters,
+function designator =
+   value designator,
+value constructor =
+   array constructor | record constructor | set constructor,
+array constructor =
+   array type identifier, array constructed value,
+array type identifier =
+   type identifier,
+array constructed value =
+   left brace, repeated structure component,
+   {comma, repeated structure component}, right brace,
+repeated structure component =
+   structure component, ["BY", repetition factor],
+repetition factor =
+   constant expression,
+structure component =
+   expression | array constructed value |
+   record constructed value | set constructed value,
+record constructor =
+   record type identifier, record constructed value,
+record type identifier =
+   type identifier,
+record constructed value =
+   left brace, [structure component, {comma, structure component}],
+   right brace,
+
+set constructor =
+   set type identifier, set constructed value,
+set type identifier =
+   type identifier,
+set constructed value =
+   left brace, [member, {comma, member}], right brace,
+member =
+   interval | singleton,
+interval =
+   ordinal expression, ellipsis, ordinal expression,
+singleton =
+   ordinal expression,
+constant literal =
+   whole number literal | real literal |
+   string literal | pointer literal,
+constant expression =
+   expression,
+actual parameters =
+   left parenthesis, [actual parameter list], right parenthesis,
+actual parameter list =
+   actual parameter, {comma, actual parameter},
+actual parameter =
+   variable designator | expression | type parameter,
+type parameter =
+   type identifier,
+   -}
diff --git a/src/Language/Modula2/ISO/Pretty.hs b/src/Language/Modula2/ISO/Pretty.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Modula2/ISO/Pretty.hs
@@ -0,0 +1,174 @@
+{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GADTs, OverloadedStrings, ScopedTypeVariables,
+             TypeApplications, TypeFamilies, UndecidableInstances #-}
+
+-- | This module exports the instances of the 'Pretty' type class necessary for printing of an ISO Modula-2 abstract
+-- syntax tree.
+
+module Language.Modula2.ISO.Pretty () where
+
+import Control.Applicative (ZipList(ZipList, getZipList))
+import Data.Coerce (coerce)
+import Data.Functor.Identity (Identity(..))
+import Data.List (intersperse)
+import Data.List.NonEmpty (NonEmpty((:|)), fromList, toList)
+import qualified Data.Text as Text
+import Data.Text.Prettyprint.Doc
+import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)
+
+import qualified Language.Oberon.Abstract
+import qualified Language.Oberon.AST
+import qualified Language.Modula2.Abstract as Abstract
+import qualified Language.Modula2.ISO.Abstract as ISO.Abstract
+import Language.Modula2.ISO.AST
+import Language.Oberon.Pretty (Precedence(Precedence))
+import Language.Modula2.Pretty ()
+import qualified Language.Modula2.AST as Report
+
+instance (Abstract.Nameable l, Pretty (Abstract.IdentDef l),
+          Pretty (Abstract.Export l), Pretty (Abstract.Import l),
+          Pretty (Abstract.Type l l Identity Identity),
+          Pretty (Abstract.Declaration l l Identity Identity),
+          Pretty (Abstract.Expression l l Identity Identity),
+          Pretty (Abstract.FormalParameters l l Identity Identity),
+          Pretty (Abstract.ProcedureHeading l l Identity Identity),
+          Pretty (Abstract.Block l l Identity Identity)) =>
+         Pretty (Declaration False Language l Identity Identity) where
+   pretty (ProcedureDefinition heading) = pretty heading <> semi
+   pretty (ConstantDeclaration ident (Identity expr)) = "CONST" <+> pretty ident <+> "=" <+> pretty expr <> semi
+   pretty (TypeDeclaration ident typeDef) = "TYPE" <+> pretty ident <+> "=" <+> pretty typeDef <> semi
+   pretty (OpaqueTypeDeclaration ident) = "TYPE" <+> pretty ident <> semi
+   pretty (VariableDeclaration idents varType) =
+      "VAR" <+> hsep (punctuate comma $ pretty <$> toList idents) <+> colon <+> pretty varType <> semi
+
+instance (Abstract.Nameable l, Pretty (Abstract.IdentDef l),
+          Pretty (Abstract.Export l), Pretty (Abstract.Import l),
+          Pretty (ISO.Abstract.AddressedIdent l l Identity Identity),
+          Pretty (Abstract.Type l l Identity Identity),
+          Pretty (Abstract.Declaration l l Identity Identity),
+          Pretty (Abstract.Expression l l Identity Identity),
+          Pretty (Abstract.FormalParameters l l Identity Identity),
+          Pretty (Abstract.ProcedureHeading l l Identity Identity),
+          Pretty (Abstract.Block l l Identity Identity)) =>
+         Pretty (Declaration True Language l Identity Identity) where
+   pretty (AddressedVariableDeclaration var vars varType) =
+      "VAR" <+> hsep (punctuate comma $ pretty <$> (var : getZipList vars)) <> colon <+> pretty varType <> semi
+   pretty (ForwardProcedureDeclaration heading) = pretty heading <> semi <> "FORWARD" <> semi
+   pretty (ModuleDeclaration name priority imports export body) =
+      vsep $ intersperse mempty $
+      ["MODULE" <+> pretty name <> maybe mempty (brackets . pretty) priority <> semi,
+       vsep (pretty <$> imports),
+       foldMap pretty export,
+       pretty body,
+       "END" <+> pretty name <> semi]
+   pretty dec = Abstract.maybe3 mempty pretty (Abstract.coDeclaration @Language @(Abstract.WirthySubsetOf Report.Language) dec)
+
+instance Pretty (Abstract.ConstExpression l l Identity Identity) => Pretty (AddressedIdent l l Identity Identity) where
+   pretty (AddressedIdent name address) = pretty name <> brackets (pretty address)
+   pretty (UnaddressedIdent name) = pretty name
+
+instance (Pretty (Abstract.IdentDef l), Pretty (Abstract.FormalParameters l l Identity Identity),
+          Pretty (Abstract.FieldList l l Identity Identity),
+          Pretty (Abstract.ConstExpression l l Identity Identity), Pretty (Abstract.Type l l Identity Identity),
+          Pretty (Abstract.BaseType l)) => Pretty (Type Language l Identity Identity) where
+   pretty (ArrayType dimensions itemType) =
+      "ARRAY" <+> hsep (punctuate comma $ pretty . runIdentity <$> getZipList dimensions) <+> "OF" <+> pretty itemType
+   pretty (EnumerationType values) = "(" <> hsep (punctuate comma $ toList $ pretty <$> values) <> ")"
+   pretty (SubrangeType enumType min max) = foldMap pretty enumType <> "[" <> pretty min <+> ".." <+> pretty max <> "]"
+   pretty (SetType memberType) = "SET" <+> "OF" <+> pretty memberType
+   pretty (PackedSetType memberType) = "PACKED" <+> "SET" <+> "OF" <+> pretty memberType
+   pretty (RecordType fields) = vsep ["RECORD",
+                                       indent 3 (vsep $ punctuate semi $ pretty <$> getZipList fields),
+                                       "END"]
+   pretty (ProcedureType parameters) = "PROCEDURE" <+> adjust (pretty parameters)
+      where adjust = pretty . Text.replace " : " "" . Text.replace ";" "," . renderStrict . layoutCompact
+   pretty ty = Abstract.maybe3 mempty pretty (Abstract.coType @Language @(Abstract.WirthySubsetOf Report.Language) ty)
+
+instance (Pretty (Abstract.IdentDef l), Pretty (Abstract.QualIdent l), Pretty (Abstract.Type l l Identity Identity),
+          Pretty (Abstract.Value l l Identity Identity),
+          Pretty (Abstract.FieldList l l Identity Identity), Pretty (Abstract.Variant l l Identity Identity)) =>
+         Pretty (Report.FieldList Language l Identity Identity) where
+   pretty fl = pretty (coerce fl :: Report.FieldList Report.Language l Identity Identity)
+
+instance (Pretty (Abstract.CaseLabels l l Identity Identity), Pretty (Abstract.FieldList l l Identity Identity)) =>
+         Pretty (Variant λ l Identity Identity) where
+   pretty EmptyVariant = mempty
+   pretty (Variant label labels fields) = pretty (Report.Variant label labels fields)
+
+instance (Pretty (Abstract.Declaration l l Identity Identity), Pretty (Abstract.StatementSequence l l Identity Identity)) =>
+         Pretty (Block λ l Identity Identity) where
+   pretty (Block declarations body) =
+      vsep ((indent 3 . pretty <$> getZipList declarations)
+            ++ foldMap (\statements-> ["BEGIN", prettyBody statements]) body)
+   pretty (ExceptionHandlingBlock declarations body except finally) =
+      vsep ((indent 3 . pretty <$> getZipList declarations)
+            ++ foldMap (\statements-> ["BEGIN", prettyBody statements]) body
+            ++ foldMap (\statements-> ["EXCEPT", prettyBody statements]) except
+            ++ foldMap (\statements-> ["FINALLY", prettyBody statements]) finally)
+
+instance (Pretty (Abstract.ConstExpression l l Identity Identity),
+          Pretty (Abstract.Designator l l Identity Identity),
+          Pretty (Abstract.Case l l Identity Identity),
+          Pretty (Abstract.ConditionalBranch l l Identity Identity),
+          Pretty (Language.Oberon.Abstract.WithAlternative l l Identity Identity),
+          Pretty (Abstract.StatementSequence l l Identity Identity)) =>
+         Pretty (Statement Language l Identity Identity) where
+   prettyList l = vsep (dropEmptyTail $ punctuate semi $ pretty <$> l)
+      where dropEmptyTail
+               | not (null l), EmptyStatement <- last l = init
+               | otherwise = id
+   pretty (For index from to by body) = vsep ["FOR" <+> pretty index <+> ":=" <+> pretty from <+> "TO" <+> pretty to
+                                              <+> foldMap ("BY" <+>) (pretty <$> by) <+> "DO",
+                                              prettyBody body,
+                                              "END"]
+   pretty (With designator body) = vsep ["WITH" <+> pretty designator <+> "DO",
+                                         prettyBody body,
+                                         "END"]
+   pretty RetryStatement = "RETRY"
+   pretty stat = Abstract.maybe3 mempty pretty (Abstract.coStatement @Language @(Abstract.WirthySubsetOf Report.Language) stat)
+
+instance (Pretty (Precedence (Abstract.Expression l l Identity Identity)),
+          Pretty (Abstract.Expression l l Identity Identity),
+          Pretty (Abstract.Value l l Identity Identity),
+          Pretty (Abstract.Element l l Identity Identity),
+          Pretty (ISO.Abstract.Item l l Identity Identity),
+          Pretty (Abstract.Designator l l Identity Identity),
+          Pretty (Abstract.QualIdent l)) => Pretty (Expression Language l Identity Identity) where
+   pretty e = pretty (Precedence 0 e)
+
+instance Pretty (Abstract.Value l l Identity Identity) => Pretty (Report.Value Language l Identity Identity) where
+   pretty v = Abstract.maybe3 mempty pretty (Abstract.coValue @Language @(Abstract.WirthySubsetOf Report.Language) v)
+
+instance (Pretty (Abstract.Expression l l Identity Identity)) => Pretty (Item Language l Identity Identity) where
+   pretty (Single e) = pretty e
+   pretty (Repeated e count) = pretty e <+> "BY" <+> pretty count
+
+instance (Pretty (Precedence (Abstract.Expression l l Identity Identity)),
+          Pretty (Abstract.Expression l l Identity Identity),
+          Pretty (Abstract.Value l l Identity Identity),
+          Pretty (Abstract.Element l l Identity Identity),
+          Pretty (ISO.Abstract.Item l l Identity Identity),
+          Pretty (Abstract.Designator l l Identity Identity),
+          Pretty (Abstract.QualIdent l)) =>
+         Pretty (Precedence (Expression Language l Identity Identity)) where
+   pretty (Precedence p e@(Remainder left right))
+      | p < 4 = pretty (Precedence 4 $ runIdentity left) <+> "REM" <+> pretty (Precedence 4 $ runIdentity right)
+      | otherwise = parens (pretty e)
+   pretty (Precedence _ (Array itemType items)) =
+      foldMap pretty itemType <+> braces (hsep $ punctuate comma $ pretty <$> items)
+   pretty (Precedence _ (Record recordType fields)) =
+      foldMap pretty recordType <+> braces (hsep $ punctuate comma $ pretty <$> fields)
+   pretty (Precedence _ (Set setType elements)) =
+      foldMap pretty setType <+> braces (hsep $ punctuate comma $ pretty <$> getZipList elements)
+   pretty (Precedence p e) =
+      Abstract.maybe3 mempty (pretty . Precedence p) (Abstract.coExpression @Language @(Abstract.WirthySubsetOf Report.Language) e)
+
+instance (Pretty (Abstract.QualIdent l), Pretty (Abstract.Designator l l Identity Identity),
+          Pretty (Abstract.Expression l l Identity Identity)) =>
+         Pretty (Report.Designator Language l Identity Identity) where
+   pretty d = Abstract.maybe3 mempty pretty (Abstract.coDesignator @Language @(Abstract.WirthySubsetOf Report.Language) d)
+
+-- not used at run-time
+instance Language.Oberon.Abstract.Oberon Language where
+   type WithAlternative Language = Language.Oberon.AST.WithAlternative Language
+
+prettyBody (Identity statements) = indent 3 (pretty statements)
diff --git a/src/Language/Modula2/Pretty.hs b/src/Language/Modula2/Pretty.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Modula2/Pretty.hs
@@ -0,0 +1,203 @@
+{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GADTs, OverloadedStrings, ScopedTypeVariables,
+             TypeApplications, TypeFamilies, UndecidableInstances #-}
+
+-- | This module exports the instances of the 'Pretty' type class necessary for printing of a Modula-2 abstract syntax
+-- tree.
+
+module Language.Modula2.Pretty () where
+
+import Control.Applicative (ZipList(ZipList, getZipList))
+import Data.Functor.Identity (Identity(..))
+import Data.List (intersperse)
+import Data.List.NonEmpty (NonEmpty((:|)), fromList, toList)
+import qualified Data.Text as Text
+import Data.Text.Prettyprint.Doc
+import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)
+import Numeric (showHex, showOct)
+
+import qualified Language.Oberon.Abstract
+import qualified Language.Oberon.AST
+import qualified Language.Modula2.Abstract as Abstract
+import Language.Modula2.AST
+import Language.Oberon.Pretty (Precedence(Precedence))
+import qualified Language.Oberon.AST as Oberon
+
+instance (Pretty (Abstract.Priority l l Identity Identity),
+          Pretty (Abstract.Export l),
+          Pretty (Abstract.Import l),
+          Pretty (Abstract.Declaration l l Identity Identity),
+          Pretty (Abstract.Definition l l Identity Identity),
+          Pretty (Abstract.Block l l Identity Identity)) =>
+         Pretty (Module λ l Identity Identity) where
+   pretty (DefinitionModule name imports export declarations) =
+      vsep $ intersperse mempty $
+      ["DEFINITION" <+> "MODULE" <+> pretty name <> semi,
+       vsep (pretty <$> imports),
+       foldMap pretty export]
+      <> (pretty <$> getZipList declarations)
+      <> ["END" <+> pretty name <> "." <> line]
+   pretty (ImplementationModule name priority imports body) =
+     "IMPLEMENTATION" <+> pretty (ProgramModule name priority imports body)
+   pretty (ProgramModule name priority imports body) =
+      vsep $ intersperse mempty $
+      ["MODULE" <+> pretty name <> maybe mempty (brackets . pretty) priority <> semi,
+       vsep (pretty <$> imports)]
+      <> [vsep [pretty body, "END" <+> pretty name <> "." <> line]]
+
+instance Pretty (Abstract.IdentDef l) => Pretty (Import l) where
+  pretty (Import origin names) =
+    maybe id ((<+>) . ("FROM" <+>) . pretty) origin ("IMPORT" <+> hsep (punctuate comma $ toList $ pretty <$> names))
+    <> semi
+
+instance Pretty (Abstract.IdentDef l) => Pretty (Export l) where
+  pretty (Export qualified names) =
+    "EXPORT" <+> (if qualified then ("QUALIFIED" <+>) else id) (hsep $ punctuate comma $ toList $ pretty <$> names)
+    <> semi
+
+instance Pretty (IdentDef l) where
+  pretty (IdentDef name) = pretty name
+
+instance (Abstract.Nameable l, Pretty (Abstract.IdentDef l),
+          Pretty (Abstract.Export l), Pretty (Abstract.Import l),
+          Pretty (Abstract.Type l l Identity Identity),
+          Pretty (Abstract.Declaration l l Identity Identity),
+          Pretty (Abstract.Expression l l Identity Identity),
+          Pretty (Abstract.FormalParameters l l Identity Identity),
+          Pretty (Abstract.ProcedureHeading l l Identity Identity),
+          Pretty (Abstract.Block l l Identity Identity)) =>
+         Pretty (Declaration False Language l Identity Identity) where
+   pretty (ProcedureDefinition heading) = pretty heading <> semi
+   pretty (ConstantDeclaration ident (Identity expr)) = "CONST" <+> pretty ident <+> "=" <+> pretty expr <> semi
+   pretty (TypeDeclaration ident typeDef) = "TYPE" <+> pretty ident <+> "=" <+> pretty typeDef <> semi
+   pretty (OpaqueTypeDeclaration ident) = "TYPE" <+> pretty ident <> semi
+   pretty (VariableDeclaration idents varType) =
+      "VAR" <+> hsep (punctuate comma $ pretty <$> toList idents) <+> colon <+> pretty varType <> semi
+
+instance (Abstract.Nameable l, Pretty (Abstract.IdentDef l),
+          Pretty (Abstract.Export l), Pretty (Abstract.Import l),
+          Pretty (Abstract.Type l l Identity Identity),
+          Pretty (Abstract.Declaration l l Identity Identity),
+          Pretty (Abstract.Expression l l Identity Identity),
+          Pretty (Abstract.FormalParameters l l Identity Identity),
+          Pretty (Abstract.ProcedureHeading l l Identity Identity),
+          Pretty (Abstract.Block l l Identity Identity)) =>
+         Pretty (Declaration True Language l Identity Identity) where
+   pretty (ProcedureDeclaration heading body) = vsep [pretty heading <> semi,
+                                                      pretty body,
+                                                      "END" <+> pretty (Abstract.getProcedureName $ runIdentity heading)
+                                                      <> semi]
+   pretty (ModuleDeclaration name priority imports export body) =
+      vsep $ intersperse mempty $
+      ["MODULE" <+> pretty name <> maybe mempty (brackets . pretty) priority <> semi,
+       vsep (pretty <$> imports),
+       foldMap pretty export,
+       pretty body,
+       "END" <+> pretty name <> semi]
+   pretty declaration = Abstract.maybe3 mempty pretty (Abstract.coDeclaration
+                                                       @Language @(Abstract.WirthySubsetOf Oberon.Language) declaration)
+
+instance (Pretty (Precedence (Abstract.Expression l l Identity Identity)),
+          Pretty (Abstract.Value l l Identity Identity),
+          Pretty (Abstract.Expression l l Identity Identity),
+          Pretty (Abstract.Element l l Identity Identity),
+          Pretty (Abstract.Designator l l Identity Identity),
+          Pretty (Abstract.QualIdent l)) => Pretty (Expression Language l Identity Identity) where
+   pretty e = pretty (Precedence 0 e)
+
+instance (Pretty (Precedence (Abstract.Expression l l Identity Identity)),
+          Pretty (Abstract.Value l l Identity Identity),
+          Pretty (Abstract.Expression l l Identity Identity),
+          Pretty (Abstract.Element l l Identity Identity),
+          Pretty (Abstract.Designator l l Identity Identity),
+          Pretty (Abstract.QualIdent l)) =>
+         Pretty (Precedence (Expression Language l Identity Identity)) where
+   pretty (Precedence _ (Set ty elements)) =
+      foldMap pretty ty <+> braces (hsep $ punctuate comma $ pretty <$> getZipList elements)
+   pretty (Precedence p e) =
+      Abstract.maybe3 mempty (pretty . Precedence p) (Abstract.coExpression @Language @(Abstract.WirthySubsetOf Oberon.Language) e)
+
+instance Pretty (Abstract.Value l l Identity Identity) => Pretty (Value Language l Identity Identity) where
+   pretty (CharCode c) = pretty (showOct c "") <> "C"
+   pretty v = Abstract.maybe3 mempty pretty (Abstract.coValue @Language @(Abstract.WirthySubsetOf Oberon.Language) v)
+
+instance (Pretty (Abstract.QualIdent l), Pretty (Abstract.Designator l l Identity Identity),
+          Pretty (Abstract.Expression l l Identity Identity)) => Pretty (Designator Language l Identity Identity) where
+   pretty d = Abstract.maybe3 mempty pretty (Abstract.coDesignator @Language @(Abstract.WirthySubsetOf Oberon.Language) d)
+
+instance (Pretty (Abstract.IdentDef l), Pretty (Abstract.FormalParameters l l Identity Identity),
+          Pretty (Abstract.FieldList l l Identity Identity),
+          Pretty (Abstract.ConstExpression l l Identity Identity), Pretty (Abstract.Type l l Identity Identity),
+          Pretty (Abstract.BaseType l)) => Pretty (Type Language l Identity Identity) where
+   pretty (ArrayType dimensions itemType) =
+      "ARRAY" <+> hsep (punctuate comma $ pretty . runIdentity <$> getZipList dimensions) <+> "OF" <+> pretty itemType
+   pretty (EnumerationType values) = "(" <> hsep (punctuate comma $ toList $ pretty <$> values) <> ")"
+   pretty (SubrangeType enumType min max) = foldMap pretty enumType <> "[" <> pretty min <+> ".." <+> pretty max <> "]"
+   pretty (SetType memberType) = "SET" <+> "OF" <+> pretty memberType
+   pretty (RecordType fields) = vsep ["RECORD",
+                                       indent 3 (vsep $ punctuate semi $ pretty <$> getZipList fields),
+                                       "END"]
+   pretty (ProcedureType parameters) = "PROCEDURE" <+> adjust (pretty parameters)
+      where adjust = pretty . Text.replace " : " "" . Text.replace ";" "," . renderStrict . layoutCompact
+   pretty ty = Abstract.maybe3 mempty pretty (Abstract.coType @Language @(Abstract.WirthySubsetOf Oberon.Language) ty)
+
+instance Pretty (QualIdent l) where
+   pretty (QualIdent modulePath name) = mconcat (punctuate dot $ pretty <$> (modulePath <> [name]))
+
+instance (Pretty (Abstract.IdentDef l), Pretty (Abstract.QualIdent l), Pretty (Abstract.Type l l Identity Identity),
+          Pretty (Abstract.Value l l Identity Identity),
+          Pretty (Abstract.FieldList l l Identity Identity), Pretty (Abstract.Variant l l Identity Identity)) =>
+         Pretty (FieldList Language l Identity Identity) where
+   pretty (CaseFieldList localName name variant variants fallback) =
+     vsep (["CASE" <+> maybe id ((<+>) . (<+> ":") . pretty) localName (pretty name) <+> "OF"]
+           <> punctuate' "| " (pretty <$> (variant : getZipList variants))
+           <> (if null fallback then []
+               else ["ELSE" <#>
+                     indent 3 (vsep $ punctuate semi $ pretty . runIdentity <$> getZipList fallback)])
+           <> ["END"])
+   pretty (FieldList names t) = hsep (punctuate comma $ pretty <$> toList names) <+> ":" <+> pretty t
+
+instance (Pretty (Abstract.CaseLabels l l Identity Identity), Pretty (Abstract.FieldList l l Identity Identity)) =>
+         Pretty (Variant λ l Identity Identity) where
+  pretty (Variant label labels fields) = vsep [hsep (punctuate comma $ pretty <$> (label : getZipList labels)) <> ":",
+                                               indent 3 (vsep $ punctuate semi $ pretty <$> getZipList fields)]
+
+instance (Pretty (Abstract.IdentDef l), Pretty (Abstract.FormalParameters l l Identity Identity),
+          Pretty (Abstract.Type l l Identity Identity)) =>
+         Pretty (ProcedureHeading l l Identity Identity) where
+   pretty (ProcedureHeading name parameters) =
+      "PROCEDURE" <+> pretty name <> pretty parameters
+
+instance (Pretty (Abstract.ConstExpression l l Identity Identity),
+          Pretty (Abstract.Designator l l Identity Identity),
+          Pretty (Abstract.Case l l Identity Identity),
+          Pretty (Abstract.ConditionalBranch l l Identity Identity),
+          Pretty (Language.Oberon.Abstract.WithAlternative l l Identity Identity),
+          Pretty (Abstract.StatementSequence l l Identity Identity)) =>
+         Pretty (Statement Language l Identity Identity) where
+   prettyList l = vsep (dropEmptyTail $ punctuate semi $ pretty <$> l)
+      where dropEmptyTail
+               | not (null l), EmptyStatement <- last l = init
+               | otherwise = id
+   pretty (For index from to by body) = vsep ["FOR" <+> pretty index <+> ":=" <+> pretty from <+> "TO" <+> pretty to
+                                              <+> foldMap ("BY" <+>) (pretty <$> by) <+> "DO",
+                                              prettyBody body,
+                                              "END"]
+   pretty (With designator body) = vsep ["WITH" <+> pretty designator <+> "DO",
+                                         prettyBody body,
+                                         "END"]
+   pretty stat = Abstract.maybe3 mempty pretty (Abstract.coStatement @Language @(Abstract.WirthySubsetOf Oberon.Language) stat)
+
+instance Language.Oberon.Abstract.Oberon Language where
+   type WithAlternative Language = Language.Oberon.AST.WithAlternative Language
+--instance Pretty (Language.Oberon.AST.WithAlternative Language Language Identity Identity) where
+--   pretty _ = error "There's no WithAlternative in Modula-2."
+
+prettyBody :: Pretty (Abstract.StatementSequence l l Identity Identity) =>
+              Identity (Abstract.StatementSequence l l Identity Identity) -> Doc ann
+prettyBody (Identity statements) = indent 3 (pretty statements)
+
+punctuate' :: Doc ann -> [Doc ann] -> [Doc ann]
+punctuate' p [] = []
+punctuate' p (x:xs) = x : ((p <>) <$> xs)
+
+a <#> b = vsep [a, b]
diff --git a/test/Test.hs b/test/Test.hs
new file mode 100644
--- /dev/null
+++ b/test/Test.hs
@@ -0,0 +1,129 @@
+{-# Language FlexibleInstances #-}
+module Main where
+
+import Control.Monad (unless)
+import Data.Either.Validation (Validation(..))
+import Data.Functor.Identity (Identity(Identity))
+import Data.List (isSuffixOf)
+import Data.List.NonEmpty (NonEmpty((:|)))
+import Data.Text (Text, unpack)
+import Data.Text.IO (readFile)
+import Data.Text.Prettyprint.Doc (Pretty(pretty), layoutPretty, defaultLayoutOptions)
+import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)
+import System.Directory (doesDirectoryExist, listDirectory)
+import System.FilePath.Posix (combine)
+import Test.Tasty (TestTree, defaultMain, testGroup)
+import Test.Tasty.HUnit (assertFailure, assertEqual, testCase)
+import Text.Grampa (failureDescription)
+
+import qualified Transformation.Rank2 as Rank2
+
+import qualified Language.Oberon.Reserializer as Reserializer
+
+import Language.Modula2 (parseModule, parseAndSimplifyModule, Placed, Version(..))
+import Language.Modula2.AST (Language, Module)
+import qualified Language.Modula2.ISO.AST as ISO (Language)
+import qualified Language.Modula2.ConstantFolder -- brings in HasField instances
+import qualified Language.Modula2.ISO.ConstantFolder -- brings in HasField instances
+
+import Prelude hiding (readFile)
+
+main = exampleTree "" "examples/" >>= defaultMain . testGroup "Modula-2"
+
+width = 80
+contextLines = 3
+
+unparsables = map ("examples/Modula-2_Libraries/" <>)
+              ["andrea-m2/applications/eth-hamburg/life/lifemodul.def",
+               "andrea-m2/examples/generic/base3-2.mod",
+               "andrea-m2/examples/generic/somebits.mod",
+               "andrea-m2/lib/generic/bitmapope.mod",
+               "andrea-m2/lib/generic/bitsetfun.mod",
+               "andrea-m2/lib/generic/largesets.mod",
+               "andrea-m2/lib/generic/packarray.mod",
+               "andrea-m2/lib/generic/shufflefa.mod",
+               "andrea-m2/lib/multiscope/bitmapop.mod",
+               "andrea-m2/lib/eth-hamburg/blockio.mod",
+               "andrea-m2/lib/eth-hamburg/cmdline.mod",
+               "andrea-m2/lib/eth-hamburg/dateopera.mod",
+               "andrea-m2/lib/eth-hamburg/directacc.mod",
+               "andrea-m2/lib/eth-hamburg/extendstr.mod",
+               "andrea-m2/lib/eth-hamburg/foreignco.mod",
+               "andrea-m2/lib/eth-hamburg/fortrandi.def",
+               "andrea-m2/lib/eth-hamburg/fortranfo.def",
+               "andrea-m2/lib/eth-hamburg/fortranjp.def",
+               "andrea-m2/lib/eth-hamburg/getcharac.mod",
+               "andrea-m2/lib/eth-hamburg/memorysta.mod",
+               "andrea-m2/lib/eth-hamburg/moremath.mod",
+               "andrea-m2/lib/eth-hamburg/realinout.mod",
+               "andrea-m2/lib/eth-hamburg/simplescr.mod",
+               "andrea-m2/lib/eth-hamburg/simplewin.mod",
+               "andrea-m2/lib/eth-hamburg/systemcon.def",
+               "C.-Lins_Modula-2_Software_Component_Library/Vol4/sorting/timesort.mod",
+               "PMOS/def/internet.def",
+               "PMOS/def/kbdriver.def",
+               "PMOS/def/miscpmos.def",
+               "PMOS/def/netdb.def",
+               "PMOS/sources/notdone/fastwind.mod",
+               "PMOS/sources/general/graphics.mod",
+               "PMOS/sources/general/lowlevel.def",
+               "PMOS/sources/general/mouse33.mod",
+               "PMOS/sources/general/play3.mod",
+               "PMOS/sources/general/serialmo.mod",
+               "PMOS/sources/special/lowlevel.mod"]
+              <>
+              ["examples/Dipl/BUFFERS.MOD",
+               "examples/Dipl/LIBRARY.MOD",
+               "examples/Dipl/MACHINE.MOD",
+               "examples/Dipl/MEMORY.MOD",
+               "examples/Dipl/NAMES.MOD",
+               "examples/Dipl/M2/BUFFERS.MOD",
+               "examples/Dipl/M2/LIBRARY.MOD",
+               "examples/Dipl/M2/MACHINE.MOD",
+               "examples/Dipl/M2/MEMORY.MOD",
+               "examples/Dipl/M2/NAMES.MOD"]
+
+exampleTree :: FilePath -> FilePath -> IO [TestTree]
+exampleTree ancestry path =
+   do let fullPath = combine ancestry path
+      putStrLn fullPath
+      isDir <- doesDirectoryExist fullPath
+      if isDir
+         then (:[]) . testGroup path . concat <$> (listDirectory fullPath >>= mapM (exampleTree fullPath))
+         else return . (:[]) . testCase path . unless (any (`isSuffixOf` path) [".BNF", ".bnf", ".GRM"]) $
+              do moduleSource <- readFile fullPath
+                 (originalModule, prettyModule) <- prettyFile fullPath moduleSource
+                 (originalModule', prettyModule') <- prettyFile fullPath originalModule
+                 (originalModule'', prettyModule'') <- prettyFile fullPath prettyModule
+                 putStrLn fullPath
+                 assertEqual "original=original" originalModule originalModule'
+                 assertEqual "pretty=pretty" prettyModule prettyModule'
+                 assertEqual "pretty=pretty'" prettyModule prettyModule''
+                 assertEqual "original=pretty" originalModule'' prettyModule''
+
+prettyFile :: FilePath -> Text -> IO (Text, Text)
+prettyFile path src
+   | path `elem` unparsables = case (parsedModule1, parsedModule2) of
+       (Left err1, Left err2)
+          | err1 == err2 -> putStrLn (unpack $ failureDescription src err1 4) *> pure (src, src)
+          | otherwise -> putStrLn (unpack $ failureDescription src err1 4 <> failureDescription src err2 4) *> pure (src, src)
+       _ -> error (path ++ " is supposed to be unparseable")
+   | otherwise = case parsedModule1 of
+       Right [tree] -> return (Reserializer.reserialize tree, renderStrict $ layoutPretty defaultLayoutOptions $ pretty tree)
+       Right trees -> error (show (length trees) ++ " ambiguous parses.")
+       Left err1 -> case parsedModule2 of
+         Left err2
+          | err1 == err2 -> error (unpack $ failureDescription src err1 4)
+          | otherwise -> error (unpack $ failureDescription src err1 4 <> failureDescription src err2 4)
+         Right [tree] -> return (Reserializer.reserialize tree, renderStrict $ layoutPretty defaultLayoutOptions $ pretty tree)
+         Right trees -> error (show (length trees) ++ " ambiguous parses.")
+   where parsedModule1 = parseAndSimplifyModule Report src
+         parsedModule2 = parseAndSimplifyModule ISO src
+
+instance {-# overlaps #-} Pretty a => Pretty (Placed a) where
+   pretty = pretty . snd
+
+instance Pretty (Module Language Language Placed Placed) where
+   pretty m = pretty ((Identity . snd) Rank2.<$> m)
+instance Pretty (Module ISO.Language ISO.Language Placed Placed) where
+   pretty m = pretty ((Identity . snd) Rank2.<$> m)