--- sf_code/esrgpcpj/shared/tclxtens/arblenints.c 2016/10/08 06:43:03 25
+++ projs/ets/trunk/src/c_tclxtens_7_5/arblenints.c 2018/07/22 15:58:07 220
@@ -1,4507 +1,3809 @@
-/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tclxtens/arblenints.c,v 1.12 2001/08/18 09:47:00 dtashley Exp $ */
-
-//--------------------------------------------------------------------------------
-//Copyright 2001 David T. Ashley
-//-------------------------------------------------------------------------------------------------
-//This source code and any program in which it is compiled/used is provided under the GNU GENERAL
-//PUBLIC LICENSE, Version 3, full license text below.
-//-------------------------------------------------------------------------------------------------
-// GNU GENERAL PUBLIC LICENSE
-// Version 3, 29 June 2007
-//
-// Copyright (C) 2007 Free Software Foundation, Inc.
-// 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.
-//
-//
-// Copyright (C)
-//
-// This program is free software: you can 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 .
-//
-//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:
-//
-// Copyright (C)
-// 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
-//.
-//
-// 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
-//.
-//-------------------------------------------------------------------------------------------------
-//--------------------------------------------------------------------------------
-#define MODULE_ARBLENINTS
-
-#include
-#include
-
-#include "tcl.h"
-#include "tcldecls.h"
-
-#include "arblenints.h"
-#include "bstrfunc.h"
-#include "extninit.h"
-#include "gmp_ints.h"
-#include "gmp_rats.h"
-#include "gmp_ralg.h"
-#include "intfunc.h"
-#include "tclalloc.h"
-
-
-//Handles the "cfbrapab" subextension.
-//08/16/01: Visual inspection OK.
-static
-int ARBLENINTS_cfbrapab_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have at least two additional arguments
- //to this extension.
- if (objc < 4)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "srn uint_kmax ?uint_hmax? ?options?");
- return(TCL_ERROR);
- }
- else
- {
- char *input_arg;
- int failure, first_dashed_parameter;
- char *string_result;
- int string_result_n_allocd;
- int chars_reqd;
- int i;
- int pred_option_specified = 0;
- int succ_option_specified = 0;
- int neversmaller_option_specified = 0;
- int neverlarger_option_specified = 0;
- int n_option_specified = 0;
- unsigned n = 0;
-
- GMP_RATS_mpq_struct q_rn;
- GMP_INTS_mpz_struct z_kmax;
- GMP_INTS_mpz_struct z_hmax;
-
- //Allocate dynamic memory.
- GMP_RATS_mpq_init(&q_rn);
- GMP_INTS_mpz_init(&z_kmax);
- GMP_INTS_mpz_init(&z_hmax);
-
- //Grab a pointer to the string representation of
- //the first input argument. The storage does not belong to us.
- input_arg = Tcl_GetString(objv[2]);
- assert(input_arg != NULL);
-
- //Try to parse our first input string as a rational number.
- //If we are not successful in this, must abort.
- GMP_RATS_mpq_set_all_format_rat_num(input_arg,
- &failure,
- &q_rn);
-
- if (failure)
- {
- rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1);
- Tcl_AppendToObj(rv, input_arg, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&q_rn);
- GMP_INTS_mpz_clear(&z_kmax);
- GMP_INTS_mpz_clear(&z_hmax);
-
- return(TCL_ERROR);
- }
-
- //Try to parse our next argument as an integer, which
- //will be KMAX. This must be specified.
- //
- //Get string pointer. Storage does not belong to us.
- input_arg = Tcl_GetString(objv[3]);
- assert(input_arg != NULL);
-
- //Try to convert KMAX to an integer. Fatal if an error,
- //and fatal if the argument is zero or negative.
- GMP_INTS_mpz_set_general_int(&z_kmax, &failure, input_arg);
-
- //If there was a parse failure or if the integer is zero
- //or negative, must flag error.
- if (failure || GMP_INTS_mpz_is_neg(&z_kmax) || GMP_INTS_mpz_is_zero(&z_kmax))
- {
- rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1);
- Tcl_AppendToObj(rv, input_arg, -1);
- Tcl_AppendToObj(rv, "\" is not a recognized positive integer.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&q_rn);
- GMP_INTS_mpz_clear(&z_kmax);
- GMP_INTS_mpz_clear(&z_hmax);
-
- return(TCL_ERROR);
- }
-
- //We need to look for HMAX as the next parameter, if it exists.
- //The way we will figure this out is by whether the
- //parameter begins with a "-" or not.
- if (objc >= 5)
- {
- input_arg = Tcl_GetString(objv[4]);
- assert(input_arg != NULL);
-
- if (input_arg[0] == '-')
- {
- first_dashed_parameter = 4;
- }
- else
- {
- first_dashed_parameter = 5;
- }
- }
- else
- {
- first_dashed_parameter = 4;
- }
-
- //If there is another parameter and it
- //doesn't begin with a dash, try to parse
- //it as HMAX. We don't explicitly record whether
- //HMAX is specified, because zero is a signal
- //when calculating Farey neighbors that HMAX isn't
- //to be considered.
- if ((objc >= 5) && (first_dashed_parameter == 5))
- {
- //Get string pointer. Storage does not belong to us.
- input_arg = Tcl_GetString(objv[4]);
- assert(input_arg != NULL);
-
- //Try to convert HMAX to an integer. Fatal if an error,
- //and fatal if the argument is zero or negative.
- GMP_INTS_mpz_set_general_int(&z_hmax, &failure, input_arg);
-
- //If there was a parse failure or if the integer is zero
- //or negative, must flag error.
- if (failure || GMP_INTS_mpz_is_neg(&z_hmax) || GMP_INTS_mpz_is_zero(&z_hmax))
- {
- rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1);
- Tcl_AppendToObj(rv, input_arg, -1);
- Tcl_AppendToObj(rv, "\" is not a recognized positive integer.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&q_rn);
- GMP_INTS_mpz_clear(&z_kmax);
- GMP_INTS_mpz_clear(&z_hmax);
-
- return(TCL_ERROR);
- }
- }
-
- //Process all of the dashed command-line arguments.
- //This involves iterating through all of the
- //parameters and processing them.
- for (i=first_dashed_parameter; i= (objc - 1))
- {
- rv = Tcl_NewStringObj("arbint cfbrapab: -n option specified without following integer.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&q_rn);
- GMP_INTS_mpz_clear(&z_kmax);
- GMP_INTS_mpz_clear(&z_hmax);
-
- return(TCL_ERROR);
- }
-
- //We have at least one additional parameter. Try
- //to parse out the next parameter as the integer
- //we need for n.
- i++;
-
- input_arg = Tcl_GetString(objv[i]);
- assert(input_arg != NULL);
-
- GMP_INTS_mpz_parse_into_uint32(&n, &failure, input_arg);
-
- //If the parse was unsuccessful, terminate.
- if (failure)
- {
- rv = Tcl_NewStringObj("arbint cfbrapab: -n option followed by invalid integer.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&q_rn);
- GMP_INTS_mpz_clear(&z_kmax);
- GMP_INTS_mpz_clear(&z_hmax);
-
- return(TCL_ERROR);
- }
-
- //Clip the integer into a 24-bit quantity.
- n &= 0x00FFFFFF;
- }
- else
- {
- //Unrecognized option. Crash out.
- rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1);
- Tcl_AppendToObj(rv, input_arg, -1);
- Tcl_AppendToObj(rv, "\" is not a recognized option.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&q_rn);
- GMP_INTS_mpz_clear(&z_kmax);
- GMP_INTS_mpz_clear(&z_hmax);
-
- return(TCL_ERROR);
- }
- }
-
- //Look for any mutually exclusive options. Give a catchall if any of
- //them specified. Because we set them all to 1, addition is the easiest
- //way to do this.
- if ((pred_option_specified + succ_option_specified + neversmaller_option_specified
- + neverlarger_option_specified + n_option_specified) > 1)
- {
- rv = Tcl_NewStringObj("arbint cfbrapab: -pred, -succ, -neversmaller, -neverlarger, and -n are mutually exclusive options.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&q_rn);
- GMP_INTS_mpz_clear(&z_kmax);
- GMP_INTS_mpz_clear(&z_hmax);
-
- return(TCL_ERROR);
- }
-
- //Split into cases based on what we're doing. This is wasteful of code,
- //but this is a PC application, not an embedded application. In all cases
- //create a hard error if something goes wrong. Any anomalies should trash
- //a script.
- if (!pred_option_specified && !succ_option_specified && !n_option_specified)
- {
- //This is the traditional best approximation case, with the possibility of
- //the -neverlarger or -neversmaller being specified. This is the most messy
- //of all the cases. We must gather neighbors and figure out which is closer,
- //and if there is a tie, which has the smaller magnitude. It is fairly
- //messy.
- GMP_RALG_fab_neighbor_collection_struct neighbor_data;
- GMP_RATS_mpq_struct left_neigh, right_neigh, diff_left, diff_right, closer_neighbor;
- int dist_cmp;
- int mag_cmp;
-
- //Allocate inner dynamic variables.
- GMP_RATS_mpq_init(&left_neigh);
- GMP_RATS_mpq_init(&right_neigh);
- GMP_RATS_mpq_init(&diff_left);
- GMP_RATS_mpq_init(&diff_right);
- GMP_RATS_mpq_init(&closer_neighbor);
-
- //Form up the neighbor data. We're only looking for up to one neighbor on each
- //side.
- GMP_RALG_consecutive_fab_terms(
- &q_rn,
- &z_kmax,
- &z_hmax,
- 1,
- 1,
- &neighbor_data
- );
-
- //If there was an error or we couldn't get any neighbors to play with, give
- //an error return. As long as we have one neighbor on either side, we can definitely
- //complete.
- if (neighbor_data.error || (!neighbor_data.equality && (!neighbor_data.n_left_out || !neighbor_data.n_right_out)))
- {
- rv = Tcl_NewStringObj("arbint cfbrapab: unable to form neighbors.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
- GMP_RATS_mpq_clear(&q_rn);
- GMP_INTS_mpz_clear(&z_kmax);
- GMP_INTS_mpz_clear(&z_hmax);
-
- GMP_RATS_mpq_clear(&left_neigh);
- GMP_RATS_mpq_clear(&right_neigh);
- GMP_RATS_mpq_clear(&diff_left);
- GMP_RATS_mpq_clear(&diff_right);
- GMP_RATS_mpq_clear(&closer_neighbor);
-
- return(TCL_ERROR);
- }
-
- if (neighbor_data.equality)
- {
- //The equality case takes precedence, always.
- GMP_RATS_mpq_copy(&closer_neighbor, &(neighbor_data.norm_rn));
- }
- else
- {
- //The boolean test somewhat above guaranteed that we have both left
- //and right neighbors. We can assume this.
- GMP_RATS_mpq_copy(&left_neigh, &(neighbor_data.lefts[0].neighbor));
- GMP_RATS_mpq_copy(&right_neigh, &(neighbor_data.rights[0].neighbor));
-
- GMP_RATS_mpq_sub(&diff_left, &left_neigh, &(neighbor_data.norm_rn));
- GMP_RATS_mpq_sub(&diff_right, &right_neigh, &(neighbor_data.norm_rn));
- GMP_INTS_mpz_abs(&(diff_left.num));
- GMP_INTS_mpz_abs(&(diff_right.num));
- dist_cmp = GMP_RATS_mpq_cmp(&diff_left, &diff_right, NULL);
-
- //If we have a tie on the distance, will need to revert to magnitude of the neighbors.
- GMP_INTS_mpz_abs(&(left_neigh.num));
- GMP_INTS_mpz_abs(&(right_neigh.num));
- mag_cmp = GMP_RATS_mpq_cmp(&left_neigh, &right_neigh, NULL);
-
- if (!neversmaller_option_specified
- &&
- (neverlarger_option_specified || (dist_cmp < 0) || ((dist_cmp==0) && (mag_cmp < 0))))
- {
- GMP_RATS_mpq_copy(&closer_neighbor, &(neighbor_data.lefts[0].neighbor));
- }
- else
- {
- GMP_RATS_mpq_copy(&closer_neighbor, &(neighbor_data.rights[0].neighbor));
- }
- }
-
- //Stuff our variable of choice into a string ...
- chars_reqd = INTFUNC_max(
- GMP_INTS_mpz_size_in_base_10(&(closer_neighbor.num)),
- GMP_INTS_mpz_size_in_base_10(&(closer_neighbor.den))
- );
- string_result = TclpAlloc(sizeof(char) * chars_reqd);
- assert(string_result != NULL);
-
- GMP_INTS_mpz_to_string(string_result, &(closer_neighbor.num));
- rv = Tcl_NewStringObj(string_result, -1);
- Tcl_AppendToObj(rv, "/", -1);
- GMP_INTS_mpz_to_string(string_result, &(closer_neighbor.den));
- Tcl_AppendToObj(rv, string_result, -1);
-
- Tcl_SetObjResult(interp, rv);
-
- //Deallocate variables, make normal return.
- TclpFree(string_result);
- GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
- GMP_RATS_mpq_clear(&q_rn);
- GMP_INTS_mpz_clear(&z_kmax);
- GMP_INTS_mpz_clear(&z_hmax);
-
- GMP_RATS_mpq_clear(&left_neigh);
- GMP_RATS_mpq_clear(&right_neigh);
- GMP_RATS_mpq_clear(&diff_left);
- GMP_RATS_mpq_clear(&diff_right);
- GMP_RATS_mpq_clear(&closer_neighbor);
-
- return(TCL_OK);
- }
- else if (n_option_specified)
- {
- char sbuf[50];
- //Static buffer just to stage 32-bit integers.
-
- //Multiple neighbors. Must iterate through.
-
- GMP_RALG_fab_neighbor_collection_struct neighbor_data;
-
- //Form up the neighbor data.
- GMP_RALG_consecutive_fab_terms(
- &q_rn,
- &z_kmax,
- &z_hmax,
- n,
- n,
- &neighbor_data
- );
-
- //If there was an error forming up the neighbor data, create a hard error.
- if (neighbor_data.error)
- {
- rv = Tcl_NewStringObj("arbint cfbrapab: unable to form neighbors.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
- GMP_RATS_mpq_clear(&q_rn);
- GMP_INTS_mpz_clear(&z_kmax);
- GMP_INTS_mpz_clear(&z_hmax);
-
- return(TCL_ERROR);
- }
-
- //Allocate a default buffer of 10K for the ASCII representation of integers.
- //In the vast majority of cases, there will be only one allocation, because it
- //takes a mean integer to exceed 10K. However, the logic allows it to grow.
- string_result_n_allocd = 10000;
- string_result = TclpAlloc(sizeof(char) * string_result_n_allocd);
- assert(string_result != NULL);
-
- //Start off with a return value of the null string.
- rv = Tcl_NewStringObj("", -1);
-
- //Loop through, spitting out the left neighbors.
- for (i = neighbor_data.n_left_out-1; i >= 0; i--)
- {
- //The protocol here is everyone spits out one space before
- //they print anything. Must skip this on first loop iteration.
- if (i != neighbor_data.n_left_out-1)
- Tcl_AppendToObj(rv, " ", -1);
-
- //The index will be the negative of the iteration variable minus one.
- sprintf(sbuf, "%d", -i - 1);
- Tcl_AppendToObj(rv, sbuf, -1);
-
- //Force the buffer to have enough space for the components of the rational
- //number.
- chars_reqd = INTFUNC_max(
- GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[i].neighbor.num)),
- GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[i].neighbor.den))
- );
- if (chars_reqd > string_result_n_allocd)
- {
- string_result_n_allocd = chars_reqd;
- string_result = TclpRealloc(string_result, sizeof(char) * string_result_n_allocd);
- assert(string_result != NULL);
- }
-
- //Print the rational number out to the Tcl object.
- Tcl_AppendToObj(rv, " ", -1);
- GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[i].neighbor.num));
- Tcl_AppendToObj(rv, string_result, -1);
- Tcl_AppendToObj(rv, "/", -1);
- GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[i].neighbor.den));
- Tcl_AppendToObj(rv, string_result, -1);
- }
-
- //Spit out the equality case if appropriate.
- if (neighbor_data.equality)
- {
- if (neighbor_data.n_left_out)
- Tcl_AppendToObj(rv, " ", -1);
-
- Tcl_AppendToObj(rv, "0", -1);
-
- //Force the buffer to have enough space for the components of the rational
- //number.
- chars_reqd = INTFUNC_max(
- GMP_INTS_mpz_size_in_base_10(&(neighbor_data.norm_rn.num)),
- GMP_INTS_mpz_size_in_base_10(&(neighbor_data.norm_rn.den))
- );
- if (chars_reqd > string_result_n_allocd)
- {
- string_result_n_allocd = chars_reqd;
- string_result = TclpRealloc(string_result, sizeof(char) * string_result_n_allocd);
- assert(string_result != NULL);
- }
-
- //Print the rational number out to the Tcl object.
- Tcl_AppendToObj(rv, " ", -1);
- GMP_INTS_mpz_to_string(string_result, &(neighbor_data.norm_rn.num));
- Tcl_AppendToObj(rv, string_result, -1);
- Tcl_AppendToObj(rv, "/", -1);
- GMP_INTS_mpz_to_string(string_result, &(neighbor_data.norm_rn.den));
- Tcl_AppendToObj(rv, string_result, -1);
- }
-
- //Loop through, spitting out the right neighbors.
- for (i = 0; i < neighbor_data.n_right_out; i++)
- {
- //The protocol here is everyone spits out one space before
- //they print anything. Must skip this on first loop iteration.
- if (neighbor_data.n_left_out || neighbor_data.equality || i)
- Tcl_AppendToObj(rv, " ", -1);
-
- //The index will be the iteration variable plus one.
- sprintf(sbuf, "%d", i+1);
- Tcl_AppendToObj(rv, sbuf, -1);
-
- //Force the buffer to have enough space for the components of the rational
- //number.
- chars_reqd = INTFUNC_max(
- GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[i].neighbor.num)),
- GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[i].neighbor.den))
- );
- if (chars_reqd > string_result_n_allocd)
- {
- string_result_n_allocd = chars_reqd;
- string_result = TclpRealloc(string_result, sizeof(char) * string_result_n_allocd);
- assert(string_result != NULL);
- }
-
- //Print the rational number out to the Tcl object.
- Tcl_AppendToObj(rv, " ", -1);
- GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[i].neighbor.num));
- Tcl_AppendToObj(rv, string_result, -1);
- Tcl_AppendToObj(rv, "/", -1);
- GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[i].neighbor.den));
- Tcl_AppendToObj(rv, string_result, -1);
- }
-
- //Set up for a normal return.
- Tcl_SetObjResult(interp, rv);
-
- TclpFree(string_result);
- GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
- GMP_RATS_mpq_clear(&q_rn);
- GMP_INTS_mpz_clear(&z_kmax);
- GMP_INTS_mpz_clear(&z_hmax);
-
- return(TCL_OK);
- }
- else if (pred_option_specified)
- {
- //Simple predecessor case.
-
- GMP_RALG_fab_neighbor_collection_struct neighbor_data;
-
- //Form up the neighbor data.
- GMP_RALG_consecutive_fab_terms(
- &q_rn,
- &z_kmax,
- &z_hmax,
- 1,
- 0,
- &neighbor_data
- );
-
- //If there was an error forming up the neighbor data or there are no left neighbors,
- //create a hard error.
- if (neighbor_data.error || !neighbor_data.n_left_out)
- {
- rv = Tcl_NewStringObj("arbint cfbrapab: unable to find predecessor.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
- GMP_RATS_mpq_clear(&q_rn);
- GMP_INTS_mpz_clear(&z_kmax);
- GMP_INTS_mpz_clear(&z_hmax);
-
- return(TCL_ERROR);
- }
-
- //The test above confirmed that we have at least one left neighbor calculated.
- //We can dump it to a string and finish up.
- chars_reqd = INTFUNC_max(
- GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[0].neighbor.num)),
- GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[0].neighbor.den))
- );
- string_result = TclpAlloc(sizeof(char) * chars_reqd);
- assert(string_result != NULL);
-
- GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[0].neighbor.num));
- rv = Tcl_NewStringObj(string_result, -1);
- Tcl_AppendToObj(rv, "/", -1);
- GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[0].neighbor.den));
- Tcl_AppendToObj(rv, string_result, -1);
-
- Tcl_SetObjResult(interp, rv);
-
- TclpFree(string_result);
- GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
- GMP_RATS_mpq_clear(&q_rn);
- GMP_INTS_mpz_clear(&z_kmax);
- GMP_INTS_mpz_clear(&z_hmax);
-
- return(TCL_OK);
- }
- else if (succ_option_specified)
- {
- //Simple successor.
-
- GMP_RALG_fab_neighbor_collection_struct neighbor_data;
-
- //Form up the neighbor data.
- GMP_RALG_consecutive_fab_terms(
- &q_rn,
- &z_kmax,
- &z_hmax,
- 0,
- 1,
- &neighbor_data
- );
-
- //If there was an error forming up the neighbor data or there are no right neighbors,
- //create a hard error.
- if (neighbor_data.error || !neighbor_data.n_right_out)
- {
- rv = Tcl_NewStringObj("arbint cfbrapab: unable to find successor.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
- GMP_RATS_mpq_clear(&q_rn);
- GMP_INTS_mpz_clear(&z_kmax);
- GMP_INTS_mpz_clear(&z_hmax);
-
- return(TCL_ERROR);
- }
-
- //The test above confirmed that we have at least one right neighbor calculated.
- //We can dump it to a string and finish up.
- chars_reqd = INTFUNC_max(
- GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[0].neighbor.num)),
- GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[0].neighbor.den))
- );
- string_result = TclpAlloc(sizeof(char) * chars_reqd);
- assert(string_result != NULL);
-
- GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[0].neighbor.num));
- rv = Tcl_NewStringObj(string_result, -1);
- Tcl_AppendToObj(rv, "/", -1);
- GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[0].neighbor.den));
- Tcl_AppendToObj(rv, string_result, -1);
-
- Tcl_SetObjResult(interp, rv);
-
- TclpFree(string_result);
- GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
- GMP_RATS_mpq_clear(&q_rn);
- GMP_INTS_mpz_clear(&z_kmax);
- GMP_INTS_mpz_clear(&z_hmax);
-
- return(TCL_OK);
- }
-
- //Free up all dynamic memory.
- GMP_RATS_mpq_clear(&q_rn);
- GMP_INTS_mpz_clear(&z_kmax);
- GMP_INTS_mpz_clear(&z_hmax);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//Handles the "cfratnum" subextension.
-//08/07/01: Visually inspected, OK.
-static
-int ARBLENINTS_cfratnum_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have exactly one additional argument
- //to this function, which is the rational number
- //whose continued fraction decomposition is to be
- //calculated.
- if (objc != 3)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "urn");
- return(TCL_ERROR);
- }
- else
- {
- char *input_arg;
- int failure;
- unsigned chars_reqd;
- char *string_result;
- int n_string_result;
- int i;
- GMP_RATS_mpq_struct rn;
- GMP_RALG_cf_app_struct decomp;
-
- //In this function, we are going to return a string
- //result formed by starting with a string and then
- //concatenating to it again and again. We start
- //off believing that 10,000 characters of space is enough,
- //but we may need to revise upward and reallocate.
- //A 10,000 character block is chosen because it is quick
- //to allocate and most times won't go beyond that.
- n_string_result = 10000;
- string_result = TclpAlloc(sizeof(char) * n_string_result);
- assert(string_result != NULL);
-
- //We will need a rational number to hold the return value
- //from the parsing function. Allocate that now.
- GMP_RATS_mpq_init(&rn);
-
- //Grab a pointer to the string representation of
- //the input argument. The storage does not belong to us.
- input_arg = Tcl_GetString(objv[2]);
- assert(input_arg != NULL);
-
- //Try to parse our input string as a rational number.
- //If we are not successful in this, must abort.
- GMP_RATS_mpq_set_all_format_rat_num(input_arg,
- &failure,
- &rn);
-
- if (failure)
- {
- rv = Tcl_NewStringObj("arbint cfratnum: \"", -1);
- Tcl_AppendToObj(rv, input_arg, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized non-negative rational number.", -1);
- Tcl_SetObjResult(interp, rv);
-
- TclpFree(string_result);
- GMP_RATS_mpq_clear(&rn);
-
- return(TCL_ERROR);
- }
-
- //OK, we have a rational number, but there is a possibility
- //it is negative, which is a no-no. Normalize the signs
- //for easier testing.
- GMP_RATS_mpq_normalize_sign(&rn);
- if (GMP_INTS_mpz_is_neg(&(rn.num)))
- {
- rv = Tcl_NewStringObj("arbint cfratnum: \"", -1);
- Tcl_AppendToObj(rv, input_arg, -1);
-
- Tcl_AppendToObj(rv, "\" is negative.", -1);
- Tcl_SetObjResult(interp, rv);
-
- TclpFree(string_result);
- GMP_RATS_mpq_clear(&rn);
-
- return(TCL_ERROR);
- }
-
- //OK, we have a rational number. Form the continued fraction
- //decomposition of it. The function called is set up so that
- //one must deallocate, even in an error condition.
- GMP_RALG_cfdecomp_init(&decomp,
- &failure,
- &(rn.num),
- &(rn.den));
-
- //If we failed in the decomposition (don't know why that would
- //happen) use the general error flag "NAN".
- if (failure)
- {
- rv = Tcl_NewStringObj("NAN", -1);
-
- Tcl_SetObjResult(interp, rv);
-
- TclpFree(string_result);
- GMP_RATS_mpq_clear(&rn);
- GMP_RALG_cfdecomp_destroy(&decomp);
-
- return(TCL_ERROR);
- }
-
- //OK, that really is the last error we could have.
- //Iterate, adding the partial quotients and convergents
- //to the string which we'll return. We need to watch out
- //for running over our 10K buffer.
- rv = Tcl_NewStringObj("", -1);
- for (i=0; i (unsigned)n_string_result)
- {
- n_string_result = chars_reqd;
- string_result = TclpRealloc(string_result,
- sizeof(char) * n_string_result);
- }
- GMP_INTS_mpz_to_string(string_result, &(decomp.a[i]));
- Tcl_AppendToObj(rv, string_result, -1);
- Tcl_AppendToObj(rv, " ", -1);
-
- //Numerator of convergent.
- chars_reqd = GMP_INTS_mpz_size_in_base_10(&(decomp.p[i]));
- if (chars_reqd > (unsigned)n_string_result)
- {
- n_string_result = chars_reqd;
- string_result = TclpRealloc(string_result,
- sizeof(char) * n_string_result);
- }
- GMP_INTS_mpz_to_string(string_result, &(decomp.p[i]));
- Tcl_AppendToObj(rv, string_result, -1);
- Tcl_AppendToObj(rv, " ", -1);
-
- //Denominator of convergent.
- chars_reqd = GMP_INTS_mpz_size_in_base_10(&(decomp.q[i]));
- if (chars_reqd > (unsigned)n_string_result)
- {
- n_string_result = chars_reqd;
- string_result = TclpRealloc(string_result,
- sizeof(char) * n_string_result);
- }
- GMP_INTS_mpz_to_string(string_result, &(decomp.q[i]));
- Tcl_AppendToObj(rv, string_result, -1);
- if (i != (decomp.n - 1)) //No space after last number.
- Tcl_AppendToObj(rv, " ", -1);
- }
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Free up all dynamic memory.
- TclpFree(string_result);
- GMP_RATS_mpq_clear(&rn);
- GMP_RALG_cfdecomp_destroy(&decomp);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//Handles the "commanate" subextension.
-//07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
-//from memory an intuition as far as how to set return results and so forth.
-static
-int ARBLENINTS_commanate_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have one and exactly one additional argument
- //to this function, which is the string we want to
- //commanate.
- if (objc != 3)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "sint");
- return(TCL_ERROR);
- }
- else
- {
- char *string_arg;
-
- //Grab a pointer to the string representation of
- //the input argument. The storage does not belong to us.
- string_arg = Tcl_GetString(objv[2]);
- assert(string_arg != NULL);
-
- //Try to parse the string as one of the error tags.
- //If it is one of those, it isn't an error, but don't
- //want to touch the string.
- if (GMP_INTS_identify_nan_string(string_arg) >= 0)
- {
- rv = Tcl_NewStringObj(string_arg, -1);
- Tcl_SetObjResult(interp, rv);
- return(TCL_OK);
- }
- //Try to parse it as a signed integer with commas already.
- //If it already has commas, there is no need to add any.
- else if (BSTRFUNC_is_sint_w_commas(string_arg))
- {
- //This is already an acceptable commanated signed integer. Send it
- //back as the return value.
- rv = Tcl_NewStringObj(string_arg, -1);
- Tcl_SetObjResult(interp, rv);
- return(TCL_OK);
- }
- //Try to parse the argument as a signed integer without commas.
- //If it is one of those, commanate it and return it.
- else if (BSTRFUNC_is_sint_wo_commas(string_arg))
- {
- size_t len;
- char *buffer;
-
- len = strlen(string_arg);
- buffer = TclpAlloc(((sizeof(char) * 4 * len) / 3) + 10);
- strcpy(buffer, string_arg);
- BSTRFUNC_commanate(buffer);
- rv = Tcl_NewStringObj(buffer, -1);
- TclpFree(buffer);
- Tcl_SetObjResult(interp, rv);
- return(TCL_OK);
- }
- else
- {
- //Error case. Must give error message.
- rv = Tcl_NewStringObj("arbint commanate: \"", -1);
- Tcl_AppendToObj(rv, string_arg, -1);
- Tcl_AppendToObj(rv, "\" is not a recognized integer.", -1);
- Tcl_SetObjResult(interp, rv);
- return(TCL_ERROR);
- }
- }
- }
-
-
-//Handles the "const" subextension.
-//08/17/01: Visual inspection OK.
-static
-int ARBLENINTS_const_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- //Table of constants used.
- static struct
- {
- char *tag;
- //The symbolic tag used to identify the number.
- char *desc;
- //The full description of the number. It must consist
- //of a string with lines no longer than about 70 chars,
- //separated by newlines, and indented by 6 spaces.
- char *minmant;
- //The minimum mantissa or minimum representation.
- //May not be empty or NULL.
- char *mantrem;
- //The remaining mantissa or remaining portion of
- //number. May be empty, but may not be NULL.
- char *exp;
- //The exponent portion, if any, or NULL otherwise.
- int deflen;
- //The default number of digits for the constant
- //if none is specified.
- int digit_count_offset;
- //The offset to go from string length of mantissa
- //portions to number of digits. Cheap way to adjust
- //for - sign and decimal point.
- } tbl[] =
- {
- //e--the transcendental number e.
- {
- //tag
- "e",
- //desc
- " Historically significant transcendental constant. Digits obtained\n"
- " from http://fermi.udw.ac.za/physics/e.html on 08/17/01.",
- //minmant
- "2.7",
- //mantrem
- "182818284590452353602874713526624977572470936999595749669676277240766303535"
- "475945713821785251664274274663919320030599218174135966290435729003342952605956"
- "307381323286279434907632338298807531952510190115738341879307021540891499348841"
- "675092447614606680822648001684774118537423454424371075390777449920695517027618"
- "386062613313845830007520449338265602976067371132007093287091274437470472306969"
- "772093101416928368190255151086574637721112523897844250569536967707854499699679"
- "468644549059879316368892300987931277361782154249992295763514822082698951936680"
- "331825288693984964651058209392398294887933203625094431173012381970684161403970"
- "198376793206832823764648042953118023287825098194558153017567173613320698112509"
- "961818815930416903515988885193458072738667385894228792284998920868058257492796"
- "104841984443634632449684875602336248270419786232090021609902353043699418491463"
- "140934317381436405462531520961836908887070167683964243781405927145635490613031"
- "07208510383750510115747704171898610687396965521267154688957035035",
- //exp
- NULL,
- //deflen
- 30,
- //digit_count_offset
- 1
- },
- //g_metric
- {
- //tag
- "g_si",
- //desc
- " Gravitational acceleration in SI units, meters per second**2.\n"
- " Obtained from NIST Special Publication 811 on 08/17/01.",
- //minmant
- "9.80665",
- //mantrem
- "",
- //exp
- NULL,
- //deflen
- 30,
- //digit_count_offset
- 1
- },
- //in2m
- {
- //tag
- "in2m",
- //desc
- " Multiplicative conversion factor from inches to meters.\n"
- " Obtained from NIST Special Publication 811 on 08/17/01.",
- //minmant
- "2.54",
- //mantrem
- "",
- //exp
- "e-2",
- //deflen
- 30,
- //digit_count_offset
- 1
- },
- //mi2km
- {
- //tag
- "mi2km",
- //desc
- " Multiplicative conversion factor from miles to kilometers.\n"
- " Obtained from NIST Special Publication 811 on 08/17/01.",
- //minmant
- "1.609344",
- //mantrem
- "",
- //exp
- NULL,
- //deflen
- 30,
- //digit_count_offset
- 1
- },
- //pi--the transcendental number PI.
- {
- //tag
- "pi",
- //desc
- " Transcendental constant supplying ratio of a circle's circumference\n"
- " to its diameter. Digits obtained from http://www.joyofpi.com/\n"
- " pi.htm on 08/17/01.",
- //minmant
- "3.14",
- //mantrem
- "15926535897932384626433832795028841971"
- "6939937510582097494459230781640628620899"
- "8628034825342117067982148086513282306647"
- "0938446095505822317253594081284811174502"
- "8410270193852110555964462294895493038196"
- "4428810975665933446128475648233786783165"
- "2712019091456485669234603486104543266482"
- "1339360726024914127372458700660631558817"
- "4881520920962829254091715364367892590360"
- "0113305305488204665213841469519415116094"
- "3305727036575959195309218611738193261179"
- "3105118548074462379962749567351885752724"
- "8912279381830119491298336733624406566430"
- "8602139494639522473719070217986094370277"
- "0539217176293176752384674818467669405132"
- "0005681271452635608277857713427577896091"
- "7363717872146844090122495343014654958537"
- "1050792279689258923542019956112129021960"
- "8640344181598136297747713099605187072113"
- "4999999837297804995105973173281609631859"
- "5024459455346908302642522308253344685035"
- "2619311881710100031378387528865875332083"
- "8142061717766914730359825349042875546873"
- "1159562863882353787593751957781857780532"
- "1712268066130019278766111959092164201989"
- "3809525720106548586327886593615338182796"
- "8230301952035301852968995773622599413891"
- "2497217752834791315155748572424541506959"
- "5082953311686172785588907509838175463746"
- "4939319255060400927701671139009848824012",
- //exp
- NULL,
- //deflen
- 30,
- //digit_count_offset
- 1
- },
- //sqrt5--the square root of 5.
- {
- //tag
- "sqrt5",
- //desc
- " The square root of 5. Digits obtained from\n"
- " http://home.earthlink.net/~maryski/sqrt51000000.txt on 08/17/01.",
- //minmant
- "2.236",
- //mantrem
- "0679774997896964091736687312762354406183596115257242708972454105209256378048"
- "99414414408378782274969508176150773783504253267724447073863586360121533452708866"
- "77817319187916581127664532263985658053576135041753378500342339241406444208643253"
- "90972525926272288762995174024406816117759089094984923713907297288984820886415426"
- "89894099131693577019748678884425089754132956183176921499977424801530434115035957"
- "66833251249881517813940800056242085524354223555610630634282023409333198293395974"
- "63522712013417496142026359047378855043896870611356600457571399565955669569175645"
- "78221952500060539231234005009286764875529722056766253666074485853505262330678494"
- "63342224231763727702663240768010444331582573350589309813622634319868647194698997"
- "01808189524264459620345221411922329125981963258111041704958070481204034559949435"
- "06855551855572512388641655010262436312571024449618789424682903404474716115455723"
- "20173767659046091852957560357798439805415538077906439363972302875606299948221385"
- "21773485924535151210463455550407072278724215347787529112121211843317893351910380",
- //exp
- NULL,
- //deflen
- 30,
- //digit_count_offset
- 1
- },
- };
-
- Tcl_Obj *rv;
- //Value that will be returned to caller.
- int i;
- //Iteration variable.
- int tbl_idx;
- //Index into lookup table, of -1 if not found.
- int ndigits;
- //The number of digits to supply.
- int result_code;
- //Return value from Tcl library function.
-
- //We must have either one or two additional arguments.
- if ((objc != 3) && (objc != 4))
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "constant_tag ?ndigits?");
- return(TCL_ERROR);
- }
- else
- {
- char *string_arg;
-
- //Grab a pointer to the string representation of
- //the input argument. The storage does not belong to us.
- string_arg = Tcl_GetString(objv[2]);
- assert(string_arg != NULL);
-
- //Try to look up the string argument in the table.
- tbl_idx = -1;
- for (i=0; i 0)
- {
- if (ndigits >= (int)strlen(tbl[tbl_idx].mantrem))
- {
- Tcl_AppendToObj(rv, tbl[tbl_idx].mantrem, -1);
- }
- else
- {
- Tcl_AppendToObj(rv, tbl[tbl_idx].mantrem, ndigits);
- }
- }
-
- //Append the exponent portion.
- if (tbl[tbl_idx].exp)
- Tcl_AppendToObj(rv, tbl[tbl_idx].exp, -1);
-
- //Default successful return.
- Tcl_SetObjResult(interp, rv);
- return(TCL_OK);
- }
- }
-
-
-//Handles the "decommanate" subextension.
-//07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
-//from memory an intuition as far as how to set return results and so forth.
-static
-int ARBLENINTS_decommanate_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have one and exactly one additional argument
- //to this function, which is the string we want to
- //decommanate.
- if (objc != 3)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "sint");
- return(TCL_ERROR);
- }
- else
- {
- char *string_arg;
-
- //Grab a pointer to the string representation of
- //the input argument. The storage does not belong to us.
- string_arg = Tcl_GetString(objv[2]);
- assert(string_arg != NULL);
-
- //Try to parse the string as one of the error tags.
- //If it is one of those, it isn't an error, but don't
- //want to touch the string.
- if (GMP_INTS_identify_nan_string(string_arg) >= 0)
- {
- rv = Tcl_NewStringObj(string_arg, -1);
- Tcl_SetObjResult(interp, rv);
- return(TCL_OK);
- }
- //Try to parse it as a signed integer without commas.
- //If it has no commas, there is no need to decommanate it.
- else if (BSTRFUNC_is_sint_wo_commas(string_arg))
- {
- //This is already an acceptable commanated signed integer. Send it
- //back as the return value.
- rv = Tcl_NewStringObj(string_arg, -1);
- Tcl_SetObjResult(interp, rv);
- return(TCL_OK);
- }
- //Try to parse the argument as a signed integer with commas.
- //If it is one of those, decommanate it and return it.
- else if (BSTRFUNC_is_sint_w_commas(string_arg))
- {
- size_t len;
- char *buffer;
-
- len = strlen(string_arg);
- buffer = TclpAlloc(sizeof(char) * len + 1);
- strcpy(buffer, string_arg);
- BSTRFUNC_decommanate(buffer);
- rv = Tcl_NewStringObj(buffer, -1);
- TclpFree(buffer);
- Tcl_SetObjResult(interp, rv);
- return(TCL_OK);
- }
- else
- {
- //Error case. Must give error message.
- rv = Tcl_NewStringObj("arbint decommanate: \"", -1);
- Tcl_AppendToObj(rv, string_arg, -1);
- Tcl_AppendToObj(rv, "\" is not a recognized integer.", -1);
- Tcl_SetObjResult(interp, rv);
- return(TCL_ERROR);
- }
- }
- }
-
-
-//Handles the "intadd" subextension.
-//08/06/01: Visual inspection OK.
-static
-int ARBLENINTS_intadd_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have two and exactly two additional arguments
- //to this function, which are the integers whose
- //sum is to be calculated.
- if (objc != 4)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "sint sint");
- return(TCL_ERROR);
- }
- else
- {
- GMP_INTS_mpz_struct arb_arg1, arb_arg2, arb_result;
- char *add_arg1, *add_arg2;
- int failure1, failure2;
- unsigned chars_reqd;
- char *string_result;
- int i, j;
-
- //Allocate space for the arbitrary-length integer result.
- GMP_INTS_mpz_init(&arb_arg1);
- GMP_INTS_mpz_init(&arb_arg2);
- GMP_INTS_mpz_init(&arb_result);
-
- //Grab pointers to the string representation of
- //the input arguments. The storage does not belong to us.
- add_arg1 = Tcl_GetString(objv[2]);
- assert(add_arg1 != NULL);
- add_arg2 = Tcl_GetString(objv[3]);
- assert(add_arg2 != NULL);
-
- //Try to interpret either of the strings as one of the NAN tags.
- //If it is one, return the appropriate result for
- //a binary operation.
- i = GMP_INTS_identify_nan_string(add_arg1);
- j = GMP_INTS_identify_nan_string(add_arg2);
-
- if ((i >= 0) || (j >= 0))
- {
- const char *p;
-
- //Find the max of i and j. This isn't a scientific way to tag the
- //result, but will be OK. Some information is lost no matter what
- //we do.
- if (i > j)
- ;
- else
- i = j;
-
- //i now contains the max.
- switch (i)
- {
- case 0: p = GMP_INTS_supply_nan_string(2);
- break;
- case 1: p = GMP_INTS_supply_nan_string(3);
- break;
- case 2: p = GMP_INTS_supply_nan_string(2);
- break;
- case 3: p = GMP_INTS_supply_nan_string(3);
- break;
- default:
- assert(0);
- break;
- }
-
- rv = Tcl_NewStringObj(p, -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
- GMP_INTS_mpz_clear(&arb_result);
-
- return(TCL_OK);
- }
-
- //Try to convert both strings into arbitrary integers.
- GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, add_arg1);
- GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, add_arg2);
-
- //If there was a parse failure, we have to return an error
- //message. It is possible that both arguments failed the parse,
- //but only return one in the error message.
- if (failure1 || failure2)
- {
- rv = Tcl_NewStringObj("arbint intadd: \"", -1);
- if (failure1)
- Tcl_AppendToObj(rv, add_arg1, -1);
- else
- Tcl_AppendToObj(rv, add_arg2, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
- GMP_INTS_mpz_clear(&arb_result);
-
- return(TCL_ERROR);
- }
-
- //Calculate the sum.
- GMP_INTS_mpz_add(&arb_result, &arb_arg1, &arb_arg2);
-
- //Figure out the number of characters required for
- //the output string.
- chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
-
- //Allocate space for the conversion result.
- string_result = TclpAlloc(sizeof(char) * chars_reqd);
- assert(string_result != NULL);
-
- //Make the conversion to a character string.
- GMP_INTS_mpz_to_string(string_result, &arb_result);
-
- //Assign the string result to a Tcl object.
- rv = Tcl_NewStringObj(string_result, -1);
-
- //Deallocate the string.
- TclpFree(string_result);
-
- //Deallocate space for the arbitrary-length integers.
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
- GMP_INTS_mpz_clear(&arb_result);
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//08/01/01: Visual inspection and some unit testing, OK.
-//Handles the "intcmp" subextension.
-static
-int ARBLENINTS_intcmp_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have two and exactly two additional arguments
- //to this function, which are the integers to be compared.
- if (objc != 4)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "sint sint");
- return(TCL_ERROR);
- }
- else
- {
- GMP_INTS_mpz_struct arb_arg1, arb_arg2;
- char *cmp_arg1, *cmp_arg2;
- int failure1, failure2;
- int i, j, compare_result;
-
- //Allocate space for the arbitrary-length integer result.
- GMP_INTS_mpz_init(&arb_arg1);
- GMP_INTS_mpz_init(&arb_arg2);
-
- //Grab pointers to the string representation of
- //the input arguments. The storage does not belong to us.
- cmp_arg1 = Tcl_GetString(objv[2]);
- assert(cmp_arg1 != NULL);
- cmp_arg2 = Tcl_GetString(objv[3]);
- assert(cmp_arg2 != NULL);
-
- //Try to interpret either of the strings as one of the NAN tags.
- //We cannot compare NAN tags. If either is a NAN tag, we must signal an
- //error.
- i = GMP_INTS_identify_nan_string(cmp_arg1);
- j = GMP_INTS_identify_nan_string(cmp_arg2);
-
- if ((i >= 0) || (j >= 0))
- {
- rv = Tcl_NewStringObj("arbint intcmp: cannot compare NAN symbolic tags.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
-
- return(TCL_ERROR);
- }
-
- //Try to convert both strings into arbitrary integers.
- GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, cmp_arg1);
- GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, cmp_arg2);
-
- //If there was a parse failure, we have to return an error
- //message. It is possible that both arguments failed the parse,
- //but only return one in the error message.
- if (failure1 || failure2)
- {
- rv = Tcl_NewStringObj("arbint intcmp: \"", -1);
- if (failure1)
- Tcl_AppendToObj(rv, cmp_arg1, -1);
- else
- Tcl_AppendToObj(rv, cmp_arg2, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
-
- return(TCL_ERROR);
- }
-
- //Calculate the compare result.
- compare_result = GMP_INTS_mpz_cmp(&arb_arg1, &arb_arg2);
-
- //Assign the return value based on the result.
- if (compare_result < 0)
- rv = Tcl_NewStringObj("-1", -1);
- else if (compare_result == 0)
- rv = Tcl_NewStringObj("0", -1);
- else
- rv = Tcl_NewStringObj("1", -1);
-
- //Deallocate space for the arbitrary-length integers.
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//Handles the "intdiv" subextension.
-//07/31/01: Visually inspected, OK.
-static
-int ARBLENINTS_intdiv_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have two and exactly two additional arguments
- //to this function, which are the integers whose
- //integer quotient is to be calculated.
- if (objc != 4)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "sint sint");
- return(TCL_ERROR);
- }
- else
- {
- GMP_INTS_mpz_struct arb_dividend, arb_divisor, arb_quotient, arb_remainder;
- char *dividend_arg1, *divisor_arg2;
- int failure1, failure2;
- unsigned chars_reqd;
- char *string_result;
- int i, j;
-
- //Allocate space for the arbitrary-length integer arguments and results.
- GMP_INTS_mpz_init(&arb_dividend);
- GMP_INTS_mpz_init(&arb_divisor);
- GMP_INTS_mpz_init(&arb_quotient);
- GMP_INTS_mpz_init(&arb_remainder);
-
- //Grab pointers to the string representation of
- //the input arguments. The storage does not belong to us.
- dividend_arg1 = Tcl_GetString(objv[2]);
- assert(dividend_arg1 != NULL);
- divisor_arg2 = Tcl_GetString(objv[3]);
- assert(divisor_arg2 != NULL);
-
- //Try to interpret either of the strings as one of the NAN tags.
- //If it is one, return the appropriate result for
- //a binary operation.
- i = GMP_INTS_identify_nan_string(dividend_arg1);
- j = GMP_INTS_identify_nan_string(divisor_arg2);
-
- if ((i >= 0) || (j >= 0))
- {
- const char *p;
-
- //Find the max of i and j. This isn't a scientific way to tag the
- //result, but will be OK. Some information is lost no matter what
- //we do.
- if (i > j)
- ;
- else
- i = j;
-
- //i now contains the max.
- switch (i)
- {
- case 0: p = GMP_INTS_supply_nan_string(2);
- break;
- case 1: p = GMP_INTS_supply_nan_string(3);
- break;
- case 2: p = GMP_INTS_supply_nan_string(2);
- break;
- case 3: p = GMP_INTS_supply_nan_string(3);
- break;
- default:
- assert(0);
- break;
- }
-
- rv = Tcl_NewStringObj(p, -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_dividend);
- GMP_INTS_mpz_clear(&arb_divisor);
- GMP_INTS_mpz_clear(&arb_quotient);
- GMP_INTS_mpz_clear(&arb_remainder);
-
- return(TCL_OK);
- }
-
- //Try to convert both strings into arbitrary integers.
- GMP_INTS_mpz_set_general_int(&arb_dividend, &failure1, dividend_arg1);
- GMP_INTS_mpz_set_general_int(&arb_divisor, &failure2, divisor_arg2);
-
- //If there was a parse failure, we have to return an error
- //message. It is possible that both arguments failed the parse,
- //but only return one in the error message.
- if (failure1 || failure2)
- {
- rv = Tcl_NewStringObj("arbint intdiv: \"", -1);
- if (failure1)
- Tcl_AppendToObj(rv, dividend_arg1, -1);
- else
- Tcl_AppendToObj(rv, divisor_arg2, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_dividend);
- GMP_INTS_mpz_clear(&arb_divisor);
- GMP_INTS_mpz_clear(&arb_quotient);
- GMP_INTS_mpz_clear(&arb_remainder);
-
- return(TCL_ERROR);
- }
-
- //Calculate the quotient.
- GMP_INTS_mpz_tdiv_qr(&arb_quotient, &arb_remainder, &arb_dividend, &arb_divisor);
-
- //Figure out the number of characters required for
- //the output string.
- chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_quotient);
-
- //Allocate space for the conversion result.
- string_result = TclpAlloc(sizeof(char) * chars_reqd);
- assert(string_result != NULL);
-
- //Make the conversion to a character string.
- GMP_INTS_mpz_to_string(string_result, &arb_quotient);
-
- //Assign the string result to a Tcl object.
- rv = Tcl_NewStringObj(string_result, -1);
-
- //Deallocate the string.
- TclpFree(string_result);
-
- //Deallocate space for the arbitrary-length integers.
- GMP_INTS_mpz_clear(&arb_dividend);
- GMP_INTS_mpz_clear(&arb_divisor);
- GMP_INTS_mpz_clear(&arb_quotient);
- GMP_INTS_mpz_clear(&arb_remainder);
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//08/01/01: Visually inspected.
-//Handles the "intexp" subextension.
-static
-int ARBLENINTS_intexp_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have two and exactly two additional arguments
- //to this function, which are the integers used to
- //calculate the exponential.
- if (objc != 4)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "sint uint32");
- return(TCL_ERROR);
- }
- else
- {
- GMP_INTS_mpz_struct arb_arg1, arb_result;
- unsigned arg2;
- char *str_arg1, *str_arg2;
- int failure1, failure2;
- unsigned chars_reqd;
- char *string_result;
- int i, j;
-
- //Allocate space for the arbitrary-length integers.
- GMP_INTS_mpz_init(&arb_arg1);
- GMP_INTS_mpz_init(&arb_result);
-
- //Grab pointers to the string representation of
- //the input arguments. The storage does not belong to us.
- str_arg1 = Tcl_GetString(objv[2]);
- assert(str_arg1 != NULL);
- str_arg2 = Tcl_GetString(objv[3]);
- assert(str_arg2 != NULL);
-
- //Try to interpret either of the strings as one of the NAN tags.
- //If it is one, return the appropriate result for
- //a binary operation.
- i = GMP_INTS_identify_nan_string(str_arg1);
- j = GMP_INTS_identify_nan_string(str_arg2);
-
- if ((i >= 0) || (j >= 0))
- {
- const char *p;
-
- //Find the max of i and j. This isn't a scientific way to tag the
- //result, but will be OK. Some information is lost no matter what
- //we do.
- if (i > j)
- ;
- else
- i = j;
-
- //i now contains the max.
- switch (i)
- {
- case 0: p = GMP_INTS_supply_nan_string(2);
- break;
- case 1: p = GMP_INTS_supply_nan_string(3);
- break;
- case 2: p = GMP_INTS_supply_nan_string(2);
- break;
- case 3: p = GMP_INTS_supply_nan_string(3);
- break;
- default:
- assert(0);
- break;
- }
-
- rv = Tcl_NewStringObj(p, -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_result);
-
- return(TCL_OK);
- }
-
- //Try to convert the first string into arbitrary integers.
- //The first string can be anything, including zero or a negative
- //arugument.
- GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, str_arg1);
-
- //If the conversion of the first string did not go alright,
- //print error message and abort.
- if (failure1)
- {
- rv = Tcl_NewStringObj("arbint intexp: \"", -1);
- Tcl_AppendToObj(rv, str_arg1, -1);
- Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_result);
-
- return(TCL_ERROR);
- }
-
-
- //Try to convert the second string into an unsigned 32-bit
- //integer.
- GMP_INTS_mpz_parse_into_uint32(&arg2, &failure2, str_arg2);
-
- //If the conversion of the second string did not go alright,
- //print error message and abort.
- if (failure2)
- {
- rv = Tcl_NewStringObj("arbint intexp: \"", -1);
- Tcl_AppendToObj(rv, str_arg2, -1);
- Tcl_AppendToObj(rv, "\" is not a recognized unsigned 32-bit integer.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_result);
-
- return(TCL_ERROR);
- }
-
- //Calculate the exponential.
- GMP_INTS_mpz_pow_ui(&arb_result, &arb_arg1, arg2);
-
- //Figure out the number of characters required for
- //the output string.
- chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
-
- //Allocate space for the conversion result.
- string_result = TclpAlloc(sizeof(char) * chars_reqd);
- assert(string_result != NULL);
-
- //Make the conversion to a character string.
- GMP_INTS_mpz_to_string(string_result, &arb_result);
-
- //Assign the string result to a Tcl object.
- rv = Tcl_NewStringObj(string_result, -1);
-
- //Deallocate the string.
- TclpFree(string_result);
-
- //Deallocate space for the arbitrary-length integers.
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_result);
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//Handles the "intfac" subextension.
-//07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
-//from memory an intuition as far as how to set return results and so forth.
-static
-int ARBLENINTS_intfac_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have one and exactly one additional argument
- //to this function, which is the integer whose
- //factorial is to be evaluated.
- if (objc != 3)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "uint32");
- return(TCL_ERROR);
- }
- else
- {
- GMP_INTS_mpz_struct arb_result;
- char *fac_arg;
- int failure;
- unsigned fac_ui_arg;
- unsigned chars_reqd;
- char *string_result;
- int i;
-
- //Allocate space for the arbitrary-length integer result.
- GMP_INTS_mpz_init(&arb_result);
-
- //Grab a pointer to the string representation of
- //the input argument. The storage does not belong to us.
- fac_arg = Tcl_GetString(objv[2]);
- assert(fac_arg != NULL);
-
- //Try to interpret the string as one of the NAN tags.
- //If it is one, return the appropriate result for
- //a unary operation.
- if ((i = GMP_INTS_identify_nan_string(fac_arg)) >= 0)
- {
- const char *p;
-
- switch (i)
- {
- case 0: p = GMP_INTS_supply_nan_string(2);
- break;
- case 1: p = GMP_INTS_supply_nan_string(3);
- break;
- case 2: p = GMP_INTS_supply_nan_string(2);
- break;
- case 3: p = GMP_INTS_supply_nan_string(3);
- break;
- default:
- assert(0);
- break;
- }
-
- rv = Tcl_NewStringObj(p, -1);
- Tcl_SetObjResult(interp, rv);
- GMP_INTS_mpz_clear(&arb_result);
- return(TCL_OK);
- }
-
- //Try to convert the string to a UINT32 using all
- //known methods.
- GMP_INTS_mpz_parse_into_uint32(&fac_ui_arg, &failure, fac_arg);
-
- //If there was a parse failure, we have to return an error
- //message.
- if (failure)
- {
- rv = Tcl_NewStringObj("arbint intfac: \"", -1);
- Tcl_AppendToObj(rv, fac_arg, -1);
- Tcl_AppendToObj(rv, "\" is not a recognized 32-bit unsigned integer.", -1);
- Tcl_SetObjResult(interp, rv);
- GMP_INTS_mpz_clear(&arb_result);
- return(TCL_ERROR);
- }
-
- //Calculate the factorial.
- GMP_INTS_mpz_fac_ui(&arb_result, fac_ui_arg);
-
- //Figure out the number of characters required for
- //the output string.
- chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
-
- //Allocate space for the conversion result.
- string_result = TclpAlloc(sizeof(char) * chars_reqd);
- assert(string_result != NULL);
-
- //Make the conversion to a character string.
- GMP_INTS_mpz_to_string(string_result, &arb_result);
-
- //Assign the string result to a Tcl object.
- rv = Tcl_NewStringObj(string_result, -1);
-
- //Deallocate the string.
- TclpFree(string_result);
-
- //Deallocate space for the arbitrary-length integer.
- GMP_INTS_mpz_clear(&arb_result);
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//Handles the "intgcd" subextension.
-//08/06/01: Visual inspection OK.
-static
-int ARBLENINTS_intgcd_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have two and exactly two additional arguments
- //to this function, which are the integers whose
- //gcd is to be calculated.
- if (objc != 4)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "sint sint");
- return(TCL_ERROR);
- }
- else
- {
- GMP_INTS_mpz_struct arb_arg1, arb_arg2, arb_result;
- char *gcd_arg1, *gcd_arg2;
- int failure1, failure2;
- unsigned chars_reqd;
- char *string_result;
- int i, j;
-
- //Allocate space for the arbitrary-length integer result.
- GMP_INTS_mpz_init(&arb_arg1);
- GMP_INTS_mpz_init(&arb_arg2);
- GMP_INTS_mpz_init(&arb_result);
-
- //Grab pointers to the string representation of
- //the input arguments. The storage does not belong to us.
- gcd_arg1 = Tcl_GetString(objv[2]);
- assert(gcd_arg1 != NULL);
- gcd_arg2 = Tcl_GetString(objv[3]);
- assert(gcd_arg2 != NULL);
-
- //Try to interpret either of the strings as one of the NAN tags.
- //If it is one, return the appropriate result for
- //a binary operation.
- i = GMP_INTS_identify_nan_string(gcd_arg1);
- j = GMP_INTS_identify_nan_string(gcd_arg2);
-
- if ((i >= 0) || (j >= 0))
- {
- const char *p;
-
- //Find the max of i and j. This isn't a scientific way to tag the
- //result, but will be OK. Some information is lost no matter what
- //we do.
- if (i > j)
- ;
- else
- i = j;
-
- //i now contains the max.
- switch (i)
- {
- case 0: p = GMP_INTS_supply_nan_string(2);
- break;
- case 1: p = GMP_INTS_supply_nan_string(3);
- break;
- case 2: p = GMP_INTS_supply_nan_string(2);
- break;
- case 3: p = GMP_INTS_supply_nan_string(3);
- break;
- default:
- assert(0);
- break;
- }
-
- rv = Tcl_NewStringObj(p, -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
- GMP_INTS_mpz_clear(&arb_result);
-
- return(TCL_OK);
- }
-
- //Try to convert both strings into arbitrary integers.
- GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, gcd_arg1);
- GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, gcd_arg2);
-
- //If there was a parse failure, we have to return an error
- //message. It is possible that both arguments failed the parse,
- //but only return one in the error message.
- if (failure1 || failure2)
- {
- rv = Tcl_NewStringObj("arbint intgcd: \"", -1);
- if (failure1)
- Tcl_AppendToObj(rv, gcd_arg1, -1);
- else
- Tcl_AppendToObj(rv, gcd_arg2, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
- GMP_INTS_mpz_clear(&arb_result);
-
- return(TCL_ERROR);
- }
-
- //Calculate the gcd.
- GMP_INTS_mpz_gcd(&arb_result, &arb_arg1, &arb_arg2);
-
- //Figure out the number of characters required for
- //the output string.
- chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
-
- //Allocate space for the conversion result.
- string_result = TclpAlloc(sizeof(char) * chars_reqd);
- assert(string_result != NULL);
-
- //Make the conversion to a character string.
- GMP_INTS_mpz_to_string(string_result, &arb_result);
-
- //Assign the string result to a Tcl object.
- rv = Tcl_NewStringObj(string_result, -1);
-
- //Deallocate the string.
- TclpFree(string_result);
-
- //Deallocate space for the arbitrary-length integers.
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
- GMP_INTS_mpz_clear(&arb_result);
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//Handles the "intlcm" subextension.
-//08/10/01: Visual inspection OK.
-static
-int ARBLENINTS_intlcm_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have two and exactly two additional arguments
- //to this function, which are the integers whose
- //lcm is to be calculated.
- if (objc != 4)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "sint sint");
- return(TCL_ERROR);
- }
- else
- {
- GMP_INTS_mpz_struct arb_arg1, arb_arg2, gcd, remainder, arb_result;
- char *lcm_arg1, *lcm_arg2;
- int failure1, failure2;
- unsigned chars_reqd;
- char *string_result;
- int i, j;
-
- //Allocate space for the arbitrary-length integers.
- GMP_INTS_mpz_init(&arb_arg1);
- GMP_INTS_mpz_init(&arb_arg2);
- GMP_INTS_mpz_init(&gcd);
- GMP_INTS_mpz_init(&remainder);
- GMP_INTS_mpz_init(&arb_result);
-
- //Grab pointers to the string representation of
- //the input arguments. The storage does not belong to us.
- lcm_arg1 = Tcl_GetString(objv[2]);
- assert(lcm_arg1 != NULL);
- lcm_arg2 = Tcl_GetString(objv[3]);
- assert(lcm_arg2 != NULL);
-
- //Try to interpret either of the strings as one of the NAN tags.
- //If it is one, return the appropriate result for
- //a binary operation.
- i = GMP_INTS_identify_nan_string(lcm_arg1);
- j = GMP_INTS_identify_nan_string(lcm_arg2);
-
- if ((i >= 0) || (j >= 0))
- {
- const char *p;
-
- //Find the max of i and j. This isn't a scientific way to tag the
- //result, but will be OK. Some information is lost no matter what
- //we do.
- if (i > j)
- ;
- else
- i = j;
-
- //i now contains the max.
- switch (i)
- {
- case 0: p = GMP_INTS_supply_nan_string(2);
- break;
- case 1: p = GMP_INTS_supply_nan_string(3);
- break;
- case 2: p = GMP_INTS_supply_nan_string(2);
- break;
- case 3: p = GMP_INTS_supply_nan_string(3);
- break;
- default:
- assert(0);
- break;
- }
-
- rv = Tcl_NewStringObj(p, -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
- GMP_INTS_mpz_clear(&gcd);
- GMP_INTS_mpz_clear(&remainder);
- GMP_INTS_mpz_clear(&arb_result);
-
- return(TCL_OK);
- }
-
- //Try to convert both strings into arbitrary integers.
- GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, lcm_arg1);
- GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, lcm_arg2);
-
- //If there was a parse failure, we have to return an error
- //message. It is possible that both arguments failed the parse,
- //but only return one in the error message.
- if (failure1 || failure2)
- {
- rv = Tcl_NewStringObj("arbint intlcm: \"", -1);
- if (failure1)
- Tcl_AppendToObj(rv, lcm_arg1, -1);
- else
- Tcl_AppendToObj(rv, lcm_arg2, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
- GMP_INTS_mpz_clear(&gcd);
- GMP_INTS_mpz_clear(&remainder);
- GMP_INTS_mpz_clear(&arb_result);
-
- return(TCL_ERROR);
- }
-
- //Adjust errant arguments.
- if (GMP_INTS_mpz_is_neg(&arb_arg1))
- GMP_INTS_mpz_negate(&arb_arg1);
- else if (GMP_INTS_mpz_is_zero(&arb_arg1))
- GMP_INTS_mpz_set_ui(&arb_arg1, 1);
- if (GMP_INTS_mpz_is_neg(&arb_arg2))
- GMP_INTS_mpz_negate(&arb_arg2);
- else if (GMP_INTS_mpz_is_zero(&arb_arg2))
- GMP_INTS_mpz_set_ui(&arb_arg2, 1);
-
- //Calculate the gcd.
- GMP_INTS_mpz_gcd(&gcd, &arb_arg1, &arb_arg2);
-
- //Calculate the lcm.
- GMP_INTS_mpz_mul(&arb_arg1, &arb_arg1, &arb_arg2);
- GMP_INTS_mpz_tdiv_qr(&arb_result, &remainder,
- &arb_arg1, &gcd);
-
- //Figure out the number of characters required for
- //the output string.
- chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
-
- //Allocate space for the conversion result.
- string_result = TclpAlloc(sizeof(char) * chars_reqd);
- assert(string_result != NULL);
-
- //Make the conversion to a character string.
- GMP_INTS_mpz_to_string(string_result, &arb_result);
-
- //Assign the string result to a Tcl object.
- rv = Tcl_NewStringObj(string_result, -1);
-
- //Deallocate the string.
- TclpFree(string_result);
-
- //Deallocate space for the arbitrary-length integers.
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
- GMP_INTS_mpz_clear(&gcd);
- GMP_INTS_mpz_clear(&remainder);
- GMP_INTS_mpz_clear(&arb_result);
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//Handles the "intmod" subextension.
-//08/06/01: Visual inspection OK.
-static
-int ARBLENINTS_intmod_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have two and exactly two additional arguments
- //to this function, which are the integers whose
- //integer quotient is to be calculated.
- if (objc != 4)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "sint sint");
- return(TCL_ERROR);
- }
- else
- {
- GMP_INTS_mpz_struct arb_dividend, arb_divisor, arb_quotient, arb_remainder;
- char *dividend_arg1, *divisor_arg2;
- int failure1, failure2;
- unsigned chars_reqd;
- char *string_result;
- int i, j;
-
- //Allocate space for the arbitrary-length integer arguments and results.
- GMP_INTS_mpz_init(&arb_dividend);
- GMP_INTS_mpz_init(&arb_divisor);
- GMP_INTS_mpz_init(&arb_quotient);
- GMP_INTS_mpz_init(&arb_remainder);
-
- //Grab pointers to the string representation of
- //the input arguments. The storage does not belong to us.
- dividend_arg1 = Tcl_GetString(objv[2]);
- assert(dividend_arg1 != NULL);
- divisor_arg2 = Tcl_GetString(objv[3]);
- assert(divisor_arg2 != NULL);
-
- //Try to interpret either of the strings as one of the NAN tags.
- //If it is one, return the appropriate result for
- //a binary operation.
- i = GMP_INTS_identify_nan_string(dividend_arg1);
- j = GMP_INTS_identify_nan_string(divisor_arg2);
-
- if ((i >= 0) || (j >= 0))
- {
- const char *p;
-
- //Find the max of i and j. This isn't a scientific way to tag the
- //result, but will be OK. Some information is lost no matter what
- //we do.
- if (i > j)
- ;
- else
- i = j;
-
- //i now contains the max.
- switch (i)
- {
- case 0: p = GMP_INTS_supply_nan_string(2);
- break;
- case 1: p = GMP_INTS_supply_nan_string(3);
- break;
- case 2: p = GMP_INTS_supply_nan_string(2);
- break;
- case 3: p = GMP_INTS_supply_nan_string(3);
- break;
- default:
- assert(0);
- break;
- }
-
- rv = Tcl_NewStringObj(p, -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_dividend);
- GMP_INTS_mpz_clear(&arb_divisor);
- GMP_INTS_mpz_clear(&arb_quotient);
- GMP_INTS_mpz_clear(&arb_remainder);
-
- return(TCL_OK);
- }
-
- //Try to convert both strings into arbitrary integers.
- GMP_INTS_mpz_set_general_int(&arb_dividend, &failure1, dividend_arg1);
- GMP_INTS_mpz_set_general_int(&arb_divisor, &failure2, divisor_arg2);
-
- //If there was a parse failure, we have to return an error
- //message. It is possible that both arguments failed the parse,
- //but only return one in the error message.
- if (failure1 || failure2)
- {
- rv = Tcl_NewStringObj("arbint intmod: \"", -1);
- if (failure1)
- Tcl_AppendToObj(rv, dividend_arg1, -1);
- else
- Tcl_AppendToObj(rv, divisor_arg2, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_dividend);
- GMP_INTS_mpz_clear(&arb_divisor);
- GMP_INTS_mpz_clear(&arb_quotient);
- GMP_INTS_mpz_clear(&arb_remainder);
-
- return(TCL_ERROR);
- }
-
- //Calculate the quotient and remainder.
- GMP_INTS_mpz_tdiv_qr(&arb_quotient, &arb_remainder, &arb_dividend, &arb_divisor);
-
- //Figure out the number of characters required for
- //the output string.
- chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_remainder);
-
- //Allocate space for the conversion result.
- string_result = TclpAlloc(sizeof(char) * chars_reqd);
- assert(string_result != NULL);
-
- //Make the conversion to a character string.
- GMP_INTS_mpz_to_string(string_result, &arb_remainder);
-
- //Assign the string result to a Tcl object.
- rv = Tcl_NewStringObj(string_result, -1);
-
- //Deallocate the string.
- TclpFree(string_result);
-
- //Deallocate space for the arbitrary-length integers.
- GMP_INTS_mpz_clear(&arb_dividend);
- GMP_INTS_mpz_clear(&arb_divisor);
- GMP_INTS_mpz_clear(&arb_quotient);
- GMP_INTS_mpz_clear(&arb_remainder);
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//Handles the "intmul" subextension.
-//08/06/01: Visual inspection OK.
-static
-int ARBLENINTS_intmul_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have two and exactly two additional arguments
- //to this function, which are the integers whose
- //product is to be calculated.
- if (objc != 4)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "sint sint");
- return(TCL_ERROR);
- }
- else
- {
- GMP_INTS_mpz_struct arb_arg1, arb_arg2, arb_result;
- char *mul_arg1, *mul_arg2;
- int failure1, failure2;
- unsigned chars_reqd;
- char *string_result;
- int i, j;
-
- //Allocate space for the arbitrary-length integer result.
- GMP_INTS_mpz_init(&arb_arg1);
- GMP_INTS_mpz_init(&arb_arg2);
- GMP_INTS_mpz_init(&arb_result);
-
- //Grab pointers to the string representation of
- //the input arguments. The storage does not belong to us.
- mul_arg1 = Tcl_GetString(objv[2]);
- assert(mul_arg1 != NULL);
- mul_arg2 = Tcl_GetString(objv[3]);
- assert(mul_arg2 != NULL);
-
- //Try to interpret either of the strings as one of the NAN tags.
- //If it is one, return the appropriate result for
- //a binary operation.
- i = GMP_INTS_identify_nan_string(mul_arg1);
- j = GMP_INTS_identify_nan_string(mul_arg2);
-
- if ((i >= 0) || (j >= 0))
- {
- const char *p;
-
- //Find the max of i and j. This isn't a scientific way to tag the
- //result, but will be OK. Some information is lost no matter what
- //we do.
- if (i > j)
- ;
- else
- i = j;
-
- //i now contains the max.
- switch (i)
- {
- case 0: p = GMP_INTS_supply_nan_string(2);
- break;
- case 1: p = GMP_INTS_supply_nan_string(3);
- break;
- case 2: p = GMP_INTS_supply_nan_string(2);
- break;
- case 3: p = GMP_INTS_supply_nan_string(3);
- break;
- default:
- assert(0);
- break;
- }
-
- rv = Tcl_NewStringObj(p, -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
- GMP_INTS_mpz_clear(&arb_result);
-
- return(TCL_OK);
- }
-
- //Try to convert both strings into arbitrary integers.
- GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, mul_arg1);
- GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, mul_arg2);
-
- //If there was a parse failure, we have to return an error
- //message. It is possible that both arguments failed the parse,
- //but only return one in the error message.
- if (failure1 || failure2)
- {
- rv = Tcl_NewStringObj("arbint intmul: \"", -1);
- if (failure1)
- Tcl_AppendToObj(rv, mul_arg1, -1);
- else
- Tcl_AppendToObj(rv, mul_arg2, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
- GMP_INTS_mpz_clear(&arb_result);
-
- return(TCL_ERROR);
- }
-
- //Calculate the product.
- GMP_INTS_mpz_mul(&arb_result, &arb_arg1, &arb_arg2);
-
- //Figure out the number of characters required for
- //the output string.
- chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
-
- //Allocate space for the conversion result.
- string_result = TclpAlloc(sizeof(char) * chars_reqd);
- assert(string_result != NULL);
-
- //Make the conversion to a character string.
- GMP_INTS_mpz_to_string(string_result, &arb_result);
-
- //Assign the string result to a Tcl object.
- rv = Tcl_NewStringObj(string_result, -1);
-
- //Deallocate the string.
- TclpFree(string_result);
-
- //Deallocate space for the arbitrary-length integers.
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
- GMP_INTS_mpz_clear(&arb_result);
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//Handles the "intsub" subextension.
-//08/06/01: Visual inspection OK.
-static
-int ARBLENINTS_intsub_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have two and exactly two additional arguments
- //to this function, which are the integers whose
- //difference is to be calculated.
- if (objc != 4)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "sint sint");
- return(TCL_ERROR);
- }
- else
- {
- GMP_INTS_mpz_struct arb_arg1, arb_arg2, arb_result;
- char *sub_arg1, *sub_arg2;
- int failure1, failure2;
- unsigned chars_reqd;
- char *string_result;
- int i, j;
-
- //Allocate space for the arbitrary-length integer result.
- GMP_INTS_mpz_init(&arb_arg1);
- GMP_INTS_mpz_init(&arb_arg2);
- GMP_INTS_mpz_init(&arb_result);
-
- //Grab pointers to the string representation of
- //the input arguments. The storage does not belong to us.
- sub_arg1 = Tcl_GetString(objv[2]);
- assert(sub_arg1 != NULL);
- sub_arg2 = Tcl_GetString(objv[3]);
- assert(sub_arg2 != NULL);
-
- //Try to interpret either of the strings as one of the NAN tags.
- //If it is one, return the appropriate result for
- //a binary operation.
- i = GMP_INTS_identify_nan_string(sub_arg1);
- j = GMP_INTS_identify_nan_string(sub_arg2);
-
- if ((i >= 0) || (j >= 0))
- {
- const char *p;
-
- //Find the max of i and j. This isn't a scientific way to tag the
- //result, but will be OK. Some information is lost no matter what
- //we do.
- if (i > j)
- ;
- else
- i = j;
-
- //i now contains the max.
- switch (i)
- {
- case 0: p = GMP_INTS_supply_nan_string(2);
- break;
- case 1: p = GMP_INTS_supply_nan_string(3);
- break;
- case 2: p = GMP_INTS_supply_nan_string(2);
- break;
- case 3: p = GMP_INTS_supply_nan_string(3);
- break;
- default:
- assert(0);
- break;
- }
-
- rv = Tcl_NewStringObj(p, -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
- GMP_INTS_mpz_clear(&arb_result);
-
- return(TCL_OK);
- }
-
- //Try to convert both strings into arbitrary integers.
- GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, sub_arg1);
- GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, sub_arg2);
-
- //If there was a parse failure, we have to return an error
- //message. It is possible that both arguments failed the parse,
- //but only return one in the error message.
- if (failure1 || failure2)
- {
- rv = Tcl_NewStringObj("arbint intsub: \"", -1);
- if (failure1)
- Tcl_AppendToObj(rv, sub_arg1, -1);
- else
- Tcl_AppendToObj(rv, sub_arg2, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
- GMP_INTS_mpz_clear(&arb_result);
-
- return(TCL_ERROR);
- }
-
- //Calculate the difference.
- GMP_INTS_mpz_sub(&arb_result, &arb_arg1, &arb_arg2);
-
- //Figure out the number of characters required for
- //the output string.
- chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
-
- //Allocate space for the conversion result.
- string_result = TclpAlloc(sizeof(char) * chars_reqd);
- assert(string_result != NULL);
-
- //Make the conversion to a character string.
- GMP_INTS_mpz_to_string(string_result, &arb_result);
-
- //Assign the string result to a Tcl object.
- rv = Tcl_NewStringObj(string_result, -1);
-
- //Deallocate the string.
- TclpFree(string_result);
-
- //Deallocate space for the arbitrary-length integers.
- GMP_INTS_mpz_clear(&arb_arg1);
- GMP_INTS_mpz_clear(&arb_arg2);
- GMP_INTS_mpz_clear(&arb_result);
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//Handles the "iseflag" subextension.
-//07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
-//from memory an intuition as far as how to set return results and so forth.
-static
-int ARBLENINTS_iseflag_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have one and exactly one additional argument
- //to this function, which is the string we want to
- //classify.
- if (objc != 3)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "stringarg");
- return(TCL_ERROR);
- }
- else
- {
- char *string_arg;
-
- //Grab a pointer to the string representation of
- //the input argument. The storage does not belong to us.
- string_arg = Tcl_GetString(objv[2]);
- assert(string_arg != NULL);
-
- //Try to parse it out. We will definitely get one of
- //the return values.
- if (!strcmp(string_arg, GMP_INTS_EF_INTOVF_POS_STRING))
- {
- rv = Tcl_NewStringObj("1", -1);
- }
- else if (!strcmp(string_arg, GMP_INTS_EF_INTOVF_NEG_STRING))
- {
- rv = Tcl_NewStringObj("2", -1);
- }
- else if (!strcmp(string_arg, GMP_INTS_EF_INTOVF_TAINT_POS_STRING))
- {
- rv = Tcl_NewStringObj("3", -1);
- }
- else if (!strcmp(string_arg, GMP_INTS_EF_INTOVF_TAINT_NEG_STRING))
- {
- rv = Tcl_NewStringObj("4", -1);
- }
- else
- {
- rv = Tcl_NewStringObj("0", -1);
- }
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//08/08/01: Visual inspection OK.
-static
-int ARBLENINTS_rnadd_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have exactly two additional arguments
- //to this function, which are the rational numbers
- //to add.
- if (objc != 4)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "srn srn");
- return(TCL_ERROR);
- }
- else
- {
- char *input_arg;
- int failure;
- char *string_result;
- GMP_RATS_mpq_struct arg1, arg2, result;
-
- //Allocate space for the rational numbers.
- GMP_RATS_mpq_init(&arg1);
- GMP_RATS_mpq_init(&arg2);
- GMP_RATS_mpq_init(&result);
-
- //Grab a pointer to the string representation of
- //the first input argument. The storage does not belong to us.
- input_arg = Tcl_GetString(objv[2]);
- assert(input_arg != NULL);
-
- //Try to parse our first input string as a rational number.
- //If we are not successful in this, must abort.
- GMP_RATS_mpq_set_all_format_rat_num(input_arg,
- &failure,
- &arg1);
-
- if (failure)
- {
- rv = Tcl_NewStringObj("arbint rnadd: \"", -1);
- Tcl_AppendToObj(rv, input_arg, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
- GMP_RATS_mpq_clear(&result);
-
- return(TCL_ERROR);
- }
-
- //Grab a pointer to the string representation of
- //the second input argument. The storage does not belong to us.
- input_arg = Tcl_GetString(objv[3]);
- assert(input_arg != NULL);
-
- //Try to parse our second input string as a rational number.
- //If we are not successful in this, must abort.
- GMP_RATS_mpq_set_all_format_rat_num(input_arg,
- &failure,
- &arg2);
-
- if (failure)
- {
- rv = Tcl_NewStringObj("arbint rnadd: \"", -1);
- Tcl_AppendToObj(rv, input_arg, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
- GMP_RATS_mpq_clear(&result);
-
- return(TCL_ERROR);
- }
-
- //Perform the actual addition of the rational numbers. All
- //error cases are covered. If either of the inputs has a
- //denominator of zero, this will propagate to the result.
- GMP_RATS_mpq_add(&result, &arg1, &arg2);
-
- //If the result has been NAN'd, return the string "NAN".
- if (GMP_RATS_mpq_is_nan(&result))
- {
- rv = Tcl_NewStringObj("NAN", -1);
-
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
- GMP_RATS_mpq_clear(&result);
-
- return(TCL_OK);
- }
-
- //Allocate space for the string result which we'll form for
- //both numerator and denominator. We need the maximum, because we'll only
- //do one number at a time.
- string_result = TclpAlloc(sizeof(char)
- *
- INTFUNC_max
- (
- GMP_INTS_mpz_size_in_base_10(&(result.num)),
- GMP_INTS_mpz_size_in_base_10(&(result.den))
- )
- );
- assert(string_result != NULL);
-
- //Convert the numerator to a string and set that to be the
- //return value.
- GMP_INTS_mpz_to_string(string_result, &(result.num));
- rv = Tcl_NewStringObj(string_result, -1);
-
- //Append the separating slash.
- Tcl_AppendToObj(rv, "/", -1);
-
- //Convert the denominator to a string and append that to the
- //return value.
- GMP_INTS_mpz_to_string(string_result, &(result.den));
- Tcl_AppendToObj(rv, string_result, -1);
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Free up all dynamic memory.
- TclpFree(string_result);
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
- GMP_RATS_mpq_clear(&result);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//08/16/01: Visual inspection OK.
-static
-int ARBLENINTS_rncmp_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have exactly two additional arguments
- //to this function, which are the rational numbers
- //to compare.
- if (objc != 4)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "srn srn");
- return(TCL_ERROR);
- }
- else
- {
- char *input_arg;
- int failure, compare_result;
- GMP_RATS_mpq_struct arg1, arg2;
-
- //Allocate space for the rational numbers.
- GMP_RATS_mpq_init(&arg1);
- GMP_RATS_mpq_init(&arg2);
-
- //Grab a pointer to the string representation of
- //the first input argument. The storage does not belong to us.
- input_arg = Tcl_GetString(objv[2]);
- assert(input_arg != NULL);
-
- //Try to parse our first input string as a rational number.
- //If we are not successful in this, must abort.
- GMP_RATS_mpq_set_all_format_rat_num(input_arg,
- &failure,
- &arg1);
-
- if (failure)
- {
- rv = Tcl_NewStringObj("arbint rncmp: \"", -1);
- Tcl_AppendToObj(rv, input_arg, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
-
- return(TCL_ERROR);
- }
-
- //Grab a pointer to the string representation of
- //the second input argument. The storage does not belong to us.
- input_arg = Tcl_GetString(objv[3]);
- assert(input_arg != NULL);
-
- //Try to parse our second input string as a rational number.
- //If we are not successful in this, must abort.
- GMP_RATS_mpq_set_all_format_rat_num(input_arg,
- &failure,
- &arg2);
-
- if (failure)
- {
- rv = Tcl_NewStringObj("arbint rncmp: \"", -1);
- Tcl_AppendToObj(rv, input_arg, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
-
- return(TCL_ERROR);
- }
-
- //Perform the actual comparison of the rational numbers. All
- //error cases are covered. If either of the inputs has a
- //denominator of zero, this will propagate to the result.
- compare_result = GMP_RATS_mpq_cmp(&arg1, &arg2, &failure);
-
- //If the failure flag was thrown, we have to throw an error.
- //The reason is that if we can't successfully compare the two
- //rational numbers, then we have to kill the script--logical
- //correctness is not possible.
- if (failure)
- {
- rv = Tcl_NewStringObj("arbint rncmp: can't compare supplied rational numbers.", -1);
-
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
-
- return(TCL_ERROR);
- }
-
- //Convert the comparison result to a string.
- if (compare_result < 0)
- rv = Tcl_NewStringObj("-1", -1);
- else if (compare_result == 0)
- rv = Tcl_NewStringObj("0", -1);
- else
- rv = Tcl_NewStringObj("1", -1);
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Free up all dynamic memory.
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//08/09/01: Visual inspection OK.
-static
-int ARBLENINTS_rndiv_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have exactly two additional arguments
- //to this function, which are the rational numbers
- //to divide.
- if (objc != 4)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "srn srn");
- return(TCL_ERROR);
- }
- else
- {
- char *input_arg;
- int failure;
- char *string_result;
- GMP_RATS_mpq_struct arg1, arg2, result;
-
- //Allocate space for the rational numbers.
- GMP_RATS_mpq_init(&arg1);
- GMP_RATS_mpq_init(&arg2);
- GMP_RATS_mpq_init(&result);
-
- //Grab a pointer to the string representation of
- //the first input argument. The storage does not belong to us.
- input_arg = Tcl_GetString(objv[2]);
- assert(input_arg != NULL);
-
- //Try to parse our first input string as a rational number.
- //If we are not successful in this, must abort.
- GMP_RATS_mpq_set_all_format_rat_num(input_arg,
- &failure,
- &arg1);
-
- if (failure)
- {
- rv = Tcl_NewStringObj("arbint rndiv: \"", -1);
- Tcl_AppendToObj(rv, input_arg, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
- GMP_RATS_mpq_clear(&result);
-
- return(TCL_ERROR);
- }
-
- //Grab a pointer to the string representation of
- //the second input argument. The storage does not belong to us.
- input_arg = Tcl_GetString(objv[3]);
- assert(input_arg != NULL);
-
- //Try to parse our second input string as a rational number.
- //If we are not successful in this, must abort.
- GMP_RATS_mpq_set_all_format_rat_num(input_arg,
- &failure,
- &arg2);
-
- if (failure)
- {
- rv = Tcl_NewStringObj("arbint rndiv: \"", -1);
- Tcl_AppendToObj(rv, input_arg, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
- GMP_RATS_mpq_clear(&result);
-
- return(TCL_ERROR);
- }
-
- //Perform the actual division of the rational numbers. All
- //error cases are covered. If either of the inputs has a
- //denominator of zero, this will propagate to the result.
- GMP_RATS_mpq_div(&result, &arg1, &arg2);
-
- //If the result has been NAN'd, return the string "NAN".
- if (GMP_RATS_mpq_is_nan(&result))
- {
- rv = Tcl_NewStringObj("NAN", -1);
-
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
- GMP_RATS_mpq_clear(&result);
-
- return(TCL_OK);
- }
-
- //Allocate space for the string result which we'll form for
- //both numerator and denominator. We need the maximum, because we'll only
- //do one number at a time.
- string_result = TclpAlloc(sizeof(char)
- *
- INTFUNC_max
- (
- GMP_INTS_mpz_size_in_base_10(&(result.num)),
- GMP_INTS_mpz_size_in_base_10(&(result.den))
- )
- );
- assert(string_result != NULL);
-
- //Convert the numerator to a string and set that to be the
- //return value.
- GMP_INTS_mpz_to_string(string_result, &(result.num));
- rv = Tcl_NewStringObj(string_result, -1);
-
- //Append the separating slash.
- Tcl_AppendToObj(rv, "/", -1);
-
- //Convert the denominator to a string and append that to the
- //return value.
- GMP_INTS_mpz_to_string(string_result, &(result.den));
- Tcl_AppendToObj(rv, string_result, -1);
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Free up all dynamic memory.
- TclpFree(string_result);
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
- GMP_RATS_mpq_clear(&result);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//08/09/01: Visual inspection OK.
-static
-int ARBLENINTS_rnmul_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have exactly two additional arguments
- //to this function, which are the rational numbers
- //to add.
- if (objc != 4)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "srn srn");
- return(TCL_ERROR);
- }
- else
- {
- char *input_arg;
- int failure;
- char *string_result;
- GMP_RATS_mpq_struct arg1, arg2, result;
-
- //Allocate space for the rational numbers.
- GMP_RATS_mpq_init(&arg1);
- GMP_RATS_mpq_init(&arg2);
- GMP_RATS_mpq_init(&result);
-
- //Grab a pointer to the string representation of
- //the first input argument. The storage does not belong to us.
- input_arg = Tcl_GetString(objv[2]);
- assert(input_arg != NULL);
-
- //Try to parse our first input string as a rational number.
- //If we are not successful in this, must abort.
- GMP_RATS_mpq_set_all_format_rat_num(input_arg,
- &failure,
- &arg1);
-
- if (failure)
- {
- rv = Tcl_NewStringObj("arbint rnmul: \"", -1);
- Tcl_AppendToObj(rv, input_arg, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
- GMP_RATS_mpq_clear(&result);
-
- return(TCL_ERROR);
- }
-
- //Grab a pointer to the string representation of
- //the second input argument. The storage does not belong to us.
- input_arg = Tcl_GetString(objv[3]);
- assert(input_arg != NULL);
-
- //Try to parse our second input string as a rational number.
- //If we are not successful in this, must abort.
- GMP_RATS_mpq_set_all_format_rat_num(input_arg,
- &failure,
- &arg2);
-
- if (failure)
- {
- rv = Tcl_NewStringObj("arbint rnmul: \"", -1);
- Tcl_AppendToObj(rv, input_arg, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
- GMP_RATS_mpq_clear(&result);
-
- return(TCL_ERROR);
- }
-
- //Perform the actual multiplication of the rational numbers. All
- //error cases are covered. If either of the inputs has a
- //denominator of zero, this will propagate to the result.
- GMP_RATS_mpq_mul(&result, &arg1, &arg2);
-
- //If the result has been NAN'd, return the string "NAN".
- if (GMP_RATS_mpq_is_nan(&result))
- {
- rv = Tcl_NewStringObj("NAN", -1);
-
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
- GMP_RATS_mpq_clear(&result);
-
- return(TCL_OK);
- }
-
- //Allocate space for the string result which we'll form for
- //both numerator and denominator. We need the maximum, because we'll only
- //do one number at a time.
- string_result = TclpAlloc(sizeof(char)
- *
- INTFUNC_max
- (
- GMP_INTS_mpz_size_in_base_10(&(result.num)),
- GMP_INTS_mpz_size_in_base_10(&(result.den))
- )
- );
- assert(string_result != NULL);
-
- //Convert the numerator to a string and set that to be the
- //return value.
- GMP_INTS_mpz_to_string(string_result, &(result.num));
- rv = Tcl_NewStringObj(string_result, -1);
-
- //Append the separating slash.
- Tcl_AppendToObj(rv, "/", -1);
-
- //Convert the denominator to a string and append that to the
- //return value.
- GMP_INTS_mpz_to_string(string_result, &(result.den));
- Tcl_AppendToObj(rv, string_result, -1);
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Free up all dynamic memory.
- TclpFree(string_result);
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
- GMP_RATS_mpq_clear(&result);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//08/09/01: Visual inspection OK.
-static
-int ARBLENINTS_rnred_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have exactly one additional argument
- //to this function, which is the rational number
- //to provide the fully reduced form of.
- if (objc != 3)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "srn");
- return(TCL_ERROR);
- }
- else
- {
- char *input_arg;
- int failure;
- char *string_result;
- GMP_RATS_mpq_struct rn;
-
- //We will need a rational number to hold the return value
- //from the parsing function. Allocate that now.
- GMP_RATS_mpq_init(&rn);
-
- //Grab a pointer to the string representation of
- //the input argument. The storage does not belong to us.
- input_arg = Tcl_GetString(objv[2]);
- assert(input_arg != NULL);
-
- //Try to parse our input string as a rational number.
- //If we are not successful in this, must abort.
- GMP_RATS_mpq_set_all_format_rat_num(input_arg,
- &failure,
- &rn);
-
- if (failure)
- {
- rv = Tcl_NewStringObj("arbint rnred: \"", -1);
- Tcl_AppendToObj(rv, input_arg, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&rn);
-
- return(TCL_ERROR);
- }
-
- //Normalize the rational number. This takes care of the
- //sign and also of the coprimality of numerator and
- //denominator.
- GMP_RATS_mpq_normalize(&rn);
-
- //Allocate space for the string result which we'll form for
- //both numbers. We need the maximum, because we'll only
- //do one number at a time.
- string_result = TclpAlloc(sizeof(char)
- *
- INTFUNC_max
- (
- GMP_INTS_mpz_size_in_base_10(&(rn.num)),
- GMP_INTS_mpz_size_in_base_10(&(rn.den))
- )
- );
- assert(string_result != NULL);
-
- //Convert the numerator to a string and set that to be the
- //return value.
- GMP_INTS_mpz_to_string(string_result, &(rn.num));
- rv = Tcl_NewStringObj(string_result, -1);
-
- //Append the separating slash.
- Tcl_AppendToObj(rv, "/", -1);
-
- //Convert the denominator to a string and append that to the
- //return value.
- GMP_INTS_mpz_to_string(string_result, &(rn.den));
- Tcl_AppendToObj(rv, string_result, -1);
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Free up all dynamic memory.
- TclpFree(string_result);
- GMP_RATS_mpq_clear(&rn);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//08/08/01: Visual inspection OK.
-static
-int ARBLENINTS_rnsub_handler(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- Tcl_Obj *rv;
-
- //We must have exactly two additional arguments
- //to this function, which are the rational numbers
- //to subtract.
- if (objc != 4)
- {
- Tcl_WrongNumArgs(interp,
- 2,
- objv,
- "srn srn");
- return(TCL_ERROR);
- }
- else
- {
- char *input_arg;
- int failure;
- char *string_result;
- GMP_RATS_mpq_struct arg1, arg2, result;
-
- //Allocate space for the rational numbers.
- GMP_RATS_mpq_init(&arg1);
- GMP_RATS_mpq_init(&arg2);
- GMP_RATS_mpq_init(&result);
-
- //Grab a pointer to the string representation of
- //the first input argument. The storage does not belong to us.
- input_arg = Tcl_GetString(objv[2]);
- assert(input_arg != NULL);
-
- //Try to parse our first input string as a rational number.
- //If we are not successful in this, must abort.
- GMP_RATS_mpq_set_all_format_rat_num(input_arg,
- &failure,
- &arg1);
-
- if (failure)
- {
- rv = Tcl_NewStringObj("arbint rnsub: \"", -1);
- Tcl_AppendToObj(rv, input_arg, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
- GMP_RATS_mpq_clear(&result);
-
- return(TCL_ERROR);
- }
-
- //Grab a pointer to the string representation of
- //the second input argument. The storage does not belong to us.
- input_arg = Tcl_GetString(objv[3]);
- assert(input_arg != NULL);
-
- //Try to parse our second input string as a rational number.
- //If we are not successful in this, must abort.
- GMP_RATS_mpq_set_all_format_rat_num(input_arg,
- &failure,
- &arg2);
-
- if (failure)
- {
- rv = Tcl_NewStringObj("arbint rnsub: \"", -1);
- Tcl_AppendToObj(rv, input_arg, -1);
-
- Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
- GMP_RATS_mpq_clear(&result);
-
- return(TCL_ERROR);
- }
-
- //Perform the actual subtraction of the rational numbers. All
- //error cases are covered. If either of the inputs has a
- //denominator of zero, this will propagate to the result.
- GMP_RATS_mpq_sub(&result, &arg1, &arg2);
-
- //If the result has been NAN'd, return the string "NAN".
- if (GMP_RATS_mpq_is_nan(&result))
- {
- rv = Tcl_NewStringObj("NAN", -1);
-
- Tcl_SetObjResult(interp, rv);
-
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
- GMP_RATS_mpq_clear(&result);
-
- return(TCL_OK);
- }
-
- //Allocate space for the string result which we'll form for
- //both numerator and denominator. We need the maximum, because we'll only
- //do one number at a time.
- string_result = TclpAlloc(sizeof(char)
- *
- INTFUNC_max
- (
- GMP_INTS_mpz_size_in_base_10(&(result.num)),
- GMP_INTS_mpz_size_in_base_10(&(result.den))
- )
- );
- assert(string_result != NULL);
-
- //Convert the numerator to a string and set that to be the
- //return value.
- GMP_INTS_mpz_to_string(string_result, &(result.num));
- rv = Tcl_NewStringObj(string_result, -1);
-
- //Append the separating slash.
- Tcl_AppendToObj(rv, "/", -1);
-
- //Convert the denominator to a string and append that to the
- //return value.
- GMP_INTS_mpz_to_string(string_result, &(result.den));
- Tcl_AppendToObj(rv, string_result, -1);
-
- //Assign the result to be the return value.
- Tcl_SetObjResult(interp, rv);
-
- //Free up all dynamic memory.
- TclpFree(string_result);
- GMP_RATS_mpq_clear(&arg1);
- GMP_RATS_mpq_clear(&arg2);
- GMP_RATS_mpq_clear(&result);
-
- //Return
- return(TCL_OK);
- }
- }
-
-
-//This is the search data table of possible subcommands
-//for the "arbint" extension. These must be kept
-//in alphabetical order, because a binary search is done
-//on this table in order to find an entry. If this table
-//falls out of alphabetical order, the binary search may
-//fail when in fact the entry exists.
-//
-//In a lot of cases below, this table is set up to accept
-//short forms. This is purely undocumented, and I won't put
-//it in any documentation. In a lot of cases, these table
-//entries cover common mistakes where people forget the "int".
-//
-static struct EXTNINIT_subextn_bsearch_record_struct
- ARBLENINTS_subextn_tbl[] =
- {
- { "brap", ARBLENINTS_cfbrapab_handler },
- { "cfbrapab", ARBLENINTS_cfbrapab_handler },
- { "cfratnum", ARBLENINTS_cfratnum_handler },
- { "cmp", ARBLENINTS_intcmp_handler },
- { "commanate", ARBLENINTS_commanate_handler },
- { "compare", ARBLENINTS_intcmp_handler },
- { "const", ARBLENINTS_const_handler },
- { "decommanate", ARBLENINTS_decommanate_handler },
- { "div", ARBLENINTS_intdiv_handler },
- { "divide", ARBLENINTS_intdiv_handler },
- { "exp", ARBLENINTS_intexp_handler },
- { "fac", ARBLENINTS_intfac_handler },
- { "factorial", ARBLENINTS_intfac_handler },
- { "gcd", ARBLENINTS_intgcd_handler },
- { "intadd", ARBLENINTS_intadd_handler },
- { "intcmp", ARBLENINTS_intcmp_handler },
- { "intdiv", ARBLENINTS_intdiv_handler },
- { "intexp", ARBLENINTS_intexp_handler },
- { "intfac", ARBLENINTS_intfac_handler },
- { "intgcd", ARBLENINTS_intgcd_handler },
- { "intlcm", ARBLENINTS_intlcm_handler },
- { "intmod", ARBLENINTS_intmod_handler },
- { "intmul", ARBLENINTS_intmul_handler },
- { "intsub", ARBLENINTS_intsub_handler },
- { "iseflag", ARBLENINTS_iseflag_handler },
- { "lcm", ARBLENINTS_intlcm_handler },
- { "mod", ARBLENINTS_intmod_handler },
- { "mul", ARBLENINTS_intmul_handler },
- { "multiply", ARBLENINTS_intmul_handler },
- { "rnadd", ARBLENINTS_rnadd_handler },
- { "rncmp", ARBLENINTS_rncmp_handler },
- { "rndiv", ARBLENINTS_rndiv_handler },
- { "rnmul", ARBLENINTS_rnmul_handler },
- { "rnred", ARBLENINTS_rnred_handler },
- { "rnsub", ARBLENINTS_rnsub_handler },
- { "times", ARBLENINTS_intmul_handler },
- };
-
-
-//Procedure called when the "arbint" command is encountered in a Tcl script.
-//07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
-//from memory an intuition as far as how to set return results and so forth.
-int ARBLENINTS_arbint_extn_command(ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *objv[])
- {
- char *subcommand;
- //Pointer to subcommand string.
- int tbl_entry;
- //Index into the subcommand lookup table, or -1
- //if no match.
- Tcl_Obj *rv;
- //The return result (a string) if there is an error.
- //In the normal execution case, one of the functions
- //above supplies the return object.
-
- if (objc < 2)
- {
- //It isn't possible to have an object count of less than
- //2, because you must have at least the command name
- //plus a subcommand. The best way to handle this is
- //to indicate wrong number of arguments.
- Tcl_WrongNumArgs(interp,
- 1,
- objv,
- "option ?args?");
- return(TCL_ERROR);
- }
- else
- {
- //A potentially appropriate number of arguments has been
- //specified. Try to look up the subcommand.
-
- subcommand = Tcl_GetString(objv[1]);
- //Grab the string representation of the subcommand.
- //This is constant, belongs to Tcl, and cannot be
- //modified.
-
- tbl_entry = EXTNINIT_subextension_bsearch(
- ARBLENINTS_subextn_tbl,
- sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0]),
- subcommand);
- assert(tbl_entry < (int)(sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0])));
-
- //If the integer returned is zero or positive, should
- //run the subfunction. If negative, this is an error and
- //should generate meaningful message. A meaningful message
- //would definitely consist of all valid subcommands.
- if (tbl_entry < 0)
- {
- //This is an error path.
- rv = Tcl_NewStringObj("arbint: bad option \"", -1);
- subcommand = Tcl_GetString(objv[1]);
- Tcl_AppendToObj(rv, subcommand, -1);
- Tcl_AppendToObj(rv, "\": valid options are ", -1);
-
- for (tbl_entry=0;
- tbl_entry < sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0]);
- tbl_entry++)
- {
- if ((sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0]) != 1)
- && (tbl_entry == sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0]) - 1))
- Tcl_AppendToObj(rv, "and ", -1);
- Tcl_AppendToObj(rv, ARBLENINTS_subextn_tbl[tbl_entry].name, -1);
- if (tbl_entry == sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0]) - 1)
- Tcl_AppendToObj(rv, ".", -1);
- else
- Tcl_AppendToObj(rv, ", ", -1);
- }
-
- //Now, set the return value to be the object with our
- //meaningful string message.
- Tcl_SetObjResult(interp, rv);
-
- return(TCL_ERROR);
- }
- else
- {
- //Call the function pointer. Called function will
- //set the string return value.
- return((*ARBLENINTS_subextn_tbl[tbl_entry].fptr)
- (dummy, interp, objc, objv));
- }
- }
- }
-
-
-//Performs initial registration to the hash table.
-//07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
-//from memory an intuition as far as how to set return results and so forth.
-void ARBLENINTS_arbint_extn_init(Tcl_Interp *interp)
- {
- //Register a command named "crc32".
- Tcl_CreateObjCommand(interp,
- "arbint",
- (Tcl_ObjCmdProc *)ARBLENINTS_arbint_extn_command,
- NULL,
- NULL);
- }
-
-
-
-//Returns version control string for file.
-//
-const char *ARBLENINTS_cvcinfo(void)
-{
- return ("$Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tclxtens/arblenints.c,v 1.12 2001/08/18 09:47:00 dtashley Exp $");
-}
-
-
-//Returns version control string for associated .H file.
-//
-const char *ARBLENINTS_hvcinfo(void)
-{
- return (ARBLENINTS_H_VERSION);
-}
-
-
-//$Log: arblenints.c,v $
-//Revision 1.12 2001/08/18 09:47:00 dtashley
-//Preparing for test for release of v1.05.
-//
-//Revision 1.11 2001/08/16 19:49:40 dtashley
-//Beginning to prepare for v1.05 release.
-//
-//Revision 1.10 2001/08/16 12:20:09 dtashley
-//Version number changes.
-//
-//Revision 1.9 2001/08/12 10:20:58 dtashley
-//Safety check-in. Substantial progress.
-//
-//Revision 1.8 2001/08/10 00:53:59 dtashley
-//Completion of basic rational number arithmetic utilities and extensions.
-//
-//Revision 1.7 2001/08/08 02:16:51 dtashley
-//Completion of RNRED utility and ARBINT RNRED Tcl extension.
-//
-//Revision 1.6 2001/08/07 10:42:48 dtashley
-//Completion of CFRATNUM extensions and DOS command-line utility.
-//
-//Revision 1.5 2001/08/01 03:35:29 dtashley
-//Finished most primitive integer operations, both as Tcl extensions and
-//as DOS command-line utilities, such as addition, subtraction,
-//multiplication, division, and modulo.
-//
-//Revision 1.4 2001/07/30 02:51:18 dtashley
-//INTGCD extension and command-line utility finished up.
-//
-//Revision 1.3 2001/07/29 07:17:04 dtashley
-//Completion of ARBINT INTFAC extension.
-//
-//Revision 1.2 2001/07/28 06:03:57 dtashley
-//Safety check-in. Substantial edits.
-//
-//Revision 1.1 2001/07/27 07:00:56 dtashley
-//Initial check-in.
-//
-//End of ARBLENINTS.C
+//$Header$
+//-------------------------------------------------------------------------------------------------
+//This file is part of "David T. Ashley's Shared Source Code", a set of shared components
+//integrated into many of David T. Ashley's projects.
+//-------------------------------------------------------------------------------------------------
+//This source code and any program in which it is compiled/used is provided under the MIT License,
+//reproduced below.
+//-------------------------------------------------------------------------------------------------
+//Permission is hereby granted, free of charge, to any person obtaining a copy of
+//this software and associated documentation files(the "Software"), to deal in the
+//Software without restriction, including without limitation the rights to use,
+//copy, modify, merge, publish, distribute, sublicense, and / or sell copies of the
+//Software, and to permit persons to whom the Software is furnished to do so,
+//subject to the following conditions :
+//
+//The above copyright notice and this permission notice shall be included in all
+//copies or substantial portions of the Software.
+//
+//THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+//IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+//FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.IN NO EVENT SHALL THE
+//AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+//LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+//OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+//SOFTWARE.
+//-------------------------------------------------------------------------------------------------
+#define MODULE_ARBLENINTS
+
+#include
+#include
+
+#include "tcl.h"
+#include "tcldecls.h"
+
+#include "arblenints.h"
+#include "bstrfunc.h"
+#include "extninit.h"
+#include "gmp_ints.h"
+#include "gmp_rats.h"
+#include "gmp_ralg.h"
+#include "intfunc.h"
+#include "tclalloc.h"
+
+
+//Handles the "cfbrapab" subextension.
+//08/16/01: Visual inspection OK.
+static
+int ARBLENINTS_cfbrapab_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have at least two additional arguments
+ //to this extension.
+ if (objc < 4)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "srn uint_kmax ?uint_hmax? ?options?");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ char *input_arg;
+ int failure, first_dashed_parameter;
+ char *string_result;
+ int string_result_n_allocd;
+ int chars_reqd;
+ int i;
+ int pred_option_specified = 0;
+ int succ_option_specified = 0;
+ int neversmaller_option_specified = 0;
+ int neverlarger_option_specified = 0;
+ int n_option_specified = 0;
+ unsigned n = 0;
+
+ GMP_RATS_mpq_struct q_rn;
+ GMP_INTS_mpz_struct z_kmax;
+ GMP_INTS_mpz_struct z_hmax;
+
+ //Allocate dynamic memory.
+ GMP_RATS_mpq_init(&q_rn);
+ GMP_INTS_mpz_init(&z_kmax);
+ GMP_INTS_mpz_init(&z_hmax);
+
+ //Grab a pointer to the string representation of
+ //the first input argument. The storage does not belong to us.
+ input_arg = Tcl_GetString(objv[2]);
+ assert(input_arg != NULL);
+
+ //Try to parse our first input string as a rational number.
+ //If we are not successful in this, must abort.
+ GMP_RATS_mpq_set_all_format_rat_num(input_arg,
+ &failure,
+ &q_rn);
+
+ if (failure)
+ {
+ rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1);
+ Tcl_AppendToObj(rv, input_arg, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&q_rn);
+ GMP_INTS_mpz_clear(&z_kmax);
+ GMP_INTS_mpz_clear(&z_hmax);
+
+ return(TCL_ERROR);
+ }
+
+ //Try to parse our next argument as an integer, which
+ //will be KMAX. This must be specified.
+ //
+ //Get string pointer. Storage does not belong to us.
+ input_arg = Tcl_GetString(objv[3]);
+ assert(input_arg != NULL);
+
+ //Try to convert KMAX to an integer. Fatal if an error,
+ //and fatal if the argument is zero or negative.
+ GMP_INTS_mpz_set_general_int(&z_kmax, &failure, input_arg);
+
+ //If there was a parse failure or if the integer is zero
+ //or negative, must flag error.
+ if (failure || GMP_INTS_mpz_is_neg(&z_kmax) || GMP_INTS_mpz_is_zero(&z_kmax))
+ {
+ rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1);
+ Tcl_AppendToObj(rv, input_arg, -1);
+ Tcl_AppendToObj(rv, "\" is not a recognized positive integer.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&q_rn);
+ GMP_INTS_mpz_clear(&z_kmax);
+ GMP_INTS_mpz_clear(&z_hmax);
+
+ return(TCL_ERROR);
+ }
+
+ //We need to look for HMAX as the next parameter, if it exists.
+ //The way we will figure this out is by whether the
+ //parameter begins with a "-" or not.
+ if (objc >= 5)
+ {
+ input_arg = Tcl_GetString(objv[4]);
+ assert(input_arg != NULL);
+
+ if (input_arg[0] == '-')
+ {
+ first_dashed_parameter = 4;
+ }
+ else
+ {
+ first_dashed_parameter = 5;
+ }
+ }
+ else
+ {
+ first_dashed_parameter = 4;
+ }
+
+ //If there is another parameter and it
+ //doesn't begin with a dash, try to parse
+ //it as HMAX. We don't explicitly record whether
+ //HMAX is specified, because zero is a signal
+ //when calculating Farey neighbors that HMAX isn't
+ //to be considered.
+ if ((objc >= 5) && (first_dashed_parameter == 5))
+ {
+ //Get string pointer. Storage does not belong to us.
+ input_arg = Tcl_GetString(objv[4]);
+ assert(input_arg != NULL);
+
+ //Try to convert HMAX to an integer. Fatal if an error,
+ //and fatal if the argument is zero or negative.
+ GMP_INTS_mpz_set_general_int(&z_hmax, &failure, input_arg);
+
+ //If there was a parse failure or if the integer is zero
+ //or negative, must flag error.
+ if (failure || GMP_INTS_mpz_is_neg(&z_hmax) || GMP_INTS_mpz_is_zero(&z_hmax))
+ {
+ rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1);
+ Tcl_AppendToObj(rv, input_arg, -1);
+ Tcl_AppendToObj(rv, "\" is not a recognized positive integer.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&q_rn);
+ GMP_INTS_mpz_clear(&z_kmax);
+ GMP_INTS_mpz_clear(&z_hmax);
+
+ return(TCL_ERROR);
+ }
+ }
+
+ //Process all of the dashed command-line arguments.
+ //This involves iterating through all of the
+ //parameters and processing them.
+ for (i=first_dashed_parameter; i= (objc - 1))
+ {
+ rv = Tcl_NewStringObj("arbint cfbrapab: -n option specified without following integer.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&q_rn);
+ GMP_INTS_mpz_clear(&z_kmax);
+ GMP_INTS_mpz_clear(&z_hmax);
+
+ return(TCL_ERROR);
+ }
+
+ //We have at least one additional parameter. Try
+ //to parse out the next parameter as the integer
+ //we need for n.
+ i++;
+
+ input_arg = Tcl_GetString(objv[i]);
+ assert(input_arg != NULL);
+
+ GMP_INTS_mpz_parse_into_uint32(&n, &failure, input_arg);
+
+ //If the parse was unsuccessful, terminate.
+ if (failure)
+ {
+ rv = Tcl_NewStringObj("arbint cfbrapab: -n option followed by invalid integer.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&q_rn);
+ GMP_INTS_mpz_clear(&z_kmax);
+ GMP_INTS_mpz_clear(&z_hmax);
+
+ return(TCL_ERROR);
+ }
+
+ //Clip the integer into a 24-bit quantity.
+ n &= 0x00FFFFFF;
+ }
+ else
+ {
+ //Unrecognized option. Crash out.
+ rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1);
+ Tcl_AppendToObj(rv, input_arg, -1);
+ Tcl_AppendToObj(rv, "\" is not a recognized option.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&q_rn);
+ GMP_INTS_mpz_clear(&z_kmax);
+ GMP_INTS_mpz_clear(&z_hmax);
+
+ return(TCL_ERROR);
+ }
+ }
+
+ //Look for any mutually exclusive options. Give a catchall if any of
+ //them specified. Because we set them all to 1, addition is the easiest
+ //way to do this.
+ if ((pred_option_specified + succ_option_specified + neversmaller_option_specified
+ + neverlarger_option_specified + n_option_specified) > 1)
+ {
+ rv = Tcl_NewStringObj("arbint cfbrapab: -pred, -succ, -neversmaller, -neverlarger, and -n are mutually exclusive options.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&q_rn);
+ GMP_INTS_mpz_clear(&z_kmax);
+ GMP_INTS_mpz_clear(&z_hmax);
+
+ return(TCL_ERROR);
+ }
+
+ //Split into cases based on what we're doing. This is wasteful of code,
+ //but this is a PC application, not an embedded application. In all cases
+ //create a hard error if something goes wrong. Any anomalies should trash
+ //a script.
+ if (!pred_option_specified && !succ_option_specified && !n_option_specified)
+ {
+ //This is the traditional best approximation case, with the possibility of
+ //the -neverlarger or -neversmaller being specified. This is the most messy
+ //of all the cases. We must gather neighbors and figure out which is closer,
+ //and if there is a tie, which has the smaller magnitude. It is fairly
+ //messy.
+ GMP_RALG_fab_neighbor_collection_struct neighbor_data;
+ GMP_RATS_mpq_struct left_neigh, right_neigh, diff_left, diff_right, closer_neighbor;
+ int dist_cmp;
+ int mag_cmp;
+
+ //Allocate inner dynamic variables.
+ GMP_RATS_mpq_init(&left_neigh);
+ GMP_RATS_mpq_init(&right_neigh);
+ GMP_RATS_mpq_init(&diff_left);
+ GMP_RATS_mpq_init(&diff_right);
+ GMP_RATS_mpq_init(&closer_neighbor);
+
+ //Form up the neighbor data. We're only looking for up to one neighbor on each
+ //side.
+ GMP_RALG_consecutive_fab_terms(
+ &q_rn,
+ &z_kmax,
+ &z_hmax,
+ 1,
+ 1,
+ &neighbor_data
+ );
+
+ //If there was an error or we couldn't get any neighbors to play with, give
+ //an error return. As long as we have one neighbor on either side, we can definitely
+ //complete.
+ if (neighbor_data.error || (!neighbor_data.equality && (!neighbor_data.n_left_out || !neighbor_data.n_right_out)))
+ {
+ rv = Tcl_NewStringObj("arbint cfbrapab: unable to form neighbors.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
+ GMP_RATS_mpq_clear(&q_rn);
+ GMP_INTS_mpz_clear(&z_kmax);
+ GMP_INTS_mpz_clear(&z_hmax);
+
+ GMP_RATS_mpq_clear(&left_neigh);
+ GMP_RATS_mpq_clear(&right_neigh);
+ GMP_RATS_mpq_clear(&diff_left);
+ GMP_RATS_mpq_clear(&diff_right);
+ GMP_RATS_mpq_clear(&closer_neighbor);
+
+ return(TCL_ERROR);
+ }
+
+ if (neighbor_data.equality)
+ {
+ //The equality case takes precedence, always.
+ GMP_RATS_mpq_copy(&closer_neighbor, &(neighbor_data.norm_rn));
+ }
+ else
+ {
+ //The boolean test somewhat above guaranteed that we have both left
+ //and right neighbors. We can assume this.
+ GMP_RATS_mpq_copy(&left_neigh, &(neighbor_data.lefts[0].neighbor));
+ GMP_RATS_mpq_copy(&right_neigh, &(neighbor_data.rights[0].neighbor));
+
+ GMP_RATS_mpq_sub(&diff_left, &left_neigh, &(neighbor_data.norm_rn));
+ GMP_RATS_mpq_sub(&diff_right, &right_neigh, &(neighbor_data.norm_rn));
+ GMP_INTS_mpz_abs(&(diff_left.num));
+ GMP_INTS_mpz_abs(&(diff_right.num));
+ dist_cmp = GMP_RATS_mpq_cmp(&diff_left, &diff_right, NULL);
+
+ //If we have a tie on the distance, will need to revert to magnitude of the neighbors.
+ GMP_INTS_mpz_abs(&(left_neigh.num));
+ GMP_INTS_mpz_abs(&(right_neigh.num));
+ mag_cmp = GMP_RATS_mpq_cmp(&left_neigh, &right_neigh, NULL);
+
+ if (!neversmaller_option_specified
+ &&
+ (neverlarger_option_specified || (dist_cmp < 0) || ((dist_cmp==0) && (mag_cmp < 0))))
+ {
+ GMP_RATS_mpq_copy(&closer_neighbor, &(neighbor_data.lefts[0].neighbor));
+ }
+ else
+ {
+ GMP_RATS_mpq_copy(&closer_neighbor, &(neighbor_data.rights[0].neighbor));
+ }
+ }
+
+ //Stuff our variable of choice into a string ...
+ chars_reqd = INTFUNC_max(
+ GMP_INTS_mpz_size_in_base_10(&(closer_neighbor.num)),
+ GMP_INTS_mpz_size_in_base_10(&(closer_neighbor.den))
+ );
+ string_result = TclpAlloc(sizeof(char) * chars_reqd);
+ assert(string_result != NULL);
+
+ GMP_INTS_mpz_to_string(string_result, &(closer_neighbor.num));
+ rv = Tcl_NewStringObj(string_result, -1);
+ Tcl_AppendToObj(rv, "/", -1);
+ GMP_INTS_mpz_to_string(string_result, &(closer_neighbor.den));
+ Tcl_AppendToObj(rv, string_result, -1);
+
+ Tcl_SetObjResult(interp, rv);
+
+ //Deallocate variables, make normal return.
+ TclpFree(string_result);
+ GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
+ GMP_RATS_mpq_clear(&q_rn);
+ GMP_INTS_mpz_clear(&z_kmax);
+ GMP_INTS_mpz_clear(&z_hmax);
+
+ GMP_RATS_mpq_clear(&left_neigh);
+ GMP_RATS_mpq_clear(&right_neigh);
+ GMP_RATS_mpq_clear(&diff_left);
+ GMP_RATS_mpq_clear(&diff_right);
+ GMP_RATS_mpq_clear(&closer_neighbor);
+
+ return(TCL_OK);
+ }
+ else if (n_option_specified)
+ {
+ char sbuf[50];
+ //Static buffer just to stage 32-bit integers.
+
+ //Multiple neighbors. Must iterate through.
+
+ GMP_RALG_fab_neighbor_collection_struct neighbor_data;
+
+ //Form up the neighbor data.
+ GMP_RALG_consecutive_fab_terms(
+ &q_rn,
+ &z_kmax,
+ &z_hmax,
+ n,
+ n,
+ &neighbor_data
+ );
+
+ //If there was an error forming up the neighbor data, create a hard error.
+ if (neighbor_data.error)
+ {
+ rv = Tcl_NewStringObj("arbint cfbrapab: unable to form neighbors.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
+ GMP_RATS_mpq_clear(&q_rn);
+ GMP_INTS_mpz_clear(&z_kmax);
+ GMP_INTS_mpz_clear(&z_hmax);
+
+ return(TCL_ERROR);
+ }
+
+ //Allocate a default buffer of 10K for the ASCII representation of integers.
+ //In the vast majority of cases, there will be only one allocation, because it
+ //takes a mean integer to exceed 10K. However, the logic allows it to grow.
+ string_result_n_allocd = 10000;
+ string_result = TclpAlloc(sizeof(char) * string_result_n_allocd);
+ assert(string_result != NULL);
+
+ //Start off with a return value of the null string.
+ rv = Tcl_NewStringObj("", -1);
+
+ //Loop through, spitting out the left neighbors.
+ for (i = neighbor_data.n_left_out-1; i >= 0; i--)
+ {
+ //The protocol here is everyone spits out one space before
+ //they print anything. Must skip this on first loop iteration.
+ if (i != neighbor_data.n_left_out-1)
+ Tcl_AppendToObj(rv, " ", -1);
+
+ //The index will be the negative of the iteration variable minus one.
+ sprintf(sbuf, "%d", -i - 1);
+ Tcl_AppendToObj(rv, sbuf, -1);
+
+ //Force the buffer to have enough space for the components of the rational
+ //number.
+ chars_reqd = INTFUNC_max(
+ GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[i].neighbor.num)),
+ GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[i].neighbor.den))
+ );
+ if (chars_reqd > string_result_n_allocd)
+ {
+ string_result_n_allocd = chars_reqd;
+ string_result = TclpRealloc(string_result, sizeof(char) * string_result_n_allocd);
+ assert(string_result != NULL);
+ }
+
+ //Print the rational number out to the Tcl object.
+ Tcl_AppendToObj(rv, " ", -1);
+ GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[i].neighbor.num));
+ Tcl_AppendToObj(rv, string_result, -1);
+ Tcl_AppendToObj(rv, "/", -1);
+ GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[i].neighbor.den));
+ Tcl_AppendToObj(rv, string_result, -1);
+ }
+
+ //Spit out the equality case if appropriate.
+ if (neighbor_data.equality)
+ {
+ if (neighbor_data.n_left_out)
+ Tcl_AppendToObj(rv, " ", -1);
+
+ Tcl_AppendToObj(rv, "0", -1);
+
+ //Force the buffer to have enough space for the components of the rational
+ //number.
+ chars_reqd = INTFUNC_max(
+ GMP_INTS_mpz_size_in_base_10(&(neighbor_data.norm_rn.num)),
+ GMP_INTS_mpz_size_in_base_10(&(neighbor_data.norm_rn.den))
+ );
+ if (chars_reqd > string_result_n_allocd)
+ {
+ string_result_n_allocd = chars_reqd;
+ string_result = TclpRealloc(string_result, sizeof(char) * string_result_n_allocd);
+ assert(string_result != NULL);
+ }
+
+ //Print the rational number out to the Tcl object.
+ Tcl_AppendToObj(rv, " ", -1);
+ GMP_INTS_mpz_to_string(string_result, &(neighbor_data.norm_rn.num));
+ Tcl_AppendToObj(rv, string_result, -1);
+ Tcl_AppendToObj(rv, "/", -1);
+ GMP_INTS_mpz_to_string(string_result, &(neighbor_data.norm_rn.den));
+ Tcl_AppendToObj(rv, string_result, -1);
+ }
+
+ //Loop through, spitting out the right neighbors.
+ for (i = 0; i < neighbor_data.n_right_out; i++)
+ {
+ //The protocol here is everyone spits out one space before
+ //they print anything. Must skip this on first loop iteration.
+ if (neighbor_data.n_left_out || neighbor_data.equality || i)
+ Tcl_AppendToObj(rv, " ", -1);
+
+ //The index will be the iteration variable plus one.
+ sprintf(sbuf, "%d", i+1);
+ Tcl_AppendToObj(rv, sbuf, -1);
+
+ //Force the buffer to have enough space for the components of the rational
+ //number.
+ chars_reqd = INTFUNC_max(
+ GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[i].neighbor.num)),
+ GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[i].neighbor.den))
+ );
+ if (chars_reqd > string_result_n_allocd)
+ {
+ string_result_n_allocd = chars_reqd;
+ string_result = TclpRealloc(string_result, sizeof(char) * string_result_n_allocd);
+ assert(string_result != NULL);
+ }
+
+ //Print the rational number out to the Tcl object.
+ Tcl_AppendToObj(rv, " ", -1);
+ GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[i].neighbor.num));
+ Tcl_AppendToObj(rv, string_result, -1);
+ Tcl_AppendToObj(rv, "/", -1);
+ GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[i].neighbor.den));
+ Tcl_AppendToObj(rv, string_result, -1);
+ }
+
+ //Set up for a normal return.
+ Tcl_SetObjResult(interp, rv);
+
+ TclpFree(string_result);
+ GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
+ GMP_RATS_mpq_clear(&q_rn);
+ GMP_INTS_mpz_clear(&z_kmax);
+ GMP_INTS_mpz_clear(&z_hmax);
+
+ return(TCL_OK);
+ }
+ else if (pred_option_specified)
+ {
+ //Simple predecessor case.
+
+ GMP_RALG_fab_neighbor_collection_struct neighbor_data;
+
+ //Form up the neighbor data.
+ GMP_RALG_consecutive_fab_terms(
+ &q_rn,
+ &z_kmax,
+ &z_hmax,
+ 1,
+ 0,
+ &neighbor_data
+ );
+
+ //If there was an error forming up the neighbor data or there are no left neighbors,
+ //create a hard error.
+ if (neighbor_data.error || !neighbor_data.n_left_out)
+ {
+ rv = Tcl_NewStringObj("arbint cfbrapab: unable to find predecessor.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
+ GMP_RATS_mpq_clear(&q_rn);
+ GMP_INTS_mpz_clear(&z_kmax);
+ GMP_INTS_mpz_clear(&z_hmax);
+
+ return(TCL_ERROR);
+ }
+
+ //The test above confirmed that we have at least one left neighbor calculated.
+ //We can dump it to a string and finish up.
+ chars_reqd = INTFUNC_max(
+ GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[0].neighbor.num)),
+ GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[0].neighbor.den))
+ );
+ string_result = TclpAlloc(sizeof(char) * chars_reqd);
+ assert(string_result != NULL);
+
+ GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[0].neighbor.num));
+ rv = Tcl_NewStringObj(string_result, -1);
+ Tcl_AppendToObj(rv, "/", -1);
+ GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[0].neighbor.den));
+ Tcl_AppendToObj(rv, string_result, -1);
+
+ Tcl_SetObjResult(interp, rv);
+
+ TclpFree(string_result);
+ GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
+ GMP_RATS_mpq_clear(&q_rn);
+ GMP_INTS_mpz_clear(&z_kmax);
+ GMP_INTS_mpz_clear(&z_hmax);
+
+ return(TCL_OK);
+ }
+ else if (succ_option_specified)
+ {
+ //Simple successor.
+
+ GMP_RALG_fab_neighbor_collection_struct neighbor_data;
+
+ //Form up the neighbor data.
+ GMP_RALG_consecutive_fab_terms(
+ &q_rn,
+ &z_kmax,
+ &z_hmax,
+ 0,
+ 1,
+ &neighbor_data
+ );
+
+ //If there was an error forming up the neighbor data or there are no right neighbors,
+ //create a hard error.
+ if (neighbor_data.error || !neighbor_data.n_right_out)
+ {
+ rv = Tcl_NewStringObj("arbint cfbrapab: unable to find successor.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
+ GMP_RATS_mpq_clear(&q_rn);
+ GMP_INTS_mpz_clear(&z_kmax);
+ GMP_INTS_mpz_clear(&z_hmax);
+
+ return(TCL_ERROR);
+ }
+
+ //The test above confirmed that we have at least one right neighbor calculated.
+ //We can dump it to a string and finish up.
+ chars_reqd = INTFUNC_max(
+ GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[0].neighbor.num)),
+ GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[0].neighbor.den))
+ );
+ string_result = TclpAlloc(sizeof(char) * chars_reqd);
+ assert(string_result != NULL);
+
+ GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[0].neighbor.num));
+ rv = Tcl_NewStringObj(string_result, -1);
+ Tcl_AppendToObj(rv, "/", -1);
+ GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[0].neighbor.den));
+ Tcl_AppendToObj(rv, string_result, -1);
+
+ Tcl_SetObjResult(interp, rv);
+
+ TclpFree(string_result);
+ GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
+ GMP_RATS_mpq_clear(&q_rn);
+ GMP_INTS_mpz_clear(&z_kmax);
+ GMP_INTS_mpz_clear(&z_hmax);
+
+ return(TCL_OK);
+ }
+
+ //Free up all dynamic memory.
+ GMP_RATS_mpq_clear(&q_rn);
+ GMP_INTS_mpz_clear(&z_kmax);
+ GMP_INTS_mpz_clear(&z_hmax);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//Handles the "cfratnum" subextension.
+//08/07/01: Visually inspected, OK.
+static
+int ARBLENINTS_cfratnum_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have exactly one additional argument
+ //to this function, which is the rational number
+ //whose continued fraction decomposition is to be
+ //calculated.
+ if (objc != 3)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "urn");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ char *input_arg;
+ int failure;
+ unsigned chars_reqd;
+ char *string_result;
+ int n_string_result;
+ int i;
+ GMP_RATS_mpq_struct rn;
+ GMP_RALG_cf_app_struct decomp;
+
+ //In this function, we are going to return a string
+ //result formed by starting with a string and then
+ //concatenating to it again and again. We start
+ //off believing that 10,000 characters of space is enough,
+ //but we may need to revise upward and reallocate.
+ //A 10,000 character block is chosen because it is quick
+ //to allocate and most times won't go beyond that.
+ n_string_result = 10000;
+ string_result = TclpAlloc(sizeof(char) * n_string_result);
+ assert(string_result != NULL);
+
+ //We will need a rational number to hold the return value
+ //from the parsing function. Allocate that now.
+ GMP_RATS_mpq_init(&rn);
+
+ //Grab a pointer to the string representation of
+ //the input argument. The storage does not belong to us.
+ input_arg = Tcl_GetString(objv[2]);
+ assert(input_arg != NULL);
+
+ //Try to parse our input string as a rational number.
+ //If we are not successful in this, must abort.
+ GMP_RATS_mpq_set_all_format_rat_num(input_arg,
+ &failure,
+ &rn);
+
+ if (failure)
+ {
+ rv = Tcl_NewStringObj("arbint cfratnum: \"", -1);
+ Tcl_AppendToObj(rv, input_arg, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized non-negative rational number.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ TclpFree(string_result);
+ GMP_RATS_mpq_clear(&rn);
+
+ return(TCL_ERROR);
+ }
+
+ //OK, we have a rational number, but there is a possibility
+ //it is negative, which is a no-no. Normalize the signs
+ //for easier testing.
+ GMP_RATS_mpq_normalize_sign(&rn);
+ if (GMP_INTS_mpz_is_neg(&(rn.num)))
+ {
+ rv = Tcl_NewStringObj("arbint cfratnum: \"", -1);
+ Tcl_AppendToObj(rv, input_arg, -1);
+
+ Tcl_AppendToObj(rv, "\" is negative.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ TclpFree(string_result);
+ GMP_RATS_mpq_clear(&rn);
+
+ return(TCL_ERROR);
+ }
+
+ //OK, we have a rational number. Form the continued fraction
+ //decomposition of it. The function called is set up so that
+ //one must deallocate, even in an error condition.
+ GMP_RALG_cfdecomp_init(&decomp,
+ &failure,
+ &(rn.num),
+ &(rn.den));
+
+ //If we failed in the decomposition (don't know why that would
+ //happen) use the general error flag "NAN".
+ if (failure)
+ {
+ rv = Tcl_NewStringObj("NAN", -1);
+
+ Tcl_SetObjResult(interp, rv);
+
+ TclpFree(string_result);
+ GMP_RATS_mpq_clear(&rn);
+ GMP_RALG_cfdecomp_destroy(&decomp);
+
+ return(TCL_ERROR);
+ }
+
+ //OK, that really is the last error we could have.
+ //Iterate, adding the partial quotients and convergents
+ //to the string which we'll return. We need to watch out
+ //for running over our 10K buffer.
+ rv = Tcl_NewStringObj("", -1);
+ for (i=0; i (unsigned)n_string_result)
+ {
+ n_string_result = chars_reqd;
+ string_result = TclpRealloc(string_result,
+ sizeof(char) * n_string_result);
+ }
+ GMP_INTS_mpz_to_string(string_result, &(decomp.a[i]));
+ Tcl_AppendToObj(rv, string_result, -1);
+ Tcl_AppendToObj(rv, " ", -1);
+
+ //Numerator of convergent.
+ chars_reqd = GMP_INTS_mpz_size_in_base_10(&(decomp.p[i]));
+ if (chars_reqd > (unsigned)n_string_result)
+ {
+ n_string_result = chars_reqd;
+ string_result = TclpRealloc(string_result,
+ sizeof(char) * n_string_result);
+ }
+ GMP_INTS_mpz_to_string(string_result, &(decomp.p[i]));
+ Tcl_AppendToObj(rv, string_result, -1);
+ Tcl_AppendToObj(rv, " ", -1);
+
+ //Denominator of convergent.
+ chars_reqd = GMP_INTS_mpz_size_in_base_10(&(decomp.q[i]));
+ if (chars_reqd > (unsigned)n_string_result)
+ {
+ n_string_result = chars_reqd;
+ string_result = TclpRealloc(string_result,
+ sizeof(char) * n_string_result);
+ }
+ GMP_INTS_mpz_to_string(string_result, &(decomp.q[i]));
+ Tcl_AppendToObj(rv, string_result, -1);
+ if (i != (decomp.n - 1)) //No space after last number.
+ Tcl_AppendToObj(rv, " ", -1);
+ }
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Free up all dynamic memory.
+ TclpFree(string_result);
+ GMP_RATS_mpq_clear(&rn);
+ GMP_RALG_cfdecomp_destroy(&decomp);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//Handles the "commanate" subextension.
+//07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
+//from memory an intuition as far as how to set return results and so forth.
+static
+int ARBLENINTS_commanate_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have one and exactly one additional argument
+ //to this function, which is the string we want to
+ //commanate.
+ if (objc != 3)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "sint");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ char *string_arg;
+
+ //Grab a pointer to the string representation of
+ //the input argument. The storage does not belong to us.
+ string_arg = Tcl_GetString(objv[2]);
+ assert(string_arg != NULL);
+
+ //Try to parse the string as one of the error tags.
+ //If it is one of those, it isn't an error, but don't
+ //want to touch the string.
+ if (GMP_INTS_identify_nan_string(string_arg) >= 0)
+ {
+ rv = Tcl_NewStringObj(string_arg, -1);
+ Tcl_SetObjResult(interp, rv);
+ return(TCL_OK);
+ }
+ //Try to parse it as a signed integer with commas already.
+ //If it already has commas, there is no need to add any.
+ else if (BSTRFUNC_is_sint_w_commas(string_arg))
+ {
+ //This is already an acceptable commanated signed integer. Send it
+ //back as the return value.
+ rv = Tcl_NewStringObj(string_arg, -1);
+ Tcl_SetObjResult(interp, rv);
+ return(TCL_OK);
+ }
+ //Try to parse the argument as a signed integer without commas.
+ //If it is one of those, commanate it and return it.
+ else if (BSTRFUNC_is_sint_wo_commas(string_arg))
+ {
+ size_t len;
+ char *buffer;
+
+ len = strlen(string_arg);
+ buffer = TclpAlloc(((sizeof(char) * 4 * len) / 3) + 10);
+ strcpy(buffer, string_arg);
+ BSTRFUNC_commanate(buffer);
+ rv = Tcl_NewStringObj(buffer, -1);
+ TclpFree(buffer);
+ Tcl_SetObjResult(interp, rv);
+ return(TCL_OK);
+ }
+ else
+ {
+ //Error case. Must give error message.
+ rv = Tcl_NewStringObj("arbint commanate: \"", -1);
+ Tcl_AppendToObj(rv, string_arg, -1);
+ Tcl_AppendToObj(rv, "\" is not a recognized integer.", -1);
+ Tcl_SetObjResult(interp, rv);
+ return(TCL_ERROR);
+ }
+ }
+ }
+
+
+//Handles the "const" subextension.
+//08/17/01: Visual inspection OK.
+static
+int ARBLENINTS_const_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ //Table of constants used.
+ static struct
+ {
+ char *tag;
+ //The symbolic tag used to identify the number.
+ char *desc;
+ //The full description of the number. It must consist
+ //of a string with lines no longer than about 70 chars,
+ //separated by newlines, and indented by 6 spaces.
+ char *minmant;
+ //The minimum mantissa or minimum representation.
+ //May not be empty or NULL.
+ char *mantrem;
+ //The remaining mantissa or remaining portion of
+ //number. May be empty, but may not be NULL.
+ char *exp;
+ //The exponent portion, if any, or NULL otherwise.
+ int deflen;
+ //The default number of digits for the constant
+ //if none is specified.
+ int digit_count_offset;
+ //The offset to go from string length of mantissa
+ //portions to number of digits. Cheap way to adjust
+ //for - sign and decimal point.
+ } tbl[] =
+ {
+ //e--the transcendental number e.
+ {
+ //tag
+ "e",
+ //desc
+ " Historically significant transcendental constant. Digits obtained\n"
+ " from http://fermi.udw.ac.za/physics/e.html on 08/17/01.",
+ //minmant
+ "2.7",
+ //mantrem
+ "182818284590452353602874713526624977572470936999595749669676277240766303535"
+ "475945713821785251664274274663919320030599218174135966290435729003342952605956"
+ "307381323286279434907632338298807531952510190115738341879307021540891499348841"
+ "675092447614606680822648001684774118537423454424371075390777449920695517027618"
+ "386062613313845830007520449338265602976067371132007093287091274437470472306969"
+ "772093101416928368190255151086574637721112523897844250569536967707854499699679"
+ "468644549059879316368892300987931277361782154249992295763514822082698951936680"
+ "331825288693984964651058209392398294887933203625094431173012381970684161403970"
+ "198376793206832823764648042953118023287825098194558153017567173613320698112509"
+ "961818815930416903515988885193458072738667385894228792284998920868058257492796"
+ "104841984443634632449684875602336248270419786232090021609902353043699418491463"
+ "140934317381436405462531520961836908887070167683964243781405927145635490613031"
+ "07208510383750510115747704171898610687396965521267154688957035035",
+ //exp
+ NULL,
+ //deflen
+ 30,
+ //digit_count_offset
+ 1
+ },
+ //g_metric
+ {
+ //tag
+ "g_si",
+ //desc
+ " Gravitational acceleration in SI units, meters per second**2.\n"
+ " Obtained from NIST Special Publication 811 on 08/17/01.",
+ //minmant
+ "9.80665",
+ //mantrem
+ "",
+ //exp
+ NULL,
+ //deflen
+ 30,
+ //digit_count_offset
+ 1
+ },
+ //in2m
+ {
+ //tag
+ "in2m",
+ //desc
+ " Multiplicative conversion factor from inches to meters.\n"
+ " Obtained from NIST Special Publication 811 on 08/17/01.",
+ //minmant
+ "2.54",
+ //mantrem
+ "",
+ //exp
+ "e-2",
+ //deflen
+ 30,
+ //digit_count_offset
+ 1
+ },
+ //mi2km
+ {
+ //tag
+ "mi2km",
+ //desc
+ " Multiplicative conversion factor from miles to kilometers.\n"
+ " Obtained from NIST Special Publication 811 on 08/17/01.",
+ //minmant
+ "1.609344",
+ //mantrem
+ "",
+ //exp
+ NULL,
+ //deflen
+ 30,
+ //digit_count_offset
+ 1
+ },
+ //pi--the transcendental number PI.
+ {
+ //tag
+ "pi",
+ //desc
+ " Transcendental constant supplying ratio of a circle's circumference\n"
+ " to its diameter. Digits obtained from http://www.joyofpi.com/\n"
+ " pi.htm on 08/17/01.",
+ //minmant
+ "3.14",
+ //mantrem
+ "15926535897932384626433832795028841971"
+ "6939937510582097494459230781640628620899"
+ "8628034825342117067982148086513282306647"
+ "0938446095505822317253594081284811174502"
+ "8410270193852110555964462294895493038196"
+ "4428810975665933446128475648233786783165"
+ "2712019091456485669234603486104543266482"
+ "1339360726024914127372458700660631558817"
+ "4881520920962829254091715364367892590360"
+ "0113305305488204665213841469519415116094"
+ "3305727036575959195309218611738193261179"
+ "3105118548074462379962749567351885752724"
+ "8912279381830119491298336733624406566430"
+ "8602139494639522473719070217986094370277"
+ "0539217176293176752384674818467669405132"
+ "0005681271452635608277857713427577896091"
+ "7363717872146844090122495343014654958537"
+ "1050792279689258923542019956112129021960"
+ "8640344181598136297747713099605187072113"
+ "4999999837297804995105973173281609631859"
+ "5024459455346908302642522308253344685035"
+ "2619311881710100031378387528865875332083"
+ "8142061717766914730359825349042875546873"
+ "1159562863882353787593751957781857780532"
+ "1712268066130019278766111959092164201989"
+ "3809525720106548586327886593615338182796"
+ "8230301952035301852968995773622599413891"
+ "2497217752834791315155748572424541506959"
+ "5082953311686172785588907509838175463746"
+ "4939319255060400927701671139009848824012",
+ //exp
+ NULL,
+ //deflen
+ 30,
+ //digit_count_offset
+ 1
+ },
+ //sqrt5--the square root of 5.
+ {
+ //tag
+ "sqrt5",
+ //desc
+ " The square root of 5. Digits obtained from\n"
+ " http://home.earthlink.net/~maryski/sqrt51000000.txt on 08/17/01.",
+ //minmant
+ "2.236",
+ //mantrem
+ "0679774997896964091736687312762354406183596115257242708972454105209256378048"
+ "99414414408378782274969508176150773783504253267724447073863586360121533452708866"
+ "77817319187916581127664532263985658053576135041753378500342339241406444208643253"
+ "90972525926272288762995174024406816117759089094984923713907297288984820886415426"
+ "89894099131693577019748678884425089754132956183176921499977424801530434115035957"
+ "66833251249881517813940800056242085524354223555610630634282023409333198293395974"
+ "63522712013417496142026359047378855043896870611356600457571399565955669569175645"
+ "78221952500060539231234005009286764875529722056766253666074485853505262330678494"
+ "63342224231763727702663240768010444331582573350589309813622634319868647194698997"
+ "01808189524264459620345221411922329125981963258111041704958070481204034559949435"
+ "06855551855572512388641655010262436312571024449618789424682903404474716115455723"
+ "20173767659046091852957560357798439805415538077906439363972302875606299948221385"
+ "21773485924535151210463455550407072278724215347787529112121211843317893351910380",
+ //exp
+ NULL,
+ //deflen
+ 30,
+ //digit_count_offset
+ 1
+ },
+ };
+
+ Tcl_Obj *rv;
+ //Value that will be returned to caller.
+ int i;
+ //Iteration variable.
+ int tbl_idx;
+ //Index into lookup table, of -1 if not found.
+ int ndigits;
+ //The number of digits to supply.
+ int result_code;
+ //Return value from Tcl library function.
+
+ //We must have either one or two additional arguments.
+ if ((objc != 3) && (objc != 4))
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "constant_tag ?ndigits?");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ char *string_arg;
+
+ //Grab a pointer to the string representation of
+ //the input argument. The storage does not belong to us.
+ string_arg = Tcl_GetString(objv[2]);
+ assert(string_arg != NULL);
+
+ //Try to look up the string argument in the table.
+ tbl_idx = -1;
+ for (i=0; i 0)
+ {
+ if (ndigits >= (int)strlen(tbl[tbl_idx].mantrem))
+ {
+ Tcl_AppendToObj(rv, tbl[tbl_idx].mantrem, -1);
+ }
+ else
+ {
+ Tcl_AppendToObj(rv, tbl[tbl_idx].mantrem, ndigits);
+ }
+ }
+
+ //Append the exponent portion.
+ if (tbl[tbl_idx].exp)
+ Tcl_AppendToObj(rv, tbl[tbl_idx].exp, -1);
+
+ //Default successful return.
+ Tcl_SetObjResult(interp, rv);
+ return(TCL_OK);
+ }
+ }
+
+
+//Handles the "decommanate" subextension.
+//07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
+//from memory an intuition as far as how to set return results and so forth.
+static
+int ARBLENINTS_decommanate_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have one and exactly one additional argument
+ //to this function, which is the string we want to
+ //decommanate.
+ if (objc != 3)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "sint");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ char *string_arg;
+
+ //Grab a pointer to the string representation of
+ //the input argument. The storage does not belong to us.
+ string_arg = Tcl_GetString(objv[2]);
+ assert(string_arg != NULL);
+
+ //Try to parse the string as one of the error tags.
+ //If it is one of those, it isn't an error, but don't
+ //want to touch the string.
+ if (GMP_INTS_identify_nan_string(string_arg) >= 0)
+ {
+ rv = Tcl_NewStringObj(string_arg, -1);
+ Tcl_SetObjResult(interp, rv);
+ return(TCL_OK);
+ }
+ //Try to parse it as a signed integer without commas.
+ //If it has no commas, there is no need to decommanate it.
+ else if (BSTRFUNC_is_sint_wo_commas(string_arg))
+ {
+ //This is already an acceptable commanated signed integer. Send it
+ //back as the return value.
+ rv = Tcl_NewStringObj(string_arg, -1);
+ Tcl_SetObjResult(interp, rv);
+ return(TCL_OK);
+ }
+ //Try to parse the argument as a signed integer with commas.
+ //If it is one of those, decommanate it and return it.
+ else if (BSTRFUNC_is_sint_w_commas(string_arg))
+ {
+ size_t len;
+ char *buffer;
+
+ len = strlen(string_arg);
+ buffer = TclpAlloc(sizeof(char) * len + 1);
+ strcpy(buffer, string_arg);
+ BSTRFUNC_decommanate(buffer);
+ rv = Tcl_NewStringObj(buffer, -1);
+ TclpFree(buffer);
+ Tcl_SetObjResult(interp, rv);
+ return(TCL_OK);
+ }
+ else
+ {
+ //Error case. Must give error message.
+ rv = Tcl_NewStringObj("arbint decommanate: \"", -1);
+ Tcl_AppendToObj(rv, string_arg, -1);
+ Tcl_AppendToObj(rv, "\" is not a recognized integer.", -1);
+ Tcl_SetObjResult(interp, rv);
+ return(TCL_ERROR);
+ }
+ }
+ }
+
+
+//Handles the "intadd" subextension.
+//08/06/01: Visual inspection OK.
+static
+int ARBLENINTS_intadd_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have two and exactly two additional arguments
+ //to this function, which are the integers whose
+ //sum is to be calculated.
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "sint sint");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ GMP_INTS_mpz_struct arb_arg1, arb_arg2, arb_result;
+ char *add_arg1, *add_arg2;
+ int failure1, failure2;
+ unsigned chars_reqd;
+ char *string_result;
+ int i, j;
+
+ //Allocate space for the arbitrary-length integer result.
+ GMP_INTS_mpz_init(&arb_arg1);
+ GMP_INTS_mpz_init(&arb_arg2);
+ GMP_INTS_mpz_init(&arb_result);
+
+ //Grab pointers to the string representation of
+ //the input arguments. The storage does not belong to us.
+ add_arg1 = Tcl_GetString(objv[2]);
+ assert(add_arg1 != NULL);
+ add_arg2 = Tcl_GetString(objv[3]);
+ assert(add_arg2 != NULL);
+
+ //Try to interpret either of the strings as one of the NAN tags.
+ //If it is one, return the appropriate result for
+ //a binary operation.
+ i = GMP_INTS_identify_nan_string(add_arg1);
+ j = GMP_INTS_identify_nan_string(add_arg2);
+
+ if ((i >= 0) || (j >= 0))
+ {
+ const char *p;
+
+ //Find the max of i and j. This isn't a scientific way to tag the
+ //result, but will be OK. Some information is lost no matter what
+ //we do.
+ if (i > j)
+ ;
+ else
+ i = j;
+
+ //i now contains the max.
+ switch (i)
+ {
+ case 0: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 1: p = GMP_INTS_supply_nan_string(3);
+ break;
+ case 2: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 3: p = GMP_INTS_supply_nan_string(3);
+ break;
+ default:
+ assert(0);
+ break;
+ }
+
+ rv = Tcl_NewStringObj(p, -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ return(TCL_OK);
+ }
+
+ //Try to convert both strings into arbitrary integers.
+ GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, add_arg1);
+ GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, add_arg2);
+
+ //If there was a parse failure, we have to return an error
+ //message. It is possible that both arguments failed the parse,
+ //but only return one in the error message.
+ if (failure1 || failure2)
+ {
+ rv = Tcl_NewStringObj("arbint intadd: \"", -1);
+ if (failure1)
+ Tcl_AppendToObj(rv, add_arg1, -1);
+ else
+ Tcl_AppendToObj(rv, add_arg2, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ return(TCL_ERROR);
+ }
+
+ //Calculate the sum.
+ GMP_INTS_mpz_add(&arb_result, &arb_arg1, &arb_arg2);
+
+ //Figure out the number of characters required for
+ //the output string.
+ chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
+
+ //Allocate space for the conversion result.
+ string_result = TclpAlloc(sizeof(char) * chars_reqd);
+ assert(string_result != NULL);
+
+ //Make the conversion to a character string.
+ GMP_INTS_mpz_to_string(string_result, &arb_result);
+
+ //Assign the string result to a Tcl object.
+ rv = Tcl_NewStringObj(string_result, -1);
+
+ //Deallocate the string.
+ TclpFree(string_result);
+
+ //Deallocate space for the arbitrary-length integers.
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//08/01/01: Visual inspection and some unit testing, OK.
+//Handles the "intcmp" subextension.
+static
+int ARBLENINTS_intcmp_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have two and exactly two additional arguments
+ //to this function, which are the integers to be compared.
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "sint sint");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ GMP_INTS_mpz_struct arb_arg1, arb_arg2;
+ char *cmp_arg1, *cmp_arg2;
+ int failure1, failure2;
+ int i, j, compare_result;
+
+ //Allocate space for the arbitrary-length integer result.
+ GMP_INTS_mpz_init(&arb_arg1);
+ GMP_INTS_mpz_init(&arb_arg2);
+
+ //Grab pointers to the string representation of
+ //the input arguments. The storage does not belong to us.
+ cmp_arg1 = Tcl_GetString(objv[2]);
+ assert(cmp_arg1 != NULL);
+ cmp_arg2 = Tcl_GetString(objv[3]);
+ assert(cmp_arg2 != NULL);
+
+ //Try to interpret either of the strings as one of the NAN tags.
+ //We cannot compare NAN tags. If either is a NAN tag, we must signal an
+ //error.
+ i = GMP_INTS_identify_nan_string(cmp_arg1);
+ j = GMP_INTS_identify_nan_string(cmp_arg2);
+
+ if ((i >= 0) || (j >= 0))
+ {
+ rv = Tcl_NewStringObj("arbint intcmp: cannot compare NAN symbolic tags.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+
+ return(TCL_ERROR);
+ }
+
+ //Try to convert both strings into arbitrary integers.
+ GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, cmp_arg1);
+ GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, cmp_arg2);
+
+ //If there was a parse failure, we have to return an error
+ //message. It is possible that both arguments failed the parse,
+ //but only return one in the error message.
+ if (failure1 || failure2)
+ {
+ rv = Tcl_NewStringObj("arbint intcmp: \"", -1);
+ if (failure1)
+ Tcl_AppendToObj(rv, cmp_arg1, -1);
+ else
+ Tcl_AppendToObj(rv, cmp_arg2, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+
+ return(TCL_ERROR);
+ }
+
+ //Calculate the compare result.
+ compare_result = GMP_INTS_mpz_cmp(&arb_arg1, &arb_arg2);
+
+ //Assign the return value based on the result.
+ if (compare_result < 0)
+ rv = Tcl_NewStringObj("-1", -1);
+ else if (compare_result == 0)
+ rv = Tcl_NewStringObj("0", -1);
+ else
+ rv = Tcl_NewStringObj("1", -1);
+
+ //Deallocate space for the arbitrary-length integers.
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//Handles the "intdiv" subextension.
+//07/31/01: Visually inspected, OK.
+static
+int ARBLENINTS_intdiv_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have two and exactly two additional arguments
+ //to this function, which are the integers whose
+ //integer quotient is to be calculated.
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "sint sint");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ GMP_INTS_mpz_struct arb_dividend, arb_divisor, arb_quotient, arb_remainder;
+ char *dividend_arg1, *divisor_arg2;
+ int failure1, failure2;
+ unsigned chars_reqd;
+ char *string_result;
+ int i, j;
+
+ //Allocate space for the arbitrary-length integer arguments and results.
+ GMP_INTS_mpz_init(&arb_dividend);
+ GMP_INTS_mpz_init(&arb_divisor);
+ GMP_INTS_mpz_init(&arb_quotient);
+ GMP_INTS_mpz_init(&arb_remainder);
+
+ //Grab pointers to the string representation of
+ //the input arguments. The storage does not belong to us.
+ dividend_arg1 = Tcl_GetString(objv[2]);
+ assert(dividend_arg1 != NULL);
+ divisor_arg2 = Tcl_GetString(objv[3]);
+ assert(divisor_arg2 != NULL);
+
+ //Try to interpret either of the strings as one of the NAN tags.
+ //If it is one, return the appropriate result for
+ //a binary operation.
+ i = GMP_INTS_identify_nan_string(dividend_arg1);
+ j = GMP_INTS_identify_nan_string(divisor_arg2);
+
+ if ((i >= 0) || (j >= 0))
+ {
+ const char *p;
+
+ //Find the max of i and j. This isn't a scientific way to tag the
+ //result, but will be OK. Some information is lost no matter what
+ //we do.
+ if (i > j)
+ ;
+ else
+ i = j;
+
+ //i now contains the max.
+ switch (i)
+ {
+ case 0: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 1: p = GMP_INTS_supply_nan_string(3);
+ break;
+ case 2: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 3: p = GMP_INTS_supply_nan_string(3);
+ break;
+ default:
+ assert(0);
+ break;
+ }
+
+ rv = Tcl_NewStringObj(p, -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_dividend);
+ GMP_INTS_mpz_clear(&arb_divisor);
+ GMP_INTS_mpz_clear(&arb_quotient);
+ GMP_INTS_mpz_clear(&arb_remainder);
+
+ return(TCL_OK);
+ }
+
+ //Try to convert both strings into arbitrary integers.
+ GMP_INTS_mpz_set_general_int(&arb_dividend, &failure1, dividend_arg1);
+ GMP_INTS_mpz_set_general_int(&arb_divisor, &failure2, divisor_arg2);
+
+ //If there was a parse failure, we have to return an error
+ //message. It is possible that both arguments failed the parse,
+ //but only return one in the error message.
+ if (failure1 || failure2)
+ {
+ rv = Tcl_NewStringObj("arbint intdiv: \"", -1);
+ if (failure1)
+ Tcl_AppendToObj(rv, dividend_arg1, -1);
+ else
+ Tcl_AppendToObj(rv, divisor_arg2, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_dividend);
+ GMP_INTS_mpz_clear(&arb_divisor);
+ GMP_INTS_mpz_clear(&arb_quotient);
+ GMP_INTS_mpz_clear(&arb_remainder);
+
+ return(TCL_ERROR);
+ }
+
+ //Calculate the quotient.
+ GMP_INTS_mpz_tdiv_qr(&arb_quotient, &arb_remainder, &arb_dividend, &arb_divisor);
+
+ //Figure out the number of characters required for
+ //the output string.
+ chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_quotient);
+
+ //Allocate space for the conversion result.
+ string_result = TclpAlloc(sizeof(char) * chars_reqd);
+ assert(string_result != NULL);
+
+ //Make the conversion to a character string.
+ GMP_INTS_mpz_to_string(string_result, &arb_quotient);
+
+ //Assign the string result to a Tcl object.
+ rv = Tcl_NewStringObj(string_result, -1);
+
+ //Deallocate the string.
+ TclpFree(string_result);
+
+ //Deallocate space for the arbitrary-length integers.
+ GMP_INTS_mpz_clear(&arb_dividend);
+ GMP_INTS_mpz_clear(&arb_divisor);
+ GMP_INTS_mpz_clear(&arb_quotient);
+ GMP_INTS_mpz_clear(&arb_remainder);
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//08/01/01: Visually inspected.
+//Handles the "intexp" subextension.
+static
+int ARBLENINTS_intexp_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have two and exactly two additional arguments
+ //to this function, which are the integers used to
+ //calculate the exponential.
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "sint uint32");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ GMP_INTS_mpz_struct arb_arg1, arb_result;
+ unsigned arg2;
+ char *str_arg1, *str_arg2;
+ int failure1, failure2;
+ unsigned chars_reqd;
+ char *string_result;
+ int i, j;
+
+ //Allocate space for the arbitrary-length integers.
+ GMP_INTS_mpz_init(&arb_arg1);
+ GMP_INTS_mpz_init(&arb_result);
+
+ //Grab pointers to the string representation of
+ //the input arguments. The storage does not belong to us.
+ str_arg1 = Tcl_GetString(objv[2]);
+ assert(str_arg1 != NULL);
+ str_arg2 = Tcl_GetString(objv[3]);
+ assert(str_arg2 != NULL);
+
+ //Try to interpret either of the strings as one of the NAN tags.
+ //If it is one, return the appropriate result for
+ //a binary operation.
+ i = GMP_INTS_identify_nan_string(str_arg1);
+ j = GMP_INTS_identify_nan_string(str_arg2);
+
+ if ((i >= 0) || (j >= 0))
+ {
+ const char *p;
+
+ //Find the max of i and j. This isn't a scientific way to tag the
+ //result, but will be OK. Some information is lost no matter what
+ //we do.
+ if (i > j)
+ ;
+ else
+ i = j;
+
+ //i now contains the max.
+ switch (i)
+ {
+ case 0: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 1: p = GMP_INTS_supply_nan_string(3);
+ break;
+ case 2: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 3: p = GMP_INTS_supply_nan_string(3);
+ break;
+ default:
+ assert(0);
+ break;
+ }
+
+ rv = Tcl_NewStringObj(p, -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ return(TCL_OK);
+ }
+
+ //Try to convert the first string into arbitrary integers.
+ //The first string can be anything, including zero or a negative
+ //arugument.
+ GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, str_arg1);
+
+ //If the conversion of the first string did not go alright,
+ //print error message and abort.
+ if (failure1)
+ {
+ rv = Tcl_NewStringObj("arbint intexp: \"", -1);
+ Tcl_AppendToObj(rv, str_arg1, -1);
+ Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ return(TCL_ERROR);
+ }
+
+
+ //Try to convert the second string into an unsigned 32-bit
+ //integer.
+ GMP_INTS_mpz_parse_into_uint32(&arg2, &failure2, str_arg2);
+
+ //If the conversion of the second string did not go alright,
+ //print error message and abort.
+ if (failure2)
+ {
+ rv = Tcl_NewStringObj("arbint intexp: \"", -1);
+ Tcl_AppendToObj(rv, str_arg2, -1);
+ Tcl_AppendToObj(rv, "\" is not a recognized unsigned 32-bit integer.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ return(TCL_ERROR);
+ }
+
+ //Calculate the exponential.
+ GMP_INTS_mpz_pow_ui(&arb_result, &arb_arg1, arg2);
+
+ //Figure out the number of characters required for
+ //the output string.
+ chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
+
+ //Allocate space for the conversion result.
+ string_result = TclpAlloc(sizeof(char) * chars_reqd);
+ assert(string_result != NULL);
+
+ //Make the conversion to a character string.
+ GMP_INTS_mpz_to_string(string_result, &arb_result);
+
+ //Assign the string result to a Tcl object.
+ rv = Tcl_NewStringObj(string_result, -1);
+
+ //Deallocate the string.
+ TclpFree(string_result);
+
+ //Deallocate space for the arbitrary-length integers.
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//Handles the "intfac" subextension.
+//07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
+//from memory an intuition as far as how to set return results and so forth.
+static
+int ARBLENINTS_intfac_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have one and exactly one additional argument
+ //to this function, which is the integer whose
+ //factorial is to be evaluated.
+ if (objc != 3)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "uint32");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ GMP_INTS_mpz_struct arb_result;
+ char *fac_arg;
+ int failure;
+ unsigned fac_ui_arg;
+ unsigned chars_reqd;
+ char *string_result;
+ int i;
+
+ //Allocate space for the arbitrary-length integer result.
+ GMP_INTS_mpz_init(&arb_result);
+
+ //Grab a pointer to the string representation of
+ //the input argument. The storage does not belong to us.
+ fac_arg = Tcl_GetString(objv[2]);
+ assert(fac_arg != NULL);
+
+ //Try to interpret the string as one of the NAN tags.
+ //If it is one, return the appropriate result for
+ //a unary operation.
+ if ((i = GMP_INTS_identify_nan_string(fac_arg)) >= 0)
+ {
+ const char *p;
+
+ switch (i)
+ {
+ case 0: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 1: p = GMP_INTS_supply_nan_string(3);
+ break;
+ case 2: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 3: p = GMP_INTS_supply_nan_string(3);
+ break;
+ default:
+ assert(0);
+ break;
+ }
+
+ rv = Tcl_NewStringObj(p, -1);
+ Tcl_SetObjResult(interp, rv);
+ GMP_INTS_mpz_clear(&arb_result);
+ return(TCL_OK);
+ }
+
+ //Try to convert the string to a UINT32 using all
+ //known methods.
+ GMP_INTS_mpz_parse_into_uint32(&fac_ui_arg, &failure, fac_arg);
+
+ //If there was a parse failure, we have to return an error
+ //message.
+ if (failure)
+ {
+ rv = Tcl_NewStringObj("arbint intfac: \"", -1);
+ Tcl_AppendToObj(rv, fac_arg, -1);
+ Tcl_AppendToObj(rv, "\" is not a recognized 32-bit unsigned integer.", -1);
+ Tcl_SetObjResult(interp, rv);
+ GMP_INTS_mpz_clear(&arb_result);
+ return(TCL_ERROR);
+ }
+
+ //Calculate the factorial.
+ GMP_INTS_mpz_fac_ui(&arb_result, fac_ui_arg);
+
+ //Figure out the number of characters required for
+ //the output string.
+ chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
+
+ //Allocate space for the conversion result.
+ string_result = TclpAlloc(sizeof(char) * chars_reqd);
+ assert(string_result != NULL);
+
+ //Make the conversion to a character string.
+ GMP_INTS_mpz_to_string(string_result, &arb_result);
+
+ //Assign the string result to a Tcl object.
+ rv = Tcl_NewStringObj(string_result, -1);
+
+ //Deallocate the string.
+ TclpFree(string_result);
+
+ //Deallocate space for the arbitrary-length integer.
+ GMP_INTS_mpz_clear(&arb_result);
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//Handles the "intgcd" subextension.
+//08/06/01: Visual inspection OK.
+static
+int ARBLENINTS_intgcd_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have two and exactly two additional arguments
+ //to this function, which are the integers whose
+ //gcd is to be calculated.
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "sint sint");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ GMP_INTS_mpz_struct arb_arg1, arb_arg2, arb_result;
+ char *gcd_arg1, *gcd_arg2;
+ int failure1, failure2;
+ unsigned chars_reqd;
+ char *string_result;
+ int i, j;
+
+ //Allocate space for the arbitrary-length integer result.
+ GMP_INTS_mpz_init(&arb_arg1);
+ GMP_INTS_mpz_init(&arb_arg2);
+ GMP_INTS_mpz_init(&arb_result);
+
+ //Grab pointers to the string representation of
+ //the input arguments. The storage does not belong to us.
+ gcd_arg1 = Tcl_GetString(objv[2]);
+ assert(gcd_arg1 != NULL);
+ gcd_arg2 = Tcl_GetString(objv[3]);
+ assert(gcd_arg2 != NULL);
+
+ //Try to interpret either of the strings as one of the NAN tags.
+ //If it is one, return the appropriate result for
+ //a binary operation.
+ i = GMP_INTS_identify_nan_string(gcd_arg1);
+ j = GMP_INTS_identify_nan_string(gcd_arg2);
+
+ if ((i >= 0) || (j >= 0))
+ {
+ const char *p;
+
+ //Find the max of i and j. This isn't a scientific way to tag the
+ //result, but will be OK. Some information is lost no matter what
+ //we do.
+ if (i > j)
+ ;
+ else
+ i = j;
+
+ //i now contains the max.
+ switch (i)
+ {
+ case 0: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 1: p = GMP_INTS_supply_nan_string(3);
+ break;
+ case 2: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 3: p = GMP_INTS_supply_nan_string(3);
+ break;
+ default:
+ assert(0);
+ break;
+ }
+
+ rv = Tcl_NewStringObj(p, -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ return(TCL_OK);
+ }
+
+ //Try to convert both strings into arbitrary integers.
+ GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, gcd_arg1);
+ GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, gcd_arg2);
+
+ //If there was a parse failure, we have to return an error
+ //message. It is possible that both arguments failed the parse,
+ //but only return one in the error message.
+ if (failure1 || failure2)
+ {
+ rv = Tcl_NewStringObj("arbint intgcd: \"", -1);
+ if (failure1)
+ Tcl_AppendToObj(rv, gcd_arg1, -1);
+ else
+ Tcl_AppendToObj(rv, gcd_arg2, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ return(TCL_ERROR);
+ }
+
+ //Calculate the gcd.
+ GMP_INTS_mpz_gcd(&arb_result, &arb_arg1, &arb_arg2);
+
+ //Figure out the number of characters required for
+ //the output string.
+ chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
+
+ //Allocate space for the conversion result.
+ string_result = TclpAlloc(sizeof(char) * chars_reqd);
+ assert(string_result != NULL);
+
+ //Make the conversion to a character string.
+ GMP_INTS_mpz_to_string(string_result, &arb_result);
+
+ //Assign the string result to a Tcl object.
+ rv = Tcl_NewStringObj(string_result, -1);
+
+ //Deallocate the string.
+ TclpFree(string_result);
+
+ //Deallocate space for the arbitrary-length integers.
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//Handles the "intlcm" subextension.
+//08/10/01: Visual inspection OK.
+static
+int ARBLENINTS_intlcm_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have two and exactly two additional arguments
+ //to this function, which are the integers whose
+ //lcm is to be calculated.
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "sint sint");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ GMP_INTS_mpz_struct arb_arg1, arb_arg2, gcd, remainder, arb_result;
+ char *lcm_arg1, *lcm_arg2;
+ int failure1, failure2;
+ unsigned chars_reqd;
+ char *string_result;
+ int i, j;
+
+ //Allocate space for the arbitrary-length integers.
+ GMP_INTS_mpz_init(&arb_arg1);
+ GMP_INTS_mpz_init(&arb_arg2);
+ GMP_INTS_mpz_init(&gcd);
+ GMP_INTS_mpz_init(&remainder);
+ GMP_INTS_mpz_init(&arb_result);
+
+ //Grab pointers to the string representation of
+ //the input arguments. The storage does not belong to us.
+ lcm_arg1 = Tcl_GetString(objv[2]);
+ assert(lcm_arg1 != NULL);
+ lcm_arg2 = Tcl_GetString(objv[3]);
+ assert(lcm_arg2 != NULL);
+
+ //Try to interpret either of the strings as one of the NAN tags.
+ //If it is one, return the appropriate result for
+ //a binary operation.
+ i = GMP_INTS_identify_nan_string(lcm_arg1);
+ j = GMP_INTS_identify_nan_string(lcm_arg2);
+
+ if ((i >= 0) || (j >= 0))
+ {
+ const char *p;
+
+ //Find the max of i and j. This isn't a scientific way to tag the
+ //result, but will be OK. Some information is lost no matter what
+ //we do.
+ if (i > j)
+ ;
+ else
+ i = j;
+
+ //i now contains the max.
+ switch (i)
+ {
+ case 0: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 1: p = GMP_INTS_supply_nan_string(3);
+ break;
+ case 2: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 3: p = GMP_INTS_supply_nan_string(3);
+ break;
+ default:
+ assert(0);
+ break;
+ }
+
+ rv = Tcl_NewStringObj(p, -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+ GMP_INTS_mpz_clear(&gcd);
+ GMP_INTS_mpz_clear(&remainder);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ return(TCL_OK);
+ }
+
+ //Try to convert both strings into arbitrary integers.
+ GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, lcm_arg1);
+ GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, lcm_arg2);
+
+ //If there was a parse failure, we have to return an error
+ //message. It is possible that both arguments failed the parse,
+ //but only return one in the error message.
+ if (failure1 || failure2)
+ {
+ rv = Tcl_NewStringObj("arbint intlcm: \"", -1);
+ if (failure1)
+ Tcl_AppendToObj(rv, lcm_arg1, -1);
+ else
+ Tcl_AppendToObj(rv, lcm_arg2, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+ GMP_INTS_mpz_clear(&gcd);
+ GMP_INTS_mpz_clear(&remainder);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ return(TCL_ERROR);
+ }
+
+ //Adjust errant arguments.
+ if (GMP_INTS_mpz_is_neg(&arb_arg1))
+ GMP_INTS_mpz_negate(&arb_arg1);
+ else if (GMP_INTS_mpz_is_zero(&arb_arg1))
+ GMP_INTS_mpz_set_ui(&arb_arg1, 1);
+ if (GMP_INTS_mpz_is_neg(&arb_arg2))
+ GMP_INTS_mpz_negate(&arb_arg2);
+ else if (GMP_INTS_mpz_is_zero(&arb_arg2))
+ GMP_INTS_mpz_set_ui(&arb_arg2, 1);
+
+ //Calculate the gcd.
+ GMP_INTS_mpz_gcd(&gcd, &arb_arg1, &arb_arg2);
+
+ //Calculate the lcm.
+ GMP_INTS_mpz_mul(&arb_arg1, &arb_arg1, &arb_arg2);
+ GMP_INTS_mpz_tdiv_qr(&arb_result, &remainder,
+ &arb_arg1, &gcd);
+
+ //Figure out the number of characters required for
+ //the output string.
+ chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
+
+ //Allocate space for the conversion result.
+ string_result = TclpAlloc(sizeof(char) * chars_reqd);
+ assert(string_result != NULL);
+
+ //Make the conversion to a character string.
+ GMP_INTS_mpz_to_string(string_result, &arb_result);
+
+ //Assign the string result to a Tcl object.
+ rv = Tcl_NewStringObj(string_result, -1);
+
+ //Deallocate the string.
+ TclpFree(string_result);
+
+ //Deallocate space for the arbitrary-length integers.
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+ GMP_INTS_mpz_clear(&gcd);
+ GMP_INTS_mpz_clear(&remainder);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//Handles the "intmod" subextension.
+//08/06/01: Visual inspection OK.
+static
+int ARBLENINTS_intmod_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have two and exactly two additional arguments
+ //to this function, which are the integers whose
+ //integer quotient is to be calculated.
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "sint sint");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ GMP_INTS_mpz_struct arb_dividend, arb_divisor, arb_quotient, arb_remainder;
+ char *dividend_arg1, *divisor_arg2;
+ int failure1, failure2;
+ unsigned chars_reqd;
+ char *string_result;
+ int i, j;
+
+ //Allocate space for the arbitrary-length integer arguments and results.
+ GMP_INTS_mpz_init(&arb_dividend);
+ GMP_INTS_mpz_init(&arb_divisor);
+ GMP_INTS_mpz_init(&arb_quotient);
+ GMP_INTS_mpz_init(&arb_remainder);
+
+ //Grab pointers to the string representation of
+ //the input arguments. The storage does not belong to us.
+ dividend_arg1 = Tcl_GetString(objv[2]);
+ assert(dividend_arg1 != NULL);
+ divisor_arg2 = Tcl_GetString(objv[3]);
+ assert(divisor_arg2 != NULL);
+
+ //Try to interpret either of the strings as one of the NAN tags.
+ //If it is one, return the appropriate result for
+ //a binary operation.
+ i = GMP_INTS_identify_nan_string(dividend_arg1);
+ j = GMP_INTS_identify_nan_string(divisor_arg2);
+
+ if ((i >= 0) || (j >= 0))
+ {
+ const char *p;
+
+ //Find the max of i and j. This isn't a scientific way to tag the
+ //result, but will be OK. Some information is lost no matter what
+ //we do.
+ if (i > j)
+ ;
+ else
+ i = j;
+
+ //i now contains the max.
+ switch (i)
+ {
+ case 0: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 1: p = GMP_INTS_supply_nan_string(3);
+ break;
+ case 2: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 3: p = GMP_INTS_supply_nan_string(3);
+ break;
+ default:
+ assert(0);
+ break;
+ }
+
+ rv = Tcl_NewStringObj(p, -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_dividend);
+ GMP_INTS_mpz_clear(&arb_divisor);
+ GMP_INTS_mpz_clear(&arb_quotient);
+ GMP_INTS_mpz_clear(&arb_remainder);
+
+ return(TCL_OK);
+ }
+
+ //Try to convert both strings into arbitrary integers.
+ GMP_INTS_mpz_set_general_int(&arb_dividend, &failure1, dividend_arg1);
+ GMP_INTS_mpz_set_general_int(&arb_divisor, &failure2, divisor_arg2);
+
+ //If there was a parse failure, we have to return an error
+ //message. It is possible that both arguments failed the parse,
+ //but only return one in the error message.
+ if (failure1 || failure2)
+ {
+ rv = Tcl_NewStringObj("arbint intmod: \"", -1);
+ if (failure1)
+ Tcl_AppendToObj(rv, dividend_arg1, -1);
+ else
+ Tcl_AppendToObj(rv, divisor_arg2, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_dividend);
+ GMP_INTS_mpz_clear(&arb_divisor);
+ GMP_INTS_mpz_clear(&arb_quotient);
+ GMP_INTS_mpz_clear(&arb_remainder);
+
+ return(TCL_ERROR);
+ }
+
+ //Calculate the quotient and remainder.
+ GMP_INTS_mpz_tdiv_qr(&arb_quotient, &arb_remainder, &arb_dividend, &arb_divisor);
+
+ //Figure out the number of characters required for
+ //the output string.
+ chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_remainder);
+
+ //Allocate space for the conversion result.
+ string_result = TclpAlloc(sizeof(char) * chars_reqd);
+ assert(string_result != NULL);
+
+ //Make the conversion to a character string.
+ GMP_INTS_mpz_to_string(string_result, &arb_remainder);
+
+ //Assign the string result to a Tcl object.
+ rv = Tcl_NewStringObj(string_result, -1);
+
+ //Deallocate the string.
+ TclpFree(string_result);
+
+ //Deallocate space for the arbitrary-length integers.
+ GMP_INTS_mpz_clear(&arb_dividend);
+ GMP_INTS_mpz_clear(&arb_divisor);
+ GMP_INTS_mpz_clear(&arb_quotient);
+ GMP_INTS_mpz_clear(&arb_remainder);
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//Handles the "intmul" subextension.
+//08/06/01: Visual inspection OK.
+static
+int ARBLENINTS_intmul_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have two and exactly two additional arguments
+ //to this function, which are the integers whose
+ //product is to be calculated.
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "sint sint");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ GMP_INTS_mpz_struct arb_arg1, arb_arg2, arb_result;
+ char *mul_arg1, *mul_arg2;
+ int failure1, failure2;
+ unsigned chars_reqd;
+ char *string_result;
+ int i, j;
+
+ //Allocate space for the arbitrary-length integer result.
+ GMP_INTS_mpz_init(&arb_arg1);
+ GMP_INTS_mpz_init(&arb_arg2);
+ GMP_INTS_mpz_init(&arb_result);
+
+ //Grab pointers to the string representation of
+ //the input arguments. The storage does not belong to us.
+ mul_arg1 = Tcl_GetString(objv[2]);
+ assert(mul_arg1 != NULL);
+ mul_arg2 = Tcl_GetString(objv[3]);
+ assert(mul_arg2 != NULL);
+
+ //Try to interpret either of the strings as one of the NAN tags.
+ //If it is one, return the appropriate result for
+ //a binary operation.
+ i = GMP_INTS_identify_nan_string(mul_arg1);
+ j = GMP_INTS_identify_nan_string(mul_arg2);
+
+ if ((i >= 0) || (j >= 0))
+ {
+ const char *p;
+
+ //Find the max of i and j. This isn't a scientific way to tag the
+ //result, but will be OK. Some information is lost no matter what
+ //we do.
+ if (i > j)
+ ;
+ else
+ i = j;
+
+ //i now contains the max.
+ switch (i)
+ {
+ case 0: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 1: p = GMP_INTS_supply_nan_string(3);
+ break;
+ case 2: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 3: p = GMP_INTS_supply_nan_string(3);
+ break;
+ default:
+ assert(0);
+ break;
+ }
+
+ rv = Tcl_NewStringObj(p, -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ return(TCL_OK);
+ }
+
+ //Try to convert both strings into arbitrary integers.
+ GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, mul_arg1);
+ GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, mul_arg2);
+
+ //If there was a parse failure, we have to return an error
+ //message. It is possible that both arguments failed the parse,
+ //but only return one in the error message.
+ if (failure1 || failure2)
+ {
+ rv = Tcl_NewStringObj("arbint intmul: \"", -1);
+ if (failure1)
+ Tcl_AppendToObj(rv, mul_arg1, -1);
+ else
+ Tcl_AppendToObj(rv, mul_arg2, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ return(TCL_ERROR);
+ }
+
+ //Calculate the product.
+ GMP_INTS_mpz_mul(&arb_result, &arb_arg1, &arb_arg2);
+
+ //Figure out the number of characters required for
+ //the output string.
+ chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
+
+ //Allocate space for the conversion result.
+ string_result = TclpAlloc(sizeof(char) * chars_reqd);
+ assert(string_result != NULL);
+
+ //Make the conversion to a character string.
+ GMP_INTS_mpz_to_string(string_result, &arb_result);
+
+ //Assign the string result to a Tcl object.
+ rv = Tcl_NewStringObj(string_result, -1);
+
+ //Deallocate the string.
+ TclpFree(string_result);
+
+ //Deallocate space for the arbitrary-length integers.
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//Handles the "intsub" subextension.
+//08/06/01: Visual inspection OK.
+static
+int ARBLENINTS_intsub_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have two and exactly two additional arguments
+ //to this function, which are the integers whose
+ //difference is to be calculated.
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "sint sint");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ GMP_INTS_mpz_struct arb_arg1, arb_arg2, arb_result;
+ char *sub_arg1, *sub_arg2;
+ int failure1, failure2;
+ unsigned chars_reqd;
+ char *string_result;
+ int i, j;
+
+ //Allocate space for the arbitrary-length integer result.
+ GMP_INTS_mpz_init(&arb_arg1);
+ GMP_INTS_mpz_init(&arb_arg2);
+ GMP_INTS_mpz_init(&arb_result);
+
+ //Grab pointers to the string representation of
+ //the input arguments. The storage does not belong to us.
+ sub_arg1 = Tcl_GetString(objv[2]);
+ assert(sub_arg1 != NULL);
+ sub_arg2 = Tcl_GetString(objv[3]);
+ assert(sub_arg2 != NULL);
+
+ //Try to interpret either of the strings as one of the NAN tags.
+ //If it is one, return the appropriate result for
+ //a binary operation.
+ i = GMP_INTS_identify_nan_string(sub_arg1);
+ j = GMP_INTS_identify_nan_string(sub_arg2);
+
+ if ((i >= 0) || (j >= 0))
+ {
+ const char *p;
+
+ //Find the max of i and j. This isn't a scientific way to tag the
+ //result, but will be OK. Some information is lost no matter what
+ //we do.
+ if (i > j)
+ ;
+ else
+ i = j;
+
+ //i now contains the max.
+ switch (i)
+ {
+ case 0: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 1: p = GMP_INTS_supply_nan_string(3);
+ break;
+ case 2: p = GMP_INTS_supply_nan_string(2);
+ break;
+ case 3: p = GMP_INTS_supply_nan_string(3);
+ break;
+ default:
+ assert(0);
+ break;
+ }
+
+ rv = Tcl_NewStringObj(p, -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ return(TCL_OK);
+ }
+
+ //Try to convert both strings into arbitrary integers.
+ GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, sub_arg1);
+ GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, sub_arg2);
+
+ //If there was a parse failure, we have to return an error
+ //message. It is possible that both arguments failed the parse,
+ //but only return one in the error message.
+ if (failure1 || failure2)
+ {
+ rv = Tcl_NewStringObj("arbint intsub: \"", -1);
+ if (failure1)
+ Tcl_AppendToObj(rv, sub_arg1, -1);
+ else
+ Tcl_AppendToObj(rv, sub_arg2, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ return(TCL_ERROR);
+ }
+
+ //Calculate the difference.
+ GMP_INTS_mpz_sub(&arb_result, &arb_arg1, &arb_arg2);
+
+ //Figure out the number of characters required for
+ //the output string.
+ chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
+
+ //Allocate space for the conversion result.
+ string_result = TclpAlloc(sizeof(char) * chars_reqd);
+ assert(string_result != NULL);
+
+ //Make the conversion to a character string.
+ GMP_INTS_mpz_to_string(string_result, &arb_result);
+
+ //Assign the string result to a Tcl object.
+ rv = Tcl_NewStringObj(string_result, -1);
+
+ //Deallocate the string.
+ TclpFree(string_result);
+
+ //Deallocate space for the arbitrary-length integers.
+ GMP_INTS_mpz_clear(&arb_arg1);
+ GMP_INTS_mpz_clear(&arb_arg2);
+ GMP_INTS_mpz_clear(&arb_result);
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//Handles the "iseflag" subextension.
+//07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
+//from memory an intuition as far as how to set return results and so forth.
+static
+int ARBLENINTS_iseflag_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have one and exactly one additional argument
+ //to this function, which is the string we want to
+ //classify.
+ if (objc != 3)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "stringarg");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ char *string_arg;
+
+ //Grab a pointer to the string representation of
+ //the input argument. The storage does not belong to us.
+ string_arg = Tcl_GetString(objv[2]);
+ assert(string_arg != NULL);
+
+ //Try to parse it out. We will definitely get one of
+ //the return values.
+ if (!strcmp(string_arg, GMP_INTS_EF_INTOVF_POS_STRING))
+ {
+ rv = Tcl_NewStringObj("1", -1);
+ }
+ else if (!strcmp(string_arg, GMP_INTS_EF_INTOVF_NEG_STRING))
+ {
+ rv = Tcl_NewStringObj("2", -1);
+ }
+ else if (!strcmp(string_arg, GMP_INTS_EF_INTOVF_TAINT_POS_STRING))
+ {
+ rv = Tcl_NewStringObj("3", -1);
+ }
+ else if (!strcmp(string_arg, GMP_INTS_EF_INTOVF_TAINT_NEG_STRING))
+ {
+ rv = Tcl_NewStringObj("4", -1);
+ }
+ else
+ {
+ rv = Tcl_NewStringObj("0", -1);
+ }
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//08/08/01: Visual inspection OK.
+static
+int ARBLENINTS_rnadd_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have exactly two additional arguments
+ //to this function, which are the rational numbers
+ //to add.
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "srn srn");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ char *input_arg;
+ int failure;
+ char *string_result;
+ GMP_RATS_mpq_struct arg1, arg2, result;
+
+ //Allocate space for the rational numbers.
+ GMP_RATS_mpq_init(&arg1);
+ GMP_RATS_mpq_init(&arg2);
+ GMP_RATS_mpq_init(&result);
+
+ //Grab a pointer to the string representation of
+ //the first input argument. The storage does not belong to us.
+ input_arg = Tcl_GetString(objv[2]);
+ assert(input_arg != NULL);
+
+ //Try to parse our first input string as a rational number.
+ //If we are not successful in this, must abort.
+ GMP_RATS_mpq_set_all_format_rat_num(input_arg,
+ &failure,
+ &arg1);
+
+ if (failure)
+ {
+ rv = Tcl_NewStringObj("arbint rnadd: \"", -1);
+ Tcl_AppendToObj(rv, input_arg, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+ GMP_RATS_mpq_clear(&result);
+
+ return(TCL_ERROR);
+ }
+
+ //Grab a pointer to the string representation of
+ //the second input argument. The storage does not belong to us.
+ input_arg = Tcl_GetString(objv[3]);
+ assert(input_arg != NULL);
+
+ //Try to parse our second input string as a rational number.
+ //If we are not successful in this, must abort.
+ GMP_RATS_mpq_set_all_format_rat_num(input_arg,
+ &failure,
+ &arg2);
+
+ if (failure)
+ {
+ rv = Tcl_NewStringObj("arbint rnadd: \"", -1);
+ Tcl_AppendToObj(rv, input_arg, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+ GMP_RATS_mpq_clear(&result);
+
+ return(TCL_ERROR);
+ }
+
+ //Perform the actual addition of the rational numbers. All
+ //error cases are covered. If either of the inputs has a
+ //denominator of zero, this will propagate to the result.
+ GMP_RATS_mpq_add(&result, &arg1, &arg2);
+
+ //If the result has been NAN'd, return the string "NAN".
+ if (GMP_RATS_mpq_is_nan(&result))
+ {
+ rv = Tcl_NewStringObj("NAN", -1);
+
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+ GMP_RATS_mpq_clear(&result);
+
+ return(TCL_OK);
+ }
+
+ //Allocate space for the string result which we'll form for
+ //both numerator and denominator. We need the maximum, because we'll only
+ //do one number at a time.
+ string_result = TclpAlloc(sizeof(char)
+ *
+ INTFUNC_max
+ (
+ GMP_INTS_mpz_size_in_base_10(&(result.num)),
+ GMP_INTS_mpz_size_in_base_10(&(result.den))
+ )
+ );
+ assert(string_result != NULL);
+
+ //Convert the numerator to a string and set that to be the
+ //return value.
+ GMP_INTS_mpz_to_string(string_result, &(result.num));
+ rv = Tcl_NewStringObj(string_result, -1);
+
+ //Append the separating slash.
+ Tcl_AppendToObj(rv, "/", -1);
+
+ //Convert the denominator to a string and append that to the
+ //return value.
+ GMP_INTS_mpz_to_string(string_result, &(result.den));
+ Tcl_AppendToObj(rv, string_result, -1);
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Free up all dynamic memory.
+ TclpFree(string_result);
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+ GMP_RATS_mpq_clear(&result);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//08/16/01: Visual inspection OK.
+static
+int ARBLENINTS_rncmp_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have exactly two additional arguments
+ //to this function, which are the rational numbers
+ //to compare.
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "srn srn");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ char *input_arg;
+ int failure, compare_result;
+ GMP_RATS_mpq_struct arg1, arg2;
+
+ //Allocate space for the rational numbers.
+ GMP_RATS_mpq_init(&arg1);
+ GMP_RATS_mpq_init(&arg2);
+
+ //Grab a pointer to the string representation of
+ //the first input argument. The storage does not belong to us.
+ input_arg = Tcl_GetString(objv[2]);
+ assert(input_arg != NULL);
+
+ //Try to parse our first input string as a rational number.
+ //If we are not successful in this, must abort.
+ GMP_RATS_mpq_set_all_format_rat_num(input_arg,
+ &failure,
+ &arg1);
+
+ if (failure)
+ {
+ rv = Tcl_NewStringObj("arbint rncmp: \"", -1);
+ Tcl_AppendToObj(rv, input_arg, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+
+ return(TCL_ERROR);
+ }
+
+ //Grab a pointer to the string representation of
+ //the second input argument. The storage does not belong to us.
+ input_arg = Tcl_GetString(objv[3]);
+ assert(input_arg != NULL);
+
+ //Try to parse our second input string as a rational number.
+ //If we are not successful in this, must abort.
+ GMP_RATS_mpq_set_all_format_rat_num(input_arg,
+ &failure,
+ &arg2);
+
+ if (failure)
+ {
+ rv = Tcl_NewStringObj("arbint rncmp: \"", -1);
+ Tcl_AppendToObj(rv, input_arg, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+
+ return(TCL_ERROR);
+ }
+
+ //Perform the actual comparison of the rational numbers. All
+ //error cases are covered. If either of the inputs has a
+ //denominator of zero, this will propagate to the result.
+ compare_result = GMP_RATS_mpq_cmp(&arg1, &arg2, &failure);
+
+ //If the failure flag was thrown, we have to throw an error.
+ //The reason is that if we can't successfully compare the two
+ //rational numbers, then we have to kill the script--logical
+ //correctness is not possible.
+ if (failure)
+ {
+ rv = Tcl_NewStringObj("arbint rncmp: can't compare supplied rational numbers.", -1);
+
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+
+ return(TCL_ERROR);
+ }
+
+ //Convert the comparison result to a string.
+ if (compare_result < 0)
+ rv = Tcl_NewStringObj("-1", -1);
+ else if (compare_result == 0)
+ rv = Tcl_NewStringObj("0", -1);
+ else
+ rv = Tcl_NewStringObj("1", -1);
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Free up all dynamic memory.
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//08/09/01: Visual inspection OK.
+static
+int ARBLENINTS_rndiv_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have exactly two additional arguments
+ //to this function, which are the rational numbers
+ //to divide.
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "srn srn");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ char *input_arg;
+ int failure;
+ char *string_result;
+ GMP_RATS_mpq_struct arg1, arg2, result;
+
+ //Allocate space for the rational numbers.
+ GMP_RATS_mpq_init(&arg1);
+ GMP_RATS_mpq_init(&arg2);
+ GMP_RATS_mpq_init(&result);
+
+ //Grab a pointer to the string representation of
+ //the first input argument. The storage does not belong to us.
+ input_arg = Tcl_GetString(objv[2]);
+ assert(input_arg != NULL);
+
+ //Try to parse our first input string as a rational number.
+ //If we are not successful in this, must abort.
+ GMP_RATS_mpq_set_all_format_rat_num(input_arg,
+ &failure,
+ &arg1);
+
+ if (failure)
+ {
+ rv = Tcl_NewStringObj("arbint rndiv: \"", -1);
+ Tcl_AppendToObj(rv, input_arg, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+ GMP_RATS_mpq_clear(&result);
+
+ return(TCL_ERROR);
+ }
+
+ //Grab a pointer to the string representation of
+ //the second input argument. The storage does not belong to us.
+ input_arg = Tcl_GetString(objv[3]);
+ assert(input_arg != NULL);
+
+ //Try to parse our second input string as a rational number.
+ //If we are not successful in this, must abort.
+ GMP_RATS_mpq_set_all_format_rat_num(input_arg,
+ &failure,
+ &arg2);
+
+ if (failure)
+ {
+ rv = Tcl_NewStringObj("arbint rndiv: \"", -1);
+ Tcl_AppendToObj(rv, input_arg, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+ GMP_RATS_mpq_clear(&result);
+
+ return(TCL_ERROR);
+ }
+
+ //Perform the actual division of the rational numbers. All
+ //error cases are covered. If either of the inputs has a
+ //denominator of zero, this will propagate to the result.
+ GMP_RATS_mpq_div(&result, &arg1, &arg2);
+
+ //If the result has been NAN'd, return the string "NAN".
+ if (GMP_RATS_mpq_is_nan(&result))
+ {
+ rv = Tcl_NewStringObj("NAN", -1);
+
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+ GMP_RATS_mpq_clear(&result);
+
+ return(TCL_OK);
+ }
+
+ //Allocate space for the string result which we'll form for
+ //both numerator and denominator. We need the maximum, because we'll only
+ //do one number at a time.
+ string_result = TclpAlloc(sizeof(char)
+ *
+ INTFUNC_max
+ (
+ GMP_INTS_mpz_size_in_base_10(&(result.num)),
+ GMP_INTS_mpz_size_in_base_10(&(result.den))
+ )
+ );
+ assert(string_result != NULL);
+
+ //Convert the numerator to a string and set that to be the
+ //return value.
+ GMP_INTS_mpz_to_string(string_result, &(result.num));
+ rv = Tcl_NewStringObj(string_result, -1);
+
+ //Append the separating slash.
+ Tcl_AppendToObj(rv, "/", -1);
+
+ //Convert the denominator to a string and append that to the
+ //return value.
+ GMP_INTS_mpz_to_string(string_result, &(result.den));
+ Tcl_AppendToObj(rv, string_result, -1);
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Free up all dynamic memory.
+ TclpFree(string_result);
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+ GMP_RATS_mpq_clear(&result);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//08/09/01: Visual inspection OK.
+static
+int ARBLENINTS_rnmul_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have exactly two additional arguments
+ //to this function, which are the rational numbers
+ //to add.
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "srn srn");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ char *input_arg;
+ int failure;
+ char *string_result;
+ GMP_RATS_mpq_struct arg1, arg2, result;
+
+ //Allocate space for the rational numbers.
+ GMP_RATS_mpq_init(&arg1);
+ GMP_RATS_mpq_init(&arg2);
+ GMP_RATS_mpq_init(&result);
+
+ //Grab a pointer to the string representation of
+ //the first input argument. The storage does not belong to us.
+ input_arg = Tcl_GetString(objv[2]);
+ assert(input_arg != NULL);
+
+ //Try to parse our first input string as a rational number.
+ //If we are not successful in this, must abort.
+ GMP_RATS_mpq_set_all_format_rat_num(input_arg,
+ &failure,
+ &arg1);
+
+ if (failure)
+ {
+ rv = Tcl_NewStringObj("arbint rnmul: \"", -1);
+ Tcl_AppendToObj(rv, input_arg, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+ GMP_RATS_mpq_clear(&result);
+
+ return(TCL_ERROR);
+ }
+
+ //Grab a pointer to the string representation of
+ //the second input argument. The storage does not belong to us.
+ input_arg = Tcl_GetString(objv[3]);
+ assert(input_arg != NULL);
+
+ //Try to parse our second input string as a rational number.
+ //If we are not successful in this, must abort.
+ GMP_RATS_mpq_set_all_format_rat_num(input_arg,
+ &failure,
+ &arg2);
+
+ if (failure)
+ {
+ rv = Tcl_NewStringObj("arbint rnmul: \"", -1);
+ Tcl_AppendToObj(rv, input_arg, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+ GMP_RATS_mpq_clear(&result);
+
+ return(TCL_ERROR);
+ }
+
+ //Perform the actual multiplication of the rational numbers. All
+ //error cases are covered. If either of the inputs has a
+ //denominator of zero, this will propagate to the result.
+ GMP_RATS_mpq_mul(&result, &arg1, &arg2);
+
+ //If the result has been NAN'd, return the string "NAN".
+ if (GMP_RATS_mpq_is_nan(&result))
+ {
+ rv = Tcl_NewStringObj("NAN", -1);
+
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+ GMP_RATS_mpq_clear(&result);
+
+ return(TCL_OK);
+ }
+
+ //Allocate space for the string result which we'll form for
+ //both numerator and denominator. We need the maximum, because we'll only
+ //do one number at a time.
+ string_result = TclpAlloc(sizeof(char)
+ *
+ INTFUNC_max
+ (
+ GMP_INTS_mpz_size_in_base_10(&(result.num)),
+ GMP_INTS_mpz_size_in_base_10(&(result.den))
+ )
+ );
+ assert(string_result != NULL);
+
+ //Convert the numerator to a string and set that to be the
+ //return value.
+ GMP_INTS_mpz_to_string(string_result, &(result.num));
+ rv = Tcl_NewStringObj(string_result, -1);
+
+ //Append the separating slash.
+ Tcl_AppendToObj(rv, "/", -1);
+
+ //Convert the denominator to a string and append that to the
+ //return value.
+ GMP_INTS_mpz_to_string(string_result, &(result.den));
+ Tcl_AppendToObj(rv, string_result, -1);
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Free up all dynamic memory.
+ TclpFree(string_result);
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+ GMP_RATS_mpq_clear(&result);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//08/09/01: Visual inspection OK.
+static
+int ARBLENINTS_rnred_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have exactly one additional argument
+ //to this function, which is the rational number
+ //to provide the fully reduced form of.
+ if (objc != 3)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "srn");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ char *input_arg;
+ int failure;
+ char *string_result;
+ GMP_RATS_mpq_struct rn;
+
+ //We will need a rational number to hold the return value
+ //from the parsing function. Allocate that now.
+ GMP_RATS_mpq_init(&rn);
+
+ //Grab a pointer to the string representation of
+ //the input argument. The storage does not belong to us.
+ input_arg = Tcl_GetString(objv[2]);
+ assert(input_arg != NULL);
+
+ //Try to parse our input string as a rational number.
+ //If we are not successful in this, must abort.
+ GMP_RATS_mpq_set_all_format_rat_num(input_arg,
+ &failure,
+ &rn);
+
+ if (failure)
+ {
+ rv = Tcl_NewStringObj("arbint rnred: \"", -1);
+ Tcl_AppendToObj(rv, input_arg, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&rn);
+
+ return(TCL_ERROR);
+ }
+
+ //Normalize the rational number. This takes care of the
+ //sign and also of the coprimality of numerator and
+ //denominator.
+ GMP_RATS_mpq_normalize(&rn);
+
+ //Allocate space for the string result which we'll form for
+ //both numbers. We need the maximum, because we'll only
+ //do one number at a time.
+ string_result = TclpAlloc(sizeof(char)
+ *
+ INTFUNC_max
+ (
+ GMP_INTS_mpz_size_in_base_10(&(rn.num)),
+ GMP_INTS_mpz_size_in_base_10(&(rn.den))
+ )
+ );
+ assert(string_result != NULL);
+
+ //Convert the numerator to a string and set that to be the
+ //return value.
+ GMP_INTS_mpz_to_string(string_result, &(rn.num));
+ rv = Tcl_NewStringObj(string_result, -1);
+
+ //Append the separating slash.
+ Tcl_AppendToObj(rv, "/", -1);
+
+ //Convert the denominator to a string and append that to the
+ //return value.
+ GMP_INTS_mpz_to_string(string_result, &(rn.den));
+ Tcl_AppendToObj(rv, string_result, -1);
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Free up all dynamic memory.
+ TclpFree(string_result);
+ GMP_RATS_mpq_clear(&rn);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//08/08/01: Visual inspection OK.
+static
+int ARBLENINTS_rnsub_handler(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ Tcl_Obj *rv;
+
+ //We must have exactly two additional arguments
+ //to this function, which are the rational numbers
+ //to subtract.
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp,
+ 2,
+ objv,
+ "srn srn");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ char *input_arg;
+ int failure;
+ char *string_result;
+ GMP_RATS_mpq_struct arg1, arg2, result;
+
+ //Allocate space for the rational numbers.
+ GMP_RATS_mpq_init(&arg1);
+ GMP_RATS_mpq_init(&arg2);
+ GMP_RATS_mpq_init(&result);
+
+ //Grab a pointer to the string representation of
+ //the first input argument. The storage does not belong to us.
+ input_arg = Tcl_GetString(objv[2]);
+ assert(input_arg != NULL);
+
+ //Try to parse our first input string as a rational number.
+ //If we are not successful in this, must abort.
+ GMP_RATS_mpq_set_all_format_rat_num(input_arg,
+ &failure,
+ &arg1);
+
+ if (failure)
+ {
+ rv = Tcl_NewStringObj("arbint rnsub: \"", -1);
+ Tcl_AppendToObj(rv, input_arg, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+ GMP_RATS_mpq_clear(&result);
+
+ return(TCL_ERROR);
+ }
+
+ //Grab a pointer to the string representation of
+ //the second input argument. The storage does not belong to us.
+ input_arg = Tcl_GetString(objv[3]);
+ assert(input_arg != NULL);
+
+ //Try to parse our second input string as a rational number.
+ //If we are not successful in this, must abort.
+ GMP_RATS_mpq_set_all_format_rat_num(input_arg,
+ &failure,
+ &arg2);
+
+ if (failure)
+ {
+ rv = Tcl_NewStringObj("arbint rnsub: \"", -1);
+ Tcl_AppendToObj(rv, input_arg, -1);
+
+ Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+ GMP_RATS_mpq_clear(&result);
+
+ return(TCL_ERROR);
+ }
+
+ //Perform the actual subtraction of the rational numbers. All
+ //error cases are covered. If either of the inputs has a
+ //denominator of zero, this will propagate to the result.
+ GMP_RATS_mpq_sub(&result, &arg1, &arg2);
+
+ //If the result has been NAN'd, return the string "NAN".
+ if (GMP_RATS_mpq_is_nan(&result))
+ {
+ rv = Tcl_NewStringObj("NAN", -1);
+
+ Tcl_SetObjResult(interp, rv);
+
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+ GMP_RATS_mpq_clear(&result);
+
+ return(TCL_OK);
+ }
+
+ //Allocate space for the string result which we'll form for
+ //both numerator and denominator. We need the maximum, because we'll only
+ //do one number at a time.
+ string_result = TclpAlloc(sizeof(char)
+ *
+ INTFUNC_max
+ (
+ GMP_INTS_mpz_size_in_base_10(&(result.num)),
+ GMP_INTS_mpz_size_in_base_10(&(result.den))
+ )
+ );
+ assert(string_result != NULL);
+
+ //Convert the numerator to a string and set that to be the
+ //return value.
+ GMP_INTS_mpz_to_string(string_result, &(result.num));
+ rv = Tcl_NewStringObj(string_result, -1);
+
+ //Append the separating slash.
+ Tcl_AppendToObj(rv, "/", -1);
+
+ //Convert the denominator to a string and append that to the
+ //return value.
+ GMP_INTS_mpz_to_string(string_result, &(result.den));
+ Tcl_AppendToObj(rv, string_result, -1);
+
+ //Assign the result to be the return value.
+ Tcl_SetObjResult(interp, rv);
+
+ //Free up all dynamic memory.
+ TclpFree(string_result);
+ GMP_RATS_mpq_clear(&arg1);
+ GMP_RATS_mpq_clear(&arg2);
+ GMP_RATS_mpq_clear(&result);
+
+ //Return
+ return(TCL_OK);
+ }
+ }
+
+
+//This is the search data table of possible subcommands
+//for the "arbint" extension. These must be kept
+//in alphabetical order, because a binary search is done
+//on this table in order to find an entry. If this table
+//falls out of alphabetical order, the binary search may
+//fail when in fact the entry exists.
+//
+//In a lot of cases below, this table is set up to accept
+//short forms. This is purely undocumented, and I won't put
+//it in any documentation. In a lot of cases, these table
+//entries cover common mistakes where people forget the "int".
+//
+static struct EXTNINIT_subextn_bsearch_record_struct
+ ARBLENINTS_subextn_tbl[] =
+ {
+ { "brap", ARBLENINTS_cfbrapab_handler },
+ { "cfbrapab", ARBLENINTS_cfbrapab_handler },
+ { "cfratnum", ARBLENINTS_cfratnum_handler },
+ { "cmp", ARBLENINTS_intcmp_handler },
+ { "commanate", ARBLENINTS_commanate_handler },
+ { "compare", ARBLENINTS_intcmp_handler },
+ { "const", ARBLENINTS_const_handler },
+ { "decommanate", ARBLENINTS_decommanate_handler },
+ { "div", ARBLENINTS_intdiv_handler },
+ { "divide", ARBLENINTS_intdiv_handler },
+ { "exp", ARBLENINTS_intexp_handler },
+ { "fac", ARBLENINTS_intfac_handler },
+ { "factorial", ARBLENINTS_intfac_handler },
+ { "gcd", ARBLENINTS_intgcd_handler },
+ { "intadd", ARBLENINTS_intadd_handler },
+ { "intcmp", ARBLENINTS_intcmp_handler },
+ { "intdiv", ARBLENINTS_intdiv_handler },
+ { "intexp", ARBLENINTS_intexp_handler },
+ { "intfac", ARBLENINTS_intfac_handler },
+ { "intgcd", ARBLENINTS_intgcd_handler },
+ { "intlcm", ARBLENINTS_intlcm_handler },
+ { "intmod", ARBLENINTS_intmod_handler },
+ { "intmul", ARBLENINTS_intmul_handler },
+ { "intsub", ARBLENINTS_intsub_handler },
+ { "iseflag", ARBLENINTS_iseflag_handler },
+ { "lcm", ARBLENINTS_intlcm_handler },
+ { "mod", ARBLENINTS_intmod_handler },
+ { "mul", ARBLENINTS_intmul_handler },
+ { "multiply", ARBLENINTS_intmul_handler },
+ { "rnadd", ARBLENINTS_rnadd_handler },
+ { "rncmp", ARBLENINTS_rncmp_handler },
+ { "rndiv", ARBLENINTS_rndiv_handler },
+ { "rnmul", ARBLENINTS_rnmul_handler },
+ { "rnred", ARBLENINTS_rnred_handler },
+ { "rnsub", ARBLENINTS_rnsub_handler },
+ { "times", ARBLENINTS_intmul_handler },
+ };
+
+
+//Procedure called when the "arbint" command is encountered in a Tcl script.
+//07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
+//from memory an intuition as far as how to set return results and so forth.
+int ARBLENINTS_arbint_extn_command(ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *objv[])
+ {
+ char *subcommand;
+ //Pointer to subcommand string.
+ int tbl_entry;
+ //Index into the subcommand lookup table, or -1
+ //if no match.
+ Tcl_Obj *rv;
+ //The return result (a string) if there is an error.
+ //In the normal execution case, one of the functions
+ //above supplies the return object.
+
+ if (objc < 2)
+ {
+ //It isn't possible to have an object count of less than
+ //2, because you must have at least the command name
+ //plus a subcommand. The best way to handle this is
+ //to indicate wrong number of arguments.
+ Tcl_WrongNumArgs(interp,
+ 1,
+ objv,
+ "option ?args?");
+ return(TCL_ERROR);
+ }
+ else
+ {
+ //A potentially appropriate number of arguments has been
+ //specified. Try to look up the subcommand.
+
+ subcommand = Tcl_GetString(objv[1]);
+ //Grab the string representation of the subcommand.
+ //This is constant, belongs to Tcl, and cannot be
+ //modified.
+
+ tbl_entry = EXTNINIT_subextension_bsearch(
+ ARBLENINTS_subextn_tbl,
+ sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0]),
+ subcommand);
+ assert(tbl_entry < (int)(sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0])));
+
+ //If the integer returned is zero or positive, should
+ //run the subfunction. If negative, this is an error and
+ //should generate meaningful message. A meaningful message
+ //would definitely consist of all valid subcommands.
+ if (tbl_entry < 0)
+ {
+ //This is an error path.
+ rv = Tcl_NewStringObj("arbint: bad option \"", -1);
+ subcommand = Tcl_GetString(objv[1]);
+ Tcl_AppendToObj(rv, subcommand, -1);
+ Tcl_AppendToObj(rv, "\": valid options are ", -1);
+
+ for (tbl_entry=0;
+ tbl_entry < sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0]);
+ tbl_entry++)
+ {
+ if ((sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0]) != 1)
+ && (tbl_entry == sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0]) - 1))
+ Tcl_AppendToObj(rv, "and ", -1);
+ Tcl_AppendToObj(rv, ARBLENINTS_subextn_tbl[tbl_entry].name, -1);
+ if (tbl_entry == sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0]) - 1)
+ Tcl_AppendToObj(rv, ".", -1);
+ else
+ Tcl_AppendToObj(rv, ", ", -1);
+ }
+
+ //Now, set the return value to be the object with our
+ //meaningful string message.
+ Tcl_SetObjResult(interp, rv);
+
+ return(TCL_ERROR);
+ }
+ else
+ {
+ //Call the function pointer. Called function will
+ //set the string return value.
+ return((*ARBLENINTS_subextn_tbl[tbl_entry].fptr)
+ (dummy, interp, objc, objv));
+ }
+ }
+ }
+
+
+//Performs initial registration to the hash table.
+//07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
+//from memory an intuition as far as how to set return results and so forth.
+void ARBLENINTS_arbint_extn_init(Tcl_Interp *interp)
+ {
+ //Register a command named "crc32".
+ Tcl_CreateObjCommand(interp,
+ "arbint",
+ (Tcl_ObjCmdProc *)ARBLENINTS_arbint_extn_command,
+ NULL,
+ NULL);
+ }
+
+
+
+//Returns version control string for file.
+//
+const char *ARBLENINTS_cvcinfo(void)
+{
+ return ("$Header$");
+}
+
+
+//Returns version control string for associated .H file.
+//
+const char *ARBLENINTS_hvcinfo(void)
+{
+ return (ARBLENINTS_H_VERSION);
+}
+
+//End of arblenints.c.