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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:eol-style native
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25