/[dtapublic]/projs/trunk/shared_source/c_tclxtens_7_5/arblenints.c
ViewVC logotype

Annotation of /projs/trunk/shared_source/c_tclxtens_7_5/arblenints.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 29 - (hide annotations) (download)
Sat Oct 8 07:08:47 2016 UTC (8 years, 2 months ago) by dashley
Original Path: to_be_filed/sf_code/esrgpcpj/shared/tclxtens/arblenints.c
File MIME type: text/plain
File size: 169987 byte(s)
Directories relocated.
1 dashley 25 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tclxtens/arblenints.c,v 1.12 2001/08/18 09:47:00 dtashley Exp $ */
2    
3     //--------------------------------------------------------------------------------
4     //Copyright 2001 David T. Ashley
5     //-------------------------------------------------------------------------------------------------
6     //This source code and any program in which it is compiled/used is provided under the GNU GENERAL
7     //PUBLIC LICENSE, Version 3, full license text below.
8     //-------------------------------------------------------------------------------------------------
9     // GNU GENERAL PUBLIC LICENSE
10     // Version 3, 29 June 2007
11     //
12     // Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
13     // Everyone is permitted to copy and distribute verbatim copies
14     // of this license document, but changing it is not allowed.
15     //
16     // Preamble
17     //
18     // The GNU General Public License is a free, copyleft license for
19     //software and other kinds of works.
20     //
21     // The licenses for most software and other practical works are designed
22     //to take away your freedom to share and change the works. By contrast,
23     //the GNU General Public License is intended to guarantee your freedom to
24     //share and change all versions of a program--to make sure it remains free
25     //software for all its users. We, the Free Software Foundation, use the
26     //GNU General Public License for most of our software; it applies also to
27     //any other work released this way by its authors. You can apply it to
28     //your programs, too.
29     //
30     // When we speak of free software, we are referring to freedom, not
31     //price. Our General Public Licenses are designed to make sure that you
32     //have the freedom to distribute copies of free software (and charge for
33     //them if you wish), that you receive source code or can get it if you
34     //want it, that you can change the software or use pieces of it in new
35     //free programs, and that you know you can do these things.
36     //
37     // To protect your rights, we need to prevent others from denying you
38     //these rights or asking you to surrender the rights. Therefore, you have
39     //certain responsibilities if you distribute copies of the software, or if
40     //you modify it: responsibilities to respect the freedom of others.
41     //
42     // For example, if you distribute copies of such a program, whether
43     //gratis or for a fee, you must pass on to the recipients the same
44     //freedoms that you received. You must make sure that they, too, receive
45     //or can get the source code. And you must show them these terms so they
46     //know their rights.
47     //
48     // Developers that use the GNU GPL protect your rights with two steps:
49     //(1) assert copyright on the software, and (2) offer you this License
50     //giving you legal permission to copy, distribute and/or modify it.
51     //
52     // For the developers' and authors' protection, the GPL clearly explains
53     //that there is no warranty for this free software. For both users' and
54     //authors' sake, the GPL requires that modified versions be marked as
55     //changed, so that their problems will not be attributed erroneously to
56     //authors of previous versions.
57     //
58     // Some devices are designed to deny users access to install or run
59     //modified versions of the software inside them, although the manufacturer
60     //can do so. This is fundamentally incompatible with the aim of
61     //protecting users' freedom to change the software. The systematic
62     //pattern of such abuse occurs in the area of products for individuals to
63     //use, which is precisely where it is most unacceptable. Therefore, we
64     //have designed this version of the GPL to prohibit the practice for those
65     //products. If such problems arise substantially in other domains, we
66     //stand ready to extend this provision to those domains in future versions
67     //of the GPL, as needed to protect the freedom of users.
68     //
69     // Finally, every program is threatened constantly by software patents.
70     //States should not allow patents to restrict development and use of
71     //software on general-purpose computers, but in those that do, we wish to
72     //avoid the special danger that patents applied to a free program could
73     //make it effectively proprietary. To prevent this, the GPL assures that
74     //patents cannot be used to render the program non-free.
75     //
76     // The precise terms and conditions for copying, distribution and
77     //modification follow.
78     //
79     // TERMS AND CONDITIONS
80     //
81     // 0. Definitions.
82     //
83     // "This License" refers to version 3 of the GNU General Public License.
84     //
85     // "Copyright" also means copyright-like laws that apply to other kinds of
86     //works, such as semiconductor masks.
87     //
88     // "The Program" refers to any copyrightable work licensed under this
89     //License. Each licensee is addressed as "you". "Licensees" and
90     //"recipients" may be individuals or organizations.
91     //
92     // To "modify" a work means to copy from or adapt all or part of the work
93     //in a fashion requiring copyright permission, other than the making of an
94     //exact copy. The resulting work is called a "modified version" of the
95     //earlier work or a work "based on" the earlier work.
96     //
97     // A "covered work" means either the unmodified Program or a work based
98     //on the Program.
99     //
100     // To "propagate" a work means to do anything with it that, without
101     //permission, would make you directly or secondarily liable for
102     //infringement under applicable copyright law, except executing it on a
103     //computer or modifying a private copy. Propagation includes copying,
104     //distribution (with or without modification), making available to the
105     //public, and in some countries other activities as well.
106     //
107     // To "convey" a work means any kind of propagation that enables other
108     //parties to make or receive copies. Mere interaction with a user through
109     //a computer network, with no transfer of a copy, is not conveying.
110     //
111     // An interactive user interface displays "Appropriate Legal Notices"
112     //to the extent that it includes a convenient and prominently visible
113     //feature that (1) displays an appropriate copyright notice, and (2)
114     //tells the user that there is no warranty for the work (except to the
115     //extent that warranties are provided), that licensees may convey the
116     //work under this License, and how to view a copy of this License. If
117     //the interface presents a list of user commands or options, such as a
118     //menu, a prominent item in the list meets this criterion.
119     //
120     // 1. Source Code.
121     //
122     // The "source code" for a work means the preferred form of the work
123     //for making modifications to it. "Object code" means any non-source
124     //form of a work.
125     //
126     // A "Standard Interface" means an interface that either is an official
127     //standard defined by a recognized standards body, or, in the case of
128     //interfaces specified for a particular programming language, one that
129     //is widely used among developers working in that language.
130     //
131     // The "System Libraries" of an executable work include anything, other
132     //than the work as a whole, that (a) is included in the normal form of
133     //packaging a Major Component, but which is not part of that Major
134     //Component, and (b) serves only to enable use of the work with that
135     //Major Component, or to implement a Standard Interface for which an
136     //implementation is available to the public in source code form. A
137     //"Major Component", in this context, means a major essential component
138     //(kernel, window system, and so on) of the specific operating system
139     //(if any) on which the executable work runs, or a compiler used to
140     //produce the work, or an object code interpreter used to run it.
141     //
142     // The "Corresponding Source" for a work in object code form means all
143     //the source code needed to generate, install, and (for an executable
144     //work) run the object code and to modify the work, including scripts to
145     //control those activities. However, it does not include the work's
146     //System Libraries, or general-purpose tools or generally available free
147     //programs which are used unmodified in performing those activities but
148     //which are not part of the work. For example, Corresponding Source
149     //includes interface definition files associated with source files for
150     //the work, and the source code for shared libraries and dynamically
151     //linked subprograms that the work is specifically designed to require,
152     //such as by intimate data communication or control flow between those
153     //subprograms and other parts of the work.
154     //
155     // The Corresponding Source need not include anything that users
156     //can regenerate automatically from other parts of the Corresponding
157     //Source.
158     //
159     // The Corresponding Source for a work in source code form is that
160     //same work.
161     //
162     // 2. Basic Permissions.
163     //
164     // All rights granted under this License are granted for the term of
165     //copyright on the Program, and are irrevocable provided the stated
166     //conditions are met. This License explicitly affirms your unlimited
167     //permission to run the unmodified Program. The output from running a
168     //covered work is covered by this License only if the output, given its
169     //content, constitutes a covered work. This License acknowledges your
170     //rights of fair use or other equivalent, as provided by copyright law.
171     //
172     // You may make, run and propagate covered works that you do not
173     //convey, without conditions so long as your license otherwise remains
174     //in force. You may convey covered works to others for the sole purpose
175     //of having them make modifications exclusively for you, or provide you
176     //with facilities for running those works, provided that you comply with
177     //the terms of this License in conveying all material for which you do
178     //not control copyright. Those thus making or running the covered works
179     //for you must do so exclusively on your behalf, under your direction
180     //and control, on terms that prohibit them from making any copies of
181     //your copyrighted material outside their relationship with you.
182     //
183     // Conveying under any other circumstances is permitted solely under
184     //the conditions stated below. Sublicensing is not allowed; section 10
185     //makes it unnecessary.
186     //
187     // 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
188     //
189     // No covered work shall be deemed part of an effective technological
190     //measure under any applicable law fulfilling obligations under article
191     //11 of the WIPO copyright treaty adopted on 20 December 1996, or
192     //similar laws prohibiting or restricting circumvention of such
193     //measures.
194     //
195     // When you convey a covered work, you waive any legal power to forbid
196     //circumvention of technological measures to the extent such circumvention
197     //is effected by exercising rights under this License with respect to
198     //the covered work, and you disclaim any intention to limit operation or
199     //modification of the work as a means of enforcing, against the work's
200     //users, your or third parties' legal rights to forbid circumvention of
201     //technological measures.
202     //
203     // 4. Conveying Verbatim Copies.
204     //
205     // You may convey verbatim copies of the Program's source code as you
206     //receive it, in any medium, provided that you conspicuously and
207     //appropriately publish on each copy an appropriate copyright notice;
208     //keep intact all notices stating that this License and any
209     //non-permissive terms added in accord with section 7 apply to the code;
210     //keep intact all notices of the absence of any warranty; and give all
211     //recipients a copy of this License along with the Program.
212     //
213     // You may charge any price or no price for each copy that you convey,
214     //and you may offer support or warranty protection for a fee.
215     //
216     // 5. Conveying Modified Source Versions.
217     //
218     // You may convey a work based on the Program, or the modifications to
219     //produce it from the Program, in the form of source code under the
220     //terms of section 4, provided that you also meet all of these conditions:
221     //
222     // a) The work must carry prominent notices stating that you modified
223     // it, and giving a relevant date.
224     //
225     // b) The work must carry prominent notices stating that it is
226     // released under this License and any conditions added under section
227     // 7. This requirement modifies the requirement in section 4 to
228     // "keep intact all notices".
229     //
230     // c) You must license the entire work, as a whole, under this
231     // License to anyone who comes into possession of a copy. This
232     // License will therefore apply, along with any applicable section 7
233     // additional terms, to the whole of the work, and all its parts,
234     // regardless of how they are packaged. This License gives no
235     // permission to license the work in any other way, but it does not
236     // invalidate such permission if you have separately received it.
237     //
238     // d) If the work has interactive user interfaces, each must display
239     // Appropriate Legal Notices; however, if the Program has interactive
240     // interfaces that do not display Appropriate Legal Notices, your
241     // work need not make them do so.
242     //
243     // A compilation of a covered work with other separate and independent
244     //works, which are not by their nature extensions of the covered work,
245     //and which are not combined with it such as to form a larger program,
246     //in or on a volume of a storage or distribution medium, is called an
247     //"aggregate" if the compilation and its resulting copyright are not
248     //used to limit the access or legal rights of the compilation's users
249     //beyond what the individual works permit. Inclusion of a covered work
250     //in an aggregate does not cause this License to apply to the other
251     //parts of the aggregate.
252     //
253     // 6. Conveying Non-Source Forms.
254     //
255     // You may convey a covered work in object code form under the terms
256     //of sections 4 and 5, provided that you also convey the
257     //machine-readable Corresponding Source under the terms of this License,
258     //in one of these ways:
259     //
260     // a) Convey the object code in, or embodied in, a physical product
261     // (including a physical distribution medium), accompanied by the
262     // Corresponding Source fixed on a durable physical medium
263     // customarily used for software interchange.
264     //
265     // b) Convey the object code in, or embodied in, a physical product
266     // (including a physical distribution medium), accompanied by a
267     // written offer, valid for at least three years and valid for as
268     // long as you offer spare parts or customer support for that product
269     // model, to give anyone who possesses the object code either (1) a
270     // copy of the Corresponding Source for all the software in the
271     // product that is covered by this License, on a durable physical
272     // medium customarily used for software interchange, for a price no
273     // more than your reasonable cost of physically performing this
274     // conveying of source, or (2) access to copy the
275     // Corresponding Source from a network server at no charge.
276     //
277     // c) Convey individual copies of the object code with a copy of the
278     // written offer to provide the Corresponding Source. This
279     // alternative is allowed only occasionally and noncommercially, and
280     // only if you received the object code with such an offer, in accord
281     // with subsection 6b.
282     //
283     // d) Convey the object code by offering access from a designated
284     // place (gratis or for a charge), and offer equivalent access to the
285     // Corresponding Source in the same way through the same place at no
286     // further charge. You need not require recipients to copy the
287     // Corresponding Source along with the object code. If the place to
288     // copy the object code is a network server, the Corresponding Source
289     // may be on a different server (operated by you or a third party)
290     // that supports equivalent copying facilities, provided you maintain
291     // clear directions next to the object code saying where to find the
292     // Corresponding Source. Regardless of what server hosts the
293     // Corresponding Source, you remain obligated to ensure that it is
294     // available for as long as needed to satisfy these requirements.
295     //
296     // e) Convey the object code using peer-to-peer transmission, provided
297     // you inform other peers where the object code and Corresponding
298     // Source of the work are being offered to the general public at no
299     // charge under subsection 6d.
300     //
301     // A separable portion of the object code, whose source code is excluded
302     //from the Corresponding Source as a System Library, need not be
303     //included in conveying the object code work.
304     //
305     // A "User Product" is either (1) a "consumer product", which means any
306     //tangible personal property which is normally used for personal, family,
307     //or household purposes, or (2) anything designed or sold for incorporation
308     //into a dwelling. In determining whether a product is a consumer product,
309     //doubtful cases shall be resolved in favor of coverage. For a particular
310     //product received by a particular user, "normally used" refers to a
311     //typical or common use of that class of product, regardless of the status
312     //of the particular user or of the way in which the particular user
313     //actually uses, or expects or is expected to use, the product. A product
314     //is a consumer product regardless of whether the product has substantial
315     //commercial, industrial or non-consumer uses, unless such uses represent
316     //the only significant mode of use of the product.
317     //
318     // "Installation Information" for a User Product means any methods,
319     //procedures, authorization keys, or other information required to install
320     //and execute modified versions of a covered work in that User Product from
321     //a modified version of its Corresponding Source. The information must
322     //suffice to ensure that the continued functioning of the modified object
323     //code is in no case prevented or interfered with solely because
324     //modification has been made.
325     //
326     // If you convey an object code work under this section in, or with, or
327     //specifically for use in, a User Product, and the conveying occurs as
328     //part of a transaction in which the right of possession and use of the
329     //User Product is transferred to the recipient in perpetuity or for a
330     //fixed term (regardless of how the transaction is characterized), the
331     //Corresponding Source conveyed under this section must be accompanied
332     //by the Installation Information. But this requirement does not apply
333     //if neither you nor any third party retains the ability to install
334     //modified object code on the User Product (for example, the work has
335     //been installed in ROM).
336     //
337     // The requirement to provide Installation Information does not include a
338     //requirement to continue to provide support service, warranty, or updates
339     //for a work that has been modified or installed by the recipient, or for
340     //the User Product in which it has been modified or installed. Access to a
341     //network may be denied when the modification itself materially and
342     //adversely affects the operation of the network or violates the rules and
343     //protocols for communication across the network.
344     //
345     // Corresponding Source conveyed, and Installation Information provided,
346     //in accord with this section must be in a format that is publicly
347     //documented (and with an implementation available to the public in
348     //source code form), and must require no special password or key for
349     //unpacking, reading or copying.
350     //
351     // 7. Additional Terms.
352     //
353     // "Additional permissions" are terms that supplement the terms of this
354     //License by making exceptions from one or more of its conditions.
355     //Additional permissions that are applicable to the entire Program shall
356     //be treated as though they were included in this License, to the extent
357     //that they are valid under applicable law. If additional permissions
358     //apply only to part of the Program, that part may be used separately
359     //under those permissions, but the entire Program remains governed by
360     //this License without regard to the additional permissions.
361     //
362     // When you convey a copy of a covered work, you may at your option
363     //remove any additional permissions from that copy, or from any part of
364     //it. (Additional permissions may be written to require their own
365     //removal in certain cases when you modify the work.) You may place
366     //additional permissions on material, added by you to a covered work,
367     //for which you have or can give appropriate copyright permission.
368     //
369     // Notwithstanding any other provision of this License, for material you
370     //add to a covered work, you may (if authorized by the copyright holders of
371     //that material) supplement the terms of this License with terms:
372     //
373     // a) Disclaiming warranty or limiting liability differently from the
374     // terms of sections 15 and 16 of this License; or
375     //
376     // b) Requiring preservation of specified reasonable legal notices or
377     // author attributions in that material or in the Appropriate Legal
378     // Notices displayed by works containing it; or
379     //
380     // c) Prohibiting misrepresentation of the origin of that material, or
381     // requiring that modified versions of such material be marked in
382     // reasonable ways as different from the original version; or
383     //
384     // d) Limiting the use for publicity purposes of names of licensors or
385     // authors of the material; or
386     //
387     // e) Declining to grant rights under trademark law for use of some
388     // trade names, trademarks, or service marks; or
389     //
390     // f) Requiring indemnification of licensors and authors of that
391     // material by anyone who conveys the material (or modified versions of
392     // it) with contractual assumptions of liability to the recipient, for
393     // any liability that these contractual assumptions directly impose on
394     // those licensors and authors.
395     //
396     // All other non-permissive additional terms are considered "further
397     //restrictions" within the meaning of section 10. If the Program as you
398     //received it, or any part of it, contains a notice stating that it is
399     //governed by this License along with a term that is a further
400     //restriction, you may remove that term. If a license document contains
401     //a further restriction but permits relicensing or conveying under this
402     //License, you may add to a covered work material governed by the terms
403     //of that license document, provided that the further restriction does
404     //not survive such relicensing or conveying.
405     //
406     // If you add terms to a covered work in accord with this section, you
407     //must place, in the relevant source files, a statement of the
408     //additional terms that apply to those files, or a notice indicating
409     //where to find the applicable terms.
410     //
411     // Additional terms, permissive or non-permissive, may be stated in the
412     //form of a separately written license, or stated as exceptions;
413     //the above requirements apply either way.
414     //
415     // 8. Termination.
416     //
417     // You may not propagate or modify a covered work except as expressly
418     //provided under this License. Any attempt otherwise to propagate or
419     //modify it is void, and will automatically terminate your rights under
420     //this License (including any patent licenses granted under the third
421     //paragraph of section 11).
422     //
423     // However, if you cease all violation of this License, then your
424     //license from a particular copyright holder is reinstated (a)
425     //provisionally, unless and until the copyright holder explicitly and
426     //finally terminates your license, and (b) permanently, if the copyright
427     //holder fails to notify you of the violation by some reasonable means
428     //prior to 60 days after the cessation.
429     //
430     // Moreover, your license from a particular copyright holder is
431     //reinstated permanently if the copyright holder notifies you of the
432     //violation by some reasonable means, this is the first time you have
433     //received notice of violation of this License (for any work) from that
434     //copyright holder, and you cure the violation prior to 30 days after
435     //your receipt of the notice.
436     //
437     // Termination of your rights under this section does not terminate the
438     //licenses of parties who have received copies or rights from you under
439     //this License. If your rights have been terminated and not permanently
440     //reinstated, you do not qualify to receive new licenses for the same
441     //material under section 10.
442     //
443     // 9. Acceptance Not Required for Having Copies.
444     //
445     // You are not required to accept this License in order to receive or
446     //run a copy of the Program. Ancillary propagation of a covered work
447     //occurring solely as a consequence of using peer-to-peer transmission
448     //to receive a copy likewise does not require acceptance. However,
449     //nothing other than this License grants you permission to propagate or
450     //modify any covered work. These actions infringe copyright if you do
451     //not accept this License. Therefore, by modifying or propagating a
452     //covered work, you indicate your acceptance of this License to do so.
453     //
454     // 10. Automatic Licensing of Downstream Recipients.
455     //
456     // Each time you convey a covered work, the recipient automatically
457     //receives a license from the original licensors, to run, modify and
458     //propagate that work, subject to this License. You are not responsible
459     //for enforcing compliance by third parties with this License.
460     //
461     // An "entity transaction" is a transaction transferring control of an
462     //organization, or substantially all assets of one, or subdividing an
463     //organization, or merging organizations. If propagation of a covered
464     //work results from an entity transaction, each party to that
465     //transaction who receives a copy of the work also receives whatever
466     //licenses to the work the party's predecessor in interest had or could
467     //give under the previous paragraph, plus a right to possession of the
468     //Corresponding Source of the work from the predecessor in interest, if
469     //the predecessor has it or can get it with reasonable efforts.
470     //
471     // You may not impose any further restrictions on the exercise of the
472     //rights granted or affirmed under this License. For example, you may
473     //not impose a license fee, royalty, or other charge for exercise of
474     //rights granted under this License, and you may not initiate litigation
475     //(including a cross-claim or counterclaim in a lawsuit) alleging that
476     //any patent claim is infringed by making, using, selling, offering for
477     //sale, or importing the Program or any portion of it.
478     //
479     // 11. Patents.
480     //
481     // A "contributor" is a copyright holder who authorizes use under this
482     //License of the Program or a work on which the Program is based. The
483     //work thus licensed is called the contributor's "contributor version".
484     //
485     // A contributor's "essential patent claims" are all patent claims
486     //owned or controlled by the contributor, whether already acquired or
487     //hereafter acquired, that would be infringed by some manner, permitted
488     //by this License, of making, using, or selling its contributor version,
489     //but do not include claims that would be infringed only as a
490     //consequence of further modification of the contributor version. For
491     //purposes of this definition, "control" includes the right to grant
492     //patent sublicenses in a manner consistent with the requirements of
493     //this License.
494     //
495     // Each contributor grants you a non-exclusive, worldwide, royalty-free
496     //patent license under the contributor's essential patent claims, to
497     //make, use, sell, offer for sale, import and otherwise run, modify and
498     //propagate the contents of its contributor version.
499     //
500     // In the following three paragraphs, a "patent license" is any express
501     //agreement or commitment, however denominated, not to enforce a patent
502     //(such as an express permission to practice a patent or covenant not to
503     //sue for patent infringement). To "grant" such a patent license to a
504     //party means to make such an agreement or commitment not to enforce a
505     //patent against the party.
506     //
507     // If you convey a covered work, knowingly relying on a patent license,
508     //and the Corresponding Source of the work is not available for anyone
509     //to copy, free of charge and under the terms of this License, through a
510     //publicly available network server or other readily accessible means,
511     //then you must either (1) cause the Corresponding Source to be so
512     //available, or (2) arrange to deprive yourself of the benefit of the
513     //patent license for this particular work, or (3) arrange, in a manner
514     //consistent with the requirements of this License, to extend the patent
515     //license to downstream recipients. "Knowingly relying" means you have
516     //actual knowledge that, but for the patent license, your conveying the
517     //covered work in a country, or your recipient's use of the covered work
518     //in a country, would infringe one or more identifiable patents in that
519     //country that you have reason to believe are valid.
520     //
521     // If, pursuant to or in connection with a single transaction or
522     //arrangement, you convey, or propagate by procuring conveyance of, a
523     //covered work, and grant a patent license to some of the parties
524     //receiving the covered work authorizing them to use, propagate, modify
525     //or convey a specific copy of the covered work, then the patent license
526     //you grant is automatically extended to all recipients of the covered
527     //work and works based on it.
528     //
529     // A patent license is "discriminatory" if it does not include within
530     //the scope of its coverage, prohibits the exercise of, or is
531     //conditioned on the non-exercise of one or more of the rights that are
532     //specifically granted under this License. You may not convey a covered
533     //work if you are a party to an arrangement with a third party that is
534     //in the business of distributing software, under which you make payment
535     //to the third party based on the extent of your activity of conveying
536     //the work, and under which the third party grants, to any of the
537     //parties who would receive the covered work from you, a discriminatory
538     //patent license (a) in connection with copies of the covered work
539     //conveyed by you (or copies made from those copies), or (b) primarily
540     //for and in connection with specific products or compilations that
541     //contain the covered work, unless you entered into that arrangement,
542     //or that patent license was granted, prior to 28 March 2007.
543     //
544     // Nothing in this License shall be construed as excluding or limiting
545     //any implied license or other defenses to infringement that may
546     //otherwise be available to you under applicable patent law.
547     //
548     // 12. No Surrender of Others' Freedom.
549     //
550     // If conditions are imposed on you (whether by court order, agreement or
551     //otherwise) that contradict the conditions of this License, they do not
552     //excuse you from the conditions of this License. If you cannot convey a
553     //covered work so as to satisfy simultaneously your obligations under this
554     //License and any other pertinent obligations, then as a consequence you may
555     //not convey it at all. For example, if you agree to terms that obligate you
556     //to collect a royalty for further conveying from those to whom you convey
557     //the Program, the only way you could satisfy both those terms and this
558     //License would be to refrain entirely from conveying the Program.
559     //
560     // 13. Use with the GNU Affero General Public License.
561     //
562     // Notwithstanding any other provision of this License, you have
563     //permission to link or combine any covered work with a work licensed
564     //under version 3 of the GNU Affero General Public License into a single
565     //combined work, and to convey the resulting work. The terms of this
566     //License will continue to apply to the part which is the covered work,
567     //but the special requirements of the GNU Affero General Public License,
568     //section 13, concerning interaction through a network will apply to the
569     //combination as such.
570     //
571     // 14. Revised Versions of this License.
572     //
573     // The Free Software Foundation may publish revised and/or new versions of
574     //the GNU General Public License from time to time. Such new versions will
575     //be similar in spirit to the present version, but may differ in detail to
576     //address new problems or concerns.
577     //
578     // Each version is given a distinguishing version number. If the
579     //Program specifies that a certain numbered version of the GNU General
580     //Public License "or any later version" applies to it, you have the
581     //option of following the terms and conditions either of that numbered
582     //version or of any later version published by the Free Software
583     //Foundation. If the Program does not specify a version number of the
584     //GNU General Public License, you may choose any version ever published
585     //by the Free Software Foundation.
586     //
587     // If the Program specifies that a proxy can decide which future
588     //versions of the GNU General Public License can be used, that proxy's
589     //public statement of acceptance of a version permanently authorizes you
590     //to choose that version for the Program.
591     //
592     // Later license versions may give you additional or different
593     //permissions. However, no additional obligations are imposed on any
594     //author or copyright holder as a result of your choosing to follow a
595     //later version.
596     //
597     // 15. Disclaimer of Warranty.
598     //
599     // THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
600     //APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
601     //HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
602     //OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
603     //THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
604     //PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
605     //IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
606     //ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
607     //
608     // 16. Limitation of Liability.
609     //
610     // IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
611     //WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
612     //THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
613     //GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
614     //USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
615     //DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
616     //PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
617     //EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
618     //SUCH DAMAGES.
619     //
620     // 17. Interpretation of Sections 15 and 16.
621     //
622     // If the disclaimer of warranty and limitation of liability provided
623     //above cannot be given local legal effect according to their terms,
624     //reviewing courts shall apply local law that most closely approximates
625     //an absolute waiver of all civil liability in connection with the
626     //Program, unless a warranty or assumption of liability accompanies a
627     //copy of the Program in return for a fee.
628     //
629     // END OF TERMS AND CONDITIONS
630     //
631     // How to Apply These Terms to Your New Programs
632     //
633     // If you develop a new program, and you want it to be of the greatest
634     //possible use to the public, the best way to achieve this is to make it
635     //free software which everyone can redistribute and change under these terms.
636     //
637     // To do so, attach the following notices to the program. It is safest
638     //to attach them to the start of each source file to most effectively
639     //state the exclusion of warranty; and each file should have at least
640     //the "copyright" line and a pointer to where the full notice is found.
641     //
642     // <one line to give the program's name and a brief idea of what it does.>
643     // Copyright (C) <year> <name of author>
644     //
645     // This program is free software: you can redistribute it and/or modify
646     // it under the terms of the GNU General Public License as published by
647     // the Free Software Foundation, either version 3 of the License, or
648     // (at your option) any later version.
649     //
650     // This program is distributed in the hope that it will be useful,
651     // but WITHOUT ANY WARRANTY; without even the implied warranty of
652     // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
653     // GNU General Public License for more details.
654     //
655     // You should have received a copy of the GNU General Public License
656     // along with this program. If not, see <http://www.gnu.org/licenses/>.
657     //
658     //Also add information on how to contact you by electronic and paper mail.
659     //
660     // If the program does terminal interaction, make it output a short
661     //notice like this when it starts in an interactive mode:
662     //
663     // <program> Copyright (C) <year> <name of author>
664     // This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
665     // This is free software, and you are welcome to redistribute it
666     // under certain conditions; type `show c' for details.
667     //
668     //The hypothetical commands `show w' and `show c' should show the appropriate
669     //parts of the General Public License. Of course, your program's commands
670     //might be different; for a GUI interface, you would use an "about box".
671     //
672     // You should also get your employer (if you work as a programmer) or school,
673     //if any, to sign a "copyright disclaimer" for the program, if necessary.
674     //For more information on this, and how to apply and follow the GNU GPL, see
675     //<http://www.gnu.org/licenses/>.
676     //
677     // The GNU General Public License does not permit incorporating your program
678     //into proprietary programs. If your program is a subroutine library, you
679     //may consider it more useful to permit linking proprietary applications with
680     //the library. If this is what you want to do, use the GNU Lesser General
681     //Public License instead of this License. But first, please read
682     //<http://www.gnu.org/philosophy/why-not-lgpl.html>.
683     //-------------------------------------------------------------------------------------------------
684     //--------------------------------------------------------------------------------
685     #define MODULE_ARBLENINTS
686    
687     #include <assert.h>
688     #include <string.h>
689    
690     #include "tcl.h"
691     #include "tcldecls.h"
692    
693     #include "arblenints.h"
694     #include "bstrfunc.h"
695     #include "extninit.h"
696     #include "gmp_ints.h"
697     #include "gmp_rats.h"
698     #include "gmp_ralg.h"
699     #include "intfunc.h"
700     #include "tclalloc.h"
701    
702    
703     //Handles the "cfbrapab" subextension.
704     //08/16/01: Visual inspection OK.
705     static
706     int ARBLENINTS_cfbrapab_handler(ClientData dummy,
707     Tcl_Interp *interp,
708     int objc,
709     Tcl_Obj *objv[])
710     {
711     Tcl_Obj *rv;
712    
713     //We must have at least two additional arguments
714     //to this extension.
715     if (objc < 4)
716     {
717     Tcl_WrongNumArgs(interp,
718     2,
719     objv,
720     "srn uint_kmax ?uint_hmax? ?options?");
721     return(TCL_ERROR);
722     }
723     else
724     {
725     char *input_arg;
726     int failure, first_dashed_parameter;
727     char *string_result;
728     int string_result_n_allocd;
729     int chars_reqd;
730     int i;
731     int pred_option_specified = 0;
732     int succ_option_specified = 0;
733     int neversmaller_option_specified = 0;
734     int neverlarger_option_specified = 0;
735     int n_option_specified = 0;
736     unsigned n = 0;
737    
738     GMP_RATS_mpq_struct q_rn;
739     GMP_INTS_mpz_struct z_kmax;
740     GMP_INTS_mpz_struct z_hmax;
741    
742     //Allocate dynamic memory.
743     GMP_RATS_mpq_init(&q_rn);
744     GMP_INTS_mpz_init(&z_kmax);
745     GMP_INTS_mpz_init(&z_hmax);
746    
747     //Grab a pointer to the string representation of
748     //the first input argument. The storage does not belong to us.
749     input_arg = Tcl_GetString(objv[2]);
750     assert(input_arg != NULL);
751    
752     //Try to parse our first input string as a rational number.
753     //If we are not successful in this, must abort.
754     GMP_RATS_mpq_set_all_format_rat_num(input_arg,
755     &failure,
756     &q_rn);
757    
758     if (failure)
759     {
760     rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1);
761     Tcl_AppendToObj(rv, input_arg, -1);
762    
763     Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
764     Tcl_SetObjResult(interp, rv);
765    
766     GMP_RATS_mpq_clear(&q_rn);
767     GMP_INTS_mpz_clear(&z_kmax);
768     GMP_INTS_mpz_clear(&z_hmax);
769    
770     return(TCL_ERROR);
771     }
772    
773     //Try to parse our next argument as an integer, which
774     //will be KMAX. This must be specified.
775     //
776     //Get string pointer. Storage does not belong to us.
777     input_arg = Tcl_GetString(objv[3]);
778     assert(input_arg != NULL);
779    
780     //Try to convert KMAX to an integer. Fatal if an error,
781     //and fatal if the argument is zero or negative.
782     GMP_INTS_mpz_set_general_int(&z_kmax, &failure, input_arg);
783    
784     //If there was a parse failure or if the integer is zero
785     //or negative, must flag error.
786     if (failure || GMP_INTS_mpz_is_neg(&z_kmax) || GMP_INTS_mpz_is_zero(&z_kmax))
787     {
788     rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1);
789     Tcl_AppendToObj(rv, input_arg, -1);
790     Tcl_AppendToObj(rv, "\" is not a recognized positive integer.", -1);
791     Tcl_SetObjResult(interp, rv);
792    
793     GMP_RATS_mpq_clear(&q_rn);
794     GMP_INTS_mpz_clear(&z_kmax);
795     GMP_INTS_mpz_clear(&z_hmax);
796    
797     return(TCL_ERROR);
798     }
799    
800     //We need to look for HMAX as the next parameter, if it exists.
801     //The way we will figure this out is by whether the
802     //parameter begins with a "-" or not.
803     if (objc >= 5)
804     {
805     input_arg = Tcl_GetString(objv[4]);
806     assert(input_arg != NULL);
807    
808     if (input_arg[0] == '-')
809     {
810     first_dashed_parameter = 4;
811     }
812     else
813     {
814     first_dashed_parameter = 5;
815     }
816     }
817     else
818     {
819     first_dashed_parameter = 4;
820     }
821    
822     //If there is another parameter and it
823     //doesn't begin with a dash, try to parse
824     //it as HMAX. We don't explicitly record whether
825     //HMAX is specified, because zero is a signal
826     //when calculating Farey neighbors that HMAX isn't
827     //to be considered.
828     if ((objc >= 5) && (first_dashed_parameter == 5))
829     {
830     //Get string pointer. Storage does not belong to us.
831     input_arg = Tcl_GetString(objv[4]);
832     assert(input_arg != NULL);
833    
834     //Try to convert HMAX to an integer. Fatal if an error,
835     //and fatal if the argument is zero or negative.
836     GMP_INTS_mpz_set_general_int(&z_hmax, &failure, input_arg);
837    
838     //If there was a parse failure or if the integer is zero
839     //or negative, must flag error.
840     if (failure || GMP_INTS_mpz_is_neg(&z_hmax) || GMP_INTS_mpz_is_zero(&z_hmax))
841     {
842     rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1);
843     Tcl_AppendToObj(rv, input_arg, -1);
844     Tcl_AppendToObj(rv, "\" is not a recognized positive integer.", -1);
845     Tcl_SetObjResult(interp, rv);
846    
847     GMP_RATS_mpq_clear(&q_rn);
848     GMP_INTS_mpz_clear(&z_kmax);
849     GMP_INTS_mpz_clear(&z_hmax);
850    
851     return(TCL_ERROR);
852     }
853     }
854    
855     //Process all of the dashed command-line arguments.
856     //This involves iterating through all of the
857     //parameters and processing them.
858     for (i=first_dashed_parameter; i<objc; i++)
859     {
860     input_arg = Tcl_GetString(objv[i]);
861     assert(input_arg != NULL);
862    
863     if (!strcmp("-pred", input_arg))
864     {
865     pred_option_specified = 1;
866     }
867     else if (!strcmp("-succ", input_arg))
868     {
869     succ_option_specified = 1;
870     }
871     else if (!strcmp("-neversmaller", input_arg))
872     {
873     neversmaller_option_specified = 1;
874     }
875     else if (!strcmp("-neverlarger", input_arg))
876     {
877     neverlarger_option_specified = 1;
878     }
879     else if (!strcmp("-n", input_arg))
880     {
881     n_option_specified = 1;
882    
883     //If -n was specified, there must be a following
884     //parameter which supplies the integer. First
885     //check for existence of an additional parameter.
886     if (i >= (objc - 1))
887     {
888     rv = Tcl_NewStringObj("arbint cfbrapab: -n option specified without following integer.", -1);
889     Tcl_SetObjResult(interp, rv);
890    
891     GMP_RATS_mpq_clear(&q_rn);
892     GMP_INTS_mpz_clear(&z_kmax);
893     GMP_INTS_mpz_clear(&z_hmax);
894    
895     return(TCL_ERROR);
896     }
897    
898     //We have at least one additional parameter. Try
899     //to parse out the next parameter as the integer
900     //we need for n.
901     i++;
902    
903     input_arg = Tcl_GetString(objv[i]);
904     assert(input_arg != NULL);
905    
906     GMP_INTS_mpz_parse_into_uint32(&n, &failure, input_arg);
907    
908     //If the parse was unsuccessful, terminate.
909     if (failure)
910     {
911     rv = Tcl_NewStringObj("arbint cfbrapab: -n option followed by invalid integer.", -1);
912     Tcl_SetObjResult(interp, rv);
913    
914     GMP_RATS_mpq_clear(&q_rn);
915     GMP_INTS_mpz_clear(&z_kmax);
916     GMP_INTS_mpz_clear(&z_hmax);
917    
918     return(TCL_ERROR);
919     }
920    
921     //Clip the integer into a 24-bit quantity.
922     n &= 0x00FFFFFF;
923     }
924     else
925     {
926     //Unrecognized option. Crash out.
927     rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1);
928     Tcl_AppendToObj(rv, input_arg, -1);
929     Tcl_AppendToObj(rv, "\" is not a recognized option.", -1);
930     Tcl_SetObjResult(interp, rv);
931    
932     GMP_RATS_mpq_clear(&q_rn);
933     GMP_INTS_mpz_clear(&z_kmax);
934     GMP_INTS_mpz_clear(&z_hmax);
935    
936     return(TCL_ERROR);
937     }
938     }
939    
940     //Look for any mutually exclusive options. Give a catchall if any of
941     //them specified. Because we set them all to 1, addition is the easiest
942     //way to do this.
943     if ((pred_option_specified + succ_option_specified + neversmaller_option_specified
944     + neverlarger_option_specified + n_option_specified) > 1)
945     {
946     rv = Tcl_NewStringObj("arbint cfbrapab: -pred, -succ, -neversmaller, -neverlarger, and -n are mutually exclusive options.", -1);
947     Tcl_SetObjResult(interp, rv);
948    
949     GMP_RATS_mpq_clear(&q_rn);
950     GMP_INTS_mpz_clear(&z_kmax);
951     GMP_INTS_mpz_clear(&z_hmax);
952    
953     return(TCL_ERROR);
954     }
955    
956     //Split into cases based on what we're doing. This is wasteful of code,
957     //but this is a PC application, not an embedded application. In all cases
958     //create a hard error if something goes wrong. Any anomalies should trash
959     //a script.
960     if (!pred_option_specified && !succ_option_specified && !n_option_specified)
961     {
962     //This is the traditional best approximation case, with the possibility of
963     //the -neverlarger or -neversmaller being specified. This is the most messy
964     //of all the cases. We must gather neighbors and figure out which is closer,
965     //and if there is a tie, which has the smaller magnitude. It is fairly
966     //messy.
967     GMP_RALG_fab_neighbor_collection_struct neighbor_data;
968     GMP_RATS_mpq_struct left_neigh, right_neigh, diff_left, diff_right, closer_neighbor;
969     int dist_cmp;
970     int mag_cmp;
971    
972     //Allocate inner dynamic variables.
973     GMP_RATS_mpq_init(&left_neigh);
974     GMP_RATS_mpq_init(&right_neigh);
975     GMP_RATS_mpq_init(&diff_left);
976     GMP_RATS_mpq_init(&diff_right);
977     GMP_RATS_mpq_init(&closer_neighbor);
978    
979     //Form up the neighbor data. We're only looking for up to one neighbor on each
980     //side.
981     GMP_RALG_consecutive_fab_terms(
982     &q_rn,
983     &z_kmax,
984     &z_hmax,
985     1,
986     1,
987     &neighbor_data
988     );
989    
990     //If there was an error or we couldn't get any neighbors to play with, give
991     //an error return. As long as we have one neighbor on either side, we can definitely
992     //complete.
993     if (neighbor_data.error || (!neighbor_data.equality && (!neighbor_data.n_left_out || !neighbor_data.n_right_out)))
994     {
995     rv = Tcl_NewStringObj("arbint cfbrapab: unable to form neighbors.", -1);
996     Tcl_SetObjResult(interp, rv);
997    
998     GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
999     GMP_RATS_mpq_clear(&q_rn);
1000     GMP_INTS_mpz_clear(&z_kmax);
1001     GMP_INTS_mpz_clear(&z_hmax);
1002    
1003     GMP_RATS_mpq_clear(&left_neigh);
1004     GMP_RATS_mpq_clear(&right_neigh);
1005     GMP_RATS_mpq_clear(&diff_left);
1006     GMP_RATS_mpq_clear(&diff_right);
1007     GMP_RATS_mpq_clear(&closer_neighbor);
1008    
1009     return(TCL_ERROR);
1010     }
1011    
1012     if (neighbor_data.equality)
1013     {
1014     //The equality case takes precedence, always.
1015     GMP_RATS_mpq_copy(&closer_neighbor, &(neighbor_data.norm_rn));
1016     }
1017     else
1018     {
1019     //The boolean test somewhat above guaranteed that we have both left
1020     //and right neighbors. We can assume this.
1021     GMP_RATS_mpq_copy(&left_neigh, &(neighbor_data.lefts[0].neighbor));
1022     GMP_RATS_mpq_copy(&right_neigh, &(neighbor_data.rights[0].neighbor));
1023    
1024     GMP_RATS_mpq_sub(&diff_left, &left_neigh, &(neighbor_data.norm_rn));
1025     GMP_RATS_mpq_sub(&diff_right, &right_neigh, &(neighbor_data.norm_rn));
1026     GMP_INTS_mpz_abs(&(diff_left.num));
1027     GMP_INTS_mpz_abs(&(diff_right.num));
1028     dist_cmp = GMP_RATS_mpq_cmp(&diff_left, &diff_right, NULL);
1029    
1030     //If we have a tie on the distance, will need to revert to magnitude of the neighbors.
1031     GMP_INTS_mpz_abs(&(left_neigh.num));
1032     GMP_INTS_mpz_abs(&(right_neigh.num));
1033     mag_cmp = GMP_RATS_mpq_cmp(&left_neigh, &right_neigh, NULL);
1034    
1035     if (!neversmaller_option_specified
1036     &&
1037     (neverlarger_option_specified || (dist_cmp < 0) || ((dist_cmp==0) && (mag_cmp < 0))))
1038     {
1039     GMP_RATS_mpq_copy(&closer_neighbor, &(neighbor_data.lefts[0].neighbor));
1040     }
1041     else
1042     {
1043     GMP_RATS_mpq_copy(&closer_neighbor, &(neighbor_data.rights[0].neighbor));
1044     }
1045     }
1046    
1047     //Stuff our variable of choice into a string ...
1048     chars_reqd = INTFUNC_max(
1049     GMP_INTS_mpz_size_in_base_10(&(closer_neighbor.num)),
1050     GMP_INTS_mpz_size_in_base_10(&(closer_neighbor.den))
1051     );
1052     string_result = TclpAlloc(sizeof(char) * chars_reqd);
1053     assert(string_result != NULL);
1054    
1055     GMP_INTS_mpz_to_string(string_result, &(closer_neighbor.num));
1056     rv = Tcl_NewStringObj(string_result, -1);
1057     Tcl_AppendToObj(rv, "/", -1);
1058     GMP_INTS_mpz_to_string(string_result, &(closer_neighbor.den));
1059     Tcl_AppendToObj(rv, string_result, -1);
1060    
1061     Tcl_SetObjResult(interp, rv);
1062    
1063     //Deallocate variables, make normal return.
1064     TclpFree(string_result);
1065     GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
1066     GMP_RATS_mpq_clear(&q_rn);
1067     GMP_INTS_mpz_clear(&z_kmax);
1068     GMP_INTS_mpz_clear(&z_hmax);
1069    
1070     GMP_RATS_mpq_clear(&left_neigh);
1071     GMP_RATS_mpq_clear(&right_neigh);
1072     GMP_RATS_mpq_clear(&diff_left);
1073     GMP_RATS_mpq_clear(&diff_right);
1074     GMP_RATS_mpq_clear(&closer_neighbor);
1075    
1076     return(TCL_OK);
1077     }
1078     else if (n_option_specified)
1079     {
1080     char sbuf[50];
1081     //Static buffer just to stage 32-bit integers.
1082    
1083     //Multiple neighbors. Must iterate through.
1084    
1085     GMP_RALG_fab_neighbor_collection_struct neighbor_data;
1086    
1087     //Form up the neighbor data.
1088     GMP_RALG_consecutive_fab_terms(
1089     &q_rn,
1090     &z_kmax,
1091     &z_hmax,
1092     n,
1093     n,
1094     &neighbor_data
1095     );
1096    
1097     //If there was an error forming up the neighbor data, create a hard error.
1098     if (neighbor_data.error)
1099     {
1100     rv = Tcl_NewStringObj("arbint cfbrapab: unable to form neighbors.", -1);
1101     Tcl_SetObjResult(interp, rv);
1102    
1103     GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
1104     GMP_RATS_mpq_clear(&q_rn);
1105     GMP_INTS_mpz_clear(&z_kmax);
1106     GMP_INTS_mpz_clear(&z_hmax);
1107    
1108     return(TCL_ERROR);
1109     }
1110    
1111     //Allocate a default buffer of 10K for the ASCII representation of integers.
1112     //In the vast majority of cases, there will be only one allocation, because it
1113     //takes a mean integer to exceed 10K. However, the logic allows it to grow.
1114     string_result_n_allocd = 10000;
1115     string_result = TclpAlloc(sizeof(char) * string_result_n_allocd);
1116     assert(string_result != NULL);
1117    
1118     //Start off with a return value of the null string.
1119     rv = Tcl_NewStringObj("", -1);
1120    
1121     //Loop through, spitting out the left neighbors.
1122     for (i = neighbor_data.n_left_out-1; i >= 0; i--)
1123     {
1124     //The protocol here is everyone spits out one space before
1125     //they print anything. Must skip this on first loop iteration.
1126     if (i != neighbor_data.n_left_out-1)
1127     Tcl_AppendToObj(rv, " ", -1);
1128    
1129     //The index will be the negative of the iteration variable minus one.
1130     sprintf(sbuf, "%d", -i - 1);
1131     Tcl_AppendToObj(rv, sbuf, -1);
1132    
1133     //Force the buffer to have enough space for the components of the rational
1134     //number.
1135     chars_reqd = INTFUNC_max(
1136     GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[i].neighbor.num)),
1137     GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[i].neighbor.den))
1138     );
1139     if (chars_reqd > string_result_n_allocd)
1140     {
1141     string_result_n_allocd = chars_reqd;
1142     string_result = TclpRealloc(string_result, sizeof(char) * string_result_n_allocd);
1143     assert(string_result != NULL);
1144     }
1145    
1146     //Print the rational number out to the Tcl object.
1147     Tcl_AppendToObj(rv, " ", -1);
1148     GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[i].neighbor.num));
1149     Tcl_AppendToObj(rv, string_result, -1);
1150     Tcl_AppendToObj(rv, "/", -1);
1151     GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[i].neighbor.den));
1152     Tcl_AppendToObj(rv, string_result, -1);
1153     }
1154    
1155     //Spit out the equality case if appropriate.
1156     if (neighbor_data.equality)
1157     {
1158     if (neighbor_data.n_left_out)
1159     Tcl_AppendToObj(rv, " ", -1);
1160    
1161     Tcl_AppendToObj(rv, "0", -1);
1162    
1163     //Force the buffer to have enough space for the components of the rational
1164     //number.
1165     chars_reqd = INTFUNC_max(
1166     GMP_INTS_mpz_size_in_base_10(&(neighbor_data.norm_rn.num)),
1167     GMP_INTS_mpz_size_in_base_10(&(neighbor_data.norm_rn.den))
1168     );
1169     if (chars_reqd > string_result_n_allocd)
1170     {
1171     string_result_n_allocd = chars_reqd;
1172     string_result = TclpRealloc(string_result, sizeof(char) * string_result_n_allocd);
1173     assert(string_result != NULL);
1174     }
1175    
1176     //Print the rational number out to the Tcl object.
1177     Tcl_AppendToObj(rv, " ", -1);
1178     GMP_INTS_mpz_to_string(string_result, &(neighbor_data.norm_rn.num));
1179     Tcl_AppendToObj(rv, string_result, -1);
1180     Tcl_AppendToObj(rv, "/", -1);
1181     GMP_INTS_mpz_to_string(string_result, &(neighbor_data.norm_rn.den));
1182     Tcl_AppendToObj(rv, string_result, -1);
1183     }
1184    
1185     //Loop through, spitting out the right neighbors.
1186     for (i = 0; i < neighbor_data.n_right_out; i++)
1187     {
1188     //The protocol here is everyone spits out one space before
1189     //they print anything. Must skip this on first loop iteration.
1190     if (neighbor_data.n_left_out || neighbor_data.equality || i)
1191     Tcl_AppendToObj(rv, " ", -1);
1192    
1193     //The index will be the iteration variable plus one.
1194     sprintf(sbuf, "%d", i+1);
1195     Tcl_AppendToObj(rv, sbuf, -1);
1196    
1197     //Force the buffer to have enough space for the components of the rational
1198     //number.
1199     chars_reqd = INTFUNC_max(
1200     GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[i].neighbor.num)),
1201     GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[i].neighbor.den))
1202     );
1203     if (chars_reqd > string_result_n_allocd)
1204     {
1205     string_result_n_allocd = chars_reqd;
1206     string_result = TclpRealloc(string_result, sizeof(char) * string_result_n_allocd);
1207     assert(string_result != NULL);
1208     }
1209    
1210     //Print the rational number out to the Tcl object.
1211     Tcl_AppendToObj(rv, " ", -1);
1212     GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[i].neighbor.num));
1213     Tcl_AppendToObj(rv, string_result, -1);
1214     Tcl_AppendToObj(rv, "/", -1);
1215     GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[i].neighbor.den));
1216     Tcl_AppendToObj(rv, string_result, -1);
1217     }
1218    
1219     //Set up for a normal return.
1220     Tcl_SetObjResult(interp, rv);
1221    
1222     TclpFree(string_result);
1223     GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
1224     GMP_RATS_mpq_clear(&q_rn);
1225     GMP_INTS_mpz_clear(&z_kmax);
1226     GMP_INTS_mpz_clear(&z_hmax);
1227    
1228     return(TCL_OK);
1229     }
1230     else if (pred_option_specified)
1231     {
1232     //Simple predecessor case.
1233    
1234     GMP_RALG_fab_neighbor_collection_struct neighbor_data;
1235    
1236     //Form up the neighbor data.
1237     GMP_RALG_consecutive_fab_terms(
1238     &q_rn,
1239     &z_kmax,
1240     &z_hmax,
1241     1,
1242     0,
1243     &neighbor_data
1244     );
1245    
1246     //If there was an error forming up the neighbor data or there are no left neighbors,
1247     //create a hard error.
1248     if (neighbor_data.error || !neighbor_data.n_left_out)
1249     {
1250     rv = Tcl_NewStringObj("arbint cfbrapab: unable to find predecessor.", -1);
1251     Tcl_SetObjResult(interp, rv);
1252    
1253     GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
1254     GMP_RATS_mpq_clear(&q_rn);
1255     GMP_INTS_mpz_clear(&z_kmax);
1256     GMP_INTS_mpz_clear(&z_hmax);
1257    
1258     return(TCL_ERROR);
1259     }
1260    
1261     //The test above confirmed that we have at least one left neighbor calculated.
1262     //We can dump it to a string and finish up.
1263     chars_reqd = INTFUNC_max(
1264     GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[0].neighbor.num)),
1265     GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[0].neighbor.den))
1266     );
1267     string_result = TclpAlloc(sizeof(char) * chars_reqd);
1268     assert(string_result != NULL);
1269    
1270     GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[0].neighbor.num));
1271     rv = Tcl_NewStringObj(string_result, -1);
1272     Tcl_AppendToObj(rv, "/", -1);
1273     GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[0].neighbor.den));
1274     Tcl_AppendToObj(rv, string_result, -1);
1275    
1276     Tcl_SetObjResult(interp, rv);
1277    
1278     TclpFree(string_result);
1279     GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
1280     GMP_RATS_mpq_clear(&q_rn);
1281     GMP_INTS_mpz_clear(&z_kmax);
1282     GMP_INTS_mpz_clear(&z_hmax);
1283    
1284     return(TCL_OK);
1285     }
1286     else if (succ_option_specified)
1287     {
1288     //Simple successor.
1289    
1290     GMP_RALG_fab_neighbor_collection_struct neighbor_data;
1291    
1292     //Form up the neighbor data.
1293     GMP_RALG_consecutive_fab_terms(
1294     &q_rn,
1295     &z_kmax,
1296     &z_hmax,
1297     0,
1298     1,
1299     &neighbor_data
1300     );
1301    
1302     //If there was an error forming up the neighbor data or there are no right neighbors,
1303     //create a hard error.
1304     if (neighbor_data.error || !neighbor_data.n_right_out)
1305     {
1306     rv = Tcl_NewStringObj("arbint cfbrapab: unable to find successor.", -1);
1307     Tcl_SetObjResult(interp, rv);
1308    
1309     GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
1310     GMP_RATS_mpq_clear(&q_rn);
1311     GMP_INTS_mpz_clear(&z_kmax);
1312     GMP_INTS_mpz_clear(&z_hmax);
1313    
1314     return(TCL_ERROR);
1315     }
1316    
1317     //The test above confirmed that we have at least one right neighbor calculated.
1318     //We can dump it to a string and finish up.
1319     chars_reqd = INTFUNC_max(
1320     GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[0].neighbor.num)),
1321     GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[0].neighbor.den))
1322     );
1323     string_result = TclpAlloc(sizeof(char) * chars_reqd);
1324     assert(string_result != NULL);
1325    
1326     GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[0].neighbor.num));
1327     rv = Tcl_NewStringObj(string_result, -1);
1328     Tcl_AppendToObj(rv, "/", -1);
1329     GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[0].neighbor.den));
1330     Tcl_AppendToObj(rv, string_result, -1);
1331    
1332     Tcl_SetObjResult(interp, rv);
1333    
1334     TclpFree(string_result);
1335     GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data);
1336     GMP_RATS_mpq_clear(&q_rn);
1337     GMP_INTS_mpz_clear(&z_kmax);
1338     GMP_INTS_mpz_clear(&z_hmax);
1339    
1340     return(TCL_OK);
1341     }
1342    
1343     //Free up all dynamic memory.
1344     GMP_RATS_mpq_clear(&q_rn);
1345     GMP_INTS_mpz_clear(&z_kmax);
1346     GMP_INTS_mpz_clear(&z_hmax);
1347    
1348     //Return
1349     return(TCL_OK);
1350     }
1351     }
1352    
1353    
1354     //Handles the "cfratnum" subextension.
1355     //08/07/01: Visually inspected, OK.
1356     static
1357     int ARBLENINTS_cfratnum_handler(ClientData dummy,
1358     Tcl_Interp *interp,
1359     int objc,
1360     Tcl_Obj *objv[])
1361     {
1362     Tcl_Obj *rv;
1363    
1364     //We must have exactly one additional argument
1365     //to this function, which is the rational number
1366     //whose continued fraction decomposition is to be
1367     //calculated.
1368     if (objc != 3)
1369     {
1370     Tcl_WrongNumArgs(interp,
1371     2,
1372     objv,
1373     "urn");
1374     return(TCL_ERROR);
1375     }
1376     else
1377     {
1378     char *input_arg;
1379     int failure;
1380     unsigned chars_reqd;
1381     char *string_result;
1382     int n_string_result;
1383     int i;
1384     GMP_RATS_mpq_struct rn;
1385     GMP_RALG_cf_app_struct decomp;
1386    
1387     //In this function, we are going to return a string
1388     //result formed by starting with a string and then
1389     //concatenating to it again and again. We start
1390     //off believing that 10,000 characters of space is enough,
1391     //but we may need to revise upward and reallocate.
1392     //A 10,000 character block is chosen because it is quick
1393     //to allocate and most times won't go beyond that.
1394     n_string_result = 10000;
1395     string_result = TclpAlloc(sizeof(char) * n_string_result);
1396     assert(string_result != NULL);
1397    
1398     //We will need a rational number to hold the return value
1399     //from the parsing function. Allocate that now.
1400     GMP_RATS_mpq_init(&rn);
1401    
1402     //Grab a pointer to the string representation of
1403     //the input argument. The storage does not belong to us.
1404     input_arg = Tcl_GetString(objv[2]);
1405     assert(input_arg != NULL);
1406    
1407     //Try to parse our input string as a rational number.
1408     //If we are not successful in this, must abort.
1409     GMP_RATS_mpq_set_all_format_rat_num(input_arg,
1410     &failure,
1411     &rn);
1412    
1413     if (failure)
1414     {
1415     rv = Tcl_NewStringObj("arbint cfratnum: \"", -1);
1416     Tcl_AppendToObj(rv, input_arg, -1);
1417    
1418     Tcl_AppendToObj(rv, "\" is not a recognized non-negative rational number.", -1);
1419     Tcl_SetObjResult(interp, rv);
1420    
1421     TclpFree(string_result);
1422     GMP_RATS_mpq_clear(&rn);
1423    
1424     return(TCL_ERROR);
1425     }
1426    
1427     //OK, we have a rational number, but there is a possibility
1428     //it is negative, which is a no-no. Normalize the signs
1429     //for easier testing.
1430     GMP_RATS_mpq_normalize_sign(&rn);
1431     if (GMP_INTS_mpz_is_neg(&(rn.num)))
1432     {
1433     rv = Tcl_NewStringObj("arbint cfratnum: \"", -1);
1434     Tcl_AppendToObj(rv, input_arg, -1);
1435    
1436     Tcl_AppendToObj(rv, "\" is negative.", -1);
1437     Tcl_SetObjResult(interp, rv);
1438    
1439     TclpFree(string_result);
1440     GMP_RATS_mpq_clear(&rn);
1441    
1442     return(TCL_ERROR);
1443     }
1444    
1445     //OK, we have a rational number. Form the continued fraction
1446     //decomposition of it. The function called is set up so that
1447     //one must deallocate, even in an error condition.
1448     GMP_RALG_cfdecomp_init(&decomp,
1449     &failure,
1450     &(rn.num),
1451     &(rn.den));
1452    
1453     //If we failed in the decomposition (don't know why that would
1454     //happen) use the general error flag "NAN".
1455     if (failure)
1456     {
1457     rv = Tcl_NewStringObj("NAN", -1);
1458    
1459     Tcl_SetObjResult(interp, rv);
1460    
1461     TclpFree(string_result);
1462     GMP_RATS_mpq_clear(&rn);
1463     GMP_RALG_cfdecomp_destroy(&decomp);
1464    
1465     return(TCL_ERROR);
1466     }
1467    
1468     //OK, that really is the last error we could have.
1469     //Iterate, adding the partial quotients and convergents
1470     //to the string which we'll return. We need to watch out
1471     //for running over our 10K buffer.
1472     rv = Tcl_NewStringObj("", -1);
1473     for (i=0; i<decomp.n; i++)
1474     {
1475     //Partial quotient.
1476     chars_reqd = GMP_INTS_mpz_size_in_base_10(&(decomp.a[i]));
1477     if (chars_reqd > (unsigned)n_string_result)
1478     {
1479     n_string_result = chars_reqd;
1480     string_result = TclpRealloc(string_result,
1481     sizeof(char) * n_string_result);
1482     }
1483     GMP_INTS_mpz_to_string(string_result, &(decomp.a[i]));
1484     Tcl_AppendToObj(rv, string_result, -1);
1485     Tcl_AppendToObj(rv, " ", -1);
1486    
1487     //Numerator of convergent.
1488     chars_reqd = GMP_INTS_mpz_size_in_base_10(&(decomp.p[i]));
1489     if (chars_reqd > (unsigned)n_string_result)
1490     {
1491     n_string_result = chars_reqd;
1492     string_result = TclpRealloc(string_result,
1493     sizeof(char) * n_string_result);
1494     }
1495     GMP_INTS_mpz_to_string(string_result, &(decomp.p[i]));
1496     Tcl_AppendToObj(rv, string_result, -1);
1497     Tcl_AppendToObj(rv, " ", -1);
1498    
1499     //Denominator of convergent.
1500     chars_reqd = GMP_INTS_mpz_size_in_base_10(&(decomp.q[i]));
1501     if (chars_reqd > (unsigned)n_string_result)
1502     {
1503     n_string_result = chars_reqd;
1504     string_result = TclpRealloc(string_result,
1505     sizeof(char) * n_string_result);
1506     }
1507     GMP_INTS_mpz_to_string(string_result, &(decomp.q[i]));
1508     Tcl_AppendToObj(rv, string_result, -1);
1509     if (i != (decomp.n - 1)) //No space after last number.
1510     Tcl_AppendToObj(rv, " ", -1);
1511     }
1512    
1513     //Assign the result to be the return value.
1514     Tcl_SetObjResult(interp, rv);
1515    
1516     //Free up all dynamic memory.
1517     TclpFree(string_result);
1518     GMP_RATS_mpq_clear(&rn);
1519     GMP_RALG_cfdecomp_destroy(&decomp);
1520    
1521     //Return
1522     return(TCL_OK);
1523     }
1524     }
1525    
1526    
1527     //Handles the "commanate" subextension.
1528     //07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
1529     //from memory an intuition as far as how to set return results and so forth.
1530     static
1531     int ARBLENINTS_commanate_handler(ClientData dummy,
1532     Tcl_Interp *interp,
1533     int objc,
1534     Tcl_Obj *objv[])
1535     {
1536     Tcl_Obj *rv;
1537    
1538     //We must have one and exactly one additional argument
1539     //to this function, which is the string we want to
1540     //commanate.
1541     if (objc != 3)
1542     {
1543     Tcl_WrongNumArgs(interp,
1544     2,
1545     objv,
1546     "sint");
1547     return(TCL_ERROR);
1548     }
1549     else
1550     {
1551     char *string_arg;
1552    
1553     //Grab a pointer to the string representation of
1554     //the input argument. The storage does not belong to us.
1555     string_arg = Tcl_GetString(objv[2]);
1556     assert(string_arg != NULL);
1557    
1558     //Try to parse the string as one of the error tags.
1559     //If it is one of those, it isn't an error, but don't
1560     //want to touch the string.
1561     if (GMP_INTS_identify_nan_string(string_arg) >= 0)
1562     {
1563     rv = Tcl_NewStringObj(string_arg, -1);
1564     Tcl_SetObjResult(interp, rv);
1565     return(TCL_OK);
1566     }
1567     //Try to parse it as a signed integer with commas already.
1568     //If it already has commas, there is no need to add any.
1569     else if (BSTRFUNC_is_sint_w_commas(string_arg))
1570     {
1571     //This is already an acceptable commanated signed integer. Send it
1572     //back as the return value.
1573     rv = Tcl_NewStringObj(string_arg, -1);
1574     Tcl_SetObjResult(interp, rv);
1575     return(TCL_OK);
1576     }
1577     //Try to parse the argument as a signed integer without commas.
1578     //If it is one of those, commanate it and return it.
1579     else if (BSTRFUNC_is_sint_wo_commas(string_arg))
1580     {
1581     size_t len;
1582     char *buffer;
1583    
1584     len = strlen(string_arg);
1585     buffer = TclpAlloc(((sizeof(char) * 4 * len) / 3) + 10);
1586     strcpy(buffer, string_arg);
1587     BSTRFUNC_commanate(buffer);
1588     rv = Tcl_NewStringObj(buffer, -1);
1589     TclpFree(buffer);
1590     Tcl_SetObjResult(interp, rv);
1591     return(TCL_OK);
1592     }
1593     else
1594     {
1595     //Error case. Must give error message.
1596     rv = Tcl_NewStringObj("arbint commanate: \"", -1);
1597     Tcl_AppendToObj(rv, string_arg, -1);
1598     Tcl_AppendToObj(rv, "\" is not a recognized integer.", -1);
1599     Tcl_SetObjResult(interp, rv);
1600     return(TCL_ERROR);
1601     }
1602     }
1603     }
1604    
1605    
1606     //Handles the "const" subextension.
1607     //08/17/01: Visual inspection OK.
1608     static
1609     int ARBLENINTS_const_handler(ClientData dummy,
1610     Tcl_Interp *interp,
1611     int objc,
1612     Tcl_Obj *objv[])
1613     {
1614     //Table of constants used.
1615     static struct
1616     {
1617     char *tag;
1618     //The symbolic tag used to identify the number.
1619     char *desc;
1620     //The full description of the number. It must consist
1621     //of a string with lines no longer than about 70 chars,
1622     //separated by newlines, and indented by 6 spaces.
1623     char *minmant;
1624     //The minimum mantissa or minimum representation.
1625     //May not be empty or NULL.
1626     char *mantrem;
1627     //The remaining mantissa or remaining portion of
1628     //number. May be empty, but may not be NULL.
1629     char *exp;
1630     //The exponent portion, if any, or NULL otherwise.
1631     int deflen;
1632     //The default number of digits for the constant
1633     //if none is specified.
1634     int digit_count_offset;
1635     //The offset to go from string length of mantissa
1636     //portions to number of digits. Cheap way to adjust
1637     //for - sign and decimal point.
1638     } tbl[] =
1639     {
1640     //e--the transcendental number e.
1641     {
1642     //tag
1643     "e",
1644     //desc
1645     " Historically significant transcendental constant. Digits obtained\n"
1646     " from http://fermi.udw.ac.za/physics/e.html on 08/17/01.",
1647     //minmant
1648     "2.7",
1649     //mantrem
1650     "182818284590452353602874713526624977572470936999595749669676277240766303535"
1651     "475945713821785251664274274663919320030599218174135966290435729003342952605956"
1652     "307381323286279434907632338298807531952510190115738341879307021540891499348841"
1653     "675092447614606680822648001684774118537423454424371075390777449920695517027618"
1654     "386062613313845830007520449338265602976067371132007093287091274437470472306969"
1655     "772093101416928368190255151086574637721112523897844250569536967707854499699679"
1656     "468644549059879316368892300987931277361782154249992295763514822082698951936680"
1657     "331825288693984964651058209392398294887933203625094431173012381970684161403970"
1658     "198376793206832823764648042953118023287825098194558153017567173613320698112509"
1659     "961818815930416903515988885193458072738667385894228792284998920868058257492796"
1660     "104841984443634632449684875602336248270419786232090021609902353043699418491463"
1661     "140934317381436405462531520961836908887070167683964243781405927145635490613031"
1662     "07208510383750510115747704171898610687396965521267154688957035035",
1663     //exp
1664     NULL,
1665     //deflen
1666     30,
1667     //digit_count_offset
1668     1
1669     },
1670     //g_metric
1671     {
1672     //tag
1673     "g_si",
1674     //desc
1675     " Gravitational acceleration in SI units, meters per second**2.\n"
1676     " Obtained from NIST Special Publication 811 on 08/17/01.",
1677     //minmant
1678     "9.80665",
1679     //mantrem
1680     "",
1681     //exp
1682     NULL,
1683     //deflen
1684     30,
1685     //digit_count_offset
1686     1
1687     },
1688     //in2m
1689     {
1690     //tag
1691     "in2m",
1692     //desc
1693     " Multiplicative conversion factor from inches to meters.\n"
1694     " Obtained from NIST Special Publication 811 on 08/17/01.",
1695     //minmant
1696     "2.54",
1697     //mantrem
1698     "",
1699     //exp
1700     "e-2",
1701     //deflen
1702     30,
1703     //digit_count_offset
1704     1
1705     },
1706     //mi2km
1707     {
1708     //tag
1709     "mi2km",
1710     //desc
1711     " Multiplicative conversion factor from miles to kilometers.\n"
1712     " Obtained from NIST Special Publication 811 on 08/17/01.",
1713     //minmant
1714     "1.609344",
1715     //mantrem
1716     "",
1717     //exp
1718     NULL,
1719     //deflen
1720     30,
1721     //digit_count_offset
1722     1
1723     },
1724     //pi--the transcendental number PI.
1725     {
1726     //tag
1727     "pi",
1728     //desc
1729     " Transcendental constant supplying ratio of a circle's circumference\n"
1730     " to its diameter. Digits obtained from http://www.joyofpi.com/\n"
1731     " pi.htm on 08/17/01.",
1732     //minmant
1733     "3.14",
1734     //mantrem
1735     "15926535897932384626433832795028841971"
1736     "6939937510582097494459230781640628620899"
1737     "8628034825342117067982148086513282306647"
1738     "0938446095505822317253594081284811174502"
1739     "8410270193852110555964462294895493038196"
1740     "4428810975665933446128475648233786783165"
1741     "2712019091456485669234603486104543266482"
1742     "1339360726024914127372458700660631558817"
1743     "4881520920962829254091715364367892590360"
1744     "0113305305488204665213841469519415116094"
1745     "3305727036575959195309218611738193261179"
1746     "3105118548074462379962749567351885752724"
1747     "8912279381830119491298336733624406566430"
1748     "8602139494639522473719070217986094370277"
1749     "0539217176293176752384674818467669405132"
1750     "0005681271452635608277857713427577896091"
1751     "7363717872146844090122495343014654958537"
1752     "1050792279689258923542019956112129021960"
1753     "8640344181598136297747713099605187072113"
1754     "4999999837297804995105973173281609631859"
1755     "5024459455346908302642522308253344685035"
1756     "2619311881710100031378387528865875332083"
1757     "8142061717766914730359825349042875546873"
1758     "1159562863882353787593751957781857780532"
1759     "1712268066130019278766111959092164201989"
1760     "3809525720106548586327886593615338182796"
1761     "8230301952035301852968995773622599413891"
1762     "2497217752834791315155748572424541506959"
1763     "5082953311686172785588907509838175463746"
1764     "4939319255060400927701671139009848824012",
1765     //exp
1766     NULL,
1767     //deflen
1768     30,
1769     //digit_count_offset
1770     1
1771     },
1772     //sqrt5--the square root of 5.
1773     {
1774     //tag
1775     "sqrt5",
1776     //desc
1777     " The square root of 5. Digits obtained from\n"
1778     " http://home.earthlink.net/~maryski/sqrt51000000.txt on 08/17/01.",
1779     //minmant
1780     "2.236",
1781     //mantrem
1782     "0679774997896964091736687312762354406183596115257242708972454105209256378048"
1783     "99414414408378782274969508176150773783504253267724447073863586360121533452708866"
1784     "77817319187916581127664532263985658053576135041753378500342339241406444208643253"
1785     "90972525926272288762995174024406816117759089094984923713907297288984820886415426"
1786     "89894099131693577019748678884425089754132956183176921499977424801530434115035957"
1787     "66833251249881517813940800056242085524354223555610630634282023409333198293395974"
1788     "63522712013417496142026359047378855043896870611356600457571399565955669569175645"
1789     "78221952500060539231234005009286764875529722056766253666074485853505262330678494"
1790     "63342224231763727702663240768010444331582573350589309813622634319868647194698997"
1791     "01808189524264459620345221411922329125981963258111041704958070481204034559949435"
1792     "06855551855572512388641655010262436312571024449618789424682903404474716115455723"
1793     "20173767659046091852957560357798439805415538077906439363972302875606299948221385"
1794     "21773485924535151210463455550407072278724215347787529112121211843317893351910380",
1795     //exp
1796     NULL,
1797     //deflen
1798     30,
1799     //digit_count_offset
1800     1
1801     },
1802     };
1803    
1804     Tcl_Obj *rv;
1805     //Value that will be returned to caller.
1806     int i;
1807     //Iteration variable.
1808     int tbl_idx;
1809     //Index into lookup table, of -1 if not found.
1810     int ndigits;
1811     //The number of digits to supply.
1812     int result_code;
1813     //Return value from Tcl library function.
1814    
1815     //We must have either one or two additional arguments.
1816     if ((objc != 3) && (objc != 4))
1817     {
1818     Tcl_WrongNumArgs(interp,
1819     2,
1820     objv,
1821     "constant_tag ?ndigits?");
1822     return(TCL_ERROR);
1823     }
1824     else
1825     {
1826     char *string_arg;
1827    
1828     //Grab a pointer to the string representation of
1829     //the input argument. The storage does not belong to us.
1830     string_arg = Tcl_GetString(objv[2]);
1831     assert(string_arg != NULL);
1832    
1833     //Try to look up the string argument in the table.
1834     tbl_idx = -1;
1835     for (i=0; i<sizeof(tbl)/sizeof(tbl[0]); i++)
1836     {
1837     if (!strcmp(string_arg, tbl[i].tag))
1838     {
1839     tbl_idx = i;
1840     break;
1841     }
1842     }
1843    
1844     //If the tag was not found in the table, print a hostile
1845     //message and abort.
1846     if (tbl_idx == -1)
1847     {
1848     char buf[100];
1849    
1850     //Error case. Must give error message.
1851     //Must also list the constants available.
1852     rv = Tcl_NewStringObj("arbint const: \"", -1);
1853     Tcl_AppendToObj(rv, string_arg, -1);
1854     Tcl_AppendToObj(rv, "\" is not a recognized constant.\n", -1);
1855    
1856     Tcl_AppendToObj(rv, "Available constants are:\n", -1);
1857    
1858     for (i=0; i<sizeof(tbl)/sizeof(tbl[0]); i++)
1859     {
1860     Tcl_AppendToObj(rv, " ", -1);
1861     Tcl_AppendToObj(rv, tbl[i].tag, -1);
1862     sprintf(buf, " (%d digits available)\n",
1863     strlen(tbl[i].minmant) + strlen(tbl[i].mantrem) - tbl[i].digit_count_offset);
1864     Tcl_AppendToObj(rv, buf, -1);
1865     Tcl_AppendToObj(rv, tbl[i].desc, -1);
1866     if (i != (sizeof(tbl)/sizeof(tbl[0]) - 1))
1867     Tcl_AppendToObj(rv, "\n", -1);
1868     }
1869    
1870     Tcl_SetObjResult(interp, rv);
1871     return(TCL_ERROR);
1872     }
1873    
1874     //Make assertions about the string pointers.
1875     assert(tbl[tbl_idx].tag != NULL);
1876     assert(tbl[tbl_idx].desc != NULL);
1877     assert(tbl[tbl_idx].minmant != NULL);
1878     assert(tbl[tbl_idx].mantrem != NULL);
1879    
1880     //Assume the default number of digits by default.
1881     ndigits = tbl[tbl_idx].deflen;
1882    
1883     //If there is an additional parameter, try to interpret
1884     //that as the number of digits.
1885     if (objc == 4)
1886     {
1887     //SetIntFromAny(interp, objPtr)
1888     result_code = Tcl_GetIntFromObj(NULL, objv[3], &ndigits);
1889    
1890     if (result_code != TCL_OK)
1891     {
1892     //Could not obtain an integer. Use hostile error
1893     //message and abort.
1894     string_arg = Tcl_GetString(objv[3]);
1895     assert(string_arg != NULL);
1896    
1897     rv = Tcl_NewStringObj("arbint const: \"", -1);
1898     Tcl_AppendToObj(rv, string_arg, -1);
1899     Tcl_AppendToObj(rv, "\" is not a recognized integer.", -1);
1900     Tcl_SetObjResult(interp, rv);
1901     return(TCL_ERROR);
1902     }
1903     }
1904    
1905     //Ndigits may be corrupt. We have to be careful below to not
1906     //allow any funny stuff.
1907     rv = Tcl_NewStringObj(tbl[tbl_idx].minmant, -1);
1908     ndigits = ndigits - strlen(tbl[tbl_idx].minmant) + tbl[tbl_idx].digit_count_offset;
1909     if (ndigits > 0)
1910     {
1911     if (ndigits >= (int)strlen(tbl[tbl_idx].mantrem))
1912     {
1913     Tcl_AppendToObj(rv, tbl[tbl_idx].mantrem, -1);
1914     }
1915     else
1916     {
1917     Tcl_AppendToObj(rv, tbl[tbl_idx].mantrem, ndigits);
1918     }
1919     }
1920    
1921     //Append the exponent portion.
1922     if (tbl[tbl_idx].exp)
1923     Tcl_AppendToObj(rv, tbl[tbl_idx].exp, -1);
1924    
1925     //Default successful return.
1926     Tcl_SetObjResult(interp, rv);
1927     return(TCL_OK);
1928     }
1929     }
1930    
1931    
1932     //Handles the "decommanate" subextension.
1933     //07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
1934     //from memory an intuition as far as how to set return results and so forth.
1935     static
1936     int ARBLENINTS_decommanate_handler(ClientData dummy,
1937     Tcl_Interp *interp,
1938     int objc,
1939     Tcl_Obj *objv[])
1940     {
1941     Tcl_Obj *rv;
1942    
1943     //We must have one and exactly one additional argument
1944     //to this function, which is the string we want to
1945     //decommanate.
1946     if (objc != 3)
1947     {
1948     Tcl_WrongNumArgs(interp,
1949     2,
1950     objv,
1951     "sint");
1952     return(TCL_ERROR);
1953     }
1954     else
1955     {
1956     char *string_arg;
1957    
1958     //Grab a pointer to the string representation of
1959     //the input argument. The storage does not belong to us.
1960     string_arg = Tcl_GetString(objv[2]);
1961     assert(string_arg != NULL);
1962    
1963     //Try to parse the string as one of the error tags.
1964     //If it is one of those, it isn't an error, but don't
1965     //want to touch the string.
1966     if (GMP_INTS_identify_nan_string(string_arg) >= 0)
1967     {
1968     rv = Tcl_NewStringObj(string_arg, -1);
1969     Tcl_SetObjResult(interp, rv);
1970     return(TCL_OK);
1971     }
1972     //Try to parse it as a signed integer without commas.
1973     //If it has no commas, there is no need to decommanate it.
1974     else if (BSTRFUNC_is_sint_wo_commas(string_arg))
1975     {
1976     //This is already an acceptable commanated signed integer. Send it
1977     //back as the return value.
1978     rv = Tcl_NewStringObj(string_arg, -1);
1979     Tcl_SetObjResult(interp, rv);
1980     return(TCL_OK);
1981     }
1982     //Try to parse the argument as a signed integer with commas.
1983     //If it is one of those, decommanate it and return it.
1984     else if (BSTRFUNC_is_sint_w_commas(string_arg))
1985     {
1986     size_t len;
1987     char *buffer;
1988    
1989     len = strlen(string_arg);
1990     buffer = TclpAlloc(sizeof(char) * len + 1);
1991     strcpy(buffer, string_arg);
1992     BSTRFUNC_decommanate(buffer);
1993     rv = Tcl_NewStringObj(buffer, -1);
1994     TclpFree(buffer);
1995     Tcl_SetObjResult(interp, rv);
1996     return(TCL_OK);
1997     }
1998     else
1999     {
2000     //Error case. Must give error message.
2001     rv = Tcl_NewStringObj("arbint decommanate: \"", -1);
2002     Tcl_AppendToObj(rv, string_arg, -1);
2003     Tcl_AppendToObj(rv, "\" is not a recognized integer.", -1);
2004     Tcl_SetObjResult(interp, rv);
2005     return(TCL_ERROR);
2006     }
2007     }
2008     }
2009    
2010    
2011     //Handles the "intadd" subextension.
2012     //08/06/01: Visual inspection OK.
2013     static
2014     int ARBLENINTS_intadd_handler(ClientData dummy,
2015     Tcl_Interp *interp,
2016     int objc,
2017     Tcl_Obj *objv[])
2018     {
2019     Tcl_Obj *rv;
2020    
2021     //We must have two and exactly two additional arguments
2022     //to this function, which are the integers whose
2023     //sum is to be calculated.
2024     if (objc != 4)
2025     {
2026     Tcl_WrongNumArgs(interp,
2027     2,
2028     objv,
2029     "sint sint");
2030     return(TCL_ERROR);
2031     }
2032     else
2033     {
2034     GMP_INTS_mpz_struct arb_arg1, arb_arg2, arb_result;
2035     char *add_arg1, *add_arg2;
2036     int failure1, failure2;
2037     unsigned chars_reqd;
2038     char *string_result;
2039     int i, j;
2040    
2041     //Allocate space for the arbitrary-length integer result.
2042     GMP_INTS_mpz_init(&arb_arg1);
2043     GMP_INTS_mpz_init(&arb_arg2);
2044     GMP_INTS_mpz_init(&arb_result);
2045    
2046     //Grab pointers to the string representation of
2047     //the input arguments. The storage does not belong to us.
2048     add_arg1 = Tcl_GetString(objv[2]);
2049     assert(add_arg1 != NULL);
2050     add_arg2 = Tcl_GetString(objv[3]);
2051     assert(add_arg2 != NULL);
2052    
2053     //Try to interpret either of the strings as one of the NAN tags.
2054     //If it is one, return the appropriate result for
2055     //a binary operation.
2056     i = GMP_INTS_identify_nan_string(add_arg1);
2057     j = GMP_INTS_identify_nan_string(add_arg2);
2058    
2059     if ((i >= 0) || (j >= 0))
2060     {
2061     const char *p;
2062    
2063     //Find the max of i and j. This isn't a scientific way to tag the
2064     //result, but will be OK. Some information is lost no matter what
2065     //we do.
2066     if (i > j)
2067     ;
2068     else
2069     i = j;
2070    
2071     //i now contains the max.
2072     switch (i)
2073     {
2074     case 0: p = GMP_INTS_supply_nan_string(2);
2075     break;
2076     case 1: p = GMP_INTS_supply_nan_string(3);
2077     break;
2078     case 2: p = GMP_INTS_supply_nan_string(2);
2079     break;
2080     case 3: p = GMP_INTS_supply_nan_string(3);
2081     break;
2082     default:
2083     assert(0);
2084     break;
2085     }
2086    
2087     rv = Tcl_NewStringObj(p, -1);
2088     Tcl_SetObjResult(interp, rv);
2089    
2090     GMP_INTS_mpz_clear(&arb_arg1);
2091     GMP_INTS_mpz_clear(&arb_arg2);
2092     GMP_INTS_mpz_clear(&arb_result);
2093    
2094     return(TCL_OK);
2095     }
2096    
2097     //Try to convert both strings into arbitrary integers.
2098     GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, add_arg1);
2099     GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, add_arg2);
2100    
2101     //If there was a parse failure, we have to return an error
2102     //message. It is possible that both arguments failed the parse,
2103     //but only return one in the error message.
2104     if (failure1 || failure2)
2105     {
2106     rv = Tcl_NewStringObj("arbint intadd: \"", -1);
2107     if (failure1)
2108     Tcl_AppendToObj(rv, add_arg1, -1);
2109     else
2110     Tcl_AppendToObj(rv, add_arg2, -1);
2111    
2112     Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
2113     Tcl_SetObjResult(interp, rv);
2114    
2115     GMP_INTS_mpz_clear(&arb_arg1);
2116     GMP_INTS_mpz_clear(&arb_arg2);
2117     GMP_INTS_mpz_clear(&arb_result);
2118    
2119     return(TCL_ERROR);
2120     }
2121    
2122     //Calculate the sum.
2123     GMP_INTS_mpz_add(&arb_result, &arb_arg1, &arb_arg2);
2124    
2125     //Figure out the number of characters required for
2126     //the output string.
2127     chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
2128    
2129     //Allocate space for the conversion result.
2130     string_result = TclpAlloc(sizeof(char) * chars_reqd);
2131     assert(string_result != NULL);
2132    
2133     //Make the conversion to a character string.
2134     GMP_INTS_mpz_to_string(string_result, &arb_result);
2135    
2136     //Assign the string result to a Tcl object.
2137     rv = Tcl_NewStringObj(string_result, -1);
2138    
2139     //Deallocate the string.
2140     TclpFree(string_result);
2141    
2142     //Deallocate space for the arbitrary-length integers.
2143     GMP_INTS_mpz_clear(&arb_arg1);
2144     GMP_INTS_mpz_clear(&arb_arg2);
2145     GMP_INTS_mpz_clear(&arb_result);
2146    
2147     //Assign the result to be the return value.
2148     Tcl_SetObjResult(interp, rv);
2149    
2150     //Return
2151     return(TCL_OK);
2152     }
2153     }
2154    
2155    
2156     //08/01/01: Visual inspection and some unit testing, OK.
2157     //Handles the "intcmp" subextension.
2158     static
2159     int ARBLENINTS_intcmp_handler(ClientData dummy,
2160     Tcl_Interp *interp,
2161     int objc,
2162     Tcl_Obj *objv[])
2163     {
2164     Tcl_Obj *rv;
2165    
2166     //We must have two and exactly two additional arguments
2167     //to this function, which are the integers to be compared.
2168     if (objc != 4)
2169     {
2170     Tcl_WrongNumArgs(interp,
2171     2,
2172     objv,
2173     "sint sint");
2174     return(TCL_ERROR);
2175     }
2176     else
2177     {
2178     GMP_INTS_mpz_struct arb_arg1, arb_arg2;
2179     char *cmp_arg1, *cmp_arg2;
2180     int failure1, failure2;
2181     int i, j, compare_result;
2182    
2183     //Allocate space for the arbitrary-length integer result.
2184     GMP_INTS_mpz_init(&arb_arg1);
2185     GMP_INTS_mpz_init(&arb_arg2);
2186    
2187     //Grab pointers to the string representation of
2188     //the input arguments. The storage does not belong to us.
2189     cmp_arg1 = Tcl_GetString(objv[2]);
2190     assert(cmp_arg1 != NULL);
2191     cmp_arg2 = Tcl_GetString(objv[3]);
2192     assert(cmp_arg2 != NULL);
2193    
2194     //Try to interpret either of the strings as one of the NAN tags.
2195     //We cannot compare NAN tags. If either is a NAN tag, we must signal an
2196     //error.
2197     i = GMP_INTS_identify_nan_string(cmp_arg1);
2198     j = GMP_INTS_identify_nan_string(cmp_arg2);
2199    
2200     if ((i >= 0) || (j >= 0))
2201     {
2202     rv = Tcl_NewStringObj("arbint intcmp: cannot compare NAN symbolic tags.", -1);
2203     Tcl_SetObjResult(interp, rv);
2204    
2205     GMP_INTS_mpz_clear(&arb_arg1);
2206     GMP_INTS_mpz_clear(&arb_arg2);
2207    
2208     return(TCL_ERROR);
2209     }
2210    
2211     //Try to convert both strings into arbitrary integers.
2212     GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, cmp_arg1);
2213     GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, cmp_arg2);
2214    
2215     //If there was a parse failure, we have to return an error
2216     //message. It is possible that both arguments failed the parse,
2217     //but only return one in the error message.
2218     if (failure1 || failure2)
2219     {
2220     rv = Tcl_NewStringObj("arbint intcmp: \"", -1);
2221     if (failure1)
2222     Tcl_AppendToObj(rv, cmp_arg1, -1);
2223     else
2224     Tcl_AppendToObj(rv, cmp_arg2, -1);
2225    
2226     Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
2227     Tcl_SetObjResult(interp, rv);
2228    
2229     GMP_INTS_mpz_clear(&arb_arg1);
2230     GMP_INTS_mpz_clear(&arb_arg2);
2231    
2232     return(TCL_ERROR);
2233     }
2234    
2235     //Calculate the compare result.
2236     compare_result = GMP_INTS_mpz_cmp(&arb_arg1, &arb_arg2);
2237    
2238     //Assign the return value based on the result.
2239     if (compare_result < 0)
2240     rv = Tcl_NewStringObj("-1", -1);
2241     else if (compare_result == 0)
2242     rv = Tcl_NewStringObj("0", -1);
2243     else
2244     rv = Tcl_NewStringObj("1", -1);
2245    
2246     //Deallocate space for the arbitrary-length integers.
2247     GMP_INTS_mpz_clear(&arb_arg1);
2248     GMP_INTS_mpz_clear(&arb_arg2);
2249    
2250     //Assign the result to be the return value.
2251     Tcl_SetObjResult(interp, rv);
2252    
2253     //Return
2254     return(TCL_OK);
2255     }
2256     }
2257    
2258    
2259     //Handles the "intdiv" subextension.
2260     //07/31/01: Visually inspected, OK.
2261     static
2262     int ARBLENINTS_intdiv_handler(ClientData dummy,
2263     Tcl_Interp *interp,
2264     int objc,
2265     Tcl_Obj *objv[])
2266     {
2267     Tcl_Obj *rv;
2268    
2269     //We must have two and exactly two additional arguments
2270     //to this function, which are the integers whose
2271     //integer quotient is to be calculated.
2272     if (objc != 4)
2273     {
2274     Tcl_WrongNumArgs(interp,
2275     2,
2276     objv,
2277     "sint sint");
2278     return(TCL_ERROR);
2279     }
2280     else
2281     {
2282     GMP_INTS_mpz_struct arb_dividend, arb_divisor, arb_quotient, arb_remainder;
2283     char *dividend_arg1, *divisor_arg2;
2284     int failure1, failure2;
2285     unsigned chars_reqd;
2286     char *string_result;
2287     int i, j;
2288    
2289     //Allocate space for the arbitrary-length integer arguments and results.
2290     GMP_INTS_mpz_init(&arb_dividend);
2291     GMP_INTS_mpz_init(&arb_divisor);
2292     GMP_INTS_mpz_init(&arb_quotient);
2293     GMP_INTS_mpz_init(&arb_remainder);
2294    
2295     //Grab pointers to the string representation of
2296     //the input arguments. The storage does not belong to us.
2297     dividend_arg1 = Tcl_GetString(objv[2]);
2298     assert(dividend_arg1 != NULL);
2299     divisor_arg2 = Tcl_GetString(objv[3]);
2300     assert(divisor_arg2 != NULL);
2301    
2302     //Try to interpret either of the strings as one of the NAN tags.
2303     //If it is one, return the appropriate result for
2304     //a binary operation.
2305     i = GMP_INTS_identify_nan_string(dividend_arg1);
2306     j = GMP_INTS_identify_nan_string(divisor_arg2);
2307    
2308     if ((i >= 0) || (j >= 0))
2309     {
2310     const char *p;
2311    
2312     //Find the max of i and j. This isn't a scientific way to tag the
2313     //result, but will be OK. Some information is lost no matter what
2314     //we do.
2315     if (i > j)
2316     ;
2317     else
2318     i = j;
2319    
2320     //i now contains the max.
2321     switch (i)
2322     {
2323     case 0: p = GMP_INTS_supply_nan_string(2);
2324     break;
2325     case 1: p = GMP_INTS_supply_nan_string(3);
2326     break;
2327     case 2: p = GMP_INTS_supply_nan_string(2);
2328     break;
2329     case 3: p = GMP_INTS_supply_nan_string(3);
2330     break;
2331     default:
2332     assert(0);
2333     break;
2334     }
2335    
2336     rv = Tcl_NewStringObj(p, -1);
2337     Tcl_SetObjResult(interp, rv);
2338    
2339     GMP_INTS_mpz_clear(&arb_dividend);
2340     GMP_INTS_mpz_clear(&arb_divisor);
2341     GMP_INTS_mpz_clear(&arb_quotient);
2342     GMP_INTS_mpz_clear(&arb_remainder);
2343    
2344     return(TCL_OK);
2345     }
2346    
2347     //Try to convert both strings into arbitrary integers.
2348     GMP_INTS_mpz_set_general_int(&arb_dividend, &failure1, dividend_arg1);
2349     GMP_INTS_mpz_set_general_int(&arb_divisor, &failure2, divisor_arg2);
2350    
2351     //If there was a parse failure, we have to return an error
2352     //message. It is possible that both arguments failed the parse,
2353     //but only return one in the error message.
2354     if (failure1 || failure2)
2355     {
2356     rv = Tcl_NewStringObj("arbint intdiv: \"", -1);
2357     if (failure1)
2358     Tcl_AppendToObj(rv, dividend_arg1, -1);
2359     else
2360     Tcl_AppendToObj(rv, divisor_arg2, -1);
2361    
2362     Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
2363     Tcl_SetObjResult(interp, rv);
2364    
2365     GMP_INTS_mpz_clear(&arb_dividend);
2366     GMP_INTS_mpz_clear(&arb_divisor);
2367     GMP_INTS_mpz_clear(&arb_quotient);
2368     GMP_INTS_mpz_clear(&arb_remainder);
2369    
2370     return(TCL_ERROR);
2371     }
2372    
2373     //Calculate the quotient.
2374     GMP_INTS_mpz_tdiv_qr(&arb_quotient, &arb_remainder, &arb_dividend, &arb_divisor);
2375    
2376     //Figure out the number of characters required for
2377     //the output string.
2378     chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_quotient);
2379    
2380     //Allocate space for the conversion result.
2381     string_result = TclpAlloc(sizeof(char) * chars_reqd);
2382     assert(string_result != NULL);
2383    
2384     //Make the conversion to a character string.
2385     GMP_INTS_mpz_to_string(string_result, &arb_quotient);
2386    
2387     //Assign the string result to a Tcl object.
2388     rv = Tcl_NewStringObj(string_result, -1);
2389    
2390     //Deallocate the string.
2391     TclpFree(string_result);
2392    
2393     //Deallocate space for the arbitrary-length integers.
2394     GMP_INTS_mpz_clear(&arb_dividend);
2395     GMP_INTS_mpz_clear(&arb_divisor);
2396     GMP_INTS_mpz_clear(&arb_quotient);
2397     GMP_INTS_mpz_clear(&arb_remainder);
2398    
2399     //Assign the result to be the return value.
2400     Tcl_SetObjResult(interp, rv);
2401    
2402     //Return
2403     return(TCL_OK);
2404     }
2405     }
2406    
2407    
2408     //08/01/01: Visually inspected.
2409     //Handles the "intexp" subextension.
2410     static
2411     int ARBLENINTS_intexp_handler(ClientData dummy,
2412     Tcl_Interp *interp,
2413     int objc,
2414     Tcl_Obj *objv[])
2415     {
2416     Tcl_Obj *rv;
2417    
2418     //We must have two and exactly two additional arguments
2419     //to this function, which are the integers used to
2420     //calculate the exponential.
2421     if (objc != 4)
2422     {
2423     Tcl_WrongNumArgs(interp,
2424     2,
2425     objv,
2426     "sint uint32");
2427     return(TCL_ERROR);
2428     }
2429     else
2430     {
2431     GMP_INTS_mpz_struct arb_arg1, arb_result;
2432     unsigned arg2;
2433     char *str_arg1, *str_arg2;
2434     int failure1, failure2;
2435     unsigned chars_reqd;
2436     char *string_result;
2437     int i, j;
2438    
2439     //Allocate space for the arbitrary-length integers.
2440     GMP_INTS_mpz_init(&arb_arg1);
2441     GMP_INTS_mpz_init(&arb_result);
2442    
2443     //Grab pointers to the string representation of
2444     //the input arguments. The storage does not belong to us.
2445     str_arg1 = Tcl_GetString(objv[2]);
2446     assert(str_arg1 != NULL);
2447     str_arg2 = Tcl_GetString(objv[3]);
2448     assert(str_arg2 != NULL);
2449    
2450     //Try to interpret either of the strings as one of the NAN tags.
2451     //If it is one, return the appropriate result for
2452     //a binary operation.
2453     i = GMP_INTS_identify_nan_string(str_arg1);
2454     j = GMP_INTS_identify_nan_string(str_arg2);
2455    
2456     if ((i >= 0) || (j >= 0))
2457     {
2458     const char *p;
2459    
2460     //Find the max of i and j. This isn't a scientific way to tag the
2461     //result, but will be OK. Some information is lost no matter what
2462     //we do.
2463     if (i > j)
2464     ;
2465     else
2466     i = j;
2467    
2468     //i now contains the max.
2469     switch (i)
2470     {
2471     case 0: p = GMP_INTS_supply_nan_string(2);
2472     break;
2473     case 1: p = GMP_INTS_supply_nan_string(3);
2474     break;
2475     case 2: p = GMP_INTS_supply_nan_string(2);
2476     break;
2477     case 3: p = GMP_INTS_supply_nan_string(3);
2478     break;
2479     default:
2480     assert(0);
2481     break;
2482     }
2483    
2484     rv = Tcl_NewStringObj(p, -1);
2485     Tcl_SetObjResult(interp, rv);
2486    
2487     GMP_INTS_mpz_clear(&arb_arg1);
2488     GMP_INTS_mpz_clear(&arb_result);
2489    
2490     return(TCL_OK);
2491     }
2492    
2493     //Try to convert the first string into arbitrary integers.
2494     //The first string can be anything, including zero or a negative
2495     //arugument.
2496     GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, str_arg1);
2497    
2498     //If the conversion of the first string did not go alright,
2499     //print error message and abort.
2500     if (failure1)
2501     {
2502     rv = Tcl_NewStringObj("arbint intexp: \"", -1);
2503     Tcl_AppendToObj(rv, str_arg1, -1);
2504     Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
2505     Tcl_SetObjResult(interp, rv);
2506    
2507     GMP_INTS_mpz_clear(&arb_arg1);
2508     GMP_INTS_mpz_clear(&arb_result);
2509    
2510     return(TCL_ERROR);
2511     }
2512    
2513    
2514     //Try to convert the second string into an unsigned 32-bit
2515     //integer.
2516     GMP_INTS_mpz_parse_into_uint32(&arg2, &failure2, str_arg2);
2517    
2518     //If the conversion of the second string did not go alright,
2519     //print error message and abort.
2520     if (failure2)
2521     {
2522     rv = Tcl_NewStringObj("arbint intexp: \"", -1);
2523     Tcl_AppendToObj(rv, str_arg2, -1);
2524     Tcl_AppendToObj(rv, "\" is not a recognized unsigned 32-bit integer.", -1);
2525     Tcl_SetObjResult(interp, rv);
2526    
2527     GMP_INTS_mpz_clear(&arb_arg1);
2528     GMP_INTS_mpz_clear(&arb_result);
2529    
2530     return(TCL_ERROR);
2531     }
2532    
2533     //Calculate the exponential.
2534     GMP_INTS_mpz_pow_ui(&arb_result, &arb_arg1, arg2);
2535    
2536     //Figure out the number of characters required for
2537     //the output string.
2538     chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
2539    
2540     //Allocate space for the conversion result.
2541     string_result = TclpAlloc(sizeof(char) * chars_reqd);
2542     assert(string_result != NULL);
2543    
2544     //Make the conversion to a character string.
2545     GMP_INTS_mpz_to_string(string_result, &arb_result);
2546    
2547     //Assign the string result to a Tcl object.
2548     rv = Tcl_NewStringObj(string_result, -1);
2549    
2550     //Deallocate the string.
2551     TclpFree(string_result);
2552    
2553     //Deallocate space for the arbitrary-length integers.
2554     GMP_INTS_mpz_clear(&arb_arg1);
2555     GMP_INTS_mpz_clear(&arb_result);
2556    
2557     //Assign the result to be the return value.
2558     Tcl_SetObjResult(interp, rv);
2559    
2560     //Return
2561     return(TCL_OK);
2562     }
2563     }
2564    
2565    
2566     //Handles the "intfac" subextension.
2567     //07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
2568     //from memory an intuition as far as how to set return results and so forth.
2569     static
2570     int ARBLENINTS_intfac_handler(ClientData dummy,
2571     Tcl_Interp *interp,
2572     int objc,
2573     Tcl_Obj *objv[])
2574     {
2575     Tcl_Obj *rv;
2576    
2577     //We must have one and exactly one additional argument
2578     //to this function, which is the integer whose
2579     //factorial is to be evaluated.
2580     if (objc != 3)
2581     {
2582     Tcl_WrongNumArgs(interp,
2583     2,
2584     objv,
2585     "uint32");
2586     return(TCL_ERROR);
2587     }
2588     else
2589     {
2590     GMP_INTS_mpz_struct arb_result;
2591     char *fac_arg;
2592     int failure;
2593     unsigned fac_ui_arg;
2594     unsigned chars_reqd;
2595     char *string_result;
2596     int i;
2597    
2598     //Allocate space for the arbitrary-length integer result.
2599     GMP_INTS_mpz_init(&arb_result);
2600    
2601     //Grab a pointer to the string representation of
2602     //the input argument. The storage does not belong to us.
2603     fac_arg = Tcl_GetString(objv[2]);
2604     assert(fac_arg != NULL);
2605    
2606     //Try to interpret the string as one of the NAN tags.
2607     //If it is one, return the appropriate result for
2608     //a unary operation.
2609     if ((i = GMP_INTS_identify_nan_string(fac_arg)) >= 0)
2610     {
2611     const char *p;
2612    
2613     switch (i)
2614     {
2615     case 0: p = GMP_INTS_supply_nan_string(2);
2616     break;
2617     case 1: p = GMP_INTS_supply_nan_string(3);
2618     break;
2619     case 2: p = GMP_INTS_supply_nan_string(2);
2620     break;
2621     case 3: p = GMP_INTS_supply_nan_string(3);
2622     break;
2623     default:
2624     assert(0);
2625     break;
2626     }
2627    
2628     rv = Tcl_NewStringObj(p, -1);
2629     Tcl_SetObjResult(interp, rv);
2630     GMP_INTS_mpz_clear(&arb_result);
2631     return(TCL_OK);
2632     }
2633    
2634     //Try to convert the string to a UINT32 using all
2635     //known methods.
2636     GMP_INTS_mpz_parse_into_uint32(&fac_ui_arg, &failure, fac_arg);
2637    
2638     //If there was a parse failure, we have to return an error
2639     //message.
2640     if (failure)
2641     {
2642     rv = Tcl_NewStringObj("arbint intfac: \"", -1);
2643     Tcl_AppendToObj(rv, fac_arg, -1);
2644     Tcl_AppendToObj(rv, "\" is not a recognized 32-bit unsigned integer.", -1);
2645     Tcl_SetObjResult(interp, rv);
2646     GMP_INTS_mpz_clear(&arb_result);
2647     return(TCL_ERROR);
2648     }
2649    
2650     //Calculate the factorial.
2651     GMP_INTS_mpz_fac_ui(&arb_result, fac_ui_arg);
2652    
2653     //Figure out the number of characters required for
2654     //the output string.
2655     chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
2656    
2657     //Allocate space for the conversion result.
2658     string_result = TclpAlloc(sizeof(char) * chars_reqd);
2659     assert(string_result != NULL);
2660    
2661     //Make the conversion to a character string.
2662     GMP_INTS_mpz_to_string(string_result, &arb_result);
2663    
2664     //Assign the string result to a Tcl object.
2665     rv = Tcl_NewStringObj(string_result, -1);
2666    
2667     //Deallocate the string.
2668     TclpFree(string_result);
2669    
2670     //Deallocate space for the arbitrary-length integer.
2671     GMP_INTS_mpz_clear(&arb_result);
2672    
2673     //Assign the result to be the return value.
2674     Tcl_SetObjResult(interp, rv);
2675    
2676     //Return
2677     return(TCL_OK);
2678     }
2679     }
2680    
2681    
2682     //Handles the "intgcd" subextension.
2683     //08/06/01: Visual inspection OK.
2684     static
2685     int ARBLENINTS_intgcd_handler(ClientData dummy,
2686     Tcl_Interp *interp,
2687     int objc,
2688     Tcl_Obj *objv[])
2689     {
2690     Tcl_Obj *rv;
2691    
2692     //We must have two and exactly two additional arguments
2693     //to this function, which are the integers whose
2694     //gcd is to be calculated.
2695     if (objc != 4)
2696     {
2697     Tcl_WrongNumArgs(interp,
2698     2,
2699     objv,
2700     "sint sint");
2701     return(TCL_ERROR);
2702     }
2703     else
2704     {
2705     GMP_INTS_mpz_struct arb_arg1, arb_arg2, arb_result;
2706     char *gcd_arg1, *gcd_arg2;
2707     int failure1, failure2;
2708     unsigned chars_reqd;
2709     char *string_result;
2710     int i, j;
2711    
2712     //Allocate space for the arbitrary-length integer result.
2713     GMP_INTS_mpz_init(&arb_arg1);
2714     GMP_INTS_mpz_init(&arb_arg2);
2715     GMP_INTS_mpz_init(&arb_result);
2716    
2717     //Grab pointers to the string representation of
2718     //the input arguments. The storage does not belong to us.
2719     gcd_arg1 = Tcl_GetString(objv[2]);
2720     assert(gcd_arg1 != NULL);
2721     gcd_arg2 = Tcl_GetString(objv[3]);
2722     assert(gcd_arg2 != NULL);
2723    
2724     //Try to interpret either of the strings as one of the NAN tags.
2725     //If it is one, return the appropriate result for
2726     //a binary operation.
2727     i = GMP_INTS_identify_nan_string(gcd_arg1);
2728     j = GMP_INTS_identify_nan_string(gcd_arg2);
2729    
2730     if ((i >= 0) || (j >= 0))
2731     {
2732     const char *p;
2733    
2734     //Find the max of i and j. This isn't a scientific way to tag the
2735     //result, but will be OK. Some information is lost no matter what
2736     //we do.
2737     if (i > j)
2738     ;
2739     else
2740     i = j;
2741    
2742     //i now contains the max.
2743     switch (i)
2744     {
2745     case 0: p = GMP_INTS_supply_nan_string(2);
2746     break;
2747     case 1: p = GMP_INTS_supply_nan_string(3);
2748     break;
2749     case 2: p = GMP_INTS_supply_nan_string(2);
2750     break;
2751     case 3: p = GMP_INTS_supply_nan_string(3);
2752     break;
2753     default:
2754     assert(0);
2755     break;
2756     }
2757    
2758     rv = Tcl_NewStringObj(p, -1);
2759     Tcl_SetObjResult(interp, rv);
2760    
2761     GMP_INTS_mpz_clear(&arb_arg1);
2762     GMP_INTS_mpz_clear(&arb_arg2);
2763     GMP_INTS_mpz_clear(&arb_result);
2764    
2765     return(TCL_OK);
2766     }
2767    
2768     //Try to convert both strings into arbitrary integers.
2769     GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, gcd_arg1);
2770     GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, gcd_arg2);
2771    
2772     //If there was a parse failure, we have to return an error
2773     //message. It is possible that both arguments failed the parse,
2774     //but only return one in the error message.
2775     if (failure1 || failure2)
2776     {
2777     rv = Tcl_NewStringObj("arbint intgcd: \"", -1);
2778     if (failure1)
2779     Tcl_AppendToObj(rv, gcd_arg1, -1);
2780     else
2781     Tcl_AppendToObj(rv, gcd_arg2, -1);
2782    
2783     Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
2784     Tcl_SetObjResult(interp, rv);
2785    
2786     GMP_INTS_mpz_clear(&arb_arg1);
2787     GMP_INTS_mpz_clear(&arb_arg2);
2788     GMP_INTS_mpz_clear(&arb_result);
2789    
2790     return(TCL_ERROR);
2791     }
2792    
2793     //Calculate the gcd.
2794     GMP_INTS_mpz_gcd(&arb_result, &arb_arg1, &arb_arg2);
2795    
2796     //Figure out the number of characters required for
2797     //the output string.
2798     chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
2799    
2800     //Allocate space for the conversion result.
2801     string_result = TclpAlloc(sizeof(char) * chars_reqd);
2802     assert(string_result != NULL);
2803    
2804     //Make the conversion to a character string.
2805     GMP_INTS_mpz_to_string(string_result, &arb_result);
2806    
2807     //Assign the string result to a Tcl object.
2808     rv = Tcl_NewStringObj(string_result, -1);
2809    
2810     //Deallocate the string.
2811     TclpFree(string_result);
2812    
2813     //Deallocate space for the arbitrary-length integers.
2814     GMP_INTS_mpz_clear(&arb_arg1);
2815     GMP_INTS_mpz_clear(&arb_arg2);
2816     GMP_INTS_mpz_clear(&arb_result);
2817    
2818     //Assign the result to be the return value.
2819     Tcl_SetObjResult(interp, rv);
2820    
2821     //Return
2822     return(TCL_OK);
2823     }
2824     }
2825    
2826    
2827     //Handles the "intlcm" subextension.
2828     //08/10/01: Visual inspection OK.
2829     static
2830     int ARBLENINTS_intlcm_handler(ClientData dummy,
2831     Tcl_Interp *interp,
2832     int objc,
2833     Tcl_Obj *objv[])
2834     {
2835     Tcl_Obj *rv;
2836    
2837     //We must have two and exactly two additional arguments
2838     //to this function, which are the integers whose
2839     //lcm is to be calculated.
2840     if (objc != 4)
2841     {
2842     Tcl_WrongNumArgs(interp,
2843     2,
2844     objv,
2845     "sint sint");
2846     return(TCL_ERROR);
2847     }
2848     else
2849     {
2850     GMP_INTS_mpz_struct arb_arg1, arb_arg2, gcd, remainder, arb_result;
2851     char *lcm_arg1, *lcm_arg2;
2852     int failure1, failure2;
2853     unsigned chars_reqd;
2854     char *string_result;
2855     int i, j;
2856    
2857     //Allocate space for the arbitrary-length integers.
2858     GMP_INTS_mpz_init(&arb_arg1);
2859     GMP_INTS_mpz_init(&arb_arg2);
2860     GMP_INTS_mpz_init(&gcd);
2861     GMP_INTS_mpz_init(&remainder);
2862     GMP_INTS_mpz_init(&arb_result);
2863    
2864     //Grab pointers to the string representation of
2865     //the input arguments. The storage does not belong to us.
2866     lcm_arg1 = Tcl_GetString(objv[2]);
2867     assert(lcm_arg1 != NULL);
2868     lcm_arg2 = Tcl_GetString(objv[3]);
2869     assert(lcm_arg2 != NULL);
2870    
2871     //Try to interpret either of the strings as one of the NAN tags.
2872     //If it is one, return the appropriate result for
2873     //a binary operation.
2874     i = GMP_INTS_identify_nan_string(lcm_arg1);
2875     j = GMP_INTS_identify_nan_string(lcm_arg2);
2876    
2877     if ((i >= 0) || (j >= 0))
2878     {
2879     const char *p;
2880    
2881     //Find the max of i and j. This isn't a scientific way to tag the
2882     //result, but will be OK. Some information is lost no matter what
2883     //we do.
2884     if (i > j)
2885     ;
2886     else
2887     i = j;
2888    
2889     //i now contains the max.
2890     switch (i)
2891     {
2892     case 0: p = GMP_INTS_supply_nan_string(2);
2893     break;
2894     case 1: p = GMP_INTS_supply_nan_string(3);
2895     break;
2896     case 2: p = GMP_INTS_supply_nan_string(2);
2897     break;
2898     case 3: p = GMP_INTS_supply_nan_string(3);
2899     break;
2900     default:
2901     assert(0);
2902     break;
2903     }
2904    
2905     rv = Tcl_NewStringObj(p, -1);
2906     Tcl_SetObjResult(interp, rv);
2907    
2908     GMP_INTS_mpz_clear(&arb_arg1);
2909     GMP_INTS_mpz_clear(&arb_arg2);
2910     GMP_INTS_mpz_clear(&gcd);
2911     GMP_INTS_mpz_clear(&remainder);
2912     GMP_INTS_mpz_clear(&arb_result);
2913    
2914     return(TCL_OK);
2915     }
2916    
2917     //Try to convert both strings into arbitrary integers.
2918     GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, lcm_arg1);
2919     GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, lcm_arg2);
2920    
2921     //If there was a parse failure, we have to return an error
2922     //message. It is possible that both arguments failed the parse,
2923     //but only return one in the error message.
2924     if (failure1 || failure2)
2925     {
2926     rv = Tcl_NewStringObj("arbint intlcm: \"", -1);
2927     if (failure1)
2928     Tcl_AppendToObj(rv, lcm_arg1, -1);
2929     else
2930     Tcl_AppendToObj(rv, lcm_arg2, -1);
2931    
2932     Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
2933     Tcl_SetObjResult(interp, rv);
2934    
2935     GMP_INTS_mpz_clear(&arb_arg1);
2936     GMP_INTS_mpz_clear(&arb_arg2);
2937     GMP_INTS_mpz_clear(&gcd);
2938     GMP_INTS_mpz_clear(&remainder);
2939     GMP_INTS_mpz_clear(&arb_result);
2940    
2941     return(TCL_ERROR);
2942     }
2943    
2944     //Adjust errant arguments.
2945     if (GMP_INTS_mpz_is_neg(&arb_arg1))
2946     GMP_INTS_mpz_negate(&arb_arg1);
2947     else if (GMP_INTS_mpz_is_zero(&arb_arg1))
2948     GMP_INTS_mpz_set_ui(&arb_arg1, 1);
2949     if (GMP_INTS_mpz_is_neg(&arb_arg2))
2950     GMP_INTS_mpz_negate(&arb_arg2);
2951     else if (GMP_INTS_mpz_is_zero(&arb_arg2))
2952     GMP_INTS_mpz_set_ui(&arb_arg2, 1);
2953    
2954     //Calculate the gcd.
2955     GMP_INTS_mpz_gcd(&gcd, &arb_arg1, &arb_arg2);
2956    
2957     //Calculate the lcm.
2958     GMP_INTS_mpz_mul(&arb_arg1, &arb_arg1, &arb_arg2);
2959     GMP_INTS_mpz_tdiv_qr(&arb_result, &remainder,
2960     &arb_arg1, &gcd);
2961    
2962     //Figure out the number of characters required for
2963     //the output string.
2964     chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
2965    
2966     //Allocate space for the conversion result.
2967     string_result = TclpAlloc(sizeof(char) * chars_reqd);
2968     assert(string_result != NULL);
2969    
2970     //Make the conversion to a character string.
2971     GMP_INTS_mpz_to_string(string_result, &arb_result);
2972    
2973     //Assign the string result to a Tcl object.
2974     rv = Tcl_NewStringObj(string_result, -1);
2975    
2976     //Deallocate the string.
2977     TclpFree(string_result);
2978    
2979     //Deallocate space for the arbitrary-length integers.
2980     GMP_INTS_mpz_clear(&arb_arg1);
2981     GMP_INTS_mpz_clear(&arb_arg2);
2982     GMP_INTS_mpz_clear(&gcd);
2983     GMP_INTS_mpz_clear(&remainder);
2984     GMP_INTS_mpz_clear(&arb_result);
2985    
2986     //Assign the result to be the return value.
2987     Tcl_SetObjResult(interp, rv);
2988    
2989     //Return
2990     return(TCL_OK);
2991     }
2992     }
2993    
2994    
2995     //Handles the "intmod" subextension.
2996     //08/06/01: Visual inspection OK.
2997     static
2998     int ARBLENINTS_intmod_handler(ClientData dummy,
2999     Tcl_Interp *interp,
3000     int objc,
3001     Tcl_Obj *objv[])
3002     {
3003     Tcl_Obj *rv;
3004    
3005     //We must have two and exactly two additional arguments
3006     //to this function, which are the integers whose
3007     //integer quotient is to be calculated.
3008     if (objc != 4)
3009     {
3010     Tcl_WrongNumArgs(interp,
3011     2,
3012     objv,
3013     "sint sint");
3014     return(TCL_ERROR);
3015     }
3016     else
3017     {
3018     GMP_INTS_mpz_struct arb_dividend, arb_divisor, arb_quotient, arb_remainder;
3019     char *dividend_arg1, *divisor_arg2;
3020     int failure1, failure2;
3021     unsigned chars_reqd;
3022     char *string_result;
3023     int i, j;
3024    
3025     //Allocate space for the arbitrary-length integer arguments and results.
3026     GMP_INTS_mpz_init(&arb_dividend);
3027     GMP_INTS_mpz_init(&arb_divisor);
3028     GMP_INTS_mpz_init(&arb_quotient);
3029     GMP_INTS_mpz_init(&arb_remainder);
3030    
3031     //Grab pointers to the string representation of
3032     //the input arguments. The storage does not belong to us.
3033     dividend_arg1 = Tcl_GetString(objv[2]);
3034     assert(dividend_arg1 != NULL);
3035     divisor_arg2 = Tcl_GetString(objv[3]);
3036     assert(divisor_arg2 != NULL);
3037    
3038     //Try to interpret either of the strings as one of the NAN tags.
3039     //If it is one, return the appropriate result for
3040     //a binary operation.
3041     i = GMP_INTS_identify_nan_string(dividend_arg1);
3042     j = GMP_INTS_identify_nan_string(divisor_arg2);
3043    
3044     if ((i >= 0) || (j >= 0))
3045     {
3046     const char *p;
3047    
3048     //Find the max of i and j. This isn't a scientific way to tag the
3049     //result, but will be OK. Some information is lost no matter what
3050     //we do.
3051     if (i > j)
3052     ;
3053     else
3054     i = j;
3055    
3056     //i now contains the max.
3057     switch (i)
3058     {
3059     case 0: p = GMP_INTS_supply_nan_string(2);
3060     break;
3061     case 1: p = GMP_INTS_supply_nan_string(3);
3062     break;
3063     case 2: p = GMP_INTS_supply_nan_string(2);
3064     break;
3065     case 3: p = GMP_INTS_supply_nan_string(3);
3066     break;
3067     default:
3068     assert(0);
3069     break;
3070     }
3071    
3072     rv = Tcl_NewStringObj(p, -1);
3073     Tcl_SetObjResult(interp, rv);
3074    
3075     GMP_INTS_mpz_clear(&arb_dividend);
3076     GMP_INTS_mpz_clear(&arb_divisor);
3077     GMP_INTS_mpz_clear(&arb_quotient);
3078     GMP_INTS_mpz_clear(&arb_remainder);
3079    
3080     return(TCL_OK);
3081     }
3082    
3083     //Try to convert both strings into arbitrary integers.
3084     GMP_INTS_mpz_set_general_int(&arb_dividend, &failure1, dividend_arg1);
3085     GMP_INTS_mpz_set_general_int(&arb_divisor, &failure2, divisor_arg2);
3086    
3087     //If there was a parse failure, we have to return an error
3088     //message. It is possible that both arguments failed the parse,
3089     //but only return one in the error message.
3090     if (failure1 || failure2)
3091     {
3092     rv = Tcl_NewStringObj("arbint intmod: \"", -1);
3093     if (failure1)
3094     Tcl_AppendToObj(rv, dividend_arg1, -1);
3095     else
3096     Tcl_AppendToObj(rv, divisor_arg2, -1);
3097    
3098     Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
3099     Tcl_SetObjResult(interp, rv);
3100    
3101     GMP_INTS_mpz_clear(&arb_dividend);
3102     GMP_INTS_mpz_clear(&arb_divisor);
3103     GMP_INTS_mpz_clear(&arb_quotient);
3104     GMP_INTS_mpz_clear(&arb_remainder);
3105    
3106     return(TCL_ERROR);
3107     }
3108    
3109     //Calculate the quotient and remainder.
3110     GMP_INTS_mpz_tdiv_qr(&arb_quotient, &arb_remainder, &arb_dividend, &arb_divisor);
3111    
3112     //Figure out the number of characters required for
3113     //the output string.
3114     chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_remainder);
3115    
3116     //Allocate space for the conversion result.
3117     string_result = TclpAlloc(sizeof(char) * chars_reqd);
3118     assert(string_result != NULL);
3119    
3120     //Make the conversion to a character string.
3121     GMP_INTS_mpz_to_string(string_result, &arb_remainder);
3122    
3123     //Assign the string result to a Tcl object.
3124     rv = Tcl_NewStringObj(string_result, -1);
3125    
3126     //Deallocate the string.
3127     TclpFree(string_result);
3128    
3129     //Deallocate space for the arbitrary-length integers.
3130     GMP_INTS_mpz_clear(&arb_dividend);
3131     GMP_INTS_mpz_clear(&arb_divisor);
3132     GMP_INTS_mpz_clear(&arb_quotient);
3133     GMP_INTS_mpz_clear(&arb_remainder);
3134    
3135     //Assign the result to be the return value.
3136     Tcl_SetObjResult(interp, rv);
3137    
3138     //Return
3139     return(TCL_OK);
3140     }
3141     }
3142    
3143    
3144     //Handles the "intmul" subextension.
3145     //08/06/01: Visual inspection OK.
3146     static
3147     int ARBLENINTS_intmul_handler(ClientData dummy,
3148     Tcl_Interp *interp,
3149     int objc,
3150     Tcl_Obj *objv[])
3151     {
3152     Tcl_Obj *rv;
3153    
3154     //We must have two and exactly two additional arguments
3155     //to this function, which are the integers whose
3156     //product is to be calculated.
3157     if (objc != 4)
3158     {
3159     Tcl_WrongNumArgs(interp,
3160     2,
3161     objv,
3162     "sint sint");
3163     return(TCL_ERROR);
3164     }
3165     else
3166     {
3167     GMP_INTS_mpz_struct arb_arg1, arb_arg2, arb_result;
3168     char *mul_arg1, *mul_arg2;
3169     int failure1, failure2;
3170     unsigned chars_reqd;
3171     char *string_result;
3172     int i, j;
3173    
3174     //Allocate space for the arbitrary-length integer result.
3175     GMP_INTS_mpz_init(&arb_arg1);
3176     GMP_INTS_mpz_init(&arb_arg2);
3177     GMP_INTS_mpz_init(&arb_result);
3178    
3179     //Grab pointers to the string representation of
3180     //the input arguments. The storage does not belong to us.
3181     mul_arg1 = Tcl_GetString(objv[2]);
3182     assert(mul_arg1 != NULL);
3183     mul_arg2 = Tcl_GetString(objv[3]);
3184     assert(mul_arg2 != NULL);
3185    
3186     //Try to interpret either of the strings as one of the NAN tags.
3187     //If it is one, return the appropriate result for
3188     //a binary operation.
3189     i = GMP_INTS_identify_nan_string(mul_arg1);
3190     j = GMP_INTS_identify_nan_string(mul_arg2);
3191    
3192     if ((i >= 0) || (j >= 0))
3193     {
3194     const char *p;
3195    
3196     //Find the max of i and j. This isn't a scientific way to tag the
3197     //result, but will be OK. Some information is lost no matter what
3198     //we do.
3199     if (i > j)
3200     ;
3201     else
3202     i = j;
3203    
3204     //i now contains the max.
3205     switch (i)
3206     {
3207     case 0: p = GMP_INTS_supply_nan_string(2);
3208     break;
3209     case 1: p = GMP_INTS_supply_nan_string(3);
3210     break;
3211     case 2: p = GMP_INTS_supply_nan_string(2);
3212     break;
3213     case 3: p = GMP_INTS_supply_nan_string(3);
3214     break;
3215     default:
3216     assert(0);
3217     break;
3218     }
3219    
3220     rv = Tcl_NewStringObj(p, -1);
3221     Tcl_SetObjResult(interp, rv);
3222    
3223     GMP_INTS_mpz_clear(&arb_arg1);
3224     GMP_INTS_mpz_clear(&arb_arg2);
3225     GMP_INTS_mpz_clear(&arb_result);
3226    
3227     return(TCL_OK);
3228     }
3229    
3230     //Try to convert both strings into arbitrary integers.
3231     GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, mul_arg1);
3232     GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, mul_arg2);
3233    
3234     //If there was a parse failure, we have to return an error
3235     //message. It is possible that both arguments failed the parse,
3236     //but only return one in the error message.
3237     if (failure1 || failure2)
3238     {
3239     rv = Tcl_NewStringObj("arbint intmul: \"", -1);
3240     if (failure1)
3241     Tcl_AppendToObj(rv, mul_arg1, -1);
3242     else
3243     Tcl_AppendToObj(rv, mul_arg2, -1);
3244    
3245     Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
3246     Tcl_SetObjResult(interp, rv);
3247    
3248     GMP_INTS_mpz_clear(&arb_arg1);
3249     GMP_INTS_mpz_clear(&arb_arg2);
3250     GMP_INTS_mpz_clear(&arb_result);
3251    
3252     return(TCL_ERROR);
3253     }
3254    
3255     //Calculate the product.
3256     GMP_INTS_mpz_mul(&arb_result, &arb_arg1, &arb_arg2);
3257    
3258     //Figure out the number of characters required for
3259     //the output string.
3260     chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
3261    
3262     //Allocate space for the conversion result.
3263     string_result = TclpAlloc(sizeof(char) * chars_reqd);
3264     assert(string_result != NULL);
3265    
3266     //Make the conversion to a character string.
3267     GMP_INTS_mpz_to_string(string_result, &arb_result);
3268    
3269     //Assign the string result to a Tcl object.
3270     rv = Tcl_NewStringObj(string_result, -1);
3271    
3272     //Deallocate the string.
3273     TclpFree(string_result);
3274    
3275     //Deallocate space for the arbitrary-length integers.
3276     GMP_INTS_mpz_clear(&arb_arg1);
3277     GMP_INTS_mpz_clear(&arb_arg2);
3278     GMP_INTS_mpz_clear(&arb_result);
3279    
3280     //Assign the result to be the return value.
3281     Tcl_SetObjResult(interp, rv);
3282    
3283     //Return
3284     return(TCL_OK);
3285     }
3286     }
3287    
3288    
3289     //Handles the "intsub" subextension.
3290     //08/06/01: Visual inspection OK.
3291     static
3292     int ARBLENINTS_intsub_handler(ClientData dummy,
3293     Tcl_Interp *interp,
3294     int objc,
3295     Tcl_Obj *objv[])
3296     {
3297     Tcl_Obj *rv;
3298    
3299     //We must have two and exactly two additional arguments
3300     //to this function, which are the integers whose
3301     //difference is to be calculated.
3302     if (objc != 4)
3303     {
3304     Tcl_WrongNumArgs(interp,
3305     2,
3306     objv,
3307     "sint sint");
3308     return(TCL_ERROR);
3309     }
3310     else
3311     {
3312     GMP_INTS_mpz_struct arb_arg1, arb_arg2, arb_result;
3313     char *sub_arg1, *sub_arg2;
3314     int failure1, failure2;
3315     unsigned chars_reqd;
3316     char *string_result;
3317     int i, j;
3318    
3319     //Allocate space for the arbitrary-length integer result.
3320     GMP_INTS_mpz_init(&arb_arg1);
3321     GMP_INTS_mpz_init(&arb_arg2);
3322     GMP_INTS_mpz_init(&arb_result);
3323    
3324     //Grab pointers to the string representation of
3325     //the input arguments. The storage does not belong to us.
3326     sub_arg1 = Tcl_GetString(objv[2]);
3327     assert(sub_arg1 != NULL);
3328     sub_arg2 = Tcl_GetString(objv[3]);
3329     assert(sub_arg2 != NULL);
3330    
3331     //Try to interpret either of the strings as one of the NAN tags.
3332     //If it is one, return the appropriate result for
3333     //a binary operation.
3334     i = GMP_INTS_identify_nan_string(sub_arg1);
3335     j = GMP_INTS_identify_nan_string(sub_arg2);
3336    
3337     if ((i >= 0) || (j >= 0))
3338     {
3339     const char *p;
3340    
3341     //Find the max of i and j. This isn't a scientific way to tag the
3342     //result, but will be OK. Some information is lost no matter what
3343     //we do.
3344     if (i > j)
3345     ;
3346     else
3347     i = j;
3348    
3349     //i now contains the max.
3350     switch (i)
3351     {
3352     case 0: p = GMP_INTS_supply_nan_string(2);
3353     break;
3354     case 1: p = GMP_INTS_supply_nan_string(3);
3355     break;
3356     case 2: p = GMP_INTS_supply_nan_string(2);
3357     break;
3358     case 3: p = GMP_INTS_supply_nan_string(3);
3359     break;
3360     default:
3361     assert(0);
3362     break;
3363     }
3364    
3365     rv = Tcl_NewStringObj(p, -1);
3366     Tcl_SetObjResult(interp, rv);
3367    
3368     GMP_INTS_mpz_clear(&arb_arg1);
3369     GMP_INTS_mpz_clear(&arb_arg2);
3370     GMP_INTS_mpz_clear(&arb_result);
3371    
3372     return(TCL_OK);
3373     }
3374    
3375     //Try to convert both strings into arbitrary integers.
3376     GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, sub_arg1);
3377     GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, sub_arg2);
3378    
3379     //If there was a parse failure, we have to return an error
3380     //message. It is possible that both arguments failed the parse,
3381     //but only return one in the error message.
3382     if (failure1 || failure2)
3383     {
3384     rv = Tcl_NewStringObj("arbint intsub: \"", -1);
3385     if (failure1)
3386     Tcl_AppendToObj(rv, sub_arg1, -1);
3387     else
3388     Tcl_AppendToObj(rv, sub_arg2, -1);
3389    
3390     Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1);
3391     Tcl_SetObjResult(interp, rv);
3392    
3393     GMP_INTS_mpz_clear(&arb_arg1);
3394     GMP_INTS_mpz_clear(&arb_arg2);
3395     GMP_INTS_mpz_clear(&arb_result);
3396    
3397     return(TCL_ERROR);
3398     }
3399    
3400     //Calculate the difference.
3401     GMP_INTS_mpz_sub(&arb_result, &arb_arg1, &arb_arg2);
3402    
3403     //Figure out the number of characters required for
3404     //the output string.
3405     chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result);
3406    
3407     //Allocate space for the conversion result.
3408     string_result = TclpAlloc(sizeof(char) * chars_reqd);
3409     assert(string_result != NULL);
3410    
3411     //Make the conversion to a character string.
3412     GMP_INTS_mpz_to_string(string_result, &arb_result);
3413    
3414     //Assign the string result to a Tcl object.
3415     rv = Tcl_NewStringObj(string_result, -1);
3416    
3417     //Deallocate the string.
3418     TclpFree(string_result);
3419    
3420     //Deallocate space for the arbitrary-length integers.
3421     GMP_INTS_mpz_clear(&arb_arg1);
3422     GMP_INTS_mpz_clear(&arb_arg2);
3423     GMP_INTS_mpz_clear(&arb_result);
3424    
3425     //Assign the result to be the return value.
3426     Tcl_SetObjResult(interp, rv);
3427    
3428     //Return
3429     return(TCL_OK);
3430     }
3431     }
3432    
3433    
3434     //Handles the "iseflag" subextension.
3435     //07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
3436     //from memory an intuition as far as how to set return results and so forth.
3437     static
3438     int ARBLENINTS_iseflag_handler(ClientData dummy,
3439     Tcl_Interp *interp,
3440     int objc,
3441     Tcl_Obj *objv[])
3442     {
3443     Tcl_Obj *rv;
3444    
3445     //We must have one and exactly one additional argument
3446     //to this function, which is the string we want to
3447     //classify.
3448     if (objc != 3)
3449     {
3450     Tcl_WrongNumArgs(interp,
3451     2,
3452     objv,
3453     "stringarg");
3454     return(TCL_ERROR);
3455     }
3456     else
3457     {
3458     char *string_arg;
3459    
3460     //Grab a pointer to the string representation of
3461     //the input argument. The storage does not belong to us.
3462     string_arg = Tcl_GetString(objv[2]);
3463     assert(string_arg != NULL);
3464    
3465     //Try to parse it out. We will definitely get one of
3466     //the return values.
3467     if (!strcmp(string_arg, GMP_INTS_EF_INTOVF_POS_STRING))
3468     {
3469     rv = Tcl_NewStringObj("1", -1);
3470     }
3471     else if (!strcmp(string_arg, GMP_INTS_EF_INTOVF_NEG_STRING))
3472     {
3473     rv = Tcl_NewStringObj("2", -1);
3474     }
3475     else if (!strcmp(string_arg, GMP_INTS_EF_INTOVF_TAINT_POS_STRING))
3476     {
3477     rv = Tcl_NewStringObj("3", -1);
3478     }
3479     else if (!strcmp(string_arg, GMP_INTS_EF_INTOVF_TAINT_NEG_STRING))
3480     {
3481     rv = Tcl_NewStringObj("4", -1);
3482     }
3483     else
3484     {
3485     rv = Tcl_NewStringObj("0", -1);
3486     }
3487    
3488     //Assign the result to be the return value.
3489     Tcl_SetObjResult(interp, rv);
3490    
3491     //Return
3492     return(TCL_OK);
3493     }
3494     }
3495    
3496    
3497     //08/08/01: Visual inspection OK.
3498     static
3499     int ARBLENINTS_rnadd_handler(ClientData dummy,
3500     Tcl_Interp *interp,
3501     int objc,
3502     Tcl_Obj *objv[])
3503     {
3504     Tcl_Obj *rv;
3505    
3506     //We must have exactly two additional arguments
3507     //to this function, which are the rational numbers
3508     //to add.
3509     if (objc != 4)
3510     {
3511     Tcl_WrongNumArgs(interp,
3512     2,
3513     objv,
3514     "srn srn");
3515     return(TCL_ERROR);
3516     }
3517     else
3518     {
3519     char *input_arg;
3520     int failure;
3521     char *string_result;
3522     GMP_RATS_mpq_struct arg1, arg2, result;
3523    
3524     //Allocate space for the rational numbers.
3525     GMP_RATS_mpq_init(&arg1);
3526     GMP_RATS_mpq_init(&arg2);
3527     GMP_RATS_mpq_init(&result);
3528    
3529     //Grab a pointer to the string representation of
3530     //the first input argument. The storage does not belong to us.
3531     input_arg = Tcl_GetString(objv[2]);
3532     assert(input_arg != NULL);
3533    
3534     //Try to parse our first input string as a rational number.
3535     //If we are not successful in this, must abort.
3536     GMP_RATS_mpq_set_all_format_rat_num(input_arg,
3537     &failure,
3538     &arg1);
3539    
3540     if (failure)
3541     {
3542     rv = Tcl_NewStringObj("arbint rnadd: \"", -1);
3543     Tcl_AppendToObj(rv, input_arg, -1);
3544    
3545     Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
3546     Tcl_SetObjResult(interp, rv);
3547    
3548     GMP_RATS_mpq_clear(&arg1);
3549     GMP_RATS_mpq_clear(&arg2);
3550     GMP_RATS_mpq_clear(&result);
3551    
3552     return(TCL_ERROR);
3553     }
3554    
3555     //Grab a pointer to the string representation of
3556     //the second input argument. The storage does not belong to us.
3557     input_arg = Tcl_GetString(objv[3]);
3558     assert(input_arg != NULL);
3559    
3560     //Try to parse our second input string as a rational number.
3561     //If we are not successful in this, must abort.
3562     GMP_RATS_mpq_set_all_format_rat_num(input_arg,
3563     &failure,
3564     &arg2);
3565    
3566     if (failure)
3567     {
3568     rv = Tcl_NewStringObj("arbint rnadd: \"", -1);
3569     Tcl_AppendToObj(rv, input_arg, -1);
3570    
3571     Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
3572     Tcl_SetObjResult(interp, rv);
3573    
3574     GMP_RATS_mpq_clear(&arg1);
3575     GMP_RATS_mpq_clear(&arg2);
3576     GMP_RATS_mpq_clear(&result);
3577    
3578     return(TCL_ERROR);
3579     }
3580    
3581     //Perform the actual addition of the rational numbers. All
3582     //error cases are covered. If either of the inputs has a
3583     //denominator of zero, this will propagate to the result.
3584     GMP_RATS_mpq_add(&result, &arg1, &arg2);
3585    
3586     //If the result has been NAN'd, return the string "NAN".
3587     if (GMP_RATS_mpq_is_nan(&result))
3588     {
3589     rv = Tcl_NewStringObj("NAN", -1);
3590    
3591     Tcl_SetObjResult(interp, rv);
3592    
3593     GMP_RATS_mpq_clear(&arg1);
3594     GMP_RATS_mpq_clear(&arg2);
3595     GMP_RATS_mpq_clear(&result);
3596    
3597     return(TCL_OK);
3598     }
3599    
3600     //Allocate space for the string result which we'll form for
3601     //both numerator and denominator. We need the maximum, because we'll only
3602     //do one number at a time.
3603     string_result = TclpAlloc(sizeof(char)
3604     *
3605     INTFUNC_max
3606     (
3607     GMP_INTS_mpz_size_in_base_10(&(result.num)),
3608     GMP_INTS_mpz_size_in_base_10(&(result.den))
3609     )
3610     );
3611     assert(string_result != NULL);
3612    
3613     //Convert the numerator to a string and set that to be the
3614     //return value.
3615     GMP_INTS_mpz_to_string(string_result, &(result.num));
3616     rv = Tcl_NewStringObj(string_result, -1);
3617    
3618     //Append the separating slash.
3619     Tcl_AppendToObj(rv, "/", -1);
3620    
3621     //Convert the denominator to a string and append that to the
3622     //return value.
3623     GMP_INTS_mpz_to_string(string_result, &(result.den));
3624     Tcl_AppendToObj(rv, string_result, -1);
3625    
3626     //Assign the result to be the return value.
3627     Tcl_SetObjResult(interp, rv);
3628    
3629     //Free up all dynamic memory.
3630     TclpFree(string_result);
3631     GMP_RATS_mpq_clear(&arg1);
3632     GMP_RATS_mpq_clear(&arg2);
3633     GMP_RATS_mpq_clear(&result);
3634    
3635     //Return
3636     return(TCL_OK);
3637     }
3638     }
3639    
3640    
3641     //08/16/01: Visual inspection OK.
3642     static
3643     int ARBLENINTS_rncmp_handler(ClientData dummy,
3644     Tcl_Interp *interp,
3645     int objc,
3646     Tcl_Obj *objv[])
3647     {
3648     Tcl_Obj *rv;
3649    
3650     //We must have exactly two additional arguments
3651     //to this function, which are the rational numbers
3652     //to compare.
3653     if (objc != 4)
3654     {
3655     Tcl_WrongNumArgs(interp,
3656     2,
3657     objv,
3658     "srn srn");
3659     return(TCL_ERROR);
3660     }
3661     else
3662     {
3663     char *input_arg;
3664     int failure, compare_result;
3665     GMP_RATS_mpq_struct arg1, arg2;
3666    
3667     //Allocate space for the rational numbers.
3668     GMP_RATS_mpq_init(&arg1);
3669     GMP_RATS_mpq_init(&arg2);
3670    
3671     //Grab a pointer to the string representation of
3672     //the first input argument. The storage does not belong to us.
3673     input_arg = Tcl_GetString(objv[2]);
3674     assert(input_arg != NULL);
3675    
3676     //Try to parse our first input string as a rational number.
3677     //If we are not successful in this, must abort.
3678     GMP_RATS_mpq_set_all_format_rat_num(input_arg,
3679     &failure,
3680     &arg1);
3681    
3682     if (failure)
3683     {
3684     rv = Tcl_NewStringObj("arbint rncmp: \"", -1);
3685     Tcl_AppendToObj(rv, input_arg, -1);
3686    
3687     Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
3688     Tcl_SetObjResult(interp, rv);
3689    
3690     GMP_RATS_mpq_clear(&arg1);
3691     GMP_RATS_mpq_clear(&arg2);
3692    
3693     return(TCL_ERROR);
3694     }
3695    
3696     //Grab a pointer to the string representation of
3697     //the second input argument. The storage does not belong to us.
3698     input_arg = Tcl_GetString(objv[3]);
3699     assert(input_arg != NULL);
3700    
3701     //Try to parse our second input string as a rational number.
3702     //If we are not successful in this, must abort.
3703     GMP_RATS_mpq_set_all_format_rat_num(input_arg,
3704     &failure,
3705     &arg2);
3706    
3707     if (failure)
3708     {
3709     rv = Tcl_NewStringObj("arbint rncmp: \"", -1);
3710     Tcl_AppendToObj(rv, input_arg, -1);
3711    
3712     Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
3713     Tcl_SetObjResult(interp, rv);
3714    
3715     GMP_RATS_mpq_clear(&arg1);
3716     GMP_RATS_mpq_clear(&arg2);
3717    
3718     return(TCL_ERROR);
3719     }
3720    
3721     //Perform the actual comparison of the rational numbers. All
3722     //error cases are covered. If either of the inputs has a
3723     //denominator of zero, this will propagate to the result.
3724     compare_result = GMP_RATS_mpq_cmp(&arg1, &arg2, &failure);
3725    
3726     //If the failure flag was thrown, we have to throw an error.
3727     //The reason is that if we can't successfully compare the two
3728     //rational numbers, then we have to kill the script--logical
3729     //correctness is not possible.
3730     if (failure)
3731     {
3732     rv = Tcl_NewStringObj("arbint rncmp: can't compare supplied rational numbers.", -1);
3733    
3734     Tcl_SetObjResult(interp, rv);
3735    
3736     GMP_RATS_mpq_clear(&arg1);
3737     GMP_RATS_mpq_clear(&arg2);
3738    
3739     return(TCL_ERROR);
3740     }
3741    
3742     //Convert the comparison result to a string.
3743     if (compare_result < 0)
3744     rv = Tcl_NewStringObj("-1", -1);
3745     else if (compare_result == 0)
3746     rv = Tcl_NewStringObj("0", -1);
3747     else
3748     rv = Tcl_NewStringObj("1", -1);
3749    
3750     //Assign the result to be the return value.
3751     Tcl_SetObjResult(interp, rv);
3752    
3753     //Free up all dynamic memory.
3754     GMP_RATS_mpq_clear(&arg1);
3755     GMP_RATS_mpq_clear(&arg2);
3756    
3757     //Return
3758     return(TCL_OK);
3759     }
3760     }
3761    
3762    
3763     //08/09/01: Visual inspection OK.
3764     static
3765     int ARBLENINTS_rndiv_handler(ClientData dummy,
3766     Tcl_Interp *interp,
3767     int objc,
3768     Tcl_Obj *objv[])
3769     {
3770     Tcl_Obj *rv;
3771    
3772     //We must have exactly two additional arguments
3773     //to this function, which are the rational numbers
3774     //to divide.
3775     if (objc != 4)
3776     {
3777     Tcl_WrongNumArgs(interp,
3778     2,
3779     objv,
3780     "srn srn");
3781     return(TCL_ERROR);
3782     }
3783     else
3784     {
3785     char *input_arg;
3786     int failure;
3787     char *string_result;
3788     GMP_RATS_mpq_struct arg1, arg2, result;
3789    
3790     //Allocate space for the rational numbers.
3791     GMP_RATS_mpq_init(&arg1);
3792     GMP_RATS_mpq_init(&arg2);
3793     GMP_RATS_mpq_init(&result);
3794    
3795     //Grab a pointer to the string representation of
3796     //the first input argument. The storage does not belong to us.
3797     input_arg = Tcl_GetString(objv[2]);
3798     assert(input_arg != NULL);
3799    
3800     //Try to parse our first input string as a rational number.
3801     //If we are not successful in this, must abort.
3802     GMP_RATS_mpq_set_all_format_rat_num(input_arg,
3803     &failure,
3804     &arg1);
3805    
3806     if (failure)
3807     {
3808     rv = Tcl_NewStringObj("arbint rndiv: \"", -1);
3809     Tcl_AppendToObj(rv, input_arg, -1);
3810    
3811     Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
3812     Tcl_SetObjResult(interp, rv);
3813    
3814     GMP_RATS_mpq_clear(&arg1);
3815     GMP_RATS_mpq_clear(&arg2);
3816     GMP_RATS_mpq_clear(&result);
3817    
3818     return(TCL_ERROR);
3819     }
3820    
3821     //Grab a pointer to the string representation of
3822     //the second input argument. The storage does not belong to us.
3823     input_arg = Tcl_GetString(objv[3]);
3824     assert(input_arg != NULL);
3825    
3826     //Try to parse our second input string as a rational number.
3827     //If we are not successful in this, must abort.
3828     GMP_RATS_mpq_set_all_format_rat_num(input_arg,
3829     &failure,
3830     &arg2);
3831    
3832     if (failure)
3833     {
3834     rv = Tcl_NewStringObj("arbint rndiv: \"", -1);
3835     Tcl_AppendToObj(rv, input_arg, -1);
3836    
3837     Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
3838     Tcl_SetObjResult(interp, rv);
3839    
3840     GMP_RATS_mpq_clear(&arg1);
3841     GMP_RATS_mpq_clear(&arg2);
3842     GMP_RATS_mpq_clear(&result);
3843    
3844     return(TCL_ERROR);
3845     }
3846    
3847     //Perform the actual division of the rational numbers. All
3848     //error cases are covered. If either of the inputs has a
3849     //denominator of zero, this will propagate to the result.
3850     GMP_RATS_mpq_div(&result, &arg1, &arg2);
3851    
3852     //If the result has been NAN'd, return the string "NAN".
3853     if (GMP_RATS_mpq_is_nan(&result))
3854     {
3855     rv = Tcl_NewStringObj("NAN", -1);
3856    
3857     Tcl_SetObjResult(interp, rv);
3858    
3859     GMP_RATS_mpq_clear(&arg1);
3860     GMP_RATS_mpq_clear(&arg2);
3861     GMP_RATS_mpq_clear(&result);
3862    
3863     return(TCL_OK);
3864     }
3865    
3866     //Allocate space for the string result which we'll form for
3867     //both numerator and denominator. We need the maximum, because we'll only
3868     //do one number at a time.
3869     string_result = TclpAlloc(sizeof(char)
3870     *
3871     INTFUNC_max
3872     (
3873     GMP_INTS_mpz_size_in_base_10(&(result.num)),
3874     GMP_INTS_mpz_size_in_base_10(&(result.den))
3875     )
3876     );
3877     assert(string_result != NULL);
3878    
3879     //Convert the numerator to a string and set that to be the
3880     //return value.
3881     GMP_INTS_mpz_to_string(string_result, &(result.num));
3882     rv = Tcl_NewStringObj(string_result, -1);
3883    
3884     //Append the separating slash.
3885     Tcl_AppendToObj(rv, "/", -1);
3886    
3887     //Convert the denominator to a string and append that to the
3888     //return value.
3889     GMP_INTS_mpz_to_string(string_result, &(result.den));
3890     Tcl_AppendToObj(rv, string_result, -1);