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