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

Diff of /projs/trunk/shared_source/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     &nbs