/[dtapublic]/projs/dtats/tags/0000.00/shared_source/c_tclxtens_7_5/arblenints.c
ViewVC logotype

Contents of /projs/dtats/tags/0000.00/shared_source/c_tclxtens_7_5/arblenints.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 44 - (show annotations) (download)
Fri Oct 14 02:09:58 2016 UTC (8 years, 1 month ago) by dashley
Original Path: projs/trunk/shared_source/c_tclxtens_7_5/arblenints.c
File MIME type: text/plain
File size: 169987 byte(s)
Rename for reorganization.
1 /* $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);
3891
3892 //Assign the result to be the return value.
3893 Tcl_SetObjResult(interp, rv);
3894
3895 //Free up all dynamic memory.
3896 TclpFree(string_result);
3897 GMP_RATS_mpq_clear(&arg1);
3898 GMP_RATS_mpq_clear(&arg2);
3899 GMP_RATS_mpq_clear(&result);
3900
3901 //Return
3902 return(TCL_OK);
3903 }
3904 }
3905
3906
3907 //08/09/01: Visual inspection OK.
3908 static
3909 int ARBLENINTS_rnmul_handler(ClientData dummy,
3910 Tcl_Interp *interp,
3911 int objc,
3912 Tcl_Obj *objv[])
3913 {
3914 Tcl_Obj *rv;
3915
3916 //We must have exactly two additional arguments
3917 //to this function, which are the rational numbers
3918 //to add.
3919 if (objc != 4)
3920 {
3921 Tcl_WrongNumArgs(interp,
3922 2,
3923 objv,
3924 "srn srn");
3925 return(TCL_ERROR);
3926 }
3927 else
3928 {
3929 char *input_arg;
3930 int failure;
3931 char *string_result;
3932 GMP_RATS_mpq_struct arg1, arg2, result;
3933
3934 //Allocate space for the rational numbers.
3935 GMP_RATS_mpq_init(&arg1);
3936 GMP_RATS_mpq_init(&arg2);
3937 GMP_RATS_mpq_init(&result);
3938
3939 //Grab a pointer to the string representation of
3940 //the first input argument. The storage does not belong to us.
3941 input_arg = Tcl_GetString(objv[2]);
3942 assert(input_arg != NULL);
3943
3944 //Try to parse our first input string as a rational number.
3945 //If we are not successful in this, must abort.
3946 GMP_RATS_mpq_set_all_format_rat_num(input_arg,
3947 &failure,
3948 &arg1);
3949
3950 if (failure)
3951 {
3952 rv = Tcl_NewStringObj("arbint rnmul: \"", -1);
3953 Tcl_AppendToObj(rv, input_arg, -1);
3954
3955 Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
3956 Tcl_SetObjResult(interp, rv);
3957
3958 GMP_RATS_mpq_clear(&arg1);
3959 GMP_RATS_mpq_clear(&arg2);
3960 GMP_RATS_mpq_clear(&result);
3961
3962 return(TCL_ERROR);
3963 }
3964
3965 //Grab a pointer to the string representation of
3966 //the second input argument. The storage does not belong to us.
3967 input_arg = Tcl_GetString(objv[3]);
3968 assert(input_arg != NULL);
3969
3970 //Try to parse our second input string as a rational number.
3971 //If we are not successful in this, must abort.
3972 GMP_RATS_mpq_set_all_format_rat_num(input_arg,
3973 &failure,
3974 &arg2);
3975
3976 if (failure)
3977 {
3978 rv = Tcl_NewStringObj("arbint rnmul: \"", -1);
3979 Tcl_AppendToObj(rv, input_arg, -1);
3980
3981 Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
3982 Tcl_SetObjResult(interp, rv);
3983
3984 GMP_RATS_mpq_clear(&arg1);
3985 GMP_RATS_mpq_clear(&arg2);
3986 GMP_RATS_mpq_clear(&result);
3987
3988 return(TCL_ERROR);
3989 }
3990
3991 //Perform the actual multiplication of the rational numbers. All
3992 //error cases are covered. If either of the inputs has a
3993 //denominator of zero, this will propagate to the result.
3994 GMP_RATS_mpq_mul(&result, &arg1, &arg2);
3995
3996 //If the result has been NAN'd, return the string "NAN".
3997 if (GMP_RATS_mpq_is_nan(&result))
3998 {
3999 rv = Tcl_NewStringObj("NAN", -1);
4000
4001 Tcl_SetObjResult(interp, rv);
4002
4003 GMP_RATS_mpq_clear(&arg1);
4004 GMP_RATS_mpq_clear(&arg2);
4005 GMP_RATS_mpq_clear(&result);
4006
4007 return(TCL_OK);
4008 }
4009
4010 //Allocate space for the string result which we'll form for
4011 //both numerator and denominator. We need the maximum, because we'll only
4012 //do one number at a time.
4013 string_result = TclpAlloc(sizeof(char)
4014 *
4015 INTFUNC_max
4016 (
4017 GMP_INTS_mpz_size_in_base_10(&(result.num)),
4018 GMP_INTS_mpz_size_in_base_10(&(result.den))
4019 )
4020 );
4021 assert(string_result != NULL);
4022
4023 //Convert the numerator to a string and set that to be the
4024 //return value.
4025 GMP_INTS_mpz_to_string(string_result, &(result.num));
4026 rv = Tcl_NewStringObj(string_result, -1);
4027
4028 //Append the separating slash.
4029 Tcl_AppendToObj(rv, "/", -1);
4030
4031 //Convert the denominator to a string and append that to the
4032 //return value.
4033 GMP_INTS_mpz_to_string(string_result, &(result.den));
4034 Tcl_AppendToObj(rv, string_result, -1);
4035
4036 //Assign the result to be the return value.
4037 Tcl_SetObjResult(interp, rv);
4038
4039 //Free up all dynamic memory.
4040 TclpFree(string_result);
4041 GMP_RATS_mpq_clear(&arg1);
4042 GMP_RATS_mpq_clear(&arg2);
4043 GMP_RATS_mpq_clear(&result);
4044
4045 //Return
4046 return(TCL_OK);
4047 }
4048 }
4049
4050
4051 //08/09/01: Visual inspection OK.
4052 static
4053 int ARBLENINTS_rnred_handler(ClientData dummy,
4054 Tcl_Interp *interp,
4055 int objc,
4056 Tcl_Obj *objv[])
4057 {
4058 Tcl_Obj *rv;
4059
4060 //We must have exactly one additional argument
4061 //to this function, which is the rational number
4062 //to provide the fully reduced form of.
4063 if (objc != 3)
4064 {
4065 Tcl_WrongNumArgs(interp,
4066 2,
4067 objv,
4068 "srn");
4069 return(TCL_ERROR);
4070 }
4071 else
4072 {
4073 char *input_arg;
4074 int failure;
4075 char *string_result;
4076 GMP_RATS_mpq_struct rn;
4077
4078 //We will need a rational number to hold the return value
4079 //from the parsing function. Allocate that now.
4080 GMP_RATS_mpq_init(&rn);
4081
4082 //Grab a pointer to the string representation of
4083 //the input argument. The storage does not belong to us.
4084 input_arg = Tcl_GetString(objv[2]);
4085 assert(input_arg != NULL);
4086
4087 //Try to parse our input string as a rational number.
4088 //If we are not successful in this, must abort.
4089 GMP_RATS_mpq_set_all_format_rat_num(input_arg,
4090 &failure,
4091 &rn);
4092
4093 if (failure)
4094 {
4095 rv = Tcl_NewStringObj("arbint rnred: \"", -1);
4096 Tcl_AppendToObj(rv, input_arg, -1);
4097
4098 Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
4099 Tcl_SetObjResult(interp, rv);
4100
4101 GMP_RATS_mpq_clear(&rn);
4102
4103 return(TCL_ERROR);
4104 }
4105
4106 //Normalize the rational number. This takes care of the
4107 //sign and also of the coprimality of numerator and
4108 //denominator.
4109 GMP_RATS_mpq_normalize(&rn);
4110
4111 //Allocate space for the string result which we'll form for
4112 //both numbers. We need the maximum, because we'll only
4113 //do one number at a time.
4114 string_result = TclpAlloc(sizeof(char)
4115 *
4116 INTFUNC_max
4117 (
4118 GMP_INTS_mpz_size_in_base_10(&(rn.num)),
4119 GMP_INTS_mpz_size_in_base_10(&(rn.den))
4120 )
4121 );
4122 assert(string_result != NULL);
4123
4124 //Convert the numerator to a string and set that to be the
4125 //return value.
4126 GMP_INTS_mpz_to_string(string_result, &(rn.num));
4127 rv = Tcl_NewStringObj(string_result, -1);
4128
4129 //Append the separating slash.
4130 Tcl_AppendToObj(rv, "/", -1);
4131
4132 //Convert the denominator to a string and append that to the
4133 //return value.
4134 GMP_INTS_mpz_to_string(string_result, &(rn.den));
4135 Tcl_AppendToObj(rv, string_result, -1);
4136
4137 //Assign the result to be the return value.
4138 Tcl_SetObjResult(interp, rv);
4139
4140 //Free up all dynamic memory.
4141 TclpFree(string_result);
4142 GMP_RATS_mpq_clear(&rn);
4143
4144 //Return
4145 return(TCL_OK);
4146 }
4147 }
4148
4149
4150 //08/08/01: Visual inspection OK.
4151 static
4152 int ARBLENINTS_rnsub_handler(ClientData dummy,
4153 Tcl_Interp *interp,
4154 int objc,
4155 Tcl_Obj *objv[])
4156 {
4157 Tcl_Obj *rv;
4158
4159 //We must have exactly two additional arguments
4160 //to this function, which are the rational numbers
4161 //to subtract.
4162 if (objc != 4)
4163 {
4164 Tcl_WrongNumArgs(interp,
4165 2,
4166 objv,
4167 "srn srn");
4168 return(TCL_ERROR);
4169 }
4170 else
4171 {
4172 char *input_arg;
4173 int failure;
4174 char *string_result;
4175 GMP_RATS_mpq_struct arg1, arg2, result;
4176
4177 //Allocate space for the rational numbers.
4178 GMP_RATS_mpq_init(&arg1);
4179 GMP_RATS_mpq_init(&arg2);
4180 GMP_RATS_mpq_init(&result);
4181
4182 //Grab a pointer to the string representation of
4183 //the first input argument. The storage does not belong to us.
4184 input_arg = Tcl_GetString(objv[2]);
4185 assert(input_arg != NULL);
4186
4187 //Try to parse our first input string as a rational number.
4188 //If we are not successful in this, must abort.
4189 GMP_RATS_mpq_set_all_format_rat_num(input_arg,
4190 &failure,
4191 &arg1);
4192
4193 if (failure)
4194 {
4195 rv = Tcl_NewStringObj("arbint rnsub: \"", -1);
4196 Tcl_AppendToObj(rv, input_arg, -1);
4197
4198 Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
4199 Tcl_SetObjResult(interp, rv);
4200
4201 GMP_RATS_mpq_clear(&arg1);
4202 GMP_RATS_mpq_clear(&arg2);
4203 GMP_RATS_mpq_clear(&result);
4204
4205 return(TCL_ERROR);
4206 }
4207
4208 //Grab a pointer to the string representation of
4209 //the second input argument. The storage does not belong to us.
4210 input_arg = Tcl_GetString(objv[3]);
4211 assert(input_arg != NULL);
4212
4213 //Try to parse our second input string as a rational number.
4214 //If we are not successful in this, must abort.
4215 GMP_RATS_mpq_set_all_format_rat_num(input_arg,
4216 &failure,
4217 &arg2);
4218
4219 if (failure)
4220 {
4221 rv = Tcl_NewStringObj("arbint rnsub: \"", -1);
4222 Tcl_AppendToObj(rv, input_arg, -1);
4223
4224 Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1);
4225 Tcl_SetObjResult(interp, rv);
4226
4227 GMP_RATS_mpq_clear(&arg1);
4228 GMP_RATS_mpq_clear(&arg2);
4229 GMP_RATS_mpq_clear(&result);
4230
4231 return(TCL_ERROR);
4232 }
4233
4234 //Perform the actual subtraction of the rational numbers. All
4235 //error cases are covered. If either of the inputs has a
4236 //denominator of zero, this will propagate to the result.
4237 GMP_RATS_mpq_sub(&result, &arg1, &arg2);
4238
4239 //If the result has been NAN'd, return the string "NAN".
4240 if (GMP_RATS_mpq_is_nan(&result))
4241 {
4242 rv = Tcl_NewStringObj("NAN", -1);
4243
4244 Tcl_SetObjResult(interp, rv);
4245
4246 GMP_RATS_mpq_clear(&arg1);
4247 GMP_RATS_mpq_clear(&arg2);
4248 GMP_RATS_mpq_clear(&result);
4249
4250 return(TCL_OK);
4251 }
4252
4253 //Allocate space for the string result which we'll form for
4254 //both numerator and denominator. We need the maximum, because we'll only
4255 //do one number at a time.
4256 string_result = TclpAlloc(sizeof(char)
4257 *
4258 INTFUNC_max
4259 (
4260 GMP_INTS_mpz_size_in_base_10(&(result.num)),
4261 GMP_INTS_mpz_size_in_base_10(&(result.den))
4262 )
4263 );
4264 assert(string_result != NULL);
4265
4266 //Convert the numerator to a string and set that to be the
4267 //return value.
4268 GMP_INTS_mpz_to_string(string_result, &(result.num));
4269 rv = Tcl_NewStringObj(string_result, -1);
4270
4271 //Append the separating slash.
4272 Tcl_AppendToObj(rv, "/", -1);
4273
4274 //Convert the denominator to a string and append that to the
4275 //return value.
4276 GMP_INTS_mpz_to_string(string_result, &(result.den));
4277 Tcl_AppendToObj(rv, string_result, -1);
4278
4279 //Assign the result to be the return value.
4280 Tcl_SetObjResult(interp, rv);
4281
4282 //Free up all dynamic memory.
4283 TclpFree(string_result);
4284 GMP_RATS_mpq_clear(&arg1);
4285 GMP_RATS_mpq_clear(&arg2);
4286 GMP_RATS_mpq_clear(&result);
4287
4288 //Return
4289 return(TCL_OK);
4290 }
4291 }
4292
4293
4294 //This is the search data table of possible subcommands
4295 //for the "arbint" extension. These must be kept
4296 //in alphabetical order, because a binary search is done
4297 //on this table in order to find an entry. If this table
4298 //falls out of alphabetical order, the binary search may
4299 //fail when in fact the entry exists.
4300 //
4301 //In a lot of cases below, this table is set up to accept
4302 //short forms. This is purely undocumented, and I won't put
4303 //it in any documentation. In a lot of cases, these table
4304 //entries cover common mistakes where people forget the "int".
4305 //
4306 static struct EXTNINIT_subextn_bsearch_record_struct
4307 ARBLENINTS_subextn_tbl[] =
4308 {
4309 { "brap", ARBLENINTS_cfbrapab_handler },
4310 { "cfbrapab", ARBLENINTS_cfbrapab_handler },
4311 { "cfratnum", ARBLENINTS_cfratnum_handler },
4312 { "cmp", ARBLENINTS_intcmp_handler },
4313 { "commanate", ARBLENINTS_commanate_handler },
4314 { "compare", ARBLENINTS_intcmp_handler },
4315 { "const", ARBLENINTS_const_handler },
4316 { "decommanate", ARBLENINTS_decommanate_handler },
4317 { "div", ARBLENINTS_intdiv_handler },
4318 { "divide", ARBLENINTS_intdiv_handler },
4319 { "exp", ARBLENINTS_intexp_handler },
4320 { "fac", ARBLENINTS_intfac_handler },
4321 { "factorial", ARBLENINTS_intfac_handler },
4322 { "gcd", ARBLENINTS_intgcd_handler },
4323 { "intadd", ARBLENINTS_intadd_handler },
4324 { "intcmp", ARBLENINTS_intcmp_handler },
4325 { "intdiv", ARBLENINTS_intdiv_handler },
4326 { "intexp", ARBLENINTS_intexp_handler },
4327 { "intfac", ARBLENINTS_intfac_handler },
4328 { "intgcd", ARBLENINTS_intgcd_handler },
4329 { "intlcm", ARBLENINTS_intlcm_handler },
4330 { "intmod", ARBLENINTS_intmod_handler },
4331 { "intmul", ARBLENINTS_intmul_handler },
4332 { "intsub", ARBLENINTS_intsub_handler },
4333 { "iseflag", ARBLENINTS_iseflag_handler },
4334 { "lcm", ARBLENINTS_intlcm_handler },
4335 { "mod", ARBLENINTS_intmod_handler },
4336 { "mul", ARBLENINTS_intmul_handler },
4337 { "multiply", ARBLENINTS_intmul_handler },
4338 { "rnadd", ARBLENINTS_rnadd_handler },
4339 { "rncmp", ARBLENINTS_rncmp_handler },
4340 { "rndiv", ARBLENINTS_rndiv_handler },
4341 { "rnmul", ARBLENINTS_rnmul_handler },
4342 { "rnred", ARBLENINTS_rnred_handler },
4343 { "rnsub", ARBLENINTS_rnsub_handler },
4344 { "times", ARBLENINTS_intmul_handler },
4345 };
4346
4347
4348 //Procedure called when the "arbint" command is encountered in a Tcl script.
4349 //07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
4350 //from memory an intuition as far as how to set return results and so forth.
4351 int ARBLENINTS_arbint_extn_command(ClientData dummy,
4352 Tcl_Interp *interp,
4353 int objc,
4354 Tcl_Obj *objv[])
4355 {
4356 char *subcommand;
4357 //Pointer to subcommand string.
4358 int tbl_entry;
4359 //Index into the subcommand lookup table, or -1
4360 //if no match.
4361 Tcl_Obj *rv;
4362 //The return result (a string) if there is an error.
4363 //In the normal execution case, one of the functions
4364 //above supplies the return object.
4365
4366 if (objc < 2)
4367 {
4368 //It isn't possible to have an object count of less than
4369 //2, because you must have at least the command name
4370 //plus a subcommand. The best way to handle this is
4371 //to indicate wrong number of arguments.
4372 Tcl_WrongNumArgs(interp,
4373 1,
4374 objv,
4375 "option ?args?");
4376 return(TCL_ERROR);
4377 }
4378 else
4379 {
4380 //A potentially appropriate number of arguments has been
4381 //specified. Try to look up the subcommand.
4382
4383 subcommand = Tcl_GetString(objv[1]);
4384 //Grab the string representation of the subcommand.
4385 //This is constant, belongs to Tcl, and cannot be
4386 //modified.
4387
4388 tbl_entry = EXTNINIT_subextension_bsearch(
4389 ARBLENINTS_subextn_tbl,
4390 sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0]),
4391 subcommand);
4392 assert(tbl_entry < (int)(sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0])));
4393
4394 //If the integer returned is zero or positive, should
4395 //run the subfunction. If negative, this is an error and
4396 //should generate meaningful message. A meaningful message
4397 //would definitely consist of all valid subcommands.
4398 if (tbl_entry < 0)
4399 {
4400 //This is an error path.
4401 rv = Tcl_NewStringObj("arbint: bad option \"", -1);
4402 subcommand = Tcl_GetString(objv[1]);
4403 Tcl_AppendToObj(rv, subcommand, -1);
4404 Tcl_AppendToObj(rv, "\": valid options are ", -1);
4405
4406 for (tbl_entry=0;
4407 tbl_entry < sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0]);
4408 tbl_entry++)
4409 {
4410 if ((sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0]) != 1)
4411 && (tbl_entry == sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0]) - 1))
4412 Tcl_AppendToObj(rv, "and ", -1);
4413 Tcl_AppendToObj(rv, ARBLENINTS_subextn_tbl[tbl_entry].name, -1);
4414 if (tbl_entry == sizeof(ARBLENINTS_subextn_tbl)/sizeof(ARBLENINTS_subextn_tbl[0]) - 1)
4415 Tcl_AppendToObj(rv, ".", -1);
4416 else
4417 Tcl_AppendToObj(rv, ", ", -1);
4418 }
4419
4420 //Now, set the return value to be the object with our
4421 //meaningful string message.
4422 Tcl_SetObjResult(interp, rv);
4423
4424 return(TCL_ERROR);
4425 }
4426 else
4427 {
4428 //Call the function pointer. Called function will
4429 //set the string return value.
4430 return((*ARBLENINTS_subextn_tbl[tbl_entry].fptr)
4431 (dummy, interp, objc, objv));
4432 }
4433 }
4434 }
4435
4436
4437 //Performs initial registration to the hash table.
4438 //07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this
4439 //from memory an intuition as far as how to set return results and so forth.
4440 void ARBLENINTS_arbint_extn_init(Tcl_Interp *interp)
4441 {
4442 //Register a command named "crc32".
4443 Tcl_CreateObjCommand(interp,
4444 "arbint",
4445 (Tcl_ObjCmdProc *)ARBLENINTS_arbint_extn_command,
4446 NULL,
4447 NULL);
4448 }
4449
4450
4451
4452 //Returns version control string for file.
4453 //
4454 const char *ARBLENINTS_cvcinfo(void)
4455 {
4456 return ("$Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tclxtens/arblenints.c,v 1.12 2001/08/18 09:47:00 dtashley Exp $");
4457 }
4458
4459
4460 //Returns version control string for associated .H file.
4461 //
4462 const char *ARBLENINTS_hvcinfo(void)
4463 {
4464 return (ARBLENINTS_H_VERSION);
4465 }
4466
4467
4468 //$Log: arblenints.c,v $
4469 //Revision 1.12 2001/08/18 09:47:00 dtashley
4470 //Preparing for test for release of v1.05.
4471 //
4472 //Revision 1.11 2001/08/16 19:49:40 dtashley
4473 //Beginning to prepare for v1.05 release.
4474 //
4475 //Revision 1.10 2001/08/16 12:20:09 dtashley
4476 //Version number changes.
4477 //
4478 //Revision 1.9 2001/08/12 10:20:58 dtashley
4479 //Safety check-in. Substantial progress.
4480 //
4481 //Revision 1.8 2001/08/10 00:53:59 dtashley
4482 //Completion of basic rational number arithmetic utilities and extensions.
4483 //
4484 //Revision 1.7 2001/08/08 02:16:51 dtashley
4485 //Completion of RNRED utility and ARBINT RNRED Tcl extension.
4486 //
4487 //Revision 1.6 2001/08/07 10:42:48 dtashley
4488 //Completion of CFRATNUM extensions and DOS command-line utility.
4489 //
4490 //Revision 1.5 2001/08/01 03:35:29 dtashley
4491 //Finished most primitive integer operations, both as Tcl extensions and
4492 //as DOS command-line utilities, such as addition, subtraction,
4493 //multiplication, division, and modulo.
4494 //
4495 //Revision 1.4 2001/07/30 02:51:18 dtashley
4496 //INTGCD extension and command-line utility finished up.
4497 //
4498 //Revision 1.3 2001/07/29 07:17:04 dtashley
4499 //Completion of ARBINT INTFAC extension.
4500 //
4501 //Revision 1.2 2001/07/28 06:03:57 dtashley
4502 //Safety check-in. Substantial edits.
4503 //
4504 //Revision 1.1 2001/07/27 07:00:56 dtashley
4505 //Initial check-in.
4506 //
4507 //End of ARBLENINTS.C

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25