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

Diff of /projs/ets/trunk/src/c_tclxtens_7_5/arblenints.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

Legend:
Removed from v.68  
changed lines
  Added in v.71

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25